From 3259b17f532084f23f8b0b52b4f8e06432da2317 Mon Sep 17 00:00:00 2001 From: Till Luca Jensen Date: Mon, 30 Oct 2023 18:40:08 +0100 Subject: [PATCH 01/28] added r6 classes and modified code references --- R/class_analysis_results_r6.R | 2077 +++++++++++++++++++++++++++ R/class_analysis_stage_results_r6.R | 1675 +++++++++++++++++++++ R/class_core_parameter_set_r6.R | 1717 ++++++++++++++++++++++ R/f_analysis_multiarm_means.R | 6 +- R/f_core_assertions.R | 37 +- R/f_core_utilities.R | 53 +- 6 files changed, 5519 insertions(+), 46 deletions(-) create mode 100644 R/class_analysis_results_r6.R create mode 100644 R/class_analysis_stage_results_r6.R create mode 100644 R/class_core_parameter_set_r6.R diff --git a/R/class_analysis_results_r6.R b/R/class_analysis_results_r6.R new file mode 100644 index 00000000..374b162d --- /dev/null +++ b/R/class_analysis_results_r6.R @@ -0,0 +1,2077 @@ +## | +## | *Analysis result classes* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | rpact package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File version: $Revision: 6909 $ +## | Last changed: $Date: 2023-03-31 14:33:51 +0200 (Fr, 31 Mrz 2023) $ +## | Last changed by: $Author: pahlke $ +## | + +#' +#' @name ConditionalPowerResults +#' +#' @title +#' Conditional Power Results +#' +#' @description +#' Class for conditional power calculations +#' +#' @template field_nPlanned +#' @template field_allocationRatioPlanned +#' @template field_iterations +#' @template field_seed +#' @template field_simulated +#' @template field_conditionalPower +#' @template field_thetaH1 +#' @template field_assumedStDev +#' +#' @details +#' This object cannot be created directly; use \code{\link[=getConditionalPower]{getConditionalPower()}} +#' with suitable arguments to create the results of a group sequential or a combination test design. +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +ConditionalPowerResultsR6 <- R6Class("ConditionalPowerResultsR6", + inherit = ParameterSetR6, + public = list( + .plotSettings = NULL, + .design = NULL, + .stageResults = NULL, + .plotData = NULL, + nPlanned = NULL, + allocationRatioPlanned = NULL, + iterations = NULL, + seed = NULL, + simulated = NULL, + initialize = function(..., .design = NULL, .stageResults = NULL, .plotData = NULL, nPlanned = NULL, allocationRatioPlanned = NULL, iterations = NULL, seed = NULL, simulated = NULL) { + self$.design <- .design + self$.stageResults <- .stageResults + self$.plotData <- .plotData + self$nPlanned <- nPlanned + self$allocationRatioPlanned <- allocationRatioPlanned + self$iterations <- iterations + self$seed <- seed + self$simulated <- simulated + + super$initialize(...) + + self$.plotSettings <- PlotSettings() + self$.parameterNames <- C_PARAMETER_NAMES + self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS + + if (!is.null(self$.stageResults) && is.null(self$.design)) { + self$.design <- self$.stageResults$.design + } + + if (is.null(self$simulated) || length(self$simulated) == 0 || is.na(self$simulated)) { + self$simulated <- FALSE + } + + if (!is.null(self$.design) && length(self$.design$kMax) == 1 && self$.design$kMax == 1L) { + self$.setParameterType("nPlanned", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("allocationRatioPlanned", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("conditionalPower", C_PARAM_NOT_APPLICABLE) + } else { + self$.setParameterType("nPlanned", C_PARAM_GENERATED) + self$.setParameterType("allocationRatioPlanned", C_PARAM_USER_DEFINED) + self$.setParameterType("conditionalPower", C_PARAM_GENERATED) + } + self$.setParameterType("simulated", C_PARAM_NOT_APPLICABLE) + }, + show = function(showType = 1, digits = NA_integer_) { + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + }, + .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { + "Method for automatically printing conditional power result objects" + self$.resetCat() + if (showType == 2) { + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + } else { + if (!is.null(self$.design) && length(self$.design$kMax) == 1 && self$.design$kMax == 1) { + self$.cat(self$.toString(), ": not applicable for fixed design (kMax = 1)\n", + heading = 1, + consoleOutputEnabled = consoleOutputEnabled + ) + } else { + self$.cat(self$.toString(), ":\n\n", + heading = 1, + consoleOutputEnabled = consoleOutputEnabled + ) + } + self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Output", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + } + }, + .toString = function(startWithUpperCase = FALSE) { + return("Conditional power results") + } + ) +) + +#' +#' @name ConditionalPowerResultsMeans +#' +#' @title +#' Conditional Power Results Means +#' +#' @description +#' Class for conditional power calculations of means data +#' +#' @template field_nPlanned +#' @template field_allocationRatioPlanned +#' @template field_iterations +#' @template field_seed +#' @template field_simulated +#' @template field_conditionalPower +#' @template field_thetaH1 +#' @template field_assumedStDev +#' +#' @details +#' This object cannot be created directly; use \code{\link{getConditionalPower}} +#' with suitable arguments to create the results of a group sequential or a combination test design. +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +ConditionalPowerResultsMeansR6 <- R6Class("ConditionalPowerResultsMeansR6", + inherit = ConditionalPowerResultsR6, + public = list( + conditionalPower = NULL, + thetaH1 = NULL, + assumedStDev = NULL, + initialize = function(..., conditionalPower = NULL, thetaH1 = NULL, assumedStDev = NULL) { + self$conditionalPower<- conditionalPower + self$thetaH1<- thetaH1 + self$assumedStDev<- assumedStDev + + super$initialize(...) + + if ((is.null(self$conditionalPower) || length(self$conditionalPower) == 0) && + !is.null(self$.design) && !is.null(self$.design$kMax) && length(self$.design$kMax) > 0) { + self$conditionalPower <- rep(NA_real_, self$.design$kMax) + } + + if (is.null(self$thetaH1) || length(self$thetaH1) == 0 || all(is.na(self$thetaH1))) { + self$thetaH1 <- NA_real_ + } + if (is.null(self$assumedStDev) || length(self$assumedStDev) == 0 || all(is.na(self$assumedStDev))) { + self$assumedStDev <- NA_real_ + } + }, + .toString = function(startWithUpperCase = FALSE) { + return("Conditional power results means") + } + ) +) + +ConditionalPowerResultsMultiHypothesesR6 <- R6Class("ConditionalPowerResultsMultiHypothesesR6", + inherit = ConditionalPowerResultsR6, + public = list( + conditionalPower = NULL, + initialize = function(..., conditionalPower = NULL) { + self$conditionalPower <- conditionalPower + super$initialize(...) + + if (self$.readyForInitialization()) { + gMax <- self$getGMax() + kMax <- self$.design$kMax + if (is.null(self$conditionalPower) || (nrow(self$conditionalPower) == 0 && ncol(self$conditionalPower) == 0)) { + self$conditionalPower <- matrix(rep(NA_real_, gMax * kMax), nrow = gMax, ncol = kMax) + } + } + }, + .toString = function(startWithUpperCase = FALSE) { + s <- "Conditional power results" + s <- paste0(s, " ", ifelse(grepl("Enrichment", .getClassName(self$.stageResults)), "enrichment", "multi-arm")) + if (grepl("Means", .getClassName(self))) { + s <- paste0(s, " means") + } else if (grepl("Rates", .getClassName(self))) { + s <- paste0(s, " rates") + } else if (grepl("Survival", .getClassName(self))) { + s <- paste0(s, " survival") + } + return(s) + }, + getGMax = function() { + return(self$.stageResults$getGMax()) + }, + .readyForInitialization = function() { + if (is.null(self$.design)) { + return(FALSE) + } + + if (length(self$.design$kMax) != 1) { + return(FALSE) + } + + if (is.null(self$.stageResults)) { + return(FALSE) + } + + if (is.null(self$.stageResults$testStatistics)) { + return(FALSE) + } + + return(TRUE) + } + ) +) + +ConditionalPowerResultsMultiArmMeansR6 <- R6Class("ConditionalPowerResultsMultiArmMeansR6", + inherit = ConditionalPowerResultsMultiHypothesesR6, + public = list( + thetaH1 = NULL, + assumedStDevs = NULL, + initialize = function(..., thetaH1 = NULL, assumedStDevs = NULL) { + self$thetaH1 <- thetaH1 + self$assumedStDevs <- assumedStDevs + super$initialize(...) + + if (self$.readyForInitialization()) { + gMax <- self$getGMax() + if (is.null(self$thetaH1) || length(self$thetaH1) == 0 || all(is.na(self$thetaH1))) { + self$thetaH1 <- rep(NA_real_, gMax) + } + if (is.null(self$assumedStDevs) || length(self$assumedStDevs) == 0 || all(is.na(self$assumedStDevs))) { + self$assumedStDevs <- rep(NA_real_, gMax) + } + } + } + ) +) + +#' +#' @name ConditionalPowerResultsRates +#' +#' @title +#' Conditional Power Results Rates +#' +#' @description +#' Class for conditional power calculations of rates data +#' +#' @template field_nPlanned +#' @template field_allocationRatioPlanned +#' @template field_iterations +#' @template field_seed +#' @template field_simulated +#' @template field_conditionalPower +#' @template field_pi1 +#' @template field_pi2 +#' +#' @details +#' This object cannot be created directly; use \code{\link{getConditionalPower}} +#' with suitable arguments to create the results of a group sequential or a combination test design. +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +ConditionalPowerResultsRatesR6 <- R6Class("ConditionalPowerResultsRatesR6", + inherit = ConditionalPowerResultsR6, + public = list( + conditionalPower = NULL, + pi1 = NULL, + pi2 = NULL, + initialize = function(..., conditionalPower = NULL, + pi1 = NULL, + pi2 = NULL) { + self$conditionalPower <- conditionalPower + self$pi1 <- pi1 + self$pi2 <- pi2 + + super$initalize(...) + + if ((is.null(self$conditionalPower) || length(self$conditionalPower) == 0) && + !is.null(self$.design) && !is.null(self$.design$kMax) && length(self$.design$kMax) > 0) { + self$conditionalPower <- rep(NA_real_, self$.design$kMax) + } + + if (is.null(self$pi1) || length(self$pi1) == 0 || all(is.na(self$pi1))) { + self$pi1 <- NA_real_ + } + if (is.null(self$pi2) || length(self$pi2) == 0 || all(is.na(self$pi2))) { + self$pi2 <- NA_real_ + } + }, + .toString = function(startWithUpperCase = FALSE) { + return("Conditional power results rates") + } + ) +) + +ConditionalPowerResultsMultiArmRatesR6 <- R6Class("ConditionalPowerResultsMultiArmRatesR6", + inherit = ConditionalPowerResultsMultiHypothesesR6, + public = list( + piTreatments = NULL, + piControl = NULL, + initialize = function(..., piTreatments = NULL, piControl = NULL) { + self$piTreatments <- piTreatments + self$piControl <- piControl + super$initialize(...) + + if (self$.readyForInitialization()) { + gMax <- self$getGMax() + if (is.null(self$piControl) || length(self$piControl) == 0 || all(is.na(self$piControl))) { + self$piControl <- NA_real_ + } + if (is.null(self$piTreatments) || length(self$piTreatments) == 0 || all(is.na(self$piTreatments))) { + self$piTreatments <- rep(NA_real_, gMax) + } + } + } + ) +) + +#' +#' @name ConditionalPowerResultsSurvival +#' +#' @title +#' Conditional Power Results Survival +#' +#' @description +#' Class for conditional power calculations of survival data +#' +#' @template field_nPlanned +#' @template field_allocationRatioPlanned +#' @template field_iterations +#' @template field_seed +#' @template field_simulated +#' @template field_conditionalPower +#' @template field_thetaH1_survival +#' +#' @details +#' This object cannot be created directly; use \code{\link{getConditionalPower}} +#' with suitable arguments to create the results of a group sequential or a combination test design. +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +ConditionalPowerResultsSurvivalR6 <- R6Class("ConditionalPowerResultsSurvivalR6", + inherit = ConditionalPowerResultsR6, + public = list( + conditionalPower = NULL, + thetaH1 = NULL, + initialize = function(..., conditionalPower = NULL, thetaH1 = NULL) { + self$conditionalPower <- conditionalPower + self$thetaH1 <- thetaH1 + super$initialize(...) + + if ((is.null(self$conditionalPower) || length(self$conditionalPower) == 0) && + !is.null(self$.design) && !is.null(self$.design$kMax) && length(self$.design$kMax) > 0) { + self$conditionalPower <- rep(NA_real_, self$.design$kMax) + } + + if (is.null(self$thetaH1) || length(self$thetaH1) == 0 || all(is.na(self$thetaH1))) { + self$thetaH1 <- NA_real_ + } + }, + .toString = function(startWithUpperCase = FALSE) { + return("Conditional power results survival") + } + ) +) + +ConditionalPowerResultsMultiArmSurvivalR6 <- R6Class("ConditionalPowerResultsMultiArmSurvivalR6", + inherit = ConditionalPowerResultsMultiHypothesesR6, + public = list( + thetaH1 = NULL, + initialize = function(..., thetaH1 = NULL) { + self$thetaH1 <- thetaH1 + super$initialize(...) + + if (self$.readyForInitialization()) { + gMax <- self$getGMax() + if (is.null(self$thetaH1) || length(self$thetaH1) == 0 || all(is.na(self$thetaH1))) { + self$thetaH1 <- rep(NA_real_, gMax) + } + } + } + ) +) + +#' +#' @name ConditionalPowerResultsEnrichmentMeans +#' +#' @title +#' Conditional Power Results Enrichment Means +#' +#' @description +#' Class for conditional power calculations of enrichment means data +#' +#' @template field_nPlanned +#' @template field_allocationRatioPlanned +#' @template field_iterations +#' @template field_seed +#' @template field_simulated +#' @template field_conditionalPower +#' @template field_thetaH1 +#' @template field_assumedStDevs +#' +#' @details +#' This object cannot be created directly; use \code{\link{getConditionalPower}} +#' with suitable arguments to create the results of a group sequential or a combination test design. +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +ConditionalPowerResultsEnrichmentMeansR6 <- R6Class("ConditionalPowerResultsEnrichmentMeansR6", + inherit = ConditionalPowerResultsMultiArmMeansR6 +) + +#' +#' @name ConditionalPowerResultsEnrichmentRates +#' +#' @title +#' Conditional Power Results Enrichment Rates +#' +#' @description +#' Class for conditional power calculations of enrichment rates data +#' +#' @template field_nPlanned +#' @template field_allocationRatioPlanned +#' @template field_iterations +#' @template field_seed +#' @template field_simulated +#' @template field_conditionalPower +#' @template field_piTreatments +#' @template field_piControls +#' +#' @details +#' This object cannot be created directly; use \code{\link{getConditionalPower}} +#' with suitable arguments to create the results of a group sequential or a combination test design. +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +ConditionalPowerResultsEnrichmentRatesR6 <- R6Class("ConditionalPowerResultsEnrichmentRatesR6", + inherit = ConditionalPowerResultsMultiHypothesesR6, + public = list( + piTreatments = NULL, + piControls = NULL, + initialize = function(..., piTreatments = NULL, piControls = NULL) { + self$piTreatments <- piTreatments + self$piControls <- piControls + super$initialize(...) + + if (self$.readyForInitialization()) { + gMax <- self$getGMax() + if (is.null(self$piControls) || length(self$piControls) == 0 || all(is.na(self$piControls))) { + self$piControls <- rep(NA_real_, gMax) + } + if (is.null(self$piTreatments) || length(self$piTreatments) == 0 || all(is.na(self$piTreatments))) { + self$piTreatments <- rep(NA_real_, gMax) + } + } + } + ) +) + + +ConditionalPowerResultsEnrichmentSurvivalR6 <- R6Class("ConditionalPowerResultsEnrichmentSurvivalR6", + inherit = ConditionalPowerResultsMultiArmSurvivalR6 +) + +#' +#' @name ClosedCombinationTestResults +#' +#' @title +#' Analysis Results Closed Combination Test +#' +#' @description +#' Class for multi-arm analysis results based on a closed combination test. +#' +#' @template field_intersectionTest +#' @template field_indices +#' @template field_adjustedStageWisePValues +#' @template field_overallAdjustedTestStatistics +#' @template field_separatePValues +#' @template field_conditionalErrorRate +#' @template field_secondStagePValues +#' @template field_rejected +#' @template field_rejectedIntersections +#' +#' @details +#' This object cannot be created directly; use \code{\link{getAnalysisResults}} +#' with suitable arguments to create the multi-arm analysis results of a closed combination test design. +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +ClosedCombinationTestResultsR6 <- R6Class("ClosedCombinationTestResultsR6", + inherit = ParameterSetR6, + public = list( + .plotSettings = NULL, + .design = NULL, + .enrichment = NULL, + intersectionTest = NULL, + indices = NULL, + adjustedStageWisePValues = NULL, + overallAdjustedTestStatistics = NULL, + separatePValues = NULL, + conditionalErrorRate = NULL, + secondStagePValues = NULL, + rejected = NULL, + rejectedIntersections = NULL, + initialize = function(..., .design = NULL, + .enrichment = NULL, + intersectionTest = NULL, + indices = NULL, + adjustedStageWisePValues = NULL, + overallAdjustedTestStatistics = NULL, + separatePValues = NULL, + conditionalErrorRate = NULL, + secondStagePValues = NULL, + rejected = NULL, + rejectedIntersections = NULL) { + self$.design <- .design + self$.enrichment <- .enrichment + self$intersectionTest <- intersectionTest + self$indices <- indices + self$adjustedStageWisePValues <- adjustedStageWisePValues + self$overallAdjustedTestStatistics <- overallAdjustedTestStatistics + self$separatePValues <- separatePValues + self$conditionalErrorRate <- conditionalErrorRate + self$secondStagePValues <- secondStagePValues + self$rejected <- rejected + self$rejectedIntersections <- rejectedIntersections + + super$initialize(...) + + self$.plotSettings <- PlotSettings() + self$.parameterNames <- C_PARAMETER_NAMES + self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS + + self$.setParameterType("intersectionTest", C_PARAM_USER_DEFINED) + + parametersGenerated <- c( + "indices", + "separatePValues", + "rejected", + "rejectedIntersections" + ) + if (inherits(self$.design, "TrialDesignConditionalDunnett")) { + parametersGenerated <- c( + parametersGenerated, + "conditionalErrorRate", + "secondStagePValues" + ) + } else { + parametersGenerated <- c( + parametersGenerated, + "adjustedStageWisePValues", + "overallAdjustedTestStatistics" + ) + } + for (param in parametersGenerated) { + self$.setParameterType(param, C_PARAM_GENERATED) + } + + if (!is.null(self$.design) && inherits(self$.design, C_CLASS_NAME_TRIAL_DESIGN_FISHER)) { + self$.parameterFormatFunctions$overallAdjustedTestStatistics <- ".formatTestStatisticsFisher" + } + }, + show = function(showType = 1, digits = NA_integer_) { + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + }, + .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { + "Method for automatically printing closed combination test result objects" + self$.resetCat() + if (showType == 2) { + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + } else { + self$.cat(self$.toString(), ":\n\n", + heading = 1, + consoleOutputEnabled = consoleOutputEnabled + ) + + self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + + designParametersToShow <- c( + ".design$stages", + ".design$alpha" + ) + if (inherits(self$.design, "TrialDesignConditionalDunnett")) { + designParametersToShow <- c( + designParametersToShow, + ".design$informationAtInterim", + ".design$secondStageConditioning" + ) + } + self$.showParametersOfOneGroup(designParametersToShow, "Design parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + + self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Output", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + + self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) + if (isTRUE(self$.enrichment)) { + self$.cat(paste0(" S[i]: population i\n"), consoleOutputEnabled = consoleOutputEnabled) + self$.cat(paste0(" F: full population\n"), consoleOutputEnabled = consoleOutputEnabled) + } else { + self$.cat(paste0( + " (i): results of treatment arm i vs. control group ", + (nrow(self$separatePValues) + 1), "\n" + ), consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" [i]: hypothesis number\n", + consoleOutputEnabled = consoleOutputEnabled + ) + } + } + }, + .toString = function(startWithUpperCase = FALSE) { + s <- "Closed combination test results" + if (inherits(self$.design, "TrialDesignConditionalDunnett")) { + s <- paste0(s, " (Conditional Dunnett)") + } + return(s) + }, + .getHypothesisTreatmentArms = function(number) { + result <- c() + for (i in 1:ncol(self$indices)) { + if (self$indices[number, i] == 1) { + result <- c(result, i) + } + } + return(result) + }, + .getHypothesisTreatmentArmVariants = function() { + result <- c() + for (number in 1:nrow(self$indices)) { + arms <- self$.getHypothesisTreatmentArms(number) + result <- c(result, paste0(arms, collapse = ", ")) + } + return(result) + }, + .getHypothesisPopulationVariants = function() { + result <- c() + gMax <- 1 + for (number in 1:nrow(self$indices)) { + arms <- self$.getHypothesisTreatmentArms(number) + if (number == 1) { + gMax <- length(arms) + } + arms <- paste0("S", arms) + arms[arms == paste0("S", gMax)] <- "F" + result <- c(result, paste0(arms, collapse = ", ")) + } + return(result) + } + ) +) + +#' +#' @name AnalysisResults +#' +#' @title +#' Basic Class for Analysis Results +#' +#' @description +#' A basic class for analysis results. +#' +#' @details +#' \code{AnalysisResults} is the basic class for +#' \itemize{ +#' \item \code{\link{AnalysisResultsFisher}}, +#' \item \code{\link{AnalysisResultsGroupSequential}}, +#' \item \code{\link{AnalysisResultsInverseNormal}}, +#' \item \code{\link{AnalysisResultsMultiArmFisher}}, +#' \item \code{\link{AnalysisResultsMultiArmInverseNormal}}, +#' \item \code{\link{AnalysisResultsConditionalDunnett}}, +#' \item \code{\link{AnalysisResultsEnrichmentFisher}}, +#' \item \code{\link{AnalysisResultsEnrichmentInverseNormal}}. +#' } +#' +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include class_analysis_dataset.R +#' @include class_design.R +#' @include f_core_constants.R +#' @include class_analysis_stage_results.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +AnalysisResultsR6 <- R6Class("AnalysisResultsR6", + inherit = ParameterSetR6, + public = list( + .plotSettings = NULL, + .design = NULL, + .dataInput = NULL, + .stageResults = NULL, + .conditionalPowerResults = NULL, + normalApproximation = NULL, + directionUpper = NULL, + thetaH0 = NULL, + pi1 = NULL, + pi2 = NULL, + nPlanned = NULL, + allocationRatioPlanned = NULL, + initialize = function(design, dataInput, ..., .stageResults = NULL, .conditionalPowerResults = NULL, directionUpper = NULL, thetaH0 = NULL) { + self$.design <- design + self$.dataInput <- dataInput + self$.stageResults <- .stageResults + self$.conditionalPowerResults <- .conditionalPowerResults + self$directionUpper <- directionUpper + self$thetaH0 <- thetaH0 + + super$initialize(...) + + self$.plotSettings <- PlotSettings() + self$.parameterNames <- .getParameterNames(design = design, analysisResults = self) + self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS + }, + .setStageResults = function(stageResults) { + self$.stageResults <- stageResults + self$.parameterNames <- .getParameterNames(design = self$.design, stageResults = stageResults, analysisResults = self) + }, + getPlotSettings = function() { + return(self$.plotSettings) + }, + show = function(showType = 1, digits = NA_integer_) { + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + }, + .getStageResultParametersToShow = function() { + stageResultParametersToShow <- c() + if (self$.design$kMax > 1) { + if (!grepl("Rates", .getClassName(self$.dataInput)) || self$.dataInput$getNumberOfGroups() > 1) { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$effectSizes") + } + + if (grepl("Means", .getClassName(self$.dataInput))) { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallStDevs") + } + if (grepl("Rates", .getClassName(self$.dataInput))) { + if (.isMultiArmAnalysisResults(self)) { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPiTreatments") + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPiControl") + } else if (.isEnrichmentAnalysisResults(self)) { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPisTreatment") + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPisControl") + } else { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPi1") + if (self$.dataInput$getNumberOfGroups() > 1) { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPi2") + } + } + } + } + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$testStatistics") + if (grepl("(MultiArm|Dunnett|Enrichment)", .getClassName(self))) { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$separatePValues") + } else { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$pValues") + } + + if (self$.design$kMax == 1) { + # return(stageResultParametersToShow) + } + + # show combination test statistics + if (.isTrialDesignInverseNormal(self$.design)) { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$combInverseNormal") + } else if (.isTrialDesignGroupSequential(self$.design)) { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallTestStatistics") + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPValues") + } else if (.isTrialDesignFisher(self$.design)) { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$combFisher") + } + return(stageResultParametersToShow) + }, + .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { + "Method for automatically printing analysis result objects" + self$.resetCat() + if (showType == 2) { + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + } else { + self$.cat(self$.toString(startWithUpperCase = TRUE), ":\n\n", + heading = 1, + consoleOutputEnabled = consoleOutputEnabled + ) + + self$.showParametersOfOneGroup(.getDesignParametersToShow(self), "Design parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + + self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + + self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + + self$.showParametersOfOneGroup(self$.getStageResultParametersToShow(), "Stage results", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + + # show multi-arm parameters + if (grepl("(MultiArm|Dunnett|Enrichment)", .getClassName(self))) { + if (.isTrialDesignConditionalDunnett(self$.design)) { + self$.showParametersOfOneGroup(".closedTestResults$conditionalErrorRate", + "Conditional error rate", + orderByParameterName = FALSE, + consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(".closedTestResults$secondStagePValues", + "Second stage p-values", + orderByParameterName = FALSE, + consoleOutputEnabled = consoleOutputEnabled + ) + } else { + self$.showParametersOfOneGroup(".closedTestResults$adjustedStageWisePValues", + "Adjusted stage-wise p-values", + orderByParameterName = FALSE, + consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(".closedTestResults$overallAdjustedTestStatistics", + "Overall adjusted test statistics", + orderByParameterName = FALSE, + consoleOutputEnabled = consoleOutputEnabled + ) + } + + self$.showParametersOfOneGroup(".closedTestResults$rejected", "Test actions", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + } + + generatedParams <- self$.getGeneratedParameters() + generatedParams <- generatedParams[!(generatedParams %in% + c("assumedStDevs", "thetaH1", "pi1", "pi2", "piTreatments", "piTreatments", "piControl", "piControls"))] + + if (grepl("(MultiArm|Dunnett|Enrichment)", .getClassName(self))) { + + if (all(c("conditionalPowerSimulated", "conditionalRejectionProbabilities") %in% generatedParams)) { + generatedParams <- .moveValue(generatedParams, + "conditionalPowerSimulated", "conditionalRejectionProbabilities") + } + + self$.showParametersOfOneGroup(generatedParams, "Further analysis results", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + } else { + self$.showParametersOfOneGroup(generatedParams, "Analysis results", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + } + + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + + if (grepl("(MultiArm|Dunnett)", .getClassName(self))) { + self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(paste0( + " (i): results of treatment arm i vs. control group ", + self$.dataInput$getNumberOfGroups(), "\n" + ), + consoleOutputEnabled = consoleOutputEnabled + ) + } else if (.isEnrichmentAnalysisResults(self)) { + self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(paste0(" S[i]: population i\n"), consoleOutputEnabled = consoleOutputEnabled) + self$.cat(paste0(" F: full population\n"), consoleOutputEnabled = consoleOutputEnabled) + } else if (grepl("Rates", .getClassName(self$.dataInput)) && self$.dataInput$getNumberOfGroups() == 2) { + self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" (i): values of treatment arm i\n", consoleOutputEnabled = consoleOutputEnabled) + } + } + }, + .toString = function(startWithUpperCase = FALSE) { + str <- "analysis results" + if (inherits(self, "AnalysisResultsMultiArmR6")) { + str <- paste0("multi-arm ", str) + } else if (inherits(self, "AnalysisResultsEnrichmentR6")) { + str <- paste0("enrichment ", str) + } + if (startWithUpperCase) { + str <- .firstCharacterToUpperCase(str) + } + + numberOfGroups <- self$.dataInput$getNumberOfGroups() + str <- paste0(str, " (") + + str <- paste0(str, tolower(sub("Dataset(Enrichment)?", "", .getClassName(self$.dataInput)))) + if (grepl("Survival", .getClassName(.getClassName))) {#TODO BUG? + str <- paste0(str, " data") + } + + if (numberOfGroups == 1) { + str <- paste0(str, " of one group") + } else { + str <- paste0(str, " of ", numberOfGroups, " groups") + } + + if (self$.design$kMax > 1) { + if (grepl("GroupSequential", .getClassName(self))) { + str <- paste0(str, ", group sequential design") + } else if (grepl("InverseNormal", .getClassName(self))) { + str <- paste0(str, ", inverse normal combination test design") + } else if (grepl("Fisher", .getClassName(self))) { + str <- paste0(str, ", Fisher's combination test design") + } else if (grepl("Dunnett", .getClassName(self))) { + str <- paste0(str, ", conditional Dunnett design") + } + } else { + str <- paste0(str, ", fixed sample size design") + } + + str <- paste0(str, ")") + return(str) + }, + getNumberOfStages = function() { + return(self$.stageResults$getNumberOfStages()) + }, + getDataInput = function() { + return(self$.dataInput) + } + ) +) + +AnalysisResultsBaseR6 <- R6Class("AnalysisResultsBaseR6", + inherit = AnalysisResultsR6, + public = list( + thetaH1 = NULL, + assumedStDev = NULL, + equalVariances = NULL, + testActions = NULL, + conditionalRejectionProbabilities = NULL, + conditionalPower = NULL, + repeatedConfidenceIntervalLowerBounds = NULL, + repeatedConfidenceIntervalUpperBounds = NULL, + repeatedPValues = NULL, + finalStage = NULL, + finalPValues = NULL, + finalConfidenceIntervalLowerBounds = NULL, + finalConfidenceIntervalUpperBounds = NULL, + medianUnbiasedEstimates = NULL, + initialize = function(design, dataInput, ..., thetaH1 = NULL, + assumedStDev = NULL, + equalVariances = NULL, + testActions = NULL, + conditionalRejectionProbabilities = NULL, + conditionalPower = NULL, + repeatedConfidenceIntervalLowerBounds = NULL, + repeatedConfidenceIntervalUpperBounds = NULL, + repeatedPValues = NULL, + finalStage = NULL, + finalPValues = NULL, + finalConfidenceIntervalLowerBounds = NULL, + finalConfidenceIntervalUpperBounds = NULL, + medianUnbiasedEstimates = NULL) { + self$thetaH1 <- thetaH1 + self$assumedStDev <- assumedStDev + self$equalVariances <- equalVariances + self$testActions <- testActions + self$conditionalRejectionProbabilities <- conditionalRejectionProbabilities + self$conditionalPower <- conditionalPower + self$repeatedConfidenceIntervalLowerBounds <- repeatedConfidenceIntervalLowerBounds + self$repeatedConfidenceIntervalUpperBounds <- repeatedConfidenceIntervalUpperBounds + self$repeatedPValues <- repeatedPValues + self$finalStage <- finalStage + self$finalPValues <- finalPValues + self$finalConfidenceIntervalLowerBounds <- finalConfidenceIntervalLowerBounds + self$finalConfidenceIntervalUpperBounds <- finalConfidenceIntervalUpperBounds + self$medianUnbiasedEstimates <- medianUnbiasedEstimates + + super$initialize(design = design, dataInput = dataInput, ...) + self$finalStage <- NA_integer_ + } + ) +) + +#' +#' @name AnalysisResultsMultiHypotheses +#' +#' @title +#' Basic Class for Analysis Results Multi-Hypotheses +#' +#' @description +#' A basic class for multi-hypotheses analysis results. +#' +#' @details +#' \code{AnalysisResultsMultiHypotheses} is the basic class for +#' \itemize{ +#' \item \code{\link{AnalysisResultsMultiArm}} and +#' \item \code{\link{AnalysisResultsEnrichment}}. +#' } +#' +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include class_analysis_dataset.R +#' @include class_design.R +#' @include f_core_constants.R +#' @include class_analysis_stage_results.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +AnalysisResultsMultiHypothesesR6 <- R6Class("AnalysisResultsMultiHypothesesR6", + inherit = AnalysisResultsR6, + public = list( + .closedTestResults = NULL, + thetaH1 = NULL, # means only + assumedStDevs = NULL, # means only + piTreatments = NULL, # rates only + intersectionTest = NULL, + varianceOption = NULL, + conditionalRejectionProbabilities = NULL, + conditionalPower = NULL, + repeatedConfidenceIntervalLowerBounds = NULL, + repeatedConfidenceIntervalUpperBounds = NULL, + repeatedPValues = NULL, + initialize = function(design, dataInput, ..., .closedTestResults = NULL, + thetaH1 = NULL, + assumedStDevs = NULL, + piTreatments = NULL, + intersectionTest = NULL, + varianceOption = NULL, + conditionalRejectionProbabilities = NULL, + conditionalPower = NULL, + repeatedConfidenceIntervalLowerBounds = NULL, + repeatedConfidenceIntervalUpperBounds = NULL, + repeatedPValues = NULL) { + self$.closedTestResults <- .closedTestResults + self$thetaH1 <- thetaH1 + self$assumedStDevs <- assumedStDevs + self$piTreatments <- piTreatments + self$intersectionTest <- intersectionTest + self$varianceOption <- varianceOption + self$conditionalRejectionProbabilities <- conditionalRejectionProbabilities + self$conditionalPower <- conditionalPower + self$repeatedConfidenceIntervalLowerBounds <- repeatedConfidenceIntervalLowerBounds + self$repeatedConfidenceIntervalUpperBounds <- repeatedConfidenceIntervalUpperBounds + self$repeatedPValues <- repeatedPValues + super$initialize(design = design, dataInput = dataInput, ...) + + for (param in c("thetaH1", "assumedStDevs", "piTreatments")) { + self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) + } + } + ) +) + +#' +#' @name AnalysisResultsMultiArm +#' +#' @title +#' Basic Class for Analysis Results Multi-Arm +#' +#' @description +#' A basic class for multi-arm analysis results. +#' +#' @details +#' \code{AnalysisResultsMultiArm} is the basic class for +#' \itemize{ +#' \item \code{\link{AnalysisResultsMultiArmFisher}}, +#' \item \code{\link{AnalysisResultsMultiArmInverseNormal}}, and +#' \item \code{\link{AnalysisResultsConditionalDunnett}}. +#' } +#' +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include class_analysis_dataset.R +#' @include class_design.R +#' @include f_core_constants.R +#' @include class_analysis_stage_results.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +AnalysisResultsMultiArmR6 <- R6Class("AnalysisResultsMultiArmR6", + inherit = AnalysisResultsMultiHypothesesR6, + public = list( + piControl = NULL, # rates only + initialize = function(design, dataInput, ..., piControl = NULL) { + self$piControl <- piControl + super$initialize(design = design, dataInput = dataInput, ...) + self$.setParameterType("piControl", C_PARAM_NOT_APPLICABLE) + }, + .getParametersToShow = function() { + parametersToShow <- self$.getVisibleFieldNames() + + if ("piTreatments" %in% parametersToShow && "piControl" %in% parametersToShow) { + index <- which(parametersToShow == "piTreatments") + parametersToShow <- parametersToShow[parametersToShow != "piControl"] + parametersToShow <- c( + parametersToShow[1:index], + "piControl", parametersToShow[(index + 1):length(parametersToShow)] + ) + } + + return(parametersToShow) + } + ) +) + +#' +#' @name AnalysisResultsEnrichment +#' +#' @title +#' Basic Class for Analysis Results Enrichment +#' +#' @description +#' A basic class for enrichment analysis results. +#' +#' @details +#' \code{AnalysisResultsEnrichment} is the basic class for +#' \itemize{ +#' \item \code{\link{AnalysisResultsEnrichmentFisher}} and +#' \item \code{\link{AnalysisResultsEnrichmentInverseNormal}}. +#' } +#' +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include class_analysis_dataset.R +#' @include class_design.R +#' @include f_core_constants.R +#' @include class_analysis_stage_results.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +AnalysisResultsEnrichmentR6 <- R6Class("AnalysisResultsEnrichmentR6", + inherit = AnalysisResultsMultiHypothesesR6, + public = list( + piControls = NULL, # rates only + initialize = function(design, dataInput, ..., piControls = NULL) { + self$piControls <- piControls + super$initialize(design = design, dataInput = dataInput, ...) + self$.setParameterType("piControls", C_PARAM_NOT_APPLICABLE) + } + ) +) + +#' +#' @title +#' Analysis Results Summary +#' +#' @description +#' Displays a summary of \code{\link{AnalysisResults}} object. +#' +#' @param object An \code{\link{AnalysisResults}} object. +#' @inheritParams param_digits +#' @inheritParams param_three_dots +#' +#' @details +#' Summarizes the parameters and results of an analysis results object. +#' +#' @template details_summary +#' +#' @template return_object_summary +#' @template how_to_get_help_for_generics +#' +#' @export +#' +#' @keywords internal +#' +summary.AnalysisResultsR6 <- function(object, ..., type = 1, digits = NA_integer_) { + return(summary.ParameterSet(object = object, ..., type = type, digits = digits)) +} + +#' +#' @title +#' Coerce AnalysisResults to a Data Frame +#' +#' @description +#' Returns the \code{\link{AnalysisResults}} object as data frame. +#' +#' @param x An \code{\link{AnalysisResults}} object created by \code{\link[=getAnalysisResults]{getAnalysisResults()}}. +#' @inheritParams param_niceColumnNamesEnabled +#' @inheritParams param_three_dots +#' +#' @details +#' Coerces the analysis results to a data frame. +#' +#' @template return_dataframe +#' +#' @export +#' +#' @keywords internal +#' +as.data.frame.AnalysisResultsR6 <- function(x, row.names = NULL, optional = FALSE, ..., + niceColumnNamesEnabled = FALSE) { + + parametersToShow <- .getDesignParametersToShow(x) + if (inherits(x, "AnalysisResultsMultiArmR6")) { + parametersToShow <- c(parametersToShow, ".closedTestResults$rejected") + } + parametersToShow <- c(parametersToShow, x$.getUserDefinedParameters()) + parametersToShow <- c(parametersToShow, x$.getDefaultParameters()) + parametersToShow <- c(parametersToShow, x$.getStageResultParametersToShow()) + parametersToShow <- c(parametersToShow, x$.getGeneratedParameters()) + + parametersToShow <- parametersToShow[!(parametersToShow %in% c( + "finalStage", "allocationRatioPlanned", "thetaH0", "thetaH1", "pi1", "pi2" + ))] + return(.getAsDataFrame( + parameterSet = x, + parameterNames = parametersToShow, + tableColumnNames = .getTableColumnNames(design = x$.design), + niceColumnNamesEnabled = niceColumnNamesEnabled + )) +} + +#' +#' @title +#' Names of a Analysis Results Object +#' +#' @description +#' Function to get the names of an \code{\link{AnalysisResults}} object. +#' +#' @param x An \code{\link{AnalysisResults}} object created by \code{\link[=getAnalysisResults]{getAnalysisResults()}}. +#' +#' @details +#' Returns the names of an analysis results that can be accessed by the user. +#' +#' @template return_names +#' +#' @export +#' +#' @keywords internal +#' +names.AnalysisResultsR6 <- function(x) { + namesToShow <- c(".design", ".dataInput", ".stageResults", ".conditionalPowerResults") + if (.isMultiArmAnalysisResults(x)) { + namesToShow <- c(namesToShow, ".closedTestResults") + } + namesToShow <- c(namesToShow, x$.getVisibleFieldNames()) + return(namesToShow) +} + +#' +#' @name AnalysisResultsGroupSequential +#' +#' @title +#' Analysis Results Group Sequential +#' +#' @description +#' Class for analysis results results based on a group sequential design. +#' +#' @template field_normalApproximation +#' @template field_directionUpper +#' @template field_thetaH0 +#' @template field_pi1 +#' @template field_pi2 +#' @template field_nPlanned +#' @template field_allocationRatioPlanned +#' @template field_thetaH1 +#' @template field_assumedStDev +#' @template field_equalVariances +#' @template field_testActions +#' @template field_conditionalRejectionProbabilities +#' @template field_conditionalPower +#' @template field_repeatedConfidenceIntervalLowerBounds +#' @template field_repeatedConfidenceIntervalUpperBounds +#' @template field_repeatedPValues +#' @template field_finalStage +#' @template field_finalPValues +#' @template field_finalConfidenceIntervalLowerBounds +#' @template field_finalConfidenceIntervalUpperBounds +#' @template field_medianUnbiasedEstimates +#' @template field_maxInformation +#' @template field_informationEpsilon +#' +#' @details +#' This object cannot be created directly; use \code{\link{getAnalysisResults}} +#' with suitable arguments to create the analysis results of a group sequential design. +#' +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include class_analysis_dataset.R +#' @include class_design.R +#' @include f_core_constants.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +AnalysisResultsGroupSequentialR6 <- R6Class("AnalysisResultsGroupSequentialR6", + inherit = AnalysisResultsBaseR6, + public = list( + maxInformation = NULL, + informationEpsilon = NULL, + initialize = function(design, dataInput, ..., maxInformation = NULL, informationEpsilon = NULL) { + self$maxInformation <- maxInformation + self$informationEpsilon <- informationEpsilon + + super$initalize(design = design, dataInput = dataInput, ...) + + self$.setParameterType("maxInformation", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("informationEpsilon", C_PARAM_NOT_APPLICABLE) + } + ) +) + +#' +#' @name AnalysisResultsInverseNormal +#' +#' @title +#' Analysis Results Inverse Normal +#' +#' @description +#' Class for analysis results results based on an inverse normal design. +#' +#' @template field_normalApproximation +#' @template field_directionUpper +#' @template field_thetaH0 +#' @template field_pi1 +#' @template field_pi2 +#' @template field_nPlanned +#' @template field_allocationRatioPlanned +#' @template field_thetaH1 +#' @template field_assumedStDev +#' @template field_equalVariances +#' @template field_testActions +#' @template field_conditionalRejectionProbabilities +#' @template field_conditionalPower +#' @template field_repeatedConfidenceIntervalLowerBounds +#' @template field_repeatedConfidenceIntervalUpperBounds +#' @template field_repeatedPValues +#' @template field_finalStage +#' @template field_finalPValues +#' @template field_finalConfidenceIntervalLowerBounds +#' @template field_finalConfidenceIntervalUpperBounds +#' @template field_medianUnbiasedEstimates +#' +#' @details +#' This object cannot be created directly; use \code{\link{getAnalysisResults}} +#' with suitable arguments to create the analysis results of a inverse normal design. +#' +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include class_analysis_dataset.R +#' @include class_design.R +#' @include f_core_constants.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +AnalysisResultsInverseNormalR6 <- R6Class("AnalysisResultsInverseNormalR6", + inherit = AnalysisResultsBaseR6 +) + +#' +#' @name AnalysisResultsMultiArmInverseNormal +#' +#' @title +#' Analysis Results Multi-Arm Inverse Normal +#' +#' @description +#' Class for multi-arm analysis results based on a inverse normal design. +#' +#' @template field_normalApproximation +#' @template field_directionUpper +#' @template field_thetaH0 +#' @template field_pi1 +#' @template field_pi2 +#' @template field_nPlanned +#' @template field_allocationRatioPlanned +#' @template field_thetaH1 +#' @template field_assumedStDevs +#' @template field_piTreatments +#' @template field_intersectionTest +#' @template field_varianceOption +#' @template field_conditionalRejectionProbabilities +#' @template field_conditionalPower +#' @template field_repeatedConfidenceIntervalLowerBounds +#' @template field_repeatedConfidenceIntervalUpperBounds +#' @template field_repeatedPValues +#' @template field_piControl +#' +#' @details +#' This object cannot be created directly; use \code{\link{getAnalysisResults}} +#' with suitable arguments to create the multi-arm analysis results of an inverse normal design. +#' +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include class_analysis_dataset.R +#' @include class_design.R +#' @include f_core_constants.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +AnalysisResultsMultiArmInverseNormalR6 <- R6Class("AnalysisResultsMultiArmInverseNormalR6", + inherit = AnalysisResultsMultiArmR6 +) + +#' +#' @name AnalysisResultsEnrichmentInverseNormal +#' +#' @title +#' Analysis Results Enrichment Inverse Normal +#' +#' @description +#' Class for enrichment analysis results based on a inverse normal design. +#' +#' @template field_normalApproximation +#' @template field_directionUpper +#' @template field_thetaH0 +#' @template field_pi1 +#' @template field_pi2 +#' @template field_nPlanned +#' @template field_allocationRatioPlanned +#' @template field_thetaH1 +#' @template field_assumedStDevs +#' @template field_piTreatments +#' @template field_intersectionTest +#' @template field_varianceOption +#' @template field_conditionalRejectionProbabilities +#' @template field_conditionalPower +#' @template field_repeatedConfidenceIntervalLowerBounds +#' @template field_repeatedConfidenceIntervalUpperBounds +#' @template field_repeatedPValues +#' @template field_piControls +#' @template field_stratifiedAnalysis +#' +#' @details +#' This object cannot be created directly; use \code{\link{getAnalysisResults}} +#' with suitable arguments to create the enrichment analysis results of an inverse normal design. +#' +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include class_analysis_dataset.R +#' @include class_design.R +#' @include f_core_constants.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +AnalysisResultsEnrichmentInverseNormalR6 <- R6Class("AnalysisResultsEnrichmentInverseNormalR6", + inherit = AnalysisResultsEnrichmentR6, + public = list( + stratifiedAnalysis = NULL + ) +) + +#' +#' @name AnalysisResultsFisher +#' +#' @title +#' Analysis Results Fisher +#' +#' @description +#' Class for analysis results based on a Fisher combination test design. +#' +#' @template field_normalApproximation +#' @template field_directionUpper +#' @template field_thetaH0 +#' @template field_pi1 +#' @template field_pi2 +#' @template field_nPlanned +#' @template field_allocationRatioPlanned +#' @template field_thetaH1 +#' @template field_assumedStDev +#' @template field_equalVariances +#' @template field_testActions +#' @template field_conditionalRejectionProbabilities +#' @template field_conditionalPower +#' @template field_repeatedConfidenceIntervalLowerBounds +#' @template field_repeatedConfidenceIntervalUpperBounds +#' @template field_repeatedPValues +#' @template field_finalStage +#' @template field_finalPValues +#' @template field_finalConfidenceIntervalLowerBounds +#' @template field_finalConfidenceIntervalUpperBounds +#' @template field_medianUnbiasedEstimates +#' @template field_conditionalPowerSimulated +#' @template field_iterations +#' @template field_seed +#' +#' @details +#' This object cannot be created directly; use \code{\link{getAnalysisResults}} +#' with suitable arguments to create the analysis results of a Fisher combination test design. +#' +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include class_analysis_dataset.R +#' @include class_design.R +#' @include f_core_constants.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +AnalysisResultsFisherR6 <- R6Class("AnalysisResultsFisherR6", + inherit = AnalysisResultsBaseR6, + public = list( + conditionalPowerSimulated = NULL, + iterations = NULL, + seed = NULL, + initialize = function(design, dataInput, ..., iterations = NULL, seed = NULL) { + self$iterations <- iterations + self$seed <- seed + super$initialize(design = design, dataInput = dataInput, ...) + self$conditionalPowerSimulated <- -1 + } + ) +) + +#' +#' @title +#' Analysis Results Multi-Arm Fisher +#' +#' @description +#' Class for multi-arm analysis results based on a Fisher combination test design. +#' +#' @template field_normalApproximation +#' @template field_directionUpper +#' @template field_thetaH0 +#' @template field_pi1 +#' @template field_pi2 +#' @template field_nPlanned +#' @template field_allocationRatioPlanned +#' @template field_thetaH1 +#' @template field_assumedStDevs +#' @template field_piTreatments +#' @template field_intersectionTest +#' @template field_varianceOption +#' @template field_conditionalRejectionProbabilities +#' @template field_conditionalPower +#' @template field_repeatedConfidenceIntervalLowerBounds +#' @template field_repeatedConfidenceIntervalUpperBounds +#' @template field_repeatedPValues +#' @template field_piControl +#' @template field_conditionalPowerSimulated +#' @template field_iterations +#' @template field_seed +#' +#' @details +#' This object cannot be created directly; use \code{\link{getAnalysisResults}} +#' with suitable arguments to create the multi-arm analysis results of a Fisher combination test design. +#' +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include class_analysis_dataset.R +#' @include class_design.R +#' @include f_core_constants.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +AnalysisResultsMultiArmFisherR6 <- R6Class("AnalysisResultsMultiArmFisherR6", + inherit = AnalysisResultsMultiArmR6, + public = list( + conditionalPowerSimulated = NULL, + iterations = NULL, + seed = NULL + ) +) + +#' +#' @name AnalysisResultsEnrichmentFisher +#' +#' @title +#' Analysis Results Enrichment Fisher +#' +#' @description +#' Class for enrichment analysis results based on a Fisher combination test design. +#' +#' @template field_normalApproximation +#' @template field_directionUpper +#' @template field_thetaH0 +#' @template field_pi1 +#' @template field_pi2 +#' @template field_nPlanned +#' @template field_thetaH1 +#' @template field_assumedStDevs +#' @template field_piTreatments +#' @template field_intersectionTest +#' @template field_varianceOption +#' @template field_conditionalRejectionProbabilities +#' @template field_repeatedConfidenceIntervalLowerBounds +#' @template field_repeatedConfidenceIntervalUpperBounds +#' @template field_repeatedPValues +#' @template field_piControls +#' @template field_conditionalPowerSimulated +#' @template field_iterations +#' @template field_seed +#' @template field_stratifiedAnalysis +#' +#' +#' @details +#' This object cannot be created directly; use \code{\link{getAnalysisResults}} +#' with suitable arguments to create the multi-arm analysis results of a Fisher combination test design. +#' +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include class_analysis_dataset.R +#' @include class_design.R +#' @include f_core_constants.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +AnalysisResultsEnrichmentFisherR6 <- R6Class("AnalysisResultsEnrichmentFisherR6", + inherit = AnalysisResultsEnrichmentR6, + public = list( + conditionalPowerSimulated = NULL, + iterations = NULL, + seed = NULL, + stratifiedAnalysis = NULL + ) +) + +#' +#' @name AnalysisResultsConditionalDunnett +#' +#' @title +#' Analysis Results Multi-Arm Conditional Dunnett +#' +#' @description +#' Class for multi-arm analysis results based on a conditional Dunnett test design. +#' +#' @template field_normalApproximation +#' @template field_directionUpper +#' @template field_thetaH0 +#' @template field_pi1 +#' @template field_pi2 +#' @template field_nPlanned +#' @template field_allocationRatioPlanned +#' @template field_thetaH1 +#' @template field_assumedStDevs +#' @template field_piTreatments +#' @template field_intersectionTest +#' @template field_varianceOption +#' @template field_conditionalRejectionProbabilities +#' @template field_conditionalPower +#' @template field_repeatedConfidenceIntervalLowerBounds +#' @template field_repeatedConfidenceIntervalUpperBounds +#' @template field_repeatedPValues +#' @template field_piControl +#' +#' @details +#' This object cannot be created directly; use \code{\link{getAnalysisResults}} +#' with suitable arguments to create the multi-arm analysis results of a conditional Dunnett test design. +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +AnalysisResultsConditionalDunnettR6 <- R6Class("AnalysisResultsConditionalDunnettR6", + inherit = AnalysisResultsMultiArmR6, + public = list() +) + +.getAnalysisResultsPlotArguments <- function(x, + nPlanned = NA_real_, allocationRatioPlanned = NA_real_) { + if (all(is.na(nPlanned))) { + nPlanned <- stats::na.omit(x$nPlanned) + } + + if (is.na(allocationRatioPlanned) && length(x$allocationRatioPlanned) == 1) { + allocationRatioPlanned <- x$allocationRatioPlanned + } + + if (length(allocationRatioPlanned) != 1) { + allocationRatioPlanned <- NA_real_ + } + + if ((.isConditionalPowerEnabled(x$nPlanned) || .isConditionalPowerEnabled(nPlanned)) && is.na(allocationRatioPlanned)) { + allocationRatioPlanned <- 1 + } + + return(list( + stageResults = x$.stageResults, + nPlanned = nPlanned, + allocationRatioPlanned = allocationRatioPlanned + )) +} + +.getConfidenceIntervalPlotLegendLabels <- function(x, treatmentArmsToShow) { + if (.isEnrichmentAnalysisResults(x)) { + gMax <- x$.stageResults$getGMax() + labels <- paste0("S", treatmentArmsToShow) + labels[treatmentArmsToShow == gMax] <- "F" + labels <- factor(labels, levels = unique(labels)) + return(labels) + } + + return(paste0(treatmentArmsToShow, " vs control")) +} + +.getConfidenceIntervalData <- function(x, treatmentArmsToShow = NULL) { + data <- .getConfidenceIntervalDataPerBound(x, "lower", treatmentArmsToShow) + data$upper <- .getConfidenceIntervalDataPerBound(x, "upper", treatmentArmsToShow)$upper + data$yValues <- (data$upper + data$lower) / 2 + data <- na.omit(data) + return(data) +} + +.getConfidenceIntervalDataPerBound <- function(x, ciName = c("lower", "upper"), treatmentArmsToShow = NULL) { + ciName <- match.arg(ciName) + paramName <- ifelse(ciName == "lower", "repeatedConfidenceIntervalLowerBounds", "repeatedConfidenceIntervalUpperBounds") + data <- x[[paramName]] + + if (is.matrix(data) && !is.null(treatmentArmsToShow) && + length(treatmentArmsToShow) > 0 && !any(is.na(treatmentArmsToShow))) { + data <- data[treatmentArmsToShow, ] + } + + if (is.matrix(data) && nrow(data) == 1) { + data <- as.numeric(data) + } + + if (is.matrix(data)) { + kMax <- ncol(data) + if (is.null(treatmentArmsToShow) || length(treatmentArmsToShow) == 0 || all(is.na(treatmentArmsToShow))) { + treatmentArmsToShow <- 1:nrow(data) + } + groups <- length(treatmentArmsToShow) + result <- data.frame(ci = data[, 1]) + colnames(result) <- ciName + result$xValues <- rep(1, groups) + result$categories <- .getConfidenceIntervalPlotLegendLabels(x, treatmentArmsToShow) + if (kMax == 1) { + return(result) + } + + for (stage in 2:kMax) { + resultPart <- data.frame(ci = data[, stage]) + colnames(resultPart) <- ciName + resultPart$xValues <- rep(stage, groups) + resultPart$categories <- .getConfidenceIntervalPlotLegendLabels(x, treatmentArmsToShow) + result <- rbind(result, resultPart) + } + return(result) + } + + if (is.null(treatmentArmsToShow) || length(treatmentArmsToShow) == 0 || all(is.na(treatmentArmsToShow))) { + treatmentArmsToShow <- 1 + } + + kMax <- length(data) + result <- data.frame(ci = data) + colnames(result) <- ciName + result$xValues <- 1:kMax + result$categories <- rep(.getConfidenceIntervalPlotLegendLabels(x, treatmentArmsToShow), kMax) + return(result) +} + +#' +#' @title +#' Analysis Results Plotting +#' +#' @description +#' Plots the conditional power together with the likelihood function. +#' +#' @param x The analysis results at given stage, obtained from \code{\link[=getAnalysisResults]{getAnalysisResults()}}. +#' @param y Not available for this kind of plot (is only defined to be compatible to the generic plot function). +#' @inheritParams param_nPlanned +#' @inheritParams param_stage +#' @inheritParams param_allocationRatioPlanned +#' @param main The main title, default is \code{"Dataset"}. +#' @param xlab The x-axis label, default is \code{"Stage"}. +#' @param ylab The y-axis label. +#' @param legendTitle The legend title, default is \code{""}. +#' @inheritParams param_palette +#' @inheritParams param_showSource +#' @inheritParams param_plotSettings +#' @inheritParams param_legendPosition +#' @inheritParams param_grid +#' @param type The plot type (default = 1). Note that at the moment only one type (the conditional power plot) is available. +#' @param ... Optional \link[=param_three_dots_plot]{plot arguments}. Furthermore the following arguments can be defined: +#' \itemize{ +#' \item \code{thetaRange}: A range of assumed effect sizes if testing means or a survival design was specified. +#' Additionally, if testing means was selected, \code{assumedStDev} (assumed standard deviation) +#' can be specified (default is \code{1}). +#' \item \code{piTreatmentRange}: A range of assumed rates pi1 to calculate the conditional power. +#' Additionally, if a two-sample comparison was selected, \code{pi2} can be specified (default is the value from +#' \code{\link[=getAnalysisResults]{getAnalysisResults()}}). +#' \item \code{directionUpper}: Specifies the direction of the alternative, +#' only applicable for one-sided testing; default is \code{TRUE} +#' which means that larger values of the test statistics yield smaller p-values. +#' \item \code{\link[=param_thetaH0]{thetaH0}}: The null hypothesis value, default is \code{0} for +#' the normal and the binary case, it is \code{1} for the survival case. +#' For testing a rate in one sample, a value thetaH0 in (0, 1) has to be specified for +#' defining the null hypothesis H0: \code{pi = thetaH0}. +#' } +#' +#' @details +#' The conditional power is calculated only if effect size and sample size is specified. +#' +#' @template return_object_ggplot +#' +#' @template examples_plot_analysis_results +#' +#' @export +#' +plot.AnalysisResultsR6 <- 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) { + .assertGgplotIsInstalled() + functionCall <- match.call(expand.dots = TRUE) + analysisResultsName <- as.character(functionCall$x)[1] + .assertIsSingleInteger(grid, "grid", validateType = FALSE) + typeNumbers <- .getPlotTypeNumber(type, x) + p <- NULL + plotList <- list() + for (typeNumber in typeNumbers) { + p <- .plotAnalysisResults( + x = x, y = y, type = typeNumber, + nPlanned = nPlanned, + allocationRatioPlanned = allocationRatioPlanned, + main = main, xlab = xlab, ylab = ylab, + legendTitle = legendTitle, palette = palette, legendPosition = legendPosition, + showSource = showSource, functionCall = functionCall, + analysisResultsName = analysisResultsName, plotSettings = plotSettings, ... + ) + .printPlotShowSourceSeparator(showSource, typeNumber, typeNumbers) + if (length(typeNumbers) > 1) { + caption <- .getPlotCaption(x, typeNumber, stopIfNotFound = TRUE) + plotList[[caption]] <- p + } + } + if (length(typeNumbers) == 1) { + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(p)) + } + + return(p) + } + + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(plotList)) + } + + return(.createPlotResultObject(plotList, grid)) +} + +.plotAnalysisResultsRCI <- function(..., + x, y, nPlanned, allocationRatioPlanned, main, xlab, ylab, + legendTitle, palette, legendPosition, showSource, analysisResultsName, plotSettings = NULL) { + .assertIsAnalysisResults(x) + .warnInCaseOfUnknownArguments(functionName = "plot", ignore = c("treatmentArms", "populations"), ...) + + if (.isEnrichmentAnalysisResults(x)) { + gMax <- x$.stageResults$getGMax() + treatmentArmsToShow <- .getPopulationsToShow(x, gMax = gMax, ...) + } else { + treatmentArmsToShow <- .getTreatmentArmsToShow(x, ...) + } + + data <- .getConfidenceIntervalData(x, treatmentArmsToShow) + if (nrow(data) == 0) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "unable to create plot because no RCIs are available in the specified analysis result" + ) + } + + .warnInCaseOfUnusedArgument(nPlanned, "nPlanned", NA_real_, "plot") + .warnInCaseOfUnusedArgument(allocationRatioPlanned, "allocationRatioPlanned", NA_real_, "plot") + + plotData <- list( + main = "Repeated Confidence Intervals", + xlab = "Stage", + ylab = "RCI", + sub = NA_character_ # subtitle + ) + + if (is.na(legendPosition)) { + if (!.isMultiHypothesesAnalysisResults(x)) { + legendPosition <- ifelse(length(treatmentArmsToShow) == 1 && treatmentArmsToShow == 1, + -1, C_POSITION_RIGHT_CENTER + ) + } else { + legendPosition <- C_POSITION_RIGHT_TOP + } + } + + treatmentArmsToShowCmd <- "" + if (!is.null(treatmentArmsToShow) && !identical(sort(unique(treatmentArmsToShow)), 1:nrow(data))) { + treatmentArmsToShowCmd <- paste0(", ", .arrayToString(treatmentArmsToShow, mode = "vector")) + } + dataCmd <- paste0("rpact:::.getConfidenceIntervalData(", analysisResultsName, treatmentArmsToShowCmd, ")") + srcCmd <- .showPlotSourceInformation( + objectName = analysisResultsName, + xParameterName = paste0(dataCmd, "$xValues"), + yParameterNames = c( + paste0(dataCmd, "$lower"), + paste0(dataCmd, "$yValues"), + paste0(dataCmd, "$upper") + ), + type = 2L, showSource = showSource, lineType = FALSE + ) + + p <- .createAnalysisResultsPlotObject(x, + data = data, plotData = plotData, main = main, xlab = xlab, ylab = ylab, + legendTitle = legendTitle, palette = palette, legendPosition = legendPosition, + kMax = x$.design$kMax, plotSettings = plotSettings + ) + p <- p + ggplot2::expand_limits(x = c(1, x$.design$kMax)) + return(p) +} + +.plotAnalysisResults <- function(..., + x, y, type, nPlanned, allocationRatioPlanned, main, xlab, ylab, + legendTitle, palette, legendPosition, showSource, functionCall, + analysisResultsName, plotSettings = NULL) { + .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) + if (!(type %in% c(1, 2))) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is not allowed; must be 1 or 2") + } + + .assertIsAnalysisResults(x) + .assertIsValidLegendPosition(legendPosition = legendPosition) + + if (type == 2) { + return(.plotAnalysisResultsRCI( + x = x, y = y, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, + main = main, xlab = xlab, ylab = ylab, + legendTitle = legendTitle, palette = palette, + legendPosition = legendPosition, showSource = showSource, + analysisResultsName = analysisResultsName, + plotSettings = plotSettings, ... + )) + } + + if (!.isConditionalPowerEnabled(x$nPlanned) && !.isConditionalPowerEnabled(nPlanned)) { + stop("'nPlanned' must be defined to create conditional power plot") + } + + .warnInCaseOfUnknownArguments( + functionName = "plot", + ignore = c("thetaRange", "assumedStDev", "assumedStDevs", "treatmentArms", "populations", "pi2", "piTreatmentRange"), + ... + ) + + if (is.na(legendPosition)) { + legendPosition <- C_POSITION_RIGHT_CENTER + } + + plotArgs <- .getAnalysisResultsPlotArguments( + x = x, nPlanned = nPlanned, + allocationRatioPlanned = allocationRatioPlanned + ) + + functionCall$x <- x$.stageResults + functionCall$y <- NULL + functionCall$stageResultsName <- paste0(analysisResultsName, "$.stageResults") + functionCall$nPlanned <- plotArgs$nPlanned + functionCall$main <- main + functionCall$xlab <- xlab + functionCall$ylab <- ylab + functionCall$legendTitle <- legendTitle + functionCall$palette <- palette + functionCall$legendPosition <- legendPosition + functionCall$type <- type + functionCall$plotSettings <- plotSettings + functionCall$allocationRatioPlanned <- plotArgs$allocationRatioPlanned + if (.isTrialDesignFisher(x$.design)) { + functionCall$iterations <- x$iterations + functionCall$seed <- x$seed + } + + if (x$getDataInput()$isDatasetMeans()) { + if (.isMultiHypothesesAnalysisResults(x)) { + assumedStDevs <- eval.parent(functionCall$assumedStDevs) + if (is.null(assumedStDevs)) { + assumedStDevs <- as.numeric(x$assumedStDevs) + } + + gMax <- x$.stageResults$getGMax() + .assertIsValidAssumedStDevs(assumedStDevs, gMax) + + functionCall$assumedStDevs <- assumedStDevs + } else { + assumedStDev <- eval.parent(functionCall$assumedStDev) + if (is.null(assumedStDev)) { + assumedStDev <- x$assumedStDev + } + functionCall$assumedStDev <- assumedStDev + } + } + + if (x$getDataInput()$isDatasetMeans() || x$getDataInput()$isDatasetSurvival()) { + thetaRange <- eval.parent(functionCall$thetaRange) + if (is.null(thetaRange)) { + thetaRangeMin <- min(x$thetaH0, min(na.omit(as.numeric(x$thetaH1)))) + thetaRangeMax <- 2 * max(x$thetaH0, max(na.omit(as.numeric(x$thetaH1)))) + thetaRange <- seq( + thetaRangeMin, thetaRangeMax, + (thetaRangeMax - thetaRangeMin) / C_THETA_RANGE_SEQUENCE_LENGTH_DEFAULT + ) + } else { + thetaRange <- .assertIsValidThetaRange( + thetaRange = thetaRange, + survivalDataEnabled = x$getDataInput()$isDatasetSurvival() + ) + } + functionCall$thetaRange <- thetaRange + } else if (x$getDataInput()$isDatasetRates()) { + if (.isMultiArmAnalysisResults(x)) { + piControl <- eval.parent(functionCall$piControl) + if (is.null(piControl)) { + piControl <- as.numeric(x$piControl) + } + functionCall$piControl <- piControl + } else if (.isEnrichmentAnalysisResults(x)) { + piControl <- eval.parent(functionCall$piControl) + if (is.null(piControl)) { + piControls <- as.numeric(x$piControls) + } + functionCall$piControls <- piControls + } else { + pi2 <- eval.parent(functionCall$pi2) + if (is.null(pi2)) { + pi2 <- x$pi2 + } + functionCall$pi2 <- pi2 + } + + piTreatmentRange <- eval.parent(functionCall$piTreatmentRange) + if (is.null(piTreatmentRange)) { + piTreatmentRange <- seq(0, 1, 1 / C_THETA_RANGE_SEQUENCE_LENGTH_DEFAULT) # default + } else { + piTreatmentRange <- .assertIsValidPiTreatmentRange(piTreatmentRange = piTreatmentRange) + } + functionCall$piTreatmentRange <- piTreatmentRange + } + + functionCall[[1L]] <- as.name("plot") + return(eval.parent(functionCall)) +} diff --git a/R/class_analysis_stage_results_r6.R b/R/class_analysis_stage_results_r6.R new file mode 100644 index 00000000..4a684156 --- /dev/null +++ b/R/class_analysis_stage_results_r6.R @@ -0,0 +1,1675 @@ +## | +## | *Stage results classes* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | rpact package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File version: $Revision: 6943 $ +## | Last changed: $Date: 2023-04-24 09:47:00 +0200 (Mo, 24 Apr 2023) $ +## | Last changed by: $Author: pahlke $ +## | + +#' +#' @name StageResults +#' +#' @title +#' Basic Stage Results +#' +#' @description +#' Basic class for stage results. +#' +#' @template field_stages +#' @template field_testStatistics +#' @template field_pValues +#' @template field_combInverseNormal +#' @template field_combFisher +#' @template field_effectSizes +#' @template field_testActions +#' @template field_weightsFisher +#' @template field_weightsInverseNormal +#' +#' @details +#' \code{StageResults} is the basic class for +#' \itemize{ +#' \item \code{\link{StageResultsMeans}}, +#' \item \code{\link{StageResultsRates}}, +#' \item \code{\link{StageResultsSurvival}}, +#' \item \code{\link{StageResultsMultiArmMeans}}, +#' \item \code{\link{StageResultsMultiArmRates}}, +#' \item \code{\link{StageResultsMultiArmSurvival}}, +#' \item \code{\link{StageResultsEnrichmentMeans}}, +#' \item \code{\link{StageResultsEnrichmentRates}}, and +#' \item \code{\link{StageResultsEnrichmentSurvival}}. +#' } +#' +#' @include f_core_utilities.R +#' @include class_core_parameter_set.R +#' @include class_design.R +#' @include class_analysis_dataset.R +#' @include f_core_constants.R +#' @include class_core_plot_settings.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +StageResultsR6 <- R6Class("StageResultsR6", + inherit = ParameterSetR6, + public = list( + .plotSettings = NULL, + .design = NULL, + .dataInput = NULL, + stage = NULL, + stages = NULL, + pValues = NULL, + weightsFisher = NULL, + weightsInverseNormal = NULL, + thetaH0 = NULL, + direction = NULL, + initialize = function(..., stage = NULL, stages = NULL, pValues = NULL, weightsFisher = NULL, weightsInverseNormal = NULL, thetaH0 = NULL, direction = NULL) { + self$stage <- stage + self$stages <- stages + self$pValues <- pValues + self$weightsFisher <- weightsFisher + self$weightsInverseNormal <- weightsInverseNormal + self$thetaH0 <- thetaH0 + self$direction <- direction + super$initialize(...) + }, + init = function(design, dataInput) { + self$.design <- design + self$.dataInput <- dataInput + + self$.plotSettings <- PlotSettings() + if (!missing(design)) { + self$stages <- c(1:design$kMax) + if (design$kMax == C_KMAX_DEFAULT) { + self$.setParameterType("stages", C_PARAM_DEFAULT_VALUE) + } else { + self$.setParameterType("stages", C_PARAM_USER_DEFINED) + } + self$.parameterNames <- .getParameterNames(design = design) + } + self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS + + self$.setParameterType("stage", C_PARAM_NOT_APPLICABLE) + + self$.setParameterType("pValues", ifelse( + self$.isMultiArm(), C_PARAM_NOT_APPLICABLE, C_PARAM_GENERATED + )) + self$.setParameterType("thetaH0", ifelse( + identical(self$thetaH0, C_THETA_H0_MEANS_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + self$.setParameterType("direction", ifelse( + identical(self$direction, C_DIRECTION_UPPER), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + }, + getPlotSettings = function() { + return(self$.plotSettings) + }, + show = function(showType = 1, digits = NA_integer_) { + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + }, + .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { + "Method for automatically printing stage results" + self$.resetCat() + if (showType == 2) { + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + } else { + self$.cat(self$.toString(startWithUpperCase = TRUE), ":\n\n", + heading = 1, + consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Output", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + + if (grepl("Enrichment", .getClassName(self))) { + self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(paste0(" S[i]: population i\n"), consoleOutputEnabled = consoleOutputEnabled) + self$.cat(paste0(" F: full population\n"), consoleOutputEnabled = consoleOutputEnabled) + } else if (grepl("MultiArm", .getClassName(self))) { + self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(paste0( + " (i): results of treatment arm i vs. control group ", + self$.dataInput$getNumberOfGroups(), "\n" + ), + consoleOutputEnabled = consoleOutputEnabled + ) + } else if (self$.dataInput$getNumberOfGroups(survivalCorrectionEnabled = FALSE) >= 2) { + self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" (i): values of treatment arm i\n", consoleOutputEnabled = consoleOutputEnabled) + } + } + }, + isDirectionUpper = function() { + return(self$direction == C_DIRECTION_UPPER) + }, + .isMultiArm = function() { + return(grepl("multi", tolower(.getClassName(self)))) + }, + .isEnrichment = function() { + return(grepl("enrichment", tolower(.getClassName(self)))) + }, + getGMax = function() { + if (!is.matrix(self$testStatistics)) { + return(1L) + } + + gMax <- nrow(self$testStatistics) + if (is.null(gMax) || gMax == 0) { + gMax <- 1L + } + return(gMax) + }, + .getParametersToShow = function() { + return(c("stages")) + }, + .toString = function(startWithUpperCase = FALSE) { + s <- "stage results of" + + if (grepl("MultiArm", .getClassName(self))) { + s <- paste(s, "multi-arm") + } else if (grepl("Enrichment", .getClassName(self))) { + s <- paste(s, "enrichment") + } + + if (grepl("Means", .getClassName(self))) { + s <- paste(s, "means") + } + + if (grepl("Rates", .getClassName(self))) { + s <- paste(s, "rates") + } + + if (grepl("Survival", .getClassName(self))) { + s <- paste(s, "survival data") + } + + if (startWithUpperCase) { + s <- .firstCharacterToUpperCase(s) + } + + return(s) + }, + getDataInput = function() { + return(self$.dataInput) + }, + getNumberOfGroups = function() { + return(self$.dataInput$getNumberOfGroups()) + }, + isOneSampleDataset = function() { + return(self$getNumberOfGroups() == 1) + }, + isTwoSampleDataset = function() { + return(self$getNumberOfGroups() == 2) + }, + isDatasetMeans = function() { + return(self$.dataInput$isDatasetMeans()) + }, + isDatasetRates = function() { + return(self$.dataInput$isDatasetRates()) + }, + isDatasetSurvival = function() { + return(self$.dataInput$isDatasetSurvival()) + }, + getNumberOfStages = function() { + if (self$.isMultiArm()) { + if (inherits(self, "StageResultsMultiArmRatesR6")) { + return(max( + ncol(stats::na.omit(self$testStatistics)), + ncol(stats::na.omit(self$separatePValues)) + )) + } + return(max( + ncol(stats::na.omit(self$effectSizes)), + ncol(stats::na.omit(self$separatePValues)) + )) + } + return(max( + length(stats::na.omit(self$effectSizes)), + length(stats::na.omit(self$pValues)) + )) + } + ) +) + +#' +#' @name StageResultsMeans +#' +#' @title +#' Stage Results of Means +#' +#' @description +#' Class for stage results of means. +#' +#' @template field_stages +#' @template field_testStatistics +#' @template field_overallTestStatistics +#' @template field_pValues +#' @template field_overallPValues +#' @template field_effectSizes +#' @template field_testActions +#' @template field_direction +#' @template field_normalApproximation +#' @template field_equalVariances +#' @template field_combFisher +#' @template field_weightsFisher +#' @template field_combInverseNormal +#' @template field_weightsInverseNormal +#' @field ... Names of \code{dataInput}. +#' +#' @details +#' This object cannot be created directly; use \code{getStageResults} +#' with suitable arguments to create the stage results of a dataset of means. +#' +#' @include class_core_parameter_set.R +#' @include class_design.R +#' @include class_analysis_dataset.R +#' @include f_core_constants.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +StageResultsMeansR6 <- R6Class("StageResultsMeansR6", + inherit = StageResultsR6, + public = list( + combInverseNormal = NULL, + combFisher = NULL, + overallTestStatistics = NULL, + overallPValues = NULL, + effectSizes = NULL, + testStatistics = NULL, + overallMeans = NULL, + overallMeans1 = NULL, + overallMeans2 = NULL, + overallStDevs = NULL, + overallStDevs1 = NULL, + overallStDevs2 = NULL, + overallSampleSizes = NULL, + overallSampleSizes1 = NULL, + overallSampleSizes2 = NULL, + equalVariances = NULL, + normalApproximation = NULL, + initialize = function(design, dataInput, ..., equalVariances = TRUE, normalApproximation = FALSE) { + callSuper(.design = design, .dataInput = dataInput, ...)#TODO + + self$equalVariances <- equalVariances + self$normalApproximation <- normalApproximation + + self$init(design = design, dataInput = dataInput) + + for (param in c( + "weightsFisher", + "weightsInverseNormal", + "combFisher", + "combInverseNormal" + )) { + self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) + } + + for (param in self$.getParametersToShow()) { + if (self$.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { + self$.setParameterType(param, C_PARAM_GENERATED) + } + } + + self$.setParameterType("equalVariances", ifelse( + identical(self$equalVariances, TRUE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + self$.setParameterType("normalApproximation", ifelse( + identical(self$normalApproximation, FALSE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + }, + .getParametersToShow = function() { + parametersToShow <- c( + "stages", + "overallTestStatistics", + "overallPValues" + ) + if (self$.dataInput$getNumberOfGroups() == 1) { + parametersToShow <- c( + parametersToShow, + "overallMeans", + "overallStDevs", + "overallSampleSizes" + ) + } else if (self$.dataInput$getNumberOfGroups() == 2) { + parametersToShow <- c( + parametersToShow, + "overallMeans1", + "overallMeans2", + "overallStDevs1", + "overallStDevs2", + "overallSampleSizes1", + "overallSampleSizes2" + ) + } + parametersToShow <- c( + parametersToShow, + "testStatistics", + "pValues", + "effectSizes" + ) + if (.isTrialDesignInverseNormal(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combInverseNormal", + "weightsInverseNormal" + ) + } else if (.isTrialDesignFisher(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combFisher", + "weightsFisher" + ) + } + parametersToShow <- c( + parametersToShow, + "thetaH0", + "direction", + "normalApproximation" + ) + if (self$.dataInput$getNumberOfGroups() == 2) { + parametersToShow <- c( + parametersToShow, + "equalVariances" + ) + } + return(parametersToShow) + } + ) +) + +#' @name StageResultsMultiArmMeans +#' +#' @title +#' Stage Results Multi Arm Means +#' +#' @description +#' Class for stage results of multi arm means data +#' +#' @template field_stages +#' @template field_testStatistics +#' @template field_pValues +#' @template field_combInverseNormal +#' @template field_combFisher +#' @template field_effectSizes +#' @template field_testActions +#' @template field_weightsFisher +#' @template field_weightsInverseNormal +#' @template field_combInverseNormal +#' @template field_combFisher +#' @template field_overallTestStatistics +#' @template field_overallStDevs +#' @template field_overallPooledStDevs +#' @template field_overallPValues +#' @template field_testStatistics +#' @template field_separatePValues +#' @template field_effectSizes +#' @template field_singleStepAdjustedPValues +#' @template field_intersectionTest +#' @template field_varianceOption +#' @template field_normalApproximation +#' @template field_directionUpper +#' +#' @details +#' This object cannot be created directly; use \code{getStageResults} +#' with suitable arguments to create the stage results of a dataset of multi arm means. +#' +#' @include class_core_parameter_set.R +#' @include class_design.R +#' @include class_analysis_dataset.R +#' @include f_core_constants.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +StageResultsMultiArmMeansR6 <- R6Class("StageResultsMultiArmMeansR6", + inherit = StageResultsR6, + public = list( + combInverseNormal = NULL, + combFisher = NULL, + overallTestStatistics = NULL, + overallStDevs = NULL, + overallPooledStDevs = NULL, + overallPValues = NULL, + testStatistics = NULL, + separatePValues = NULL, + effectSizes = NULL, + singleStepAdjustedPValues = NULL, + intersectionTest = NULL, + varianceOption = NULL, + normalApproximation = NULL, + directionUpper = NULL, + initialize = function(design, dataInput, ..., varianceOption = C_VARIANCE_OPTION_MULTIARMED_DEFAULT, + normalApproximation = FALSE, directionUpper = NULL) { + super$initialize(...) + + self$varianceOption <- varianceOption + self$normalApproximation <- normalApproximation + self$directionUpper <- directionUpper + + + self$init(design = design, dataInput = dataInput) + + for (param in c( + "singleStepAdjustedPValues", + "weightsFisher", + "weightsInverseNormal", + "combFisher", + "combInverseNormal" + )) { + self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) + } + + for (param in self$.getParametersToShow()) { + if (self$.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { + self$.setParameterType(param, C_PARAM_GENERATED) + } + } + + self$.setParameterType("varianceOption", ifelse( + identical(self$varianceOption, C_VARIANCE_OPTION_MULTIARMED_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + self$.setParameterType("normalApproximation", ifelse( + identical(self$normalApproximation, FALSE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + self$.setParameterType("directionUpper", ifelse( + identical(self$directionUpper, C_DIRECTION_UPPER_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + }, + .getParametersToShow = function() { + parametersToShow <- c( + "stages", + "thetaH0", + "direction", + "normalApproximation", + "directionUpper", + "varianceOption", + "intersectionTest", + "overallTestStatistics", + "overallPValues", + "overallStDevs", + "overallPooledStDevs", + "testStatistics", + "separatePValues", + "effectSizes", + "singleStepAdjustedPValues" + ) + if (.isTrialDesignInverseNormal(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combInverseNormal", + "weightsInverseNormal" + ) + } else if (.isTrialDesignFisher(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combFisher", + "weightsFisher" + ) + } + return(parametersToShow) + } + ) +) + +#' +#' @name StageResultsRates +#' +#' @title +#' Stage Results of Rates +#' +#' @description +#' Class for stage results of rates. +#' +#' @template field_stages +#' @template field_testStatistics +#' @template field_overallTestStatistics +#' @template field_pValues +#' @template field_overallPValues +#' @template field_effectSizes +#' @template field_direction +#' @template field_testActions +#' @template field_thetaH0 +#' @template field_normalApproximation +#' @template field_weightsFisher +#' @template field_weightsInverseNormal +#' @template field_combInverseNormal +#' @template field_combFisher +#' @field ... Names of \code{dataInput}. +#' +#' @details +#' This object cannot be created directly; use \code{getStageResults} +#' with suitable arguments to create the stage results of a dataset of rates. +#' +#' @include class_core_parameter_set.R +#' @include class_design.R +#' @include class_analysis_dataset.R +#' @include f_core_constants.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +StageResultsRatesR6 <- R6Class("StageResultsRatesR6", + inherit = StageResultsR6, + public = list( + combInverseNormal = NULL, + combFisher = NULL, + overallTestStatistics = NULL, + overallPValues = NULL, + effectSizes = NULL, + testStatistics = NULL, + overallPi1 = NULL, + overallPi2 = NULL, + overallEvents = NULL, + overallEvents1 = NULL, + overallEvents2 = NULL, + overallSampleSizes = NULL, + overallSampleSizes1 = NULL, + overallSampleSizes2 = NULL, + normalApproximation = NULL, + initialize = function(design, dataInput, ..., normalApproximation = TRUE) { + callSuper(.design = design, .dataInput = dataInput, ...)#TODO + + self$normalApproximation <- normalApproximation + + self$init(design = design, dataInput = dataInput) + + for (param in c( + "weightsFisher", + "weightsInverseNormal", + "combFisher", + "combInverseNormal" + )) { + self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) + } + + for (param in self$.getParametersToShow()) { + if (self$.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { + self$.setParameterType(param, C_PARAM_GENERATED) + } + } + + self$.setParameterType("normalApproximation", ifelse( + identical(self$normalApproximation, TRUE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + }, + .getParametersToShow = function() { + parametersToShow <- c( + "stages", + "overallTestStatistics", + "overallPValues" + ) + if (self$.dataInput$getNumberOfGroups() == 1) { + parametersToShow <- c( + parametersToShow, + "overallEvents", + "overallSampleSizes", + "overallPi1" + ) + } else if (self$.dataInput$getNumberOfGroups() == 2) { + parametersToShow <- c( + parametersToShow, + "overallEvents1", + "overallEvents2", + "overallSampleSizes1", + "overallSampleSizes2", + "overallPi1", + "overallPi2" + ) + } + parametersToShow <- c( + parametersToShow, + "testStatistics", + "pValues" + ) + if (self$.dataInput$getNumberOfGroups() > 1) { + parametersToShow <- c(parametersToShow, "effectSizes") + } + + if (.isTrialDesignInverseNormal(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combInverseNormal", + "weightsInverseNormal" + ) + } else if (.isTrialDesignFisher(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combFisher", + "weightsFisher" + ) + } + parametersToShow <- c( + parametersToShow, + "thetaH0", + "direction", + "normalApproximation" + ) + return(parametersToShow) + } + ) +) + +#' @name StageResultsMultiArmRates +#' +#' @title +#' Stage Results Multi Arm Rates +#' +#' @description +#' Class for stage results of multi arm rates data +#' +#' @template field_stages +#' @template field_testStatistics +#' @template field_pValues +#' @template field_combInverseNormal +#' @template field_combFisher +#' @template field_effectSizes +#' @template field_testActions +#' @template field_weightsFisher +#' @template field_weightsInverseNormal +#' @template field_combInverseNormal +#' @template field_combFisher +#' @template field_overallTestStatistics +#' @template field_overallPValues +#' @template field_testStatistics +#' @template field_separatePValues +#' @template field_effectSizes +#' @template field_singleStepAdjustedPValues +#' @template field_intersectionTest +#' @template field_normalApproximation +#' @template field_directionUpper +#' +#' @details +#' This object cannot be created directly; use \code{getStageResults} +#' with suitable arguments to create the stage results of a dataset of multi arm rates. +#' +#' @include class_core_parameter_set.R +#' @include class_design.R +#' @include class_analysis_dataset.R +#' @include f_core_constants.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +StageResultsMultiArmRatesR6 <- R6Class("StageResultsMultiArmRatesR6", + inherit = StageResultsR6, + public = list( + stage = NULL, + overallPiTreatments = NULL, + overallPiControl = NULL, + combInverseNormal = NULL, + combFisher = NULL, + overallTestStatistics = NULL, + overallPValues = NULL, + testStatistics = NULL, + separatePValues = NULL, + effectSizes = NULL, + singleStepAdjustedPValues = NULL, + intersectionTest = NULL, + normalApproximation = NULL, + directionUpper = NULL, + initialize = function(design, dataInput, ..., + normalApproximation = FALSE) { + callSuper(.design = design, .dataInput = dataInput, ...)#TODO + + self$normalApproximation <- normalApproximation + + self$init(design = design, dataInput = dataInput) + + for (param in c( + "singleStepAdjustedPValues", + "weightsFisher", + "weightsInverseNormal", + "combFisher", + "combInverseNormal" + )) { + self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) + } + + for (param in self$.getParametersToShow()) { + if (self$.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { + self$.setParameterType(param, C_PARAM_GENERATED) + } + } + + self$.setParameterType("normalApproximation", ifelse( + identical(self$normalApproximation, FALSE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + self$.setParameterType("directionUpper", ifelse( + identical(self$directionUpper, C_DIRECTION_UPPER_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + }, + .getParametersToShow = function() { + parametersToShow <- c( + "stages", + "thetaH0", + "direction", + "normalApproximation", + "directionUpper", + "overallPiControl", + "overallPiTreatments", + "intersectionTest", + "overallTestStatistics", + "overallPValues", + "testStatistics", + "separatePValues", + "singleStepAdjustedPValues" + ) + if (.isTrialDesignInverseNormal(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combInverseNormal", + "weightsInverseNormal" + ) + } else if (.isTrialDesignFisher(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combFisher", + "weightsFisher" + ) + } + return(parametersToShow) + } + ) +) + +#' +#' @name StageResultsSurvival +#' +#' @title +#' Stage Results of Survival Data +#' +#' @description +#' Class for stage results survival data. +#' +#' @template field_stages +#' @template field_testStatistics +#' @template field_overallTestStatistics +#' @template field_separatePValues +#' @template field_singleStepAdjustedPValues +#' @template field_overallPValues +#' @template field_direction +#' @template field_directionUpper +#' @template field_intersectionTest +#' @template field_combInverseNormal +#' @template field_combFisher +#' @template field_effectSizes +#' @template field_testActions +#' @template field_thetaH0 +#' @template field_weightsFisher +#' @template field_weightsInverseNormal +#' @template field_normalApproximation +#' @field ... Names of \code{dataInput}. +#' +#' @details +#' This object cannot be created directly; use \code{getStageResults} +#' with suitable arguments to create the stage results of a dataset of survival data. +#' +#' @include class_core_parameter_set.R +#' @include class_design.R +#' @include class_analysis_dataset.R +#' @include f_core_constants.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +StageResultsSurvivalR6 <- R6Class("StageResultsSurvivalR6", + inherit = StageResultsR6, + public = list( + combInverseNormal = NULL, + combFisher = NULL, + overallPValues = NULL, + effectSizes = NULL, + overallTestStatistics = NULL, + overallEvents = NULL, + overallAllocationRatios = NULL, + events = NULL, + allocationRatios = NULL, + testStatistics = NULL, + initialize = function(design, dataInput, ...) { + callSuper(.design = design, .dataInput = dataInput, ...)#TODO + + self$init(design = design, dataInput = dataInput) + + for (param in c( + "weightsFisher", + "weightsInverseNormal", + "combFisher", + "combInverseNormal" + )) { + self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) + } + + for (param in self$.getParametersToShow()) { + if (self$.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { + self$.setParameterType(param, C_PARAM_GENERATED) + } + } + }, + .getParametersToShow = function() { + parametersToShow <- c( + "stages", + "overallTestStatistics", + "overallPValues", + "overallEvents", + "overallAllocationRatios", + "events", + "allocationRatios", + "testStatistics", + "pValues", + "overallPValues", + "effectSizes" + ) + if (.isTrialDesignInverseNormal(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combInverseNormal", + "weightsInverseNormal" + ) + } else if (.isTrialDesignFisher(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combFisher", + "weightsFisher" + ) + } + parametersToShow <- c( + parametersToShow, + "thetaH0", + "direction" + ) + return(parametersToShow) + } + ) +) + +#' @name StageResultsMultiArmSurvival +#' +#' @title +#' Stage Results Multi Arm Survival +#' +#' @description +#' Class for stage results of multi arm survival data +#' +#' @template field_stages +#' @template field_testStatistics +#' @template field_pValues +#' @template field_combInverseNormal +#' @template field_combFisher +#' @template field_effectSizes +#' @template field_testActions +#' @template field_weightsFisher +#' @template field_weightsInverseNormal +#' @template field_combInverseNormal +#' @template field_combFisher +#' @template field_overallTestStatistics +#' @template field_overallPValues +#' @template field_testStatistics +#' @template field_separatePValues +#' @template field_effectSizes +#' @template field_singleStepAdjustedPValues +#' @template field_intersectionTest +#' @template field_directionUpper +#' +#' @details +#' This object cannot be created directly; use \code{getStageResults} +#' with suitable arguments to create the stage results of a dataset of multi arm survival. +#' +#' @include class_core_parameter_set.R +#' @include class_design.R +#' @include class_analysis_dataset.R +#' @include f_core_constants.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +StageResultsMultiArmSurvivalR6 <- R6Class("StageResultsMultiArmSurvivalR6", + inherit = StageResultsR6, + public = list( + stage = NULL, + combInverseNormal = NULL, + combFisher = NULL, + overallTestStatistics = NULL, + overallPValues = NULL, + testStatistics = NULL, + separatePValues = NULL, + effectSizes = NULL, + singleStepAdjustedPValues = NULL, + intersectionTest = NULL, + directionUpper = NULL, + initialize = function(design, dataInput, ..., + normalApproximation = FALSE) { + callSuper(.design = design, .dataInput = dataInput, ...) #TODO + + self$init(design = design, dataInput = dataInput) + + for (param in c( + "singleStepAdjustedPValues", + "weightsFisher", + "weightsInverseNormal", + "combFisher", + "combInverseNormal" + )) { + self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) + } + + for (param in self$.getParametersToShow()) { + if (self$.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { + self$.setParameterType(param, C_PARAM_GENERATED) + } + } + + self$.setParameterType("directionUpper", ifelse( + identical(self$directionUpper, C_DIRECTION_UPPER_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + }, + .getParametersToShow = function() { + parametersToShow <- c( + "stages", + "thetaH0", + "direction", + "directionUpper", + "intersectionTest", + "overallTestStatistics", + "overallPValues", + "testStatistics", + "separatePValues", + "effectSizes", + "singleStepAdjustedPValues" + ) + if (.isTrialDesignInverseNormal(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combInverseNormal", + "weightsInverseNormal" + ) + } else if (.isTrialDesignFisher(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combFisher", + "weightsFisher" + ) + } + return(parametersToShow) + } + ) +) + +#' +#' @name StageResultsEnrichmentMeans +#' +#' @title +#' Stage Results Enrichment Means +#' +#' @description +#' Class for stage results of enrichment means data +#' +#' @template field_stages +#' @template field_thetaH0 +#' @template field_direction +#' @template field_normalApproximation +#' @template field_directionUpper +#' @template field_varianceOption +#' @template field_intersectionTest +#' @template field_testStatistics +#' @template field_overallTestStatistics +#' @template field_pValues +#' @template field_overallPValues +#' @template field_overallStDevs +#' @template field_overallPooledStDevs +#' @template field_separatePValues +#' @template field_effectSizes +#' @template field_singleStepAdjustedPValues +#' @template field_stratifiedAnalysis +#' @template field_combInverseNormal +#' @template field_combFisher +#' @template field_weightsFisher +#' @template field_weightsInverseNormal +#' +#' @details +#' This object cannot be created directly; use \code{getStageResults} +#' with suitable arguments to create the stage results of a dataset of enrichment means. +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +StageResultsEnrichmentMeansR6 <- R6Class("StageResultsEnrichmentMeansR6", + inherit = StageResultsMultiArmMeansR6, + public = list( + .overallSampleSizes1 = NULL, + .overallSampleSizes2 = NULL, + stratifiedAnalysis = NULL, + .getParametersToShow = function() {#TODO init + return(c(super$.getParametersToShow(), "stratifiedAnalysis")) + } + ) +) + +#' +#' @name StageResultsEnrichmentRates +#' +#' @title +#' Stage Results Enrichment Rates +#' +#' @description +#' Class for stage results of enrichment rates data. +#' +#' @template field_stages +#' @template field_testStatistics +#' @template field_pValues +#' @template field_combInverseNormal +#' @template field_combFisher +#' @template field_effectSizes +#' @template field_testActions +#' @template field_weightsFisher +#' @template field_weightsInverseNormal +#' +#' @details +#' This object cannot be created directly; use \code{getStageResults} +#' with suitable arguments to create the stage results of a dataset of enrichment rates. +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +StageResultsEnrichmentRatesR6 <- R6Class("StageResultsEnrichmentRatesR6", + inherit = StageResultsMultiArmRatesR6, + public = list( + .overallSampleSizes1 = NULL, + .overallSampleSizes2 = NULL, + overallPisTreatment = NULL, + overallPisControl = NULL, + stratifiedAnalysis = NULL, + .getParametersToShow = function() { + parametersToShow <- super$.getParametersToShow() + parametersToShow <- parametersToShow[!(parametersToShow %in% c("overallPiTreatments", "overallPiControl"))] + return(c(parametersToShow, "stratifiedAnalysis", "overallPisTreatment", "overallPisControl")) + } + ) +) + +#' +#' @name StageResultsEnrichmentSurvival +#' +#' @title +#' Stage Results Enrichment Survival +#' +#' @description +#' Class for stage results of enrichment survival data. +#' +#' @template field_stages +#' @template field_testStatistics +#' @template field_pValues +#' @template field_combInverseNormal +#' @template field_combFisher +#' @template field_effectSizes +#' @template field_testActions +#' @template field_weightsFisher +#' @template field_weightsInverseNormal +#' +#' @details +#' This object cannot be created directly; use \code{getStageResults} +#' with suitable arguments to create the stage results of a dataset of enrichment survival. +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +StageResultsEnrichmentSurvivalR6 <- R6Class("StageResultsEnrichmentSurvivalR6", + inherit = StageResultsMultiArmSurvivalR6, + public = list( + stratifiedAnalysis = NULL, + .overallEvents = NULL, + .getParametersToShow = function() { + return(c(super$.getParametersToShow(), "stratifiedAnalysis")) + } + ) +) + +#' +#' @title +#' Names of a Stage Results Object +#' +#' @description +#' Function to get the names of a \code{\link{StageResults}} object. +#' +#' @param x A \code{\link{StageResults}} object. +#' +#' @details +#' Returns the names of stage results that can be accessed by the user. +#' +#' @template return_names +#' +#' @export +#' +#' @keywords internal +#' +names.StageResultsR6 <- function(x) { + return(x$.getParametersToShow()) +} + +#' +#' @title +#' Coerce Stage Results to a Data Frame +#' +#' @description +#' Returns the \code{StageResults} as data frame. +#' +#' @param x A \code{\link{StageResults}} object. +#' @inheritParams param_niceColumnNamesEnabled +#' @inheritParams param_includeAllParameters +#' @inheritParams param_three_dots +#' +#' @details +#' Coerces the stage results to a data frame. +#' +#' @template return_dataframe +#' +#' @export +#' +#' @keywords internal +#' +as.data.frame.StageResultsR6 <- function(x, row.names = NULL, + optional = FALSE, niceColumnNamesEnabled = FALSE, + includeAllParameters = FALSE, type = 1, ...) { + if (type == 1) { + parametersToShow <- x$.getParametersToShow() + + return(.getAsDataFrame( + parameterSet = x, + parameterNames = parametersToShow, + niceColumnNamesEnabled = niceColumnNamesEnabled, + includeAllParameters = includeAllParameters, + tableColumnNames = .getTableColumnNames(design = x$.design) + )) + } + + kMax <- length(x$stages) + group1 <- rep(1, kMax) + group2 <- rep(2, kMax) + empty <- rep(NA_real_, kMax) + stageResults <- data.frame( + Stage = c(x$stages, x$stages), + Group = c(group1, group2), + "Cumulative Mean" = c(x$overallMeans1, x$overallMeans2), + "Cumulative stDev" = c(x$overallStDevs1, x$overallStDevs2), + "Cumulative test statistics" = c(x$overallTestStatistics, empty), + "Overall p-value" = c(x$overallPValues, empty), + "Cumulative stDev" = c(x$overallStDevs, empty), + "Stage-wise test statistic" = c(x$testStatistics, empty), + "Stage-wise p-value" = c(x$pValues, empty), + "Comb Inverse Normal" = c(x$combInverseNormal, empty), + "Comb Fisher" = c(x$combFisher, empty), + "Weights Fisher" = c(x$weightsFisher, empty), + "Weights Inverse Normal" = c(x$weightsInverseNormal, empty), + row.names = row.names, + ... + ) + stageResults <- stageResults[with(stageResults, order(Stage, Group)), ] + return(stageResults) +} + +.getTreatmentArmsToShow <- function(x, ...) { + dataInput <- x + if (!inherits(dataInput, "Dataset")) { + dataInput <- x[[".dataInput"]] + } + if (is.null(dataInput) || !inherits(dataInput, "Dataset")) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to get 'dataInput' from ", .getClassName(x)) + } + + numberOfTreatments <- dataInput$getNumberOfGroups() + if (numberOfTreatments > 1) { + validComparisons <- 1L:as.integer(numberOfTreatments - 1) + } else { + validComparisons <- 1L + } + + treatmentArmsToShow <- .getOptionalArgument("treatmentArms", ...) + if (!is.null(treatmentArmsToShow)) { + treatmentArmsToShow <- as.integer(na.omit(treatmentArmsToShow)) + } + if (is.null(treatmentArmsToShow) || length(treatmentArmsToShow) == 0 || + all(is.na(treatmentArmsToShow)) || !is.numeric(treatmentArmsToShow)) { + treatmentArmsToShow <- validComparisons + } else if (!all(treatmentArmsToShow %in% validComparisons)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'treatmentArms' (", + .arrayToString(treatmentArmsToShow), ") must be a vector ", + "containing one or more values of ", .arrayToString(validComparisons) + ) + } + treatmentArmsToShow <- sort(unique(treatmentArmsToShow)) + return(treatmentArmsToShow) +} + +.getPopulationsToShow <- function(x, ..., gMax) { + dataInput <- x + if (!inherits(dataInput, "Dataset")) { + dataInput <- x[[".dataInput"]] + } + if (is.null(dataInput) || !inherits(dataInput, "Dataset")) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to get 'dataInput' from ", .getClassName(x)) + } + + numberOfPopulations <- gMax + if (numberOfPopulations > 1) { + validComparisons <- 1L:as.integer(numberOfPopulations) + } else { + validComparisons <- 1L + } + + populationsToShow <- .getOptionalArgument("populations", ...) + + if (!is.null(populationsToShow)) { + populationsToShow <- as.integer(na.omit(populationsToShow)) + } + if (is.null(populationsToShow) || length(populationsToShow) == 0 || + all(is.na(populationsToShow)) || !is.numeric(populationsToShow)) { + populationsToShow <- validComparisons + } else if (!all(populationsToShow %in% validComparisons)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'populations' (", + .arrayToString(populationsToShow), ") must be a vector ", + "containing one or more values of ", .arrayToString(validComparisons) + ) + } + populationsToShow <- sort(unique(populationsToShow)) + return(populationsToShow) +} + +#' +#' @title +#' Stage Results Plotting +#' +#' @description +#' Plots the conditional power together with the likelihood function. +#' +#' @param x The stage results at given stage, obtained from \code{\link[=getStageResults]{getStageResults()}} or +#' \code{\link[=getAnalysisResults]{getAnalysisResults()}}. +#' @param y Not available for this kind of plot (is only defined to be compatible to the generic plot function). +#' @inheritParams param_stage +#' @inheritParams param_nPlanned +#' @inheritParams param_allocationRatioPlanned +#' @param main The main title. +#' @param xlab The x-axis label. +#' @param ylab The y-axis label. +#' @param legendTitle The legend title. +#' @inheritParams param_palette +#' @inheritParams param_showSource +#' @inheritParams param_plotSettings +#' @inheritParams param_legendPosition +#' @param type The plot type (default = 1). Note that at the moment only one type +#' (the conditional power plot) is available. +#' @param ... Optional \link[=param_three_dots_plot]{plot arguments}. Furthermore the following arguments can be defined: +#' \itemize{ +#' \item \code{thetaRange}: A range of assumed effect sizes if testing means or a survival design was specified. +#' Additionally, if testing means was selected, an assumed standard deviation can be specified (default is 1). +#' \item \code{piTreatmentRange}: A range of assumed rates pi1 to calculate the conditional power. +#' Additionally, if a two-sample comparison was selected, pi2 can be specified (default is the value from +#' \code{\link[=getAnalysisResults]{getAnalysisResults()}}). +#' \item \code{directionUpper}: Specifies the direction of the alternative, +#' only applicable for one-sided testing; default is \code{TRUE} +#' which means that larger values of the test statistics yield smaller p-values. +#' \item \code{\link[=param_thetaH0]{thetaH0}}: The null hypothesis value, default is 0 for the normal and the binary case, +#' it is 1 for the survival case. +#' For testing a rate in one sample, a value thetaH0 in (0,1) has to be specified for +#' defining the null hypothesis H0: pi = thetaH0. +#' } +#' +#' @details +#' Generic function to plot all kinds of stage results. +#' The conditional power is calculated only if effect size and sample size is specified. +#' +#' @template return_object_ggplot +#' +#' @examples +#' design <- getDesignGroupSequential( +#' kMax = 4, alpha = 0.025, +#' informationRates = c(0.2, 0.5, 0.8, 1), +#' typeOfDesign = "WT", deltaWT = 0.25 +#' ) +#' +#' dataExample <- getDataset( +#' n = c(20, 30, 30), +#' means = c(50, 51, 55), +#' stDevs = c(130, 140, 120) +#' ) +#' +#' stageResults <- getStageResults(design, dataExample, thetaH0 = 20) +#' +#' \dontrun{ +#' if (require(ggplot2)) plot(stageResults, nPlanned = c(30), thetaRange = c(0, 100)) +#' } +#' +#' @export +#' +plot.StageResultsR6 <- function(x, y, ..., type = 1L, + nPlanned, allocationRatioPlanned = 1, # C_ALLOCATION_RATIO_DEFAULT + main = NA_character_, xlab = NA_character_, ylab = NA_character_, + legendTitle = NA_character_, palette = "Set1", legendPosition = NA_integer_, + showSource = FALSE, plotSettings = NULL) { + fCall <- match.call(expand.dots = FALSE) + + .assertGgplotIsInstalled() + .assertIsStageResults(x) + .assertIsValidLegendPosition(legendPosition) + if (.isConditionalPowerEnabled(nPlanned)) { + .assertIsValidAllocationRatioPlanned(allocationRatioPlanned, x$.dataInput$getNumberOfGroups()) + } + .stopInCaseOfIllegalStageDefinition2(...) + + if (x$.design$kMax == 1) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "cannot plot stage results of a fixed design") + } + + if (!is.logical(showSource) || isTRUE(showSource)) { + stageResultsName <- .getOptionalArgument("stageResultsName", ...) + if (is.null(stageResultsName)) { + stageResultsName <- deparse(fCall$x) + } + cat("Source data of the plot:\n") + cat(" Use getConditionalPower(..., addPlotData = TRUE) to create the data.\n", sep = "") + cat("Simple plot command example:\n", sep = "") + + cmd <- paste0( + "condPow <- getConditionalPower(", stageResultsName, + ", nPlanned = ", .arrayToString(nPlanned, vectorLookAndFeelEnabled = TRUE) + ) + if (.isConditionalPowerEnabled(nPlanned) && allocationRatioPlanned != C_ALLOCATION_RATIO_DEFAULT) { + cmd <- paste0(cmd, ", allocationRatioPlanned = ", allocationRatioPlanned) + } + if (grepl("Means|Survival", .getClassName(x))) { + cmd <- paste0(cmd, ", thetaRange = seq(0, 1, 0.1)") + } else if (grepl("Rates", .getClassName(x))) { + cmd <- paste0(cmd, ", piTreatmentRange = seq(0, 1, 0.1)") + } + cmd <- paste0(cmd, ", addPlotData = TRUE)") + + cat(" ", cmd, "\n", sep = "") + cat(" plotData <- condPow$.plotData # get plot data list\n", sep = "") + cat(" plotData # show plot data list\n", sep = "") + cat(" plot(plotData$xValues, plotData$condPowerValues)\n", sep = "") + cat(" plot(plotData$xValues, plotData$likelihoodValues)\n", sep = "") + } + + plotData <- .getConditionalPowerPlot( + stageResults = x, nPlanned = nPlanned, + allocationRatioPlanned = allocationRatioPlanned, ... + ) + + yParameterName1 <- "Conditional power" + yParameterName2 <- "Likelihood" + + if (.isMultiArmStageResults(x)) { + treatmentArmsToShow <- .getTreatmentArmsToShow(x, ...) + data <- data.frame( + xValues = numeric(0), + yValues = numeric(0), + categories = character(0), + treatmentArms = numeric(0) + ) + for (treatmentArm in treatmentArmsToShow) { + legend1 <- ifelse(length(treatmentArmsToShow) == 1, yParameterName1, + paste0(yParameterName1, " (", treatmentArm, " vs control)") + ) + legend2 <- ifelse(length(treatmentArmsToShow) == 1, yParameterName2, + paste0(yParameterName2, " (", treatmentArm, " vs control)") + ) + + treatmentArmIndices <- which(plotData$treatmentArms == treatmentArm) + + if (all(is.na(plotData$condPowerValues[treatmentArmIndices]))) { + if (!all(is.na(plotData$likelihoodValues[treatmentArmIndices]))) { + data <- rbind(data, data.frame( + xValues = plotData$xValues[treatmentArmIndices], + yValues = plotData$likelihoodValues[treatmentArmIndices], + categories = rep(legend2, length(plotData$xValues[treatmentArmIndices])), + treatmentArms = rep(treatmentArm, length(plotData$xValues[treatmentArmIndices])) + )) + } + } else { + data <- rbind(data, data.frame( + xValues = c( + plotData$xValues[treatmentArmIndices], + plotData$xValues[treatmentArmIndices] + ), + yValues = c( + plotData$condPowerValues[treatmentArmIndices], + plotData$likelihoodValues[treatmentArmIndices] + ), + categories = c( + rep(legend1, length(plotData$xValues[treatmentArmIndices])), + rep(legend2, length(plotData$xValues[treatmentArmIndices])) + ), + treatmentArms = c( + rep(treatmentArm, length(plotData$xValues[treatmentArmIndices])), + rep(treatmentArm, length(plotData$xValues[treatmentArmIndices])) + ) + )) + } + } + } else if (.isEnrichmentStageResults(x)) { + gMax <- max(na.omit(plotData$populations)) + populationsToShow <- .getPopulationsToShow(x, ..., gMax = gMax) + data <- data.frame( + xValues = numeric(0), + yValues = numeric(0), + categories = character(0), + populations = numeric(0) + ) + for (population in populationsToShow) { + populationName <- ifelse(population == gMax, "F", paste0("S", population)) + legend1 <- ifelse(length(populationsToShow) == 1, yParameterName1, + paste0(yParameterName1, " (", populationName, ")") + ) + legend2 <- ifelse(length(populationsToShow) == 1, yParameterName2, + paste0(yParameterName2, " (", populationName, ")") + ) + + populationIndices <- which(plotData$populations == population) + + if (all(is.na(plotData$condPowerValues[populationIndices]))) { + if (!all(is.na(plotData$likelihoodValues[populationIndices]))) { + data <- rbind(data, data.frame( + xValues = plotData$xValues[populationIndices], + yValues = plotData$likelihoodValues[populationIndices], + categories = rep(legend2, length(plotData$xValues[populationIndices])), + populations = rep(population, length(plotData$xValues[populationIndices])) + )) + } + } else { + data <- rbind(data, data.frame( + xValues = c( + plotData$xValues[populationIndices], + plotData$xValues[populationIndices] + ), + yValues = c( + plotData$condPowerValues[populationIndices], + plotData$likelihoodValues[populationIndices] + ), + categories = c( + rep(legend1, length(plotData$xValues[populationIndices])), + rep(legend2, length(plotData$xValues[populationIndices])) + ), + populations = c( + rep(population, length(plotData$xValues[populationIndices])), + rep(population, length(plotData$xValues[populationIndices])) + ) + )) + } + } + } else { + if (all(is.na(plotData$condPowerValues))) { + legendPosition <- -1 + data <- data.frame( + xValues = plotData$xValues, + yValues = plotData$likelihoodValues, + categories = rep(yParameterName2, length(plotData$xValues)) + ) + } else { + data <- data.frame( + xValues = c(plotData$xValues, plotData$xValues), + yValues = c(plotData$condPowerValues, plotData$likelihoodValues), + categories = c( + rep(yParameterName1, length(plotData$xValues)), + rep(yParameterName2, length(plotData$xValues)) + ) + ) + } + } + + data$categories <- factor(data$categories, levels = unique(data$categories)) + + main <- ifelse(is.na(main), C_PLOT_MAIN_CONDITIONAL_POWER_WITH_LIKELIHOOD, main) + ylab <- ifelse(is.na(ylab), C_PLOT_YLAB_CONDITIONAL_POWER_WITH_LIKELIHOOD, ylab) + + if (is.na(legendTitle)) { + legendTitle <- "Parameter" + } + + return(.createAnalysisResultsPlotObject(x, + data = data, plotData = plotData, main = main, xlab = xlab, ylab = ylab, + legendTitle = legendTitle, palette = palette, legendPosition = legendPosition, numberOfPairedLines = 2L, + plotSettings = plotSettings + )) +} + +.createAnalysisResultsPlotObject <- function(x, ..., data, plotData, + main = NA_character_, xlab = NA_character_, ylab = NA_character_, + legendTitle = NA_character_, palette = "Set1", legendPosition = NA_integer_, + numberOfPairedLines = NA_integer_, plotSettings = NULL) { + ciModeEnabled <- !is.null(data[["lower"]]) && !is.null(data[["upper"]]) + + if (!ciModeEnabled) { + p <- ggplot2::ggplot(data, ggplot2::aes( + x = .data[["xValues"]], y = .data[["yValues"]], + colour = factor(.data[["categories"]]), + linetype = factor(.data[["categories"]]) + )) + } else { + p <- ggplot2::ggplot(data, ggplot2::aes( + x = .data[["xValues"]], y = .data[["yValues"]], + colour = factor(.data[["categories"]]) + )) + } + + if (is.null(plotSettings)) { + plotSettings <- x$getPlotSettings() + } + + p <- plotSettings$setTheme(p) + p <- plotSettings$hideGridLines(p) + + # set main title + mainTitle <- ifelse(!is.call(main) && !isS4(main) && is.na(main), plotData$main, main) + p <- plotSettings$setMainTitle(p, mainTitle, subtitle = plotData$sub) + + # set legend + if (is.na(legendPosition)) { + legendPosition <- C_POSITION_LEFT_TOP + } + p <- plotSettings$setLegendPosition(p, legendPosition = legendPosition) + p <- plotSettings$setLegendBorder(p) + p <- plotSettings$setLegendTitle(p, legendTitle) + p <- plotSettings$setLegendLabelSize(p) + + # set axes labels + p <- plotSettings$setAxesLabels(p, + xAxisLabel = plotData$xlab, yAxisLabel1 = plotData$ylab, + xlab = xlab, ylab = ylab + ) + + # plot lines and points + if (!ciModeEnabled) { + if (is.na(numberOfPairedLines)) { + numberOfPairedLines <- 2 + if (x$.isMultiArm()) { + numberOfPairedLines <- length(unique(data$treatmentArms)) - 1 + } else if (x$.isEnrichment()) { + numberOfPairedLines <- length(unique(data$populations)) - 1 + } + } + + p <- plotSettings$plotValues(p, plotPointsEnabled = FALSE, pointBorder = 1) + n <- length(unique(data$categories)) / numberOfPairedLines + if (n > 1) { + lineTypeValues <- rep(1:numberOfPairedLines, n) + colorTypes <- sort(rep(1:n, numberOfPairedLines)) + for (i in c(1, 3)) { + colorTypes[colorTypes >= i] <- colorTypes[colorTypes >= i] + 1 + } + p <- p + ggplot2::scale_color_manual(name = legendTitle, values = colorTypes) + p <- p + ggplot2::scale_linetype_manual(name = legendTitle, values = lineTypeValues) + } else { + colorValues <- c(2, 4) + if (!x$.isMultiArm()) { + colorValues <- c(2, 2) # use only one color + } + p <- p + ggplot2::scale_color_manual(name = legendTitle, values = colorValues) + p <- p + ggplot2::scale_linetype_manual(name = legendTitle, values = c(1, 2)) + } + } + + # plot confidence intervall + else { + pd <- ggplot2::position_dodge(0.15) + + p <- p + ggplot2::geom_errorbar( + data = data, + ggplot2::aes(ymin = .data[["lower"]], ymax = .data[["upper"]]), + width = 0.15, position = pd, size = 0.8 + ) + p <- p + ggplot2::geom_line(position = pd, linetype = "longdash") + p <- p + ggplot2::geom_point(position = pd, size = 2.0) + + + stage <- unique(data$xValues) + kMax <- list(...)[["kMax"]] + if (length(stage) == 1 && !is.null(kMax)) { + stages <- 1:kMax + p <- p + ggplot2::scale_x_continuous(breaks = stages) + } else if (length(stage) > 1 && all(stage %in% 1:10)) { + p <- p + ggplot2::scale_x_continuous(breaks = stage) + } + } + + p <- plotSettings$setAxesAppearance(p) + p <- plotSettings$enlargeAxisTicks(p) + + companyAnnotationEnabled <- .getOptionalArgument("companyAnnotationEnabled", ...) + if (is.null(companyAnnotationEnabled) || !is.logical(companyAnnotationEnabled)) { + companyAnnotationEnabled <- FALSE + } + + p <- plotSettings$addCompanyAnnotation(p, enabled = companyAnnotationEnabled) + + # start plot generation + return(p) +} diff --git a/R/class_core_parameter_set_r6.R b/R/class_core_parameter_set_r6.R new file mode 100644 index 00000000..40a918cc --- /dev/null +++ b/R/class_core_parameter_set_r6.R @@ -0,0 +1,1717 @@ +## | +## | *Parameter set classes* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | rpact package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File version: $Revision: 6902 $ +## | Last changed: $Date: 2023-03-29 10:01:19 +0200 (Mi, 29 Mrz 2023) $ +## | Last changed by: $Author: pahlke $ +## | + +#' @include f_core_constants.R +#' @include f_core_assertions.R +NULL + +#' +#' @name FieldSetR6 +#' +#' @title +#' Field Set +#' +#' @description +#' Basic class for field sets. +#' +#' @details +#' The field set implements basic functions for a set of fields. +#' +#' @include class_core_plot_settings.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +FieldSetR6 <- R6Class("FieldSetR6", + public = list( + .parameterTypes = NULL, + .parameterNames = NULL, + .parameterFormatFunctions = NULL, + .showParameterTypeEnabled = NULL, + .catLines = NULL, + .getFieldNames = function() { + return(unlist(lapply(class(self)[1:(length(class(self))-1)],function(x) {names(get(x)$public_fields)}))) + }, + .getVisibleFieldNames = function() { + fieldNames <- self$.getFieldNames() + fieldNames <- fieldNames[!startsWith(fieldNames, ".")] + return(fieldNames) + }, + .resetCat = function() { + self$.catLines <- character(0) + }, + .cat = function(..., file = "", sep = "", fill = FALSE, labels = NULL, + append = FALSE, heading = 0, tableColumns = 0, consoleOutputEnabled = TRUE, + na = NA_character_) { + if (consoleOutputEnabled) { + cat(..., file = file, sep = sep, fill = fill, labels = labels, append = append) + return(invisible()) #TODO self? + } + + args <- list(...) + line <- "" + if (length(args) > 0) { + if (tableColumns > 0) { + values <- unlist(args, use.names = FALSE) + values <- values[values != "\n"] + for (i in 1:length(values)) { + values[i] <- gsub("\n", "", values[i]) + } + if (!is.null(na) && length(na) == 1 && !is.na(na)) { + len <- min(nchar(values)) + naStr <- paste0(trimws(na), " ") + while (nchar(naStr) < len) { + naStr <- paste0(" ", naStr) + } + values[is.na(values) | nchar(trimws(values)) == 0] <- naStr + } + line <- paste0(values, collapse = "| ") + if (trimws(line) != "" && !grepl("\\| *$", line)) { + line <- paste0(line, "|") + } + line <- paste0("| ", line) + extraCells <- tableColumns - length(values) + if (extraCells > 0 && trimws(line) != "") { + line <- paste0(line, paste0(rep(" |", extraCells), collapse = "")) + } + line <- paste0(line, "\n") + } else { + line <- paste0(args, collapse = sep) + listItemEnabled <- grepl("^ ", line) + + headingBaseNumber <- as.integer(getOption("rpact.print.heading.base.number", 0L)) + if (is.na(headingBaseNumber)) { + headingBaseNumber <- 0L + } + if (headingBaseNumber < -1) { + warning( + "Illegal option ", sQuote("rpact.print.heading.base.number"), + " (", headingBaseNumber, ") was set to 0" + ) + headingBaseNumber <- 0L + } + if (headingBaseNumber > 4) { + warning( + "Illgeal option ", sQuote("rpact.print.heading.base.number"), + " (", headingBaseNumber, ") was set to 4 becasue it was too large" + ) + headingBaseNumber <- 4L + } + + if (heading > 0) { + if (headingBaseNumber == -1) { + lineBreak <- "" + if (grepl("\n *$", line)) { + lineBreak <- "\n\n" + } + line <- paste0("**", sub(": *", "", trimws(line)), "**", lineBreak) + } else { + headingCmd <- paste0(rep("#", heading + headingBaseNumber + 1), collapse = "") + lineBreak <- "" + if (grepl("\n *$", line)) { + lineBreak <- "\n\n" + } + line <- paste0(headingCmd, " ", sub(": *", "", trimws(line)), lineBreak) + } + } else { + parts <- strsplit(line, " *: ")[[1]] + if (length(parts) == 2) { + line <- paste0("*", trimws(parts[1]), "*: ", parts[2]) + } + } + if (listItemEnabled) { + if (grepl("^ ", line)) { + line <- sub("^ ", "* ", line) + } else { + line <- paste0("* ", line) + } + } + } + } + if (length(self$.catLines) == 0) { + self$.catLines <- line + } else { + self$.catLines <- c(self$.catLines, line) + } + return(invisible()) + }, + .getFields = function(values) { + flds <- self$.getFieldNames() + if (!missing(values)) { + flds <- flds[flds %in% values] + } + result <- setNames(vector("list", length(flds)), flds) + for (fld in flds) { + result[[fld]] <- self[[fld]] + } + return(result) + } + ) +) + +#' +#' @name ParameterSetR6 +#' +#' @title +#' Parameter Set +#' +#' @description +#' Basic class for parameter sets. +#' +#' @details +#' The parameter set implements basic functions for a set of parameters. +#' +#' @include f_core_constants.R +#' @include f_core_utilities.R +#' @include f_parameter_set_utilities.R +#' @include f_analysis_utilities.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +ParameterSetR6 <- R6Class("ParameterSetR6", + inherit = FieldSetR6, + public = list( + initialize = function(..., .showParameterTypeEnabled = TRUE) { + self$.showParameterTypeEnabled <- .showParameterTypeEnabled + self$.parameterTypes <- list() + self$.parameterNames <- list() + self$.parameterFormatFunctions <- list() + self$.catLines <- character(0) + }, + .toString = function(startWithUpperCase = FALSE) { + s <- .formatCamelCase(.getClassName(self)) + return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) + }, + .initParameterTypes = function() { + for (parameterName in names(self$.parameterNames)) { + self$.parameterTypes[[parameterName]] <- C_PARAM_TYPE_UNKNOWN + } + }, + .getParameterType = function(parameterName) { + if (is.null(parameterName) || length(parameterName) == 0 || is.na(parameterName)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'parameterName' must be a valid character with length > 0" + ) + } + + parameterType <- self$.parameterTypes[[parameterName]] + if (is.null(parameterType)) { + return(C_PARAM_TYPE_UNKNOWN) + } + + return(parameterType[1]) + }, + .getParametersToShow = function() { + return(self$.getVisibleFieldNames()) + }, + .setParameterType = function(parameterName, parameterType) { + if (is.null(parameterName) || length(parameterName) == 0 || is.na(parameterName)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'parameterName' must be a valid character with length > 0" + ) + } + + parameterType <- parameterType[1] + + if (!all(parameterType %in% c( + C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE, + C_PARAM_GENERATED, C_PARAM_DERIVED, C_PARAM_NOT_APPLICABLE + ))) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'parameterType' ('", parameterType, "') is invalid" + ) + } + + self$.parameterTypes[[parameterName]] <- parameterType + + invisible(parameterType) #TODO return? + }, + isUserDefinedParameter = function(parameterName) { + return(self$.getParameterType(parameterName) == C_PARAM_USER_DEFINED) + }, + isDefaultParameter = function(parameterName) { + return(self$.getParameterType(parameterName) == C_PARAM_DEFAULT_VALUE) + }, + isGeneratedParameter = function(parameterName) { + return(self$.getParameterType(parameterName) == C_PARAM_GENERATED) + }, + isDerivedParameter = function(parameterName) { + return(self$.getParameterType(parameterName) == C_PARAM_DERIVED) + }, + isUndefinedParameter = function(parameterName) { + return(self$.getParameterType(parameterName) == C_PARAM_TYPE_UNKNOWN) + }, + .getInputParameters = function() { + params <- self$.getParametersOfOneGroup(c(C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE)) + return(params) + }, + .getUserDefinedParameters = function() { + return(self$.getParametersOfOneGroup(C_PARAM_USER_DEFINED)) + }, + .getDefaultParameters = function() { + return(self$.getParametersOfOneGroup(C_PARAM_DEFAULT_VALUE)) + }, + .getGeneratedParameters = function() { + return(self$.getParametersOfOneGroup(C_PARAM_GENERATED)) + }, + .getDerivedParameters = function() { + return(self$.getParametersOfOneGroup(C_PARAM_DERIVED)) + }, + .getUndefinedParameters = function() { + return(self$.getParametersOfOneGroup(C_PARAM_TYPE_UNKNOWN)) + }, + .getParameterValueIfUserDefinedOrDefault = function(parameterName) { + if (self$isUserDefinedParameter(parameterName) || self$isDefaultParameter(parameterName)) { + return(self[[parameterName]]) #TODO does this work? + } + + parameterType <- .self$getRefClass()$fields()[[parameterName]]#TODO + if (parameterType == "numeric") { + return(NA_real_) + } + + if (parameterType == "integer") { + return(NA_integer_) + } + + if (parameterType == "character") { + return(NA_character_) + } + + return(NA) + }, + .getParametersOfOneGroup = function(parameterType) { + if (length(parameterType) == 1) { + parameterNames <- names(self$.parameterTypes[self$.parameterTypes == parameterType]) + } else { + parameterNames <- names(self$.parameterTypes[which(self$.parameterTypes %in% parameterType)]) + } + parametersToShow <- self$.getParametersToShow() + if (is.null(parametersToShow) || length(parametersToShow) == 0) { + return(parameterNames) + } + + return(parametersToShow[parametersToShow %in% parameterNames]) + }, + .showParameterType = function(parameterName) { + if (!self$.showParameterTypeEnabled) { + return(" ") + } + + return(paste0("[", self$.getParameterType(parameterName), "]")) + }, + .showAllParameters = function(consoleOutputEnabled = TRUE) { + parametersToShow <- self$.getVisibleFieldNamesOrdered() + for (parameter in parametersToShow) { + self$.showParameter(parameter, + showParameterType = TRUE, + consoleOutputEnabled = consoleOutputEnabled + ) + } + }, + .getVisibleFieldNamesOrdered = function() { + visibleFieldNames <- self$.getVisibleFieldNames() + + parametersToShowSorted <- self$.getParametersToShow() + if (is.null(parametersToShowSorted) || length(parametersToShowSorted) == 0) { + return(visibleFieldNames) + } + + visibleFieldNames <- visibleFieldNames[!(visibleFieldNames %in% parametersToShowSorted)] + visibleFieldNames <- c(parametersToShowSorted, visibleFieldNames) + return(visibleFieldNames) + }, + .show = function(..., consoleOutputEnabled = FALSE) { + showType <- .getOptionalArgument("showType", ...) + if (!is.null(showType) && showType == 2) { + self$.cat("Technical developer summary of the ", self$.toString(), " object (", + methods::classLabel(class(self)), "):\n\n", + sep = "", heading = 1, + consoleOutputEnabled = consoleOutputEnabled + ) + self$.showAllParameters(consoleOutputEnabled = consoleOutputEnabled) + self$.showParameterTypeDescription(consoleOutputEnabled = consoleOutputEnabled) + } else { + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, + "method '.show()' is not implemented in class '", .getClassName(self), "'" + ) + } + }, + .catMarkdownText = function(...) { + 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 <- "" + if (is.null(parameters) || length(parameters) == 0 || all(is.na(parameters))) { + if (!missing(title) && !is.null(title) && !is.na(title) && consoleOutputEnabled) { + output <- paste0(title, ": not available\n\n") + self$.cat(output, heading = 2, consoleOutputEnabled = consoleOutputEnabled) + } + invisible(output) + } else { + if (orderByParameterName) { + parameters <- sort(parameters) + } + + if (!missing(title) && !is.null(title) && !is.na(title)) { + output <- paste0(title, ":\n") + self$.cat(output, heading = 2, consoleOutputEnabled = consoleOutputEnabled) + } + for (parameterName in parameters) { + output <- paste0(output, self$.showParameter(parameterName, + consoleOutputEnabled = consoleOutputEnabled + )) + } + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) + output <- paste0(output, "\n") + invisible(output) + } + }, + .showParameter = function(parameterName, showParameterType = FALSE, consoleOutputEnabled = TRUE) { + tryCatch( + { + + params <- .getParameterValueFormatted(obj = self, parameterName = parameterName) + if (is.null(params) || !is.list(params)) { + return(invisible("")) + } + + if (!is.null(names(params)) && "paramValue" %in% names(params)) { + return(self$.showParameterSingle( + param = params, + parameterName = parameterName, + showParameterType = showParameterType, + consoleOutputEnabled = consoleOutputEnabled + )) + } + + output <- "" + for (i in 1:length(params)) { + param <- params[[i]] + category <- NULL + parts <- strsplit(param$paramName, "$", fixed = TRUE)[[1]] + if (length(parts) == 2) { + parameterName <- parts[1] + param$paramName <- parameterName + + category <- parts[2] + categoryCaption <- self$.parameterNames[[category]] + if (is.null(categoryCaption)) { + categoryCaption <- paste0("%", category, "%") + } + category <- categoryCaption + } + outputPart <- self$.showParameterSingle( + param = param, + parameterName = parameterName, + category = category, + showParameterType = showParameterType, + consoleOutputEnabled = consoleOutputEnabled + ) + if (nchar(output) > 0) { + output <- paste0(output, "\n", outputPart) + } else { + output <- outputPart + } + } + return(invisible(output)) + }, + error = function(e) { + if (consoleOutputEnabled) { + warning("Failed to show parameter '", parameterName, "': ", e$message) + } + } + ) + }, + .showParameterSingle = function(param, + parameterName, ..., + category = NULL, + showParameterType = FALSE, + consoleOutputEnabled = TRUE) { + if (is.null(param)) { + return(invisible("")) + } + + output <- "" + tryCatch( + { + if (param$type == "array" && length(dim(param$paramValue)) == 3) { + numberOfEntries <- dim(param$paramValue)[3] + numberOfRows <- dim(param$paramValue)[1] + if (numberOfEntries > 0 && numberOfRows > 0) { + index <- 1 + for (i in 1:numberOfEntries) { + for (j in 1:numberOfRows) { + output <- paste0(output, self$.showParameterFormatted( + paramName = param$paramName, + paramValue = param$paramValue[j, , i], + paramValueFormatted = param$paramValueFormatted[[index]], + showParameterType = showParameterType, + category = i, + matrixRow = ifelse(numberOfRows == 1, NA_integer_, j), + consoleOutputEnabled = consoleOutputEnabled, + paramNameRaw = parameterName, + numberOfCategories = numberOfEntries + )) + index <- index + 1 + } + } + } + } else if (param$type %in% c("matrix", "array")) { + n <- length(param$paramValueFormatted) + if (n > 0) { + for (i in 1:n) { + paramValue <- param$paramValue + if (is.array(paramValue) && + length(dim(paramValue)) == 3 && + dim(paramValue)[3] == 1) { + paramValue <- paramValue[i, , 1] + } else if (dim(paramValue)[1] > 1 || dim(paramValue)[2] > 1) { + paramValue <- paramValue[i, ] + } + + output <- paste0(output, self$.showParameterFormatted( + paramName = param$paramName, + paramValue = paramValue, + paramValueFormatted = param$paramValueFormatted[[i]], + showParameterType = showParameterType, + category = category, + matrixRow = ifelse(n == 1, NA_integer_, i), + consoleOutputEnabled = consoleOutputEnabled, + paramNameRaw = parameterName, + numberOfCategories = n + )) + } + } + } else { + output <- self$.showParameterFormatted( + paramName = param$paramName, + paramValue = param$paramValue, + paramValueFormatted = param$paramValueFormatted, + showParameterType = showParameterType, + category = category, + consoleOutputEnabled = consoleOutputEnabled, + paramNameRaw = parameterName + ) + } + }, + error = function(e) { + if (consoleOutputEnabled) { + warning("Failed to show single parameter '", parameterName, "' (", param$type, "): ", e$message) + } + } + ) + return(invisible(output)) + }, + .extractParameterNameAndValue = function(parameterName) { + d <- regexpr(paste0("\\..+\\$"), parameterName) + if (d[1] != 1) { + return(list(parameterName = parameterName, paramValue = self[[parameterName]])) + } + + index <- attr(d, "match.length") + objectName <- substr(parameterName, 1, index - 1) + parameterName <- substr(parameterName, index + 1, nchar(parameterName)) + paramValue <- self[[objectName]][[parameterName]] + + # .closedTestResults$rejected + 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)) + }, + .showUnknownParameters = function(consoleOutputEnabled = TRUE) { + params <- self$.getUndefinedParameters() + if (length(params) > 0) { + self$.showParametersOfOneGroup(params, "ISSUES (parameters with undefined type)", + consoleOutputEnabled = consoleOutputEnabled + ) + } + }, + .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 <- self$.parameterNames[[paramNameRaw]] + } + if (is.null(paramCaption)) { + paramCaption <- self$.parameterNames[[paramName]] + } + if (is.null(paramCaption)) { + paramCaption <- paste0("%", paramName, "%") + } + if (!is.null(category) && !is.na(category)) { + if (.isMultiArmSimulationResults(self) && paramName == "singleNumberOfEventsPerStage") { + if (!inherits(self, "SimulationResultsEnrichmentSurvival") && + !is.na(numberOfCategories) && numberOfCategories == category) { + category <- "control" + } + paramCaption <- paste0(paramCaption, " {", category, "}") + } else if (paramName == "effectList") { + paramCaption <- paste0(paramCaption, " [", category, "]") + } else if (.isEnrichmentSimulationResults(self)) { + categoryCaption <- .getCategoryCaptionEnrichment(self, paramName, category) + paramCaption <- paste0(paramCaption, " (", categoryCaption, ")") + } else { + paramCaption <- paste0(paramCaption, " (", category, ")") + } + + if (!is.na(matrixRow)) { + if (paramName == "effectList") { + paramCaption <- paste0(paramCaption, " (", matrixRow, ")") + } else { + paramCaption <- paste0(paramCaption, " [", matrixRow, "]") + } + } + } else if (!is.na(matrixRow)) { + if (.isMultiArmAnalysisResults(self) && paramName %in% + c( + "conditionalErrorRate", "secondStagePValues", + "adjustedStageWisePValues", "overallAdjustedTestStatistics" + )) { + treatments <- self$.closedTestResults$.getHypothesisTreatmentArmVariants()[matrixRow] + paramCaption <- paste0( + "Treatment", ifelse(grepl(",", treatments), "s", ""), " ", + treatments, " vs. control" + ) + } else if (.isEnrichmentAnalysisResults(self) || .isEnrichmentStageResults(self) || + (inherits(self, "ClosedCombinationTestResults") && isTRUE(self$.enrichment))) { + if (paramName %in% c( + "indices", "conditionalErrorRate", "secondStagePValues", + "adjustedStageWisePValues", "overallAdjustedTestStatistics", "rejectedIntersections" + )) { + if (.isEnrichmentAnalysisResults(self)) { + populations <- self$.closedTestResults$.getHypothesisPopulationVariants()[matrixRow] + } else if (inherits(self, "ClosedCombinationTestResults")) { + populations <- self$.getHypothesisPopulationVariants()[matrixRow] + } else { + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, "only ClosedCombinationTestResults ", + "supports function .getHypothesisPopulationVariants() (object is ", .getClassName(self), ")" + ) + } + paramCaption <- paste0(paramCaption, " ", populations) + } else { + if (!is.na(numberOfCategories) && numberOfCategories == matrixRow) { + paramCaption <- paste0(paramCaption, " F") + } else { + paramCaption <- paste0(paramCaption, " S", matrixRow) + } + } + } else if (.isMultiArmAnalysisResults(self) || grepl("StageResultsMultiArm", .getClassName(self)) || + (inherits(self, "SimulationResults") && paramName == "effectMatrix") || + (inherits(self, "ClosedCombinationTestResults") && + paramName %in% c("rejected", "separatePValues"))) { + paramCaption <- paste0(paramCaption, " (", matrixRow, ")") + } else { + paramCaption <- paste0(paramCaption, " [", matrixRow, "]") + } + } + if (is.null(paramValueFormatted) || length(paramValueFormatted) == 0 || + is.na(paramValueFormatted)) { + paramValueFormatted <- paramValue + } + if (is.list(paramValueFormatted)) { + paramValueFormatted <- .listToString(paramValueFormatted) + } + if (is.function(paramValue) || grepl("Function$", paramName)) { + paramValueFormatted <- ifelse( + self$.getParameterType(paramName) == C_PARAM_USER_DEFINED, + ifelse(.isCppCode(paramValueFormatted), "user defined (C++)", "user defined"), + "default" + ) + } + prefix <- ifelse(showParameterType, self$.showParameterType(paramName), "") + variableNameFormatted <- .getFormattedVariableName( + name = paramCaption, + n = self$.getNChar(), prefix = prefix + ) + + output <- paste(variableNameFormatted, paramValueFormatted, "\n") + self$.cat(output, consoleOutputEnabled = consoleOutputEnabled) + invisible(output) + }, + .getNChar = function() { + if (length(self$.parameterNames) == 0) { + return(40) + } + + return(min(40, max(nchar(self$.parameterNames))) + 4) + }, + .showParameterTypeDescription = function(consoleOutputEnabled = consoleOutputEnabled) { + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" ", C_PARAM_USER_DEFINED, ": user defined\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" ", C_PARAM_DERIVED, ": derived value\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" ", C_PARAM_DEFAULT_VALUE, ": default value\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" ", C_PARAM_GENERATED, ": generated/calculated value\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" ", C_PARAM_NOT_APPLICABLE, ": not applicable or hidden\n", consoleOutputEnabled = consoleOutputEnabled) + }, + .printAsDataFrame = function(parameterNames, niceColumnNamesEnabled = FALSE, + includeAllParameters = FALSE, handleParameterNamesAsToBeExcluded = FALSE, + lineBreakEnabled = FALSE) { + if (.isTrialDesign(self)) { + tableColumnNames <- .getTableColumnNames(design = self) + } else { + tableColumnNames <- C_TABLE_COLUMN_NAMES + } + + if (.isTrialDesignPlan(self)) { + parameterNames <- NULL + } + + dataFrame <- .getAsDataFrame( + parameterSet = self, + parameterNames = parameterNames, + niceColumnNamesEnabled = niceColumnNamesEnabled, + includeAllParameters = includeAllParameters, + handleParameterNamesAsToBeExcluded = handleParameterNamesAsToBeExcluded, + returnParametersAsCharacter = TRUE, + tableColumnNames = tableColumnNames + ) + result <- as.matrix(dataFrame) + if (.isTrialDesignPlan(self)) { + dimnames(result)[[1]] <- paste(" ", c(1:nrow(dataFrame))) + } else if (!is.null(dataFrame[["stages"]])) { + dimnames(result)[[1]] <- paste(" Stage", dataFrame$stages) + } + + print(result, quote = FALSE, right = FALSE) + }, + .getNumberOfRows = function(parameterNames) { + numberOfRows <- 1 + for (parameterName in parameterNames) { + parameterValues <- self[[parameterName]] + if (is.vector(parameterValues) && length(parameterValues) > numberOfRows) { + numberOfRows <- length(parameterValues) + } else if (is.matrix(parameterValues) && (nrow(parameterValues) == 1 || ncol(parameterValues) == 1) && + length(parameterValues) > numberOfRows) { + numberOfRows <- length(parameterValues) + } + } + return(numberOfRows) + }, + .containsMultidimensionalParameters = function(parameterNames) { + for (parameterName in parameterNames) { + parameterValues <- self[[parameterName]] + if (!is.null(parameterValues) && is.matrix(parameterValues) && + nrow(parameterValues) > 0 && ncol(parameterValues) > 0) { + return(TRUE) + } + } + return(FALSE) + }, + .getMultidimensionalNumberOfStages = function(parameterNames) { + if (!is.null(self[[".design"]])) { + return(self$.design$kMax) + } + + n <- 1 + for (parameterName in parameterNames) { + parameterValues <- self[[parameterName]] + if (!is.null(parameterValues) && is.matrix(parameterValues) && + ncol(parameterValues) > 0 && nrow(parameterValues) > n) { + n <- nrow(parameterValues) + } + } + return(n) + }, + .getVariedParameter = function(parameterNames, numberOfVariants) { + + # search for user defined parameters + for (parameterName in parameterNames) { + parameterValues <- self[[parameterName]] + if (!is.null(parameterValues) && !is.matrix(parameterValues) && + length(parameterValues) == numberOfVariants && + parameterName %in% C_VARIABLE_DESIGN_PLAN_PARAMETERS && + self$.getParameterType(parameterName) == C_PARAM_USER_DEFINED) { + return(parameterName) + } + } + + # search for default values + for (parameterName in parameterNames) { + parameterValues <- self[[parameterName]] + if (!is.null(parameterValues) && !is.matrix(parameterValues) && + length(parameterValues) == numberOfVariants && + parameterName %in% C_VARIABLE_DESIGN_PLAN_PARAMETERS && + self$.getParameterType(parameterName) == C_PARAM_DEFAULT_VALUE) { + return(parameterName) + } + } + + return(NULL) + }, + .getDataFrameColumnCaption = function(parameterName, tableColumnNames, niceColumnNamesEnabled) { + if (length(parameterName) == 0 || parameterName == "") { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'parameterName' must be a valid parameter name") + } + + tableColumnName <- tableColumnNames[[parameterName]] + return(ifelse(niceColumnNamesEnabled && !is.null(tableColumnName), + tableColumnName, parameterName + )) + }, + .getUnidimensionalNumberOfStages = function(parameterNames) { + kMax <- self[["kMax"]] + if (is.null(kMax) && !is.null(self[[".design"]])) { + kMax <- self[[".design"]][["kMax"]] + } + if (!is.null(kMax) && length(kMax) == 1 && is.integer(kMax)) { + return(kMax) + } + + n <- 1 + for (parameterName in parameterNames) { + parameterValues <- self[[parameterName]] + if (!is.null(parameterValues) && !is.matrix(parameterValues) && + length(parameterValues) > n) { + n <- length(parameterValues) + } + } + return(n) + }, + .formatDataFrameParametersAsCharacter = function(dataFrame, + parameterName, parameterValues, parameterCaption) { + tryCatch( + { + formatFunctionName <- self$.parameterFormatFunctions[[parameterName]] + if (!is.null(formatFunctionName)) { + parameterValuesFormatted <- eval(call(formatFunctionName, parameterValues)) + } else { + parameterValuesFormatted <- as.character(parameterValues) + } + + if (parameterName == "sided") { + parameterValuesFormatted <- ifelse(parameterValues == 1, + "one-sided", "two-sided" + ) + } + + if (!is.null(dataFrame[[parameterCaption]])) { + parameterValuesFormatted[is.na(dataFrame[[parameterCaption]])] <- "" + } + parameterValuesFormatted[is.na(parameterValuesFormatted)] <- "" + parameterValuesFormatted[parameterValuesFormatted == "NA"] <- "" + if (is.null(dataFrame)) { + dataFrame <- data.frame(x = parameterValuesFormatted) + names(dataFrame) <- parameterCaption + } else { + dataFrame[[parameterCaption]] <- parameterValuesFormatted + } + }, + error = function(e) { + .logError(paste0( + "Error in '.getAsDataFrame'. Failed to show parameter '%s' ", + "(class '%s'): %s" + ), parameterName, .getClassName(self), e) + } + ) + }, + + # + # Returns a sub-list. + # + # @param x A list from which you would like to get a sub-list. + # @param listEntryNames A vector of names which specify the entries of the sub-list to return. + # + .getSubListByNames = function(x, listEntryNames) { + "Returns a sub-list." + if (!is.list(x)) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'x' must be a list") + } + + if (!is.character(listEntryNames)) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'listEntryNames' must be a character vector") + } + + return(x[which(names(x) %in% listEntryNames)]) + }, + .isMultiHypothesesObject = function() { + return(.isEnrichmentAnalysisResults(self) || .isEnrichmentStageResults(self) || + .isMultiArmAnalysisResults(self) || .isMultiArmStageResults(self)) + }, + .isEnrichmentObject = function() { + return(.isEnrichmentAnalysisResults(self) || .isEnrichmentStageResults(self)) + } + ) +) + +.getMultidimensionalNumberOfVariants <- function(parameterSet, parameterNames) { + if (!is.null(parameterSet[["effectList"]])) { + effectMatrixName <- .getSimulationEnrichmentEffectMatrixName(parameterSet) + return(nrow(parameterSet$effectList[[effectMatrixName]])) + } + + parameterNames <- parameterNames[!(parameterNames %in% c( + "accrualTime", "accrualIntensity", + "plannedSubjects", "plannedEvents", + "minNumberOfSubjectsPerStage", "maxNumberOfSubjectsPerStage", + "minNumberOfEventsPerStage", "maxNumberOfEventsPerStage", + "piecewiseSurvivalTime", "lambda2", "adaptations", + "adjustedStageWisePValues", "overallAdjustedTestStatistics" + ))] + if (!is.null(parameterSet[[".piecewiseSurvivalTime"]]) && + parameterSet$.piecewiseSurvivalTime$piecewiseSurvivalEnabled) { + parameterNames <- parameterNames[!(parameterNames %in% c("lambda1"))] + } + + n <- 1 + for (parameterName in parameterNames) { + parameterValues <- parameterSet[[parameterName]] + if (!is.null(parameterValues) && (is.matrix(parameterValues) || !is.array(parameterValues))) { + if (is.matrix(parameterValues)) { + if (parameterSet$.isMultiHypothesesObject()) { + if (nrow(parameterValues) > n && ncol(parameterValues) > 0) { + n <- nrow(parameterValues) + } + } else if (nrow(parameterValues) > 0 && ncol(parameterValues) > n) { + n <- ncol(parameterValues) + } + } else if (length(parameterValues) > n && + !parameterSet$.isMultiHypothesesObject()) { + n <- length(parameterValues) + } + } + } + return(n) +} + +.getDataFrameColumnValues <- function(parameterSet, + parameterName, + numberOfVariants, + numberOfStages, + includeAllParameters, + mandatoryParameterNames) { + if (parameterSet$.getParameterType(parameterName) == C_PARAM_TYPE_UNKNOWN && + parameterName != "futilityStop") { + return(NULL) + } + + if (!includeAllParameters && + parameterSet$.getParameterType(parameterName) == C_PARAM_NOT_APPLICABLE && + !(parameterName %in% mandatoryParameterNames)) { + return(NULL) + } + + parameterValues <- parameterSet[[parameterName]] + if (is.null(parameterValues) || length(parameterValues) == 0) { + return(NULL) + } + + if (is.function(parameterValues)) { + return(NULL) + } + + if (is.array(parameterValues) && !is.matrix(parameterValues)) { + return(NULL) + } + + if (parameterName %in% c("adjustedStageWisePValues", "overallAdjustedTestStatistics")) { + return(NULL) + } + + if (!is.matrix(parameterValues)) { + if (length(parameterValues) == 1) { + return(rep(parameterValues, numberOfVariants * numberOfStages)) + } + + if (parameterSet$.isMultiHypothesesObject()) { + if (length(parameterValues) == numberOfStages) { + return(as.vector(sapply(FUN = rep, X = parameterValues, times = numberOfVariants))) + } + } + + if (length(parameterValues) == numberOfVariants) { + return(rep(parameterValues, numberOfStages)) + } + + if (length(parameterValues) == numberOfStages && + parameterName %in% c( + "plannedEvents", "plannedSubjects", + "minNumberOfEventsPerStage", "maxNumberOfEventsPerStage", + "minNumberOfSubjectsPerStage", "maxNumberOfSubjectsPerStage", + "allocationRatioPlanned" + )) { + values <- c() + for (stage in 1:numberOfStages) { + values <- c(values, rep(parameterValues[stage], numberOfVariants)) + } + return(values) + } + + if (parameterName %in% c( + "accrualTime", "accrualIntensity", + "plannedEvents", "plannedSubjects", + "minNumberOfEventsPerStage", "maxNumberOfEventsPerStage", + "minNumberOfSubjectsPerStage", "maxNumberOfSubjectsPerStage", + "piecewiseSurvivalTime", "lambda2" + )) { + return(NULL) + } + + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, + "parameter '", parameterName, "' has an invalid ", + "dimension (length is ", length(parameterValues), ")" + ) + } else if (parameterName == "effectMatrix") { + # return effect matrix row if 'effectMatrix' is user defined + if (parameterSet$.getParameterType("effectMatrix") == C_PARAM_USER_DEFINED) { + return(1:ncol(parameterValues)) + } + + return(parameterValues[nrow(parameterValues), ]) + } + + if (grepl("futility|alpha0Vec|earlyStop", parameterName) && + nrow(parameterValues) == numberOfStages - 1) { + parameterValues <- rbind(parameterValues, rep(NA_real_, ncol(parameterValues))) + } + + if (nrow(parameterValues) == numberOfStages && ncol(parameterValues) == 1) { + columnValues <- c() + for (parameterValue in parameterValues) { + columnValues <- c(columnValues, rep(parameterValue, numberOfVariants)) + } + return(columnValues) + } + + if (nrow(parameterValues) == numberOfStages && ncol(parameterValues) == numberOfVariants) { + columnValues <- c() + for (i in 1:nrow(parameterValues)) { + for (j in 1:ncol(parameterValues)) { + columnValues <- c(columnValues, parameterValues[i, j]) + } + } + return(columnValues) + } + + # applicable for analysis enrichment + if (parameterSet$.isMultiHypothesesObject()) { + if (nrow(parameterValues) %in% c(1, numberOfVariants) && + ncol(parameterValues) %in% c(1, numberOfStages)) { + columnValues <- c() + for (j in 1:ncol(parameterValues)) { + for (i in 1:nrow(parameterValues)) { + columnValues <- c(columnValues, parameterValues[i, j]) + } + } + if (nrow(parameterValues) == 1) { + columnValues <- as.vector(sapply(FUN = rep, X = columnValues, times = numberOfVariants)) + } + if (ncol(parameterValues) == 1) { + columnValues <- rep(columnValues, numberOfStages) + } + return(columnValues) + } + } + + if (nrow(parameterValues) == 1 && ncol(parameterValues) == 1) { + return(rep(parameterValues[1, 1], numberOfStages * numberOfVariants)) + } + + if (nrow(parameterValues) == 1 && ncol(parameterValues) == numberOfVariants) { + return(rep(parameterValues[1, ], numberOfStages)) + } + + if (nrow(parameterValues) == numberOfStages && ncol(parameterValues) == 1) { + return(rep(parameterValues[, 1], numberOfVariants)) + } + + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, + "parameter '", parameterName, "' has an invalid ", + "dimension (", nrow(parameterValues), " x ", ncol(parameterValues), "); ", + "expected was (", numberOfStages, " x ", numberOfVariants, ")" + ) +} + +.getAsDataFrameMultidimensional <- function(parameterSet, + parameterNames, + niceColumnNamesEnabled, + includeAllParameters, + returnParametersAsCharacter, + tableColumnNames, + mandatoryParameterNames) { + numberOfVariants <- .getMultidimensionalNumberOfVariants(parameterSet, parameterNames) + numberOfStages <- parameterSet$.getMultidimensionalNumberOfStages(parameterNames) + + stagesCaption <- parameterSet$.getDataFrameColumnCaption( + "stages", + tableColumnNames, niceColumnNamesEnabled + ) + + dataFrame <- data.frame( + stages = sort(rep(1:numberOfStages, numberOfVariants)) + ) + names(dataFrame) <- stagesCaption + + if (parameterSet$.isEnrichmentObject()) { + populations <- character(0) + for (i in 1:numberOfVariants) { + populations <- c(populations, ifelse(i == numberOfVariants, "F", paste0("S", i))) + } + dataFrame$populations <- rep(populations, numberOfStages) + populationsCaption <- parameterSet$.getDataFrameColumnCaption( + "populations", + tableColumnNames, niceColumnNamesEnabled + ) + names(dataFrame) <- c(stagesCaption, populationsCaption) + } + + variedParameter <- parameterSet$.getVariedParameter(parameterNames, numberOfVariants) + tryCatch( + { + if (!is.null(variedParameter) && variedParameter != "stages") { + variedParameterCaption <- parameterSet$.getDataFrameColumnCaption( + variedParameter, + tableColumnNames, niceColumnNamesEnabled + ) + dataFrame[[variedParameterCaption]] <- rep(parameterSet[[variedParameter]], numberOfStages) + } + }, + error = function(e) { + warning( + ".getAsDataFrameMultidimensional: ", + "failed to add 'variedParameterCaption' to data.frame; ", e$message + ) + } + ) + + usedParameterNames <- character(0) + for (parameterName in parameterNames) { + tryCatch( + { + if (!(parameterName %in% c("stages", "adaptations", "effectList")) && + !grepl("Function$", parameterName) && + (is.null(variedParameter) || parameterName != variedParameter)) { + columnValues <- .getDataFrameColumnValues( + parameterSet, parameterName, + numberOfVariants, numberOfStages, + includeAllParameters, mandatoryParameterNames + ) + if (!is.null(columnValues)) { + columnCaption <- parameterSet$.getDataFrameColumnCaption( + parameterName, + tableColumnNames, niceColumnNamesEnabled + ) + dataFrame[[columnCaption]] <- columnValues + if (returnParametersAsCharacter) { + parameterSet$.formatDataFrameParametersAsCharacter( + dataFrame, + parameterName, columnValues, columnCaption + ) + } + usedParameterNames <- c(usedParameterNames, parameterName) + } + } + + if (parameterName == "effectList") { + effectMatrixName <- .getSimulationEnrichmentEffectMatrixName(parameterSet) + effectMatrixNameSingular <- sub("s$", "", effectMatrixName) + effectMatrix <- parameterSet$effectList[[effectMatrixName]] + if (ncol(effectMatrix) == 1) { + dataFrame[[effectMatrixNameSingular]] <- rep(effectMatrix, numberOfStages) + } else { + for (j in 1:ncol(effectMatrix)) { + dataFrame[[paste0(effectMatrixNameSingular, j)]] <- rep(effectMatrix[, j], numberOfStages) + } + } + dataFrame$situation <- rep(1:nrow(effectMatrix), numberOfStages) + usedParameterNames <- c(usedParameterNames, parameterName) + } + }, + error = function(e) { + warning( + ".getAsDataFrameMultidimensional: failed to add parameter ", + sQuote(parameterName), " to data.frame; ", e$message + ) + } + ) + } + + if (includeAllParameters) { + extraParameterNames <- names(parameterSet) + extraParameterNames <- extraParameterNames[!grepl("^\\.", extraParameterNames)] + extraParameterNames <- extraParameterNames[!(extraParameterNames %in% parameterNames)] + extraParameterNames <- unique(c(parameterNames[!(parameterNames %in% usedParameterNames)], extraParameterNames)) + for (extraParameter in extraParameterNames) { + tryCatch({ + if (parameterSet$.getParameterType(extraParameter) != C_PARAM_TYPE_UNKNOWN) { + value <- parameterSet[[extraParameter]] + if (!is.null(value) && length(value) > 0 && + !is.matrix(value) && !is.array(value) && !is.data.frame(value) && + (is.numeric(value) || is.character(value) || is.logical(value))) { + + columnCaption <- parameterSet$.getDataFrameColumnCaption( + extraParameter, + tableColumnNames, niceColumnNamesEnabled + ) + + if (length(value) == 1) { + dataFrame[[columnCaption]] <- rep(value, nrow(dataFrame)) + } else { + dataFrame[[columnCaption]] <- rep(.arrayToString(value, maxLength = 10), nrow(dataFrame)) + } + } + } + }, error = function(e) { + warning( + ".getAsDataFrameMultidimensional: failed to add extra parameter ", + sQuote(parameterName), " to data.frame; ", e$message + ) + }) + } + } + + return(dataFrame) +} + +.getAsDataFrameUnidimensional <- function(parameterSet, parameterNames, niceColumnNamesEnabled, + includeAllParameters, returnParametersAsCharacter, tableColumnNames) { + numberOfStages <- parameterSet$.getUnidimensionalNumberOfStages(parameterNames) + dataFrame <- NULL + for (parameterName in parameterNames) { + tryCatch( + { + parameterCaption <- ifelse(niceColumnNamesEnabled && + !is.null(tableColumnNames[[parameterName]]), + tableColumnNames[[parameterName]], parameterName + ) + parameterValues <- parameterSet[[parameterName]] + if (parameterName == "futilityBounds") { + parameterValues[parameterValues == C_FUTILITY_BOUNDS_DEFAULT] <- -Inf + } + if (length(parameterValues) == 1) { + parameterValues <- rep(parameterValues, numberOfStages) + } else { + while (length(parameterValues) < numberOfStages) { + parameterValues <- c(parameterValues, NA) + } + } + if (includeAllParameters || ( + parameterSet$.getParameterType(parameterName) != C_PARAM_NOT_APPLICABLE && + sum(is.na(parameterValues)) < length(parameterValues))) { + if (is.null(dataFrame)) { + dataFrame <- data.frame(x = parameterValues) + names(dataFrame) <- parameterCaption + } else { + dataFrame[[parameterCaption]] <- parameterValues + } + } + if (returnParametersAsCharacter) { + parameterSet$.formatDataFrameParametersAsCharacter( + dataFrame, + parameterName, parameterValues, parameterCaption + ) + } + }, + error = function(e) { + .logError("Failed to add parameter '%s' to data.frame: %s", parameterName, e) + } + ) + } + + return(dataFrame) +} + +.getAsDataFrame <- function(..., + parameterSet, + parameterNames, + niceColumnNamesEnabled = FALSE, + includeAllParameters = FALSE, + handleParameterNamesAsToBeExcluded = FALSE, + returnParametersAsCharacter = FALSE, + tableColumnNames = C_TABLE_COLUMN_NAMES, + mandatoryParameterNames = character(0)) { + + parameterNamesToBeExcluded <- c() + if (handleParameterNamesAsToBeExcluded) { + parameterNamesToBeExcluded <- parameterNames + parameterNames <- parameterSet$.getVisibleFieldNamesOrdered() + if (!is.null(parameterNamesToBeExcluded) && length(parameterNamesToBeExcluded) > 0) { + parameterNames <- parameterNames[!(parameterNames %in% parameterNamesToBeExcluded)] + } + } else if (is.null(parameterNames)) { + parameterNames <- parameterSet$.getVisibleFieldNamesOrdered() + } + parameterNames <- parameterNames[!grepl("^\\.", parameterNames)] + + parametersToIgnore <- character(0) + if (!is.null(parameterSet[[".piecewiseSurvivalTime"]]) && + parameterSet$.piecewiseSurvivalTime$piecewiseSurvivalEnabled) { + parametersToIgnore <- c(parametersToIgnore, + "lambda1", "lambda2", "median1", "median2", + "pi1", "pi2", "piecewiseSurvivalTime") + parametersToIgnore <- intersect(parametersToIgnore, parameterNames) + } + + if (parameterSet$.getParameterType("hazardRatio") == C_PARAM_GENERATED && + !is.null(parameterSet[[".piecewiseSurvivalTime"]]) && + isTRUE(parameterSet$.piecewiseSurvivalTime$piecewiseSurvivalEnabled)) { + parametersToIgnore <- c(parametersToIgnore, "hazardRatio") + } + + if (!inherits(parameterSet, "AccrualTime")) { + accrualTime <- parameterSet[["accrualTime"]] + if (!is.null(accrualTime) && length(accrualTime) > 1) { + parametersToIgnore <- c(parametersToIgnore, c("accrualTime", "accrualIntensity")) + } + } + + if (length(parametersToIgnore) > 0) { + parameterNames <- parameterNames[!(parameterNames %in% parametersToIgnore)] + } + + if (parameterSet$.containsMultidimensionalParameters(parameterNames)) { + return(.addDelayedInformationRates(.getAsDataFrameMultidimensional( + parameterSet, parameterNames, niceColumnNamesEnabled, + includeAllParameters, returnParametersAsCharacter, tableColumnNames, + mandatoryParameterNames + ))) + } + + # remove matrices + for (parameterName in parameterNames) { + parameterValues <- parameterSet[[parameterName]] + if (is.matrix(parameterValues) && nrow(parameterValues) != 1 && ncol(parameterValues) != 1) { + parameterNames <- parameterNames[parameterNames != parameterName] + } + } + + if (length(parameterNames) == 0) { + return(data.frame()) + } + + return(.addDelayedInformationRates(.getAsDataFrameUnidimensional( + parameterSet, parameterNames, niceColumnNamesEnabled, + includeAllParameters, returnParametersAsCharacter, tableColumnNames + ))) +} + +.getCategoryCaptionEnrichment <- function(parameterSet, parameterName, categoryNumber) { + categoryCaption <- categoryNumber + if (parameterName %in% c("sampleSizes", "singleNumberOfEventsPerStage")) { + categoryCaption <- parameterSet$effectList$subGroups[categoryNumber] + maxNumberOfDigits <- max(nchar(sub("\\D*", "", parameterSet$effectList$subGroups))) + if (parameterSet$populations > 2 && grepl(paste0("^S\\d{1,", maxNumberOfDigits - 1, "}$"), categoryCaption)) { + categoryCaption <- paste0(categoryCaption, " only") + } + } else { + if (parameterSet$populations <= 2) { + categoryCaption <- ifelse(categoryNumber == parameterSet$populations, "F", "S") + } else { + categoryCaption <- ifelse(categoryNumber == parameterSet$populations, "F", paste0("S", categoryNumber)) + } + } + return(categoryCaption) +} + +#' +#' @title +#' Names of a Field Set Object +#' +#' @description +#' Function to get the names of a \code{\link{FieldSet}} object. +#' +#' @param x A \code{\link{FieldSet}} object. +#' +#' @details +#' Returns the names of a field set that can be accessed by the user. +#' +#' @template return_names +#' +#' @export +#' +#' @keywords internal +#' +names.FieldSetR6 <- function(x) { + return(x$.getVisibleFieldNames()) +} + +#' +#' @title +#' Print Field Set Values +#' +#' @description +#' \code{print} prints its \code{\link{FieldSet}} argument and returns it invisibly (via \code{invisible(x)}). +#' +#' @param x A \code{\link{FieldSet}} object. +#' @inheritParams param_three_dots +#' +#' @details +#' Prints the field set. +#' +#' @export +#' +#' @keywords internal +#' +print.FieldSetR6 <- function(x, ...) { + x$show() + invisible(x) +} + +#' +#' @title +#' Coerce Parameter Set to a Data Frame +#' +#' @description +#' Returns the \code{ParameterSet} as data frame. +#' +#' @param x A \code{\link{FieldSet}} object. +#' @inheritParams param_niceColumnNamesEnabled +#' @inheritParams param_includeAllParameters +#' @inheritParams param_three_dots +#' +#' @details +#' Coerces the parameter set to a data frame. +#' +#' @template return_dataframe +#' +#' @export +#' +#' @keywords internal +#' +as.data.frame.ParameterSetR6 <- function(x, row.names = NULL, + optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ...) { + .warnInCaseOfUnknownArguments(functionName = "as.data.frame", ...) + + return(.getAsDataFrame( + parameterSet = x, + parameterNames = NULL, + niceColumnNamesEnabled = niceColumnNamesEnabled, + includeAllParameters = includeAllParameters + )) +} + +#' +#' @title +#' Field Set Transpose +#' +#' @description +#' Given a \code{FieldSet} \code{x}, t returns the transpose of \code{x}. +#' +#' @param x A \code{FieldSet}. +#' +#' @details +#' Implementation of the base R generic function \code{\link[base]{t}} +#' +#' @keywords internal +#' +#' @export +#' +setMethod( + "t", "FieldSet",#TODO + function(x) { + x <- as.matrix(x, niceColumnNamesEnabled = TRUE) + return(t(x)) + } +) + +#' +#' @title +#' Create output in Markdown +#' +#' @description +#' The \code{kable()} function returns the output of the specified object formatted in Markdown. +#' +#' @param x A \code{ParameterSet}. If x does not inherit from class \code{\link{ParameterSet}}, +#' \code{knitr::kable(x)} will be returned. +#' @param ... Other arguments (see \code{\link[knitr]{kable}}). +#' +#' @details +#' 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. +#' +#' @export +#' +kable.ParameterSetR6 <- function(x, ...) { + fCall <- match.call(expand.dots = FALSE) + if (inherits(x, "ParameterSetR6")) { + objName <- deparse(fCall$x) + if (all(grepl("^ *print\\(", objName))) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "kable(", objName, ") does not work correctly. ", + "Use ", sub("print", "kable", objName), " without 'print' instead or ", sub("\\)", ", markdown = TRUE)", objName) + ) + } + + if (.isSimulationResults(x)) { + showStatistics <- .getOptionalArgument("showStatistics", optionalArgumentDefaultValue = FALSE, ...) + if (isTRUE(showStatistics)) { + return(print(x, markdown = TRUE, showStatistics = TRUE)) + } + } + + return(print(x, markdown = TRUE)) + } + + .assertPackageIsInstalled("knitr") + knitr::kable(x, ...) +} + +#' +#' @title +#' Create tables in Markdown +#' +#' @description +#' The \code{kable()} function returns a single table for a single object that inherits from class \code{\link{ParameterSet}}. +#' +#' @details +#' Generic to represent a parameter set in Markdown. +#' +#' @param x The object that inherits from \code{\link{ParameterSet}}. +#' @param ... Other arguments (see \code{\link[knitr]{kable}}). +#' +#' @export +#' +setGeneric("kable", kable.ParameterSetR6) + +#' +#' @title +#' Coerce Field Set to a Matrix +#' +#' @description +#' Returns the \code{FrameSet} as matrix. +#' +#' @param x A \code{\link{FieldSet}} object. +#' @param enforceRowNames If \code{TRUE}, row names will be created +#' depending on the object type, default is \code{TRUE}. +#' @inheritParams param_niceColumnNamesEnabled +#' @inheritParams param_three_dots +#' +#' @details +#' Coerces the frame set to a matrix. +#' +#' @template return_matrix +#' +#' @export +#' +#' @keywords internal +#' +as.matrix.FieldSetR6 <- function(x, ..., enforceRowNames = TRUE, niceColumnNamesEnabled = TRUE) { + dataFrame <- as.data.frame(x, niceColumnNamesEnabled = niceColumnNamesEnabled) + dataFrame <- .setStagesAsFirstColumn(dataFrame) + result <- as.matrix(dataFrame) + + if (nrow(result) == 0) { + return(result) + } + + if (inherits(x, "PowerAndAverageSampleNumberResult")) { + dimnames(result)[[1]] <- rep("", nrow(result)) + return(result) + } + + 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))]), ] + if (length(intersect(names(dfDesign), names(dfStageResults))) == 1) { + dfTemp <- merge(dfDesign, dfStageResults) + if (length(intersect(names(dfTemp), names(dataFrame))) >= 1) { + dataFrame <- merge(dfTemp, dataFrame, all.x = FALSE, all.y = TRUE) + dataFrame <- .setStagesAsFirstColumn(dataFrame) + result <- as.matrix(dataFrame) + } + } else if (length(intersect(names(dfStageResults), names(dataFrame))) >= 1) { + dataFrame <- merge(dfStageResults, dataFrame, all.x = FALSE, all.y = TRUE) + dataFrame <- .setStagesAsFirstColumn(dataFrame) + result <- as.matrix(dataFrame) + } + } + + if (any(grepl("^(S|s)tages?$", colnames(result)))) { + dimnames(result)[[1]] <- rep("", nrow(result)) + } + + return(result) +} + +.setStagesAsFirstColumn <- function(data) { + columnNames <- colnames(data) + index <- grep("^(S|s)tages?$", columnNames) + if (length(index) == 0 || index == 1) { + return(data) + } + + stageName <- columnNames[index[1]] + stageNumbers <- data[, stageName] + if (is.null(stageNumbers) || length(stageNumbers) == 0) { + return(data) + } + + data <- data[, c(stageName, columnNames[columnNames != stageName])] + + return(data) +} + +#' +#' @title +#' Parameter Set Summary +#' +#' @description +#' Displays a summary of \code{\link{ParameterSet}} object. +#' +#' @param object A \code{\link{ParameterSet}} object. +#' @inheritParams param_digits +#' @inheritParams param_three_dots +#' +#' @details +#' Summarizes the parameters and results of a parameter set. +#' +#' @template details_summary +#' +#' @template return_object_summary +#' @template how_to_get_help_for_generics +#' +#' @export +#' +#' @keywords internal +#' +summary.ParameterSetR6 <- function(object, ..., type = 1, digits = NA_integer_, output = c("all", "title", "overview", "body")) { + .warnInCaseOfUnknownArguments(functionName = "summary", ...) + + if (type == 1 && inherits(object, "SummaryFactory")) { + return(object) + } + + if (type == 1 && (inherits(object, "TrialDesign") || inherits(object, "TrialDesignPlan") || + inherits(object, "SimulationResults") || inherits(object, "AnalysisResults") || + inherits(object, "TrialDesignCharacteristics") || + inherits(object, "PerformanceScore"))) { + output <- match.arg(output) + return(.createSummary(object, digits = digits, output = output)) + } + + # create technical summary + object$show(showType = 2) + object$.cat("\n") + + if (!is.null(object[[".piecewiseSurvivalTim"]])) { + object$.piecewiseSurvivalTime$show() + object$.cat("\n") + } + + if (!is.null(object[[".accrualTime"]])) { + object$.accrualTime$show() + object$.cat("\n") + } + + object$.cat(object$.toString(startWithUpperCase = TRUE), " table:\n", heading = 1) + parametersToShow <- object$.getParametersToShow() + for (parameter in parametersToShow) { + if (length(object[[parameter]]) == 1) { + parametersToShow <- parametersToShow[parametersToShow != parameter] + } + } + object$.printAsDataFrame(parameterNames = parametersToShow, niceColumnNamesEnabled = TRUE) + invisible(object) +} + +#' +#' @title +#' Print Parameter Set Values +#' +#' @description +#' \code{print} prints its \code{ParameterSet} argument and returns it invisibly (via \code{invisible(x)}). +#' +#' @param x The \code{\link{ParameterSet}} 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 a parameter set. +#' +#' @export +#' +#' @keywords internal +#' +print.ParameterSetR6 <- function(x, ..., markdown = FALSE) { + if (markdown) { + x$.catMarkdownText() + return(invisible(x)) + } + + x$show() + invisible(x) +} + +#' +#' @title +#' Parameter Set Plotting +#' +#' @description +#' Plots an object that inherits from class \code{\link{ParameterSet}}. +#' +#' @param x The object that inherits from \code{\link{ParameterSet}}. +#' @param y Not available for this kind of plot (is only defined to be compatible to the generic plot function). +#' @param main The main title. +#' @param xlab The x-axis label. +#' @param ylab The y-axis label. +#' @param type The plot type (default = 1). +#' @inheritParams param_palette +#' @inheritParams param_showSource +#' @inheritParams param_plotSettings +#' @inheritParams param_legendPosition +#' @inheritParams param_three_dots_plot +#' +#' @details +#' Generic function to plot a parameter set. +#' +#' @template return_object_ggplot +#' +#' @export +#' +plot.ParameterSetR6 <- function(x, y, ..., main = NA_character_, + xlab = NA_character_, ylab = NA_character_, type = 1L, palette = "Set1", + legendPosition = NA_integer_, showSource = FALSE, plotSettings = NULL) { + .assertGgplotIsInstalled() + + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, + "sorry, function 'plot' is not implemented yet for class '", .getClassName(x), "'" + ) +} diff --git a/R/f_analysis_multiarm_means.R b/R/f_analysis_multiarm_means.R index b170190e..6ad9825d 100644 --- a/R/f_analysis_multiarm_means.R +++ b/R/f_analysis_multiarm_means.R @@ -59,7 +59,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsMultiArmInverseNormal(design = design, dataInput = dataInput) + results <- AnalysisResultsMultiArmInverseNormalR6$new(design = design, dataInput = dataInput) results <- .getAnalysisResultsMeansMultiArmAll( results = results, design = design, dataInput = dataInput, @@ -327,7 +327,7 @@ NULL select 'varianceOption' = \"overallPooled\"", call. = FALSE) } - stageResults <- StageResultsMultiArmMeans( + stageResults <- StageResultsMultiArmMeansR6$new( design = design, dataInput = dataInput, thetaH0 = thetaH0, @@ -1001,7 +1001,7 @@ NULL gMax <- stageResults$getGMax() kMax <- design$kMax - results <- ConditionalPowerResultsMultiArmMeans( + results <- ConditionalPowerResultsMultiArmMeansR6$new( .design = design, .stageResults = stageResults, thetaH1 = thetaH1, diff --git a/R/f_core_assertions.R b/R/f_core_assertions.R index 8b4ce212..be446a36 100644 --- a/R/f_core_assertions.R +++ b/R/f_core_assertions.R @@ -37,7 +37,7 @@ NULL } .isParameterSet <- function(x) { - return(isS4(x) && inherits(x, "ParameterSet")) + return((isS4(x) || is.R6(x)) && (inherits(x, "ParameterSet") || inherits(x, "ParameterSetR6"))) } .assertIsParameterSetClass <- function(x, objectName = "x") { @@ -208,23 +208,23 @@ NULL } .isStageResults <- function(stageResults) { - return(inherits(stageResults, "StageResults")) + return(inherits(stageResults, "StageResults") || inherits(stageResults, "StageResultsR6")) } .isStageResultsMultiArmMeans <- function(stageResults) { - return(.getClassName(stageResults) == "StageResultsMultiArmMeans") + return(.getClassName(stageResults) == "StageResultsMultiArmMeans" || .getClassName(stageResults) == "StageResultsMultiArmMeansR6") } .isStageResultsMultiArmSurvival <- function(stageResults) { - return(.getClassName(stageResults) == "StageResultsMultiArmSurvival") + return(.getClassName(stageResults) == "StageResultsMultiArmSurvival" || .getClassName(stageResults) == "StageResultsMultiArmSurvivalR6") } .isStageResultsEnrichmentMeans <- function(stageResults) { - return(.getClassName(stageResults) == "StageResultsEnrichmentMeans") + return(.getClassName(stageResults) == "StageResultsEnrichmentMeans" || .getClassName(stageResults) == "StageResultsEnrichmentMeansR6") } .isStageResultsEnrichmentSurvival <- function(stageResults) { - return(.getClassName(stageResults) == "StageResultsEnrichmentSurvival") + return(.getClassName(stageResults) == "StageResultsEnrichmentSurvival" || .getClassName(stageResults) == "StageResultsEnrichmentSurvivalR6") } .assertIsStageResults <- function(stageResults) { @@ -1338,7 +1338,7 @@ NULL for (i in 1:length(args)) { arg <- args[[i]] argName <- ifelse(is.null(argNames[i]) || argNames[i] == "", - ifelse(inherits(arg, "StageResults"), "stageResultsName", paste0("%param", i, "%")), + ifelse(inherits(arg, "StageResults") || inherits(arg, "StageResultsR6"), "stageResultsName", paste0("%param", i, "%")), argNames[i] ) if (!(argName %in% ignore) && !grepl("^\\.", argName)) { @@ -2152,20 +2152,20 @@ NULL } .isMultiArmStageResults <- function(stageResults) { - return(inherits(stageResults, "StageResults") && grepl("MultiArm", .getClassName(stageResults))) + return((inherits(stageResults, "StageResults") || inherits(stageResults, "StageResultsR6")) && grepl("MultiArm", .getClassName(stageResults))) } .isEnrichmentStageResults <- function(stageResults) { - return(inherits(stageResults, "StageResults") && grepl("Enrichment", .getClassName(stageResults))) + return((inherits(stageResults, "StageResults") || inherits(stageResults, "StageResultsR6")) && grepl("Enrichment", .getClassName(stageResults))) } .isEnrichmentConditionalPowerResults <- function(conditionalPowerResults) { - return(inherits(conditionalPowerResults, "ConditionalPowerResults") && + return((inherits(conditionalPowerResults, "ConditionalPowerResults") || inherits(conditionalPowerResults, "ConditionalPowerResultsR6")) && grepl("Enrichment", .getClassName(conditionalPowerResults))) } .isMultiArmAnalysisResults <- function(analysisResults) { - return(inherits(analysisResults, "AnalysisResultsMultiArm")) + return((inherits(analysisResults, "AnalysisResultsMultiArm") || inherits(analysisResults, "AnalysisResultsMultiArmR6"))) } .isMultiHypothesesAnalysisResults <- function(x) { @@ -2177,7 +2177,7 @@ NULL } .isEnrichmentAnalysisResults <- function(analysisResults) { - return(inherits(analysisResults, "AnalysisResultsEnrichment")) + return(inherits(analysisResults, "AnalysisResultsEnrichment") || inherits(analysisResults, "AnalysisResultsEnrichmentR6")) } .isMultiArmSimulationResults <- function(simulationResults) { @@ -2189,7 +2189,7 @@ NULL } .assertIsStageResultsMultiArm <- function(stageResults) { - if (!inherits(stageResults, "StageResults")) { + if (!(inherits(stageResults, "StageResults") || inherits(stageResults, "StageResultsR6"))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'stageResults' must be a multi-arm stage results object (is ", .getClassName(stageResults), ")" @@ -2205,14 +2205,14 @@ NULL } .assertIsStageResultsNonMultiHypotheses <- function(stageResults) { - if (inherits(stageResults, "StageResults") && .isMultiArmStageResults(stageResults)) { + if ((inherits(stageResults, "StageResults") || inherits(stageResults, "StageResultsR6")) && .isMultiArmStageResults(stageResults)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'stageResults' must be a non-multi-arm object (is ", .getClassName(stageResults), ")" ) } - if (inherits(stageResults, "StageResults") && .isEnrichmentStageResults(stageResults)) { + if ((inherits(stageResults, "StageResults") || inherits(stageResults, "StageResultsR6")) && .isEnrichmentStageResults(stageResults)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'stageResults' must be a non-enrichment object (is ", .getClassName(stageResults), ")" @@ -2222,7 +2222,10 @@ NULL allowedClasses <- c( "StageResultsMeans", "StageResultsRates", - "StageResultsSurvival" + "StageResultsSurvival", + "StageResultsMeansR6", + "StageResultsRatesR6", + "StageResultsSurvivalR6" ) if (!(.getClassName(stageResults) %in% allowedClasses)) { stop( @@ -2249,7 +2252,7 @@ NULL } .assertIsAnalysisResults <- function(analysisResults) { - if (!inherits(analysisResults, "AnalysisResults")) { + if (!(inherits(analysisResults, "AnalysisResults") || inherits(analysisResults, "AnalysisResultsR6"))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'analysisResults' must be a valid 'AnalysisResults' object ", " (is '", .getClassName(analysisResults), "')" diff --git a/R/f_core_utilities.R b/R/f_core_utilities.R index 3c8fe4f0..3cc4a900 100644 --- a/R/f_core_utilities.R +++ b/R/f_core_utilities.R @@ -756,32 +756,33 @@ NULL } .setValueAndParameterType <- function(parameterSet, parameterName, value, defaultValue, - notApplicableIfNA = FALSE) { - .assertIsParameterSetClass(parameterSet, "parameterSet") - - if (is.null(parameterSet)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'parameterSet' must be not null") - } - - if (!(parameterName %in% names(parameterSet$getRefClass()$fields()))) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'", .getClassName(parameterSet), "' does not contain a field with name '", parameterName, "'" - ) - } - - parameterSet[[parameterName]] <- value - - if (notApplicableIfNA && all(is.na(value))) { - parameterSet$.setParameterType(parameterName, C_PARAM_NOT_APPLICABLE) - } else if (!is.null(value) && length(value) == length(defaultValue) && ( - (all(is.na(value)) && all(is.na(value) == is.na(defaultValue))) || - (!is.na(all(value == defaultValue)) && all(value == defaultValue)) - )) { - parameterSet$.setParameterType(parameterName, C_PARAM_DEFAULT_VALUE) - } else { - parameterSet$.setParameterType(parameterName, C_PARAM_USER_DEFINED) - } + notApplicableIfNA = FALSE) { + .assertIsParameterSetClass(parameterSet, "parameterSet") + + if (is.null(parameterSet)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'parameterSet' must be not null") + } + + if (!ifelse(is.R6(parameterSet), parameterName %in% names(parameterSet), parameterName %in% names(getClass(class(parameterSet))@fieldClasses))) { #names(.self$getRefClass()$fields()) + + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'", .getClassName(parameterSet), "' does not contain a field with name '", parameterName, "'" + ) + } + + parameterSet[[parameterName]] <- value + + if (notApplicableIfNA && all(is.na(value))) { + parameterSet$.setParameterType(parameterName, C_PARAM_NOT_APPLICABLE) + } else if (!is.null(value) && length(value) == length(defaultValue) && ( + (all(is.na(value)) && all(is.na(value) == is.na(defaultValue))) || + (!is.na(all(value == defaultValue)) && all(value == defaultValue)) + )) { + parameterSet$.setParameterType(parameterName, C_PARAM_DEFAULT_VALUE) + } else { + parameterSet$.setParameterType(parameterName, C_PARAM_USER_DEFINED) + } } .isDefaultVector <- function(x, default) { From a6a4249af9c6aaa7468802f672749b53c7bfa22e Mon Sep 17 00:00:00 2001 From: Till Luca Jensen Date: Wed, 1 Nov 2023 14:50:38 +0100 Subject: [PATCH 02/28] added imports and generated doxygen2 --- DESCRIPTION | 6 +- NAMESPACE | 15 ++ R/class_analysis_results_r6.R | 1 + R/class_analysis_stage_results_r6.R | 1 + R/class_core_parameter_set_r6.R | 1 + R/f_core_utilities.R | 2 + man/AnalysisResults.Rd | 18 ++- man/AnalysisResultsConditionalDunnett.Rd | 45 +++++- man/AnalysisResultsEnrichment.Rd | 12 +- man/AnalysisResultsEnrichmentFisher.Rd | 49 +++++- man/AnalysisResultsEnrichmentInverseNormal.Rd | 47 +++++- man/AnalysisResultsFisher.Rd | 57 ++++++- man/AnalysisResultsGroupSequential.Rd | 55 ++++++- man/AnalysisResultsInverseNormal.Rd | 51 ++++++- man/AnalysisResultsMultiArm.Rd | 13 +- man/AnalysisResultsMultiArmFisherR6.Rd | 59 ++++++++ man/AnalysisResultsMultiArmInverseNormal.Rd | 45 +++++- man/AnalysisResultsMultiHypotheses.Rd | 12 +- man/ClosedCombinationTestResults.Rd | 27 +++- man/ConditionalPowerResults.Rd | 25 +++- man/ConditionalPowerResultsEnrichmentMeans.Rd | 25 +++- man/ConditionalPowerResultsEnrichmentRates.Rd | 25 +++- man/ConditionalPowerResultsMeans.Rd | 25 +++- man/ConditionalPowerResultsRates.Rd | 25 +++- man/ConditionalPowerResultsSurvival.Rd | 23 ++- man/FieldSetR6.Rd | 12 ++ man/ParameterSetR6.Rd | 12 ++ man/StageResults.Rd | 37 ++++- man/StageResultsEnrichmentMeans.Rd | 51 ++++++- man/StageResultsEnrichmentRates.Rd | 27 +++- man/StageResultsEnrichmentSurvival.Rd | 27 +++- man/StageResultsMeans.Rd | 39 ++++- man/StageResultsMultiArmMeans.Rd | 55 ++++++- man/StageResultsMultiArmRates.Rd | 49 +++++- man/StageResultsMultiArmSurvival.Rd | 47 +++++- man/StageResultsRates.Rd | 39 ++++- man/StageResultsSurvival.Rd | 45 +++++- man/as.data.frame.AnalysisResultsR6.Rd | 34 +++++ man/as.data.frame.ParameterSetR6.Rd | 39 +++++ man/as.data.frame.StageResultsR6.Rd | 40 +++++ man/as.matrix.FieldSetR6.Rd | 31 ++++ man/kable.ParameterSetR6.Rd | 24 +++ man/kable.Rd | 9 +- man/names.AnalysisResultsR6.Rd | 21 +++ man/names.FieldSetR6.Rd | 21 +++ man/names.StageResultsR6.Rd | 21 +++ man/plot.AnalysisResultsR6.Rd | 139 ++++++++++++++++++ man/plot.ParameterSetR6.Rd | 78 ++++++++++ man/plot.StageResultsR6.Rd | 132 +++++++++++++++++ man/print.FieldSetR6.Rd | 21 +++ man/print.ParameterSetR6.Rd | 24 +++ man/summary.AnalysisResultsR6.Rd | 63 ++++++++ man/summary.ParameterSetR6.Rd | 69 +++++++++ man/t-FieldSet-method.Rd | 9 +- 54 files changed, 1848 insertions(+), 31 deletions(-) create mode 100644 man/AnalysisResultsMultiArmFisherR6.Rd create mode 100644 man/FieldSetR6.Rd create mode 100644 man/ParameterSetR6.Rd create mode 100644 man/as.data.frame.AnalysisResultsR6.Rd create mode 100644 man/as.data.frame.ParameterSetR6.Rd create mode 100644 man/as.data.frame.StageResultsR6.Rd create mode 100644 man/as.matrix.FieldSetR6.Rd create mode 100644 man/kable.ParameterSetR6.Rd create mode 100644 man/names.AnalysisResultsR6.Rd create mode 100644 man/names.FieldSetR6.Rd create mode 100644 man/names.StageResultsR6.Rd create mode 100644 man/plot.AnalysisResultsR6.Rd create mode 100644 man/plot.ParameterSetR6.Rd create mode 100644 man/plot.StageResultsR6.Rd create mode 100644 man/print.FieldSetR6.Rd create mode 100644 man/print.ParameterSetR6.Rd create mode 100644 man/summary.AnalysisResultsR6.Rd create mode 100644 man/summary.ParameterSetR6.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 26d06406..ce851069 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -55,7 +55,8 @@ Imports: tools, rlang, knitr (>= 1.19), - Rcpp (>= 1.0.3) + Rcpp (>= 1.0.3), + R6 LinkingTo: Rcpp Suggests: ggplot2 (>= 2.2.0), @@ -85,6 +86,9 @@ Collate: 'class_analysis_dataset.R' 'class_analysis_stage_results.R' 'class_analysis_results.R' + 'class_analysis_results_r6.R' + 'class_analysis_stage_results_r6.R' + 'class_core_parameter_set_r6.R' 'class_time.R' 'class_design_set.R' 'f_design_utilities.R' diff --git a/NAMESPACE b/NAMESPACE index 631750d8..f81eaedd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,28 +1,38 @@ # Generated by roxygen2: do not edit by hand S3method(as.data.frame,AnalysisResults) +S3method(as.data.frame,AnalysisResultsR6) S3method(as.data.frame,ParameterSet) +S3method(as.data.frame,ParameterSetR6) S3method(as.data.frame,PowerAndAverageSampleNumberResult) S3method(as.data.frame,StageResults) +S3method(as.data.frame,StageResultsR6) S3method(as.data.frame,TrialDesign) S3method(as.data.frame,TrialDesignCharacteristics) S3method(as.data.frame,TrialDesignPlan) S3method(as.data.frame,TrialDesignSet) S3method(as.matrix,FieldSet) +S3method(as.matrix,FieldSetR6) S3method(knit_print,ParameterSet) S3method(length,TrialDesignSet) S3method(names,AnalysisResults) +S3method(names,AnalysisResultsR6) S3method(names,FieldSet) +S3method(names,FieldSetR6) S3method(names,SimulationResults) S3method(names,StageResults) +S3method(names,StageResultsR6) S3method(names,TrialDesignSet) S3method(plot,AnalysisResults) +S3method(plot,AnalysisResultsR6) S3method(plot,Dataset) S3method(plot,EventProbabilities) S3method(plot,NumberOfSubjects) S3method(plot,ParameterSet) +S3method(plot,ParameterSetR6) S3method(plot,SimulationResults) S3method(plot,StageResults) +S3method(plot,StageResultsR6) S3method(plot,SummaryFactory) S3method(plot,TrialDesign) S3method(plot,TrialDesignCharacteristics) @@ -30,13 +40,17 @@ S3method(plot,TrialDesignPlan) S3method(plot,TrialDesignSet) S3method(print,Dataset) S3method(print,FieldSet) +S3method(print,FieldSetR6) S3method(print,ParameterSet) +S3method(print,ParameterSetR6) S3method(print,SimulationResults) S3method(print,SummaryFactory) S3method(print,TrialDesignCharacteristics) S3method(summary,AnalysisResults) +S3method(summary,AnalysisResultsR6) S3method(summary,Dataset) S3method(summary,ParameterSet) +S3method(summary,ParameterSetR6) S3method(summary,TrialDesignSet) export(as251Normal) export(as251StudentT) @@ -109,6 +123,7 @@ export(getTestActions) export(getWideFormat) export(kable) export(kable.ParameterSet) +export(kable.ParameterSetR6) export(mvnprd) export(mvstud) export(plotTypes) diff --git a/R/class_analysis_results_r6.R b/R/class_analysis_results_r6.R index 374b162d..37ee7180 100644 --- a/R/class_analysis_results_r6.R +++ b/R/class_analysis_results_r6.R @@ -1,3 +1,4 @@ +library("R6") ## | ## | *Analysis result classes* ## | diff --git a/R/class_analysis_stage_results_r6.R b/R/class_analysis_stage_results_r6.R index 4a684156..a5268e6f 100644 --- a/R/class_analysis_stage_results_r6.R +++ b/R/class_analysis_stage_results_r6.R @@ -1,3 +1,4 @@ +library("R6") ## | ## | *Stage results classes* ## | diff --git a/R/class_core_parameter_set_r6.R b/R/class_core_parameter_set_r6.R index 40a918cc..fbab605f 100644 --- a/R/class_core_parameter_set_r6.R +++ b/R/class_core_parameter_set_r6.R @@ -1,3 +1,4 @@ +library("R6") ## | ## | *Parameter set classes* ## | diff --git a/R/f_core_utilities.R b/R/f_core_utilities.R index 3cc4a900..38ae74db 100644 --- a/R/f_core_utilities.R +++ b/R/f_core_utilities.R @@ -1,3 +1,5 @@ +library(R6) + ## | ## | *Core utilities* ## | diff --git a/man/AnalysisResults.Rd b/man/AnalysisResults.Rd index d67d0197..d5e92f1d 100644 --- a/man/AnalysisResults.Rd +++ b/man/AnalysisResults.Rd @@ -1,13 +1,29 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R +% Please edit documentation in R/class_analysis_results.R, +% R/class_analysis_results_r6.R \docType{class} \name{AnalysisResults} \alias{AnalysisResults} +\alias{AnalysisResultsR6} \title{Basic Class for Analysis Results} \description{ +A basic class for analysis results. + A basic class for analysis results. } \details{ +\code{AnalysisResults} is the basic class for +\itemize{ +\item \code{\link{AnalysisResultsFisher}}, +\item \code{\link{AnalysisResultsGroupSequential}}, +\item \code{\link{AnalysisResultsInverseNormal}}, +\item \code{\link{AnalysisResultsMultiArmFisher}}, +\item \code{\link{AnalysisResultsMultiArmInverseNormal}}, +\item \code{\link{AnalysisResultsConditionalDunnett}}, +\item \code{\link{AnalysisResultsEnrichmentFisher}}, +\item \code{\link{AnalysisResultsEnrichmentInverseNormal}}. +} + \code{AnalysisResults} is the basic class for \itemize{ \item \code{\link{AnalysisResultsFisher}}, diff --git a/man/AnalysisResultsConditionalDunnett.Rd b/man/AnalysisResultsConditionalDunnett.Rd index c9242ba4..0f88016c 100644 --- a/man/AnalysisResultsConditionalDunnett.Rd +++ b/man/AnalysisResultsConditionalDunnett.Rd @@ -1,13 +1,20 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R +% Please edit documentation in R/class_analysis_results.R, +% R/class_analysis_results_r6.R \docType{class} \name{AnalysisResultsConditionalDunnett} \alias{AnalysisResultsConditionalDunnett} +\alias{AnalysisResultsConditionalDunnettR6} \title{Analysis Results Multi-Arm Conditional Dunnett} \description{ +Class for multi-arm analysis results based on a conditional Dunnett test design. + Class for multi-arm analysis results based on a conditional Dunnett test design. } \details{ +This object cannot be created directly; use \code{\link{getAnalysisResults}} +with suitable arguments to create the multi-arm analysis results of a conditional Dunnett test design. + This object cannot be created directly; use \code{\link{getAnalysisResults}} with suitable arguments to create the multi-arm analysis results of a conditional Dunnett test design. } @@ -48,6 +55,42 @@ with suitable arguments to create the multi-arm analysis results of a conditiona \item{\code{repeatedPValues}}{The p-values that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} +\item{\code{piControl}}{The assumed probability in the control arm for simulation and under which the sample size recalculation is performed. Is a numeric vector of length 1 containing a value between 0 and 1.} + +\item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} + +\item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} + +\item{\code{thetaH0}}{The difference or assumed effect under H0. Is a numeric vector of length 1.} + +\item{\code{pi1}}{The assumed probability or probabilities in the active treatment group in two-group designs, or the alternative probability for a one-group design.} + +\item{\code{pi2}}{The assumed probability in the reference group for two-group designs. Is a numeric vector of length 1 containing a value between 0 and 1.} + +\item{\code{nPlanned}}{The sample size planned for each of the subsequent stages. Is a numeric vector of length \code{kMax} containing whole numbers.} + +\item{\code{allocationRatioPlanned}}{The planned allocation ratio (\code{n1 / n2}) for the groups. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. Is a positive numeric vector of length 1.} + +\item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} + +\item{\code{assumedStDevs}}{Assumed standard deviations to calculate conditional power in multi-arm trials or enrichment designs. Is a numeric vector.} + +\item{\code{piTreatments}}{The assumed rates in the treatment groups for multi-arm and enrichment designs, i.e., designs with multiple subsets.} + +\item{\code{intersectionTest}}{The multiple test used for intersection hypotheses in closed systems of hypotheses. Is a character vector of length 1.} + +\item{\code{varianceOption}}{Defines the way to calculate the variance in multiple (i.e., >2) treatment arms or population enrichment designs when testing means. Available options for multiple arms: \code{"overallPooled", "pairwisePooled", "notPooled"}. Available options for enrichment designs: \code{"pooled", "pooledFromFull", "notPooled"}.} + +\item{\code{conditionalRejectionProbabilities}}{The probabilities of rejecting the null hypothesis at each stage, given the stage has been reached. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{conditionalPower}}{The conditional power at each stage of the trial. Is a numeric vector of length 1 containing a value between 0 and 1.} + +\item{\code{repeatedConfidenceIntervalLowerBounds}}{The lower bound of the confidence intervals that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax}.} + +\item{\code{repeatedConfidenceIntervalUpperBounds}}{The upper bound of the confidence interval that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax}.} + +\item{\code{repeatedPValues}}{The p-values that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + \item{\code{piControl}}{The assumed probability in the control arm for simulation and under which the sample size recalculation is performed. Is a numeric vector of length 1 containing a value between 0 and 1.} }} diff --git a/man/AnalysisResultsEnrichment.Rd b/man/AnalysisResultsEnrichment.Rd index feb1922c..1ac3bc50 100644 --- a/man/AnalysisResultsEnrichment.Rd +++ b/man/AnalysisResultsEnrichment.Rd @@ -1,13 +1,23 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R +% Please edit documentation in R/class_analysis_results.R, +% R/class_analysis_results_r6.R \docType{class} \name{AnalysisResultsEnrichment} \alias{AnalysisResultsEnrichment} +\alias{AnalysisResultsEnrichmentR6} \title{Basic Class for Analysis Results Enrichment} \description{ +A basic class for enrichment analysis results. + A basic class for enrichment analysis results. } \details{ +\code{AnalysisResultsEnrichment} is the basic class for +\itemize{ +\item \code{\link{AnalysisResultsEnrichmentFisher}} and +\item \code{\link{AnalysisResultsEnrichmentInverseNormal}}. +} + \code{AnalysisResultsEnrichment} is the basic class for \itemize{ \item \code{\link{AnalysisResultsEnrichmentFisher}} and diff --git a/man/AnalysisResultsEnrichmentFisher.Rd b/man/AnalysisResultsEnrichmentFisher.Rd index a912cb06..13726cf1 100644 --- a/man/AnalysisResultsEnrichmentFisher.Rd +++ b/man/AnalysisResultsEnrichmentFisher.Rd @@ -1,13 +1,20 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R +% Please edit documentation in R/class_analysis_results.R, +% R/class_analysis_results_r6.R \docType{class} \name{AnalysisResultsEnrichmentFisher} \alias{AnalysisResultsEnrichmentFisher} +\alias{AnalysisResultsEnrichmentFisherR6} \title{Analysis Results Enrichment Fisher} \description{ +Class for enrichment analysis results based on a Fisher combination test design. + Class for enrichment analysis results based on a Fisher combination test design. } \details{ +This object cannot be created directly; use \code{\link{getAnalysisResults}} +with suitable arguments to create the multi-arm analysis results of a Fisher combination test design. + This object cannot be created directly; use \code{\link{getAnalysisResults}} with suitable arguments to create the multi-arm analysis results of a Fisher combination test design. } @@ -52,6 +59,46 @@ with suitable arguments to create the multi-arm analysis results of a Fisher com \item{\code{seed}}{The seed used for random number generation. Is a numeric vector of length 1.} +\item{\code{stratifiedAnalysis}}{For enrichment designs, typically a stratified analysis should be chosen. When testing means and rates, a non-stratified analysis can be performed on overall data. For survival data, only a stratified analysis is possible. Is a logical vector of length 1.} + +\item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} + +\item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} + +\item{\code{thetaH0}}{The difference or assumed effect under H0. Is a numeric vector of length 1.} + +\item{\code{pi1}}{The assumed probability or probabilities in the active treatment group in two-group designs, or the alternative probability for a one-group design.} + +\item{\code{pi2}}{The assumed probability in the reference group for two-group designs. Is a numeric vector of length 1 containing a value between 0 and 1.} + +\item{\code{nPlanned}}{The sample size planned for each of the subsequent stages. Is a numeric vector of length \code{kMax} containing whole numbers.} + +\item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} + +\item{\code{assumedStDevs}}{Assumed standard deviations to calculate conditional power in multi-arm trials or enrichment designs. Is a numeric vector.} + +\item{\code{piTreatments}}{The assumed rates in the treatment groups for multi-arm and enrichment designs, i.e., designs with multiple subsets.} + +\item{\code{intersectionTest}}{The multiple test used for intersection hypotheses in closed systems of hypotheses. Is a character vector of length 1.} + +\item{\code{varianceOption}}{Defines the way to calculate the variance in multiple (i.e., >2) treatment arms or population enrichment designs when testing means. Available options for multiple arms: \code{"overallPooled", "pairwisePooled", "notPooled"}. Available options for enrichment designs: \code{"pooled", "pooledFromFull", "notPooled"}.} + +\item{\code{conditionalRejectionProbabilities}}{The probabilities of rejecting the null hypothesis at each stage, given the stage has been reached. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{repeatedConfidenceIntervalLowerBounds}}{The lower bound of the confidence intervals that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax}.} + +\item{\code{repeatedConfidenceIntervalUpperBounds}}{The upper bound of the confidence interval that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax}.} + +\item{\code{repeatedPValues}}{The p-values that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{piControls}}{The assumed rates in the control group for enrichment designs, i.e., designs with multiple subsets.} + +\item{\code{conditionalPowerSimulated}}{The simulated conditional power, under the assumption of observed or assumed effect sizes.} + +\item{\code{iterations}}{The number of iterations used for simulations. Is a numeric vector of length 1 containing a whole number.} + +\item{\code{seed}}{The seed used for random number generation. Is a numeric vector of length 1.} + \item{\code{stratifiedAnalysis}}{For enrichment designs, typically a stratified analysis should be chosen. When testing means and rates, a non-stratified analysis can be performed on overall data. For survival data, only a stratified analysis is possible. Is a logical vector of length 1.} }} diff --git a/man/AnalysisResultsEnrichmentInverseNormal.Rd b/man/AnalysisResultsEnrichmentInverseNormal.Rd index db7d53c7..7a2e1915 100644 --- a/man/AnalysisResultsEnrichmentInverseNormal.Rd +++ b/man/AnalysisResultsEnrichmentInverseNormal.Rd @@ -1,13 +1,20 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R +% Please edit documentation in R/class_analysis_results.R, +% R/class_analysis_results_r6.R \docType{class} \name{AnalysisResultsEnrichmentInverseNormal} \alias{AnalysisResultsEnrichmentInverseNormal} +\alias{AnalysisResultsEnrichmentInverseNormalR6} \title{Analysis Results Enrichment Inverse Normal} \description{ +Class for enrichment analysis results based on a inverse normal design. + Class for enrichment analysis results based on a inverse normal design. } \details{ +This object cannot be created directly; use \code{\link{getAnalysisResults}} +with suitable arguments to create the enrichment analysis results of an inverse normal design. + This object cannot be created directly; use \code{\link{getAnalysisResults}} with suitable arguments to create the enrichment analysis results of an inverse normal design. } @@ -50,6 +57,44 @@ with suitable arguments to create the enrichment analysis results of an inverse \item{\code{piControls}}{The assumed rates in the control group for enrichment designs, i.e., designs with multiple subsets.} +\item{\code{stratifiedAnalysis}}{For enrichment designs, typically a stratified analysis should be chosen. When testing means and rates, a non-stratified analysis can be performed on overall data. For survival data, only a stratified analysis is possible. Is a logical vector of length 1.} + +\item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} + +\item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} + +\item{\code{thetaH0}}{The difference or assumed effect under H0. Is a numeric vector of length 1.} + +\item{\code{pi1}}{The assumed probability or probabilities in the active treatment group in two-group designs, or the alternative probability for a one-group design.} + +\item{\code{pi2}}{The assumed probability in the reference group for two-group designs. Is a numeric vector of length 1 containing a value between 0 and 1.} + +\item{\code{nPlanned}}{The sample size planned for each of the subsequent stages. Is a numeric vector of length \code{kMax} containing whole numbers.} + +\item{\code{allocationRatioPlanned}}{The planned allocation ratio (\code{n1 / n2}) for the groups. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. Is a positive numeric vector of length 1.} + +\item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} + +\item{\code{assumedStDevs}}{Assumed standard deviations to calculate conditional power in multi-arm trials or enrichment designs. Is a numeric vector.} + +\item{\code{piTreatments}}{The assumed rates in the treatment groups for multi-arm and enrichment designs, i.e., designs with multiple subsets.} + +\item{\code{intersectionTest}}{The multiple test used for intersection hypotheses in closed systems of hypotheses. Is a character vector of length 1.} + +\item{\code{varianceOption}}{Defines the way to calculate the variance in multiple (i.e., >2) treatment arms or population enrichment designs when testing means. Available options for multiple arms: \code{"overallPooled", "pairwisePooled", "notPooled"}. Available options for enrichment designs: \code{"pooled", "pooledFromFull", "notPooled"}.} + +\item{\code{conditionalRejectionProbabilities}}{The probabilities of rejecting the null hypothesis at each stage, given the stage has been reached. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{conditionalPower}}{The conditional power at each stage of the trial. Is a numeric vector of length 1 containing a value between 0 and 1.} + +\item{\code{repeatedConfidenceIntervalLowerBounds}}{The lower bound of the confidence intervals that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax}.} + +\item{\code{repeatedConfidenceIntervalUpperBounds}}{The upper bound of the confidence interval that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax}.} + +\item{\code{repeatedPValues}}{The p-values that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{piControls}}{The assumed rates in the control group for enrichment designs, i.e., designs with multiple subsets.} + \item{\code{stratifiedAnalysis}}{For enrichment designs, typically a stratified analysis should be chosen. When testing means and rates, a non-stratified analysis can be performed on overall data. For survival data, only a stratified analysis is possible. Is a logical vector of length 1.} }} diff --git a/man/AnalysisResultsFisher.Rd b/man/AnalysisResultsFisher.Rd index 892419af..c42907e8 100644 --- a/man/AnalysisResultsFisher.Rd +++ b/man/AnalysisResultsFisher.Rd @@ -1,13 +1,20 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R +% Please edit documentation in R/class_analysis_results.R, +% R/class_analysis_results_r6.R \docType{class} \name{AnalysisResultsFisher} \alias{AnalysisResultsFisher} +\alias{AnalysisResultsFisherR6} \title{Analysis Results Fisher} \description{ +Class for analysis results based on a Fisher combination test design. + Class for analysis results based on a Fisher combination test design. } \details{ +This object cannot be created directly; use \code{\link{getAnalysisResults}} +with suitable arguments to create the analysis results of a Fisher combination test design. + This object cannot be created directly; use \code{\link{getAnalysisResults}} with suitable arguments to create the analysis results of a Fisher combination test design. } @@ -60,6 +67,54 @@ with suitable arguments to create the analysis results of a Fisher combination t \item{\code{iterations}}{The number of iterations used for simulations. Is a numeric vector of length 1 containing a whole number.} +\item{\code{seed}}{The seed used for random number generation. Is a numeric vector of length 1.} + +\item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} + +\item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} + +\item{\code{thetaH0}}{The difference or assumed effect under H0. Is a numeric vector of length 1.} + +\item{\code{pi1}}{The assumed probability or probabilities in the active treatment group in two-group designs, or the alternative probability for a one-group design.} + +\item{\code{pi2}}{The assumed probability in the reference group for two-group designs. Is a numeric vector of length 1 containing a value between 0 and 1.} + +\item{\code{nPlanned}}{The sample size planned for each of the subsequent stages. Is a numeric vector of length \code{kMax} containing whole numbers.} + +\item{\code{allocationRatioPlanned}}{The planned allocation ratio (\code{n1 / n2}) for the groups. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. Is a positive numeric vector of length 1.} + +\item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} + +\item{\code{assumedStDev}}{The assumed standard deviation(s) for means analysis. Is a numeric vector.} + +\item{\code{equalVariances}}{Describes if the variances in two treatment groups are assumed to be the same. Is a logical vector of length 1.} + +\item{\code{testActions}}{The test decisions at each stage of the trial. Is a character vector of length \code{kMax}.} + +\item{\code{conditionalRejectionProbabilities}}{The probabilities of rejecting the null hypothesis at each stage, given the stage has been reached. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{conditionalPower}}{The conditional power at each stage of the trial. Is a numeric vector of length 1 containing a value between 0 and 1.} + +\item{\code{repeatedConfidenceIntervalLowerBounds}}{The lower bound of the confidence intervals that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax}.} + +\item{\code{repeatedConfidenceIntervalUpperBounds}}{The upper bound of the confidence interval that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax}.} + +\item{\code{repeatedPValues}}{The p-values that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{finalStage}}{The stage at which the trial ends, either with acceptance or rejection of the null hypothesis. Is a numeric vector of length 1.} + +\item{\code{finalPValues}}{The final p-value that is based on the stage-wise ordering. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{finalConfidenceIntervalLowerBounds}}{The lower bound of the confidence interval that is based on the stage-wise ordering. Is a numeric vector of length \code{kMax}.} + +\item{\code{finalConfidenceIntervalUpperBounds}}{The upper bound of the confidence interval that is based on the stage-wise ordering. Is a numeric vector of length \code{kMax}.} + +\item{\code{medianUnbiasedEstimates}}{The calculated median unbiased estimates that are based on the stage-wise ordering. Is a numeric vector of length \code{kMax}.} + +\item{\code{conditionalPowerSimulated}}{The simulated conditional power, under the assumption of observed or assumed effect sizes.} + +\item{\code{iterations}}{The number of iterations used for simulations. Is a numeric vector of length 1 containing a whole number.} + \item{\code{seed}}{The seed used for random number generation. Is a numeric vector of length 1.} }} diff --git a/man/AnalysisResultsGroupSequential.Rd b/man/AnalysisResultsGroupSequential.Rd index 069cf571..7cf7127d 100644 --- a/man/AnalysisResultsGroupSequential.Rd +++ b/man/AnalysisResultsGroupSequential.Rd @@ -1,13 +1,20 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R +% Please edit documentation in R/class_analysis_results.R, +% R/class_analysis_results_r6.R \docType{class} \name{AnalysisResultsGroupSequential} \alias{AnalysisResultsGroupSequential} +\alias{AnalysisResultsGroupSequentialR6} \title{Analysis Results Group Sequential} \description{ +Class for analysis results results based on a group sequential design. + Class for analysis results results based on a group sequential design. } \details{ +This object cannot be created directly; use \code{\link{getAnalysisResults}} +with suitable arguments to create the analysis results of a group sequential design. + This object cannot be created directly; use \code{\link{getAnalysisResults}} with suitable arguments to create the analysis results of a group sequential design. } @@ -58,6 +65,52 @@ with suitable arguments to create the analysis results of a group sequential des \item{\code{maxInformation}}{The maximum information. Is a numeric vector of length 1 containing a whole number.} +\item{\code{informationEpsilon}}{The absolute information epsilon, which defines the maximum distance from the observed information to the maximum information that causes the final analysis. Updates at the final analysis if the observed information at the final analysis is smaller ("under-running") than the planned maximum information. Is either a positive integer value specifying the absolute information epsilon or a floating point number >0 and <1 to define a relative information epsilon.} + +\item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} + +\item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} + +\item{\code{thetaH0}}{The difference or assumed effect under H0. Is a numeric vector of length 1.} + +\item{\code{pi1}}{The assumed probability or probabilities in the active treatment group in two-group designs, or the alternative probability for a one-group design.} + +\item{\code{pi2}}{The assumed probability in the reference group for two-group designs. Is a numeric vector of length 1 containing a value between 0 and 1.} + +\item{\code{nPlanned}}{The sample size planned for each of the subsequent stages. Is a numeric vector of length \code{kMax} containing whole numbers.} + +\item{\code{allocationRatioPlanned}}{The planned allocation ratio (\code{n1 / n2}) for the groups. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. Is a positive numeric vector of length 1.} + +\item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} + +\item{\code{assumedStDev}}{The assumed standard deviation(s) for means analysis. Is a numeric vector.} + +\item{\code{equalVariances}}{Describes if the variances in two treatment groups are assumed to be the same. Is a logical vector of length 1.} + +\item{\code{testActions}}{The test decisions at each stage of the trial. Is a character vector of length \code{kMax}.} + +\item{\code{conditionalRejectionProbabilities}}{The probabilities of rejecting the null hypothesis at each stage, given the stage has been reached. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{conditionalPower}}{The conditional power at each stage of the trial. Is a numeric vector of length 1 containing a value between 0 and 1.} + +\item{\code{repeatedConfidenceIntervalLowerBounds}}{The lower bound of the confidence intervals that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax}.} + +\item{\code{repeatedConfidenceIntervalUpperBounds}}{The upper bound of the confidence interval that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax}.} + +\item{\code{repeatedPValues}}{The p-values that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{finalStage}}{The stage at which the trial ends, either with acceptance or rejection of the null hypothesis. Is a numeric vector of length 1.} + +\item{\code{finalPValues}}{The final p-value that is based on the stage-wise ordering. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{finalConfidenceIntervalLowerBounds}}{The lower bound of the confidence interval that is based on the stage-wise ordering. Is a numeric vector of length \code{kMax}.} + +\item{\code{finalConfidenceIntervalUpperBounds}}{The upper bound of the confidence interval that is based on the stage-wise ordering. Is a numeric vector of length \code{kMax}.} + +\item{\code{medianUnbiasedEstimates}}{The calculated median unbiased estimates that are based on the stage-wise ordering. Is a numeric vector of length \code{kMax}.} + +\item{\code{maxInformation}}{The maximum information. Is a numeric vector of length 1 containing a whole number.} + \item{\code{informationEpsilon}}{The absolute information epsilon, which defines the maximum distance from the observed information to the maximum information that causes the final analysis. Updates at the final analysis if the observed information at the final analysis is smaller ("under-running") than the planned maximum information. Is either a positive integer value specifying the absolute information epsilon or a floating point number >0 and <1 to define a relative information epsilon.} }} diff --git a/man/AnalysisResultsInverseNormal.Rd b/man/AnalysisResultsInverseNormal.Rd index bbf9333a..21f95b26 100644 --- a/man/AnalysisResultsInverseNormal.Rd +++ b/man/AnalysisResultsInverseNormal.Rd @@ -1,13 +1,20 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R +% Please edit documentation in R/class_analysis_results.R, +% R/class_analysis_results_r6.R \docType{class} \name{AnalysisResultsInverseNormal} \alias{AnalysisResultsInverseNormal} +\alias{AnalysisResultsInverseNormalR6} \title{Analysis Results Inverse Normal} \description{ +Class for analysis results results based on an inverse normal design. + Class for analysis results results based on an inverse normal design. } \details{ +This object cannot be created directly; use \code{\link{getAnalysisResults}} +with suitable arguments to create the analysis results of a inverse normal design. + This object cannot be created directly; use \code{\link{getAnalysisResults}} with suitable arguments to create the analysis results of a inverse normal design. } @@ -54,6 +61,48 @@ with suitable arguments to create the analysis results of a inverse normal desig \item{\code{finalConfidenceIntervalUpperBounds}}{The upper bound of the confidence interval that is based on the stage-wise ordering. Is a numeric vector of length \code{kMax}.} +\item{\code{medianUnbiasedEstimates}}{The calculated median unbiased estimates that are based on the stage-wise ordering. Is a numeric vector of length \code{kMax}.} + +\item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} + +\item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} + +\item{\code{thetaH0}}{The difference or assumed effect under H0. Is a numeric vector of length 1.} + +\item{\code{pi1}}{The assumed probability or probabilities in the active treatment group in two-group designs, or the alternative probability for a one-group design.} + +\item{\code{pi2}}{The assumed probability in the reference group for two-group designs. Is a numeric vector of length 1 containing a value between 0 and 1.} + +\item{\code{nPlanned}}{The sample size planned for each of the subsequent stages. Is a numeric vector of length \code{kMax} containing whole numbers.} + +\item{\code{allocationRatioPlanned}}{The planned allocation ratio (\code{n1 / n2}) for the groups. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. Is a positive numeric vector of length 1.} + +\item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} + +\item{\code{assumedStDev}}{The assumed standard deviation(s) for means analysis. Is a numeric vector.} + +\item{\code{equalVariances}}{Describes if the variances in two treatment groups are assumed to be the same. Is a logical vector of length 1.} + +\item{\code{testActions}}{The test decisions at each stage of the trial. Is a character vector of length \code{kMax}.} + +\item{\code{conditionalRejectionProbabilities}}{The probabilities of rejecting the null hypothesis at each stage, given the stage has been reached. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{conditionalPower}}{The conditional power at each stage of the trial. Is a numeric vector of length 1 containing a value between 0 and 1.} + +\item{\code{repeatedConfidenceIntervalLowerBounds}}{The lower bound of the confidence intervals that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax}.} + +\item{\code{repeatedConfidenceIntervalUpperBounds}}{The upper bound of the confidence interval that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax}.} + +\item{\code{repeatedPValues}}{The p-values that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{finalStage}}{The stage at which the trial ends, either with acceptance or rejection of the null hypothesis. Is a numeric vector of length 1.} + +\item{\code{finalPValues}}{The final p-value that is based on the stage-wise ordering. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{finalConfidenceIntervalLowerBounds}}{The lower bound of the confidence interval that is based on the stage-wise ordering. Is a numeric vector of length \code{kMax}.} + +\item{\code{finalConfidenceIntervalUpperBounds}}{The upper bound of the confidence interval that is based on the stage-wise ordering. Is a numeric vector of length \code{kMax}.} + \item{\code{medianUnbiasedEstimates}}{The calculated median unbiased estimates that are based on the stage-wise ordering. Is a numeric vector of length \code{kMax}.} }} diff --git a/man/AnalysisResultsMultiArm.Rd b/man/AnalysisResultsMultiArm.Rd index 7719af7f..b5aaecf7 100644 --- a/man/AnalysisResultsMultiArm.Rd +++ b/man/AnalysisResultsMultiArm.Rd @@ -1,13 +1,24 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R +% Please edit documentation in R/class_analysis_results.R, +% R/class_analysis_results_r6.R \docType{class} \name{AnalysisResultsMultiArm} \alias{AnalysisResultsMultiArm} +\alias{AnalysisResultsMultiArmR6} \title{Basic Class for Analysis Results Multi-Arm} \description{ +A basic class for multi-arm analysis results. + A basic class for multi-arm analysis results. } \details{ +\code{AnalysisResultsMultiArm} is the basic class for +\itemize{ +\item \code{\link{AnalysisResultsMultiArmFisher}}, +\item \code{\link{AnalysisResultsMultiArmInverseNormal}}, and +\item \code{\link{AnalysisResultsConditionalDunnett}}. +} + \code{AnalysisResultsMultiArm} is the basic class for \itemize{ \item \code{\link{AnalysisResultsMultiArmFisher}}, diff --git a/man/AnalysisResultsMultiArmFisherR6.Rd b/man/AnalysisResultsMultiArmFisherR6.Rd new file mode 100644 index 00000000..97fac7cf --- /dev/null +++ b/man/AnalysisResultsMultiArmFisherR6.Rd @@ -0,0 +1,59 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_analysis_results_r6.R +\name{AnalysisResultsMultiArmFisherR6} +\alias{AnalysisResultsMultiArmFisherR6} +\title{Analysis Results Multi-Arm Fisher} +\description{ +Class for multi-arm analysis results based on a Fisher combination test design. +} +\details{ +This object cannot be created directly; use \code{\link{getAnalysisResults}} +with suitable arguments to create the multi-arm analysis results of a Fisher combination test design. +} +\section{Fields}{ + +\describe{ +\item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} + +\item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} + +\item{\code{thetaH0}}{The difference or assumed effect under H0. Is a numeric vector of length 1.} + +\item{\code{pi1}}{The assumed probability or probabilities in the active treatment group in two-group designs, or the alternative probability for a one-group design.} + +\item{\code{pi2}}{The assumed probability in the reference group for two-group designs. Is a numeric vector of length 1 containing a value between 0 and 1.} + +\item{\code{nPlanned}}{The sample size planned for each of the subsequent stages. Is a numeric vector of length \code{kMax} containing whole numbers.} + +\item{\code{allocationRatioPlanned}}{The planned allocation ratio (\code{n1 / n2}) for the groups. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. Is a positive numeric vector of length 1.} + +\item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} + +\item{\code{assumedStDevs}}{Assumed standard deviations to calculate conditional power in multi-arm trials or enrichment designs. Is a numeric vector.} + +\item{\code{piTreatments}}{The assumed rates in the treatment groups for multi-arm and enrichment designs, i.e., designs with multiple subsets.} + +\item{\code{intersectionTest}}{The multiple test used for intersection hypotheses in closed systems of hypotheses. Is a character vector of length 1.} + +\item{\code{varianceOption}}{Defines the way to calculate the variance in multiple (i.e., >2) treatment arms or population enrichment designs when testing means. Available options for multiple arms: \code{"overallPooled", "pairwisePooled", "notPooled"}. Available options for enrichment designs: \code{"pooled", "pooledFromFull", "notPooled"}.} + +\item{\code{conditionalRejectionProbabilities}}{The probabilities of rejecting the null hypothesis at each stage, given the stage has been reached. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{conditionalPower}}{The conditional power at each stage of the trial. Is a numeric vector of length 1 containing a value between 0 and 1.} + +\item{\code{repeatedConfidenceIntervalLowerBounds}}{The lower bound of the confidence intervals that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax}.} + +\item{\code{repeatedConfidenceIntervalUpperBounds}}{The upper bound of the confidence interval that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax}.} + +\item{\code{repeatedPValues}}{The p-values that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{piControl}}{The assumed probability in the control arm for simulation and under which the sample size recalculation is performed. Is a numeric vector of length 1 containing a value between 0 and 1.} + +\item{\code{conditionalPowerSimulated}}{The simulated conditional power, under the assumption of observed or assumed effect sizes.} + +\item{\code{iterations}}{The number of iterations used for simulations. Is a numeric vector of length 1 containing a whole number.} + +\item{\code{seed}}{The seed used for random number generation. Is a numeric vector of length 1.} +}} + +\keyword{internal} diff --git a/man/AnalysisResultsMultiArmInverseNormal.Rd b/man/AnalysisResultsMultiArmInverseNormal.Rd index 84be8996..76b18187 100644 --- a/man/AnalysisResultsMultiArmInverseNormal.Rd +++ b/man/AnalysisResultsMultiArmInverseNormal.Rd @@ -1,13 +1,20 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R +% Please edit documentation in R/class_analysis_results.R, +% R/class_analysis_results_r6.R \docType{class} \name{AnalysisResultsMultiArmInverseNormal} \alias{AnalysisResultsMultiArmInverseNormal} +\alias{AnalysisResultsMultiArmInverseNormalR6} \title{Analysis Results Multi-Arm Inverse Normal} \description{ +Class for multi-arm analysis results based on a inverse normal design. + Class for multi-arm analysis results based on a inverse normal design. } \details{ +This object cannot be created directly; use \code{\link{getAnalysisResults}} +with suitable arguments to create the multi-arm analysis results of an inverse normal design. + This object cannot be created directly; use \code{\link{getAnalysisResults}} with suitable arguments to create the multi-arm analysis results of an inverse normal design. } @@ -48,6 +55,42 @@ with suitable arguments to create the multi-arm analysis results of an inverse n \item{\code{repeatedPValues}}{The p-values that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} +\item{\code{piControl}}{The assumed probability in the control arm for simulation and under which the sample size recalculation is performed. Is a numeric vector of length 1 containing a value between 0 and 1.} + +\item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} + +\item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} + +\item{\code{thetaH0}}{The difference or assumed effect under H0. Is a numeric vector of length 1.} + +\item{\code{pi1}}{The assumed probability or probabilities in the active treatment group in two-group designs, or the alternative probability for a one-group design.} + +\item{\code{pi2}}{The assumed probability in the reference group for two-group designs. Is a numeric vector of length 1 containing a value between 0 and 1.} + +\item{\code{nPlanned}}{The sample size planned for each of the subsequent stages. Is a numeric vector of length \code{kMax} containing whole numbers.} + +\item{\code{allocationRatioPlanned}}{The planned allocation ratio (\code{n1 / n2}) for the groups. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. Is a positive numeric vector of length 1.} + +\item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} + +\item{\code{assumedStDevs}}{Assumed standard deviations to calculate conditional power in multi-arm trials or enrichment designs. Is a numeric vector.} + +\item{\code{piTreatments}}{The assumed rates in the treatment groups for multi-arm and enrichment designs, i.e., designs with multiple subsets.} + +\item{\code{intersectionTest}}{The multiple test used for intersection hypotheses in closed systems of hypotheses. Is a character vector of length 1.} + +\item{\code{varianceOption}}{Defines the way to calculate the variance in multiple (i.e., >2) treatment arms or population enrichment designs when testing means. Available options for multiple arms: \code{"overallPooled", "pairwisePooled", "notPooled"}. Available options for enrichment designs: \code{"pooled", "pooledFromFull", "notPooled"}.} + +\item{\code{conditionalRejectionProbabilities}}{The probabilities of rejecting the null hypothesis at each stage, given the stage has been reached. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{conditionalPower}}{The conditional power at each stage of the trial. Is a numeric vector of length 1 containing a value between 0 and 1.} + +\item{\code{repeatedConfidenceIntervalLowerBounds}}{The lower bound of the confidence intervals that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax}.} + +\item{\code{repeatedConfidenceIntervalUpperBounds}}{The upper bound of the confidence interval that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax}.} + +\item{\code{repeatedPValues}}{The p-values that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + \item{\code{piControl}}{The assumed probability in the control arm for simulation and under which the sample size recalculation is performed. Is a numeric vector of length 1 containing a value between 0 and 1.} }} diff --git a/man/AnalysisResultsMultiHypotheses.Rd b/man/AnalysisResultsMultiHypotheses.Rd index e521a933..b93259e7 100644 --- a/man/AnalysisResultsMultiHypotheses.Rd +++ b/man/AnalysisResultsMultiHypotheses.Rd @@ -1,13 +1,23 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R +% Please edit documentation in R/class_analysis_results.R, +% R/class_analysis_results_r6.R \docType{class} \name{AnalysisResultsMultiHypotheses} \alias{AnalysisResultsMultiHypotheses} +\alias{AnalysisResultsMultiHypothesesR6} \title{Basic Class for Analysis Results Multi-Hypotheses} \description{ +A basic class for multi-hypotheses analysis results. + A basic class for multi-hypotheses analysis results. } \details{ +\code{AnalysisResultsMultiHypotheses} is the basic class for +\itemize{ +\item \code{\link{AnalysisResultsMultiArm}} and +\item \code{\link{AnalysisResultsEnrichment}}. +} + \code{AnalysisResultsMultiHypotheses} is the basic class for \itemize{ \item \code{\link{AnalysisResultsMultiArm}} and diff --git a/man/ClosedCombinationTestResults.Rd b/man/ClosedCombinationTestResults.Rd index 3e457354..3b49d190 100644 --- a/man/ClosedCombinationTestResults.Rd +++ b/man/ClosedCombinationTestResults.Rd @@ -1,13 +1,20 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R +% Please edit documentation in R/class_analysis_results.R, +% R/class_analysis_results_r6.R \docType{class} \name{ClosedCombinationTestResults} \alias{ClosedCombinationTestResults} +\alias{ClosedCombinationTestResultsR6} \title{Analysis Results Closed Combination Test} \description{ +Class for multi-arm analysis results based on a closed combination test. + Class for multi-arm analysis results based on a closed combination test. } \details{ +This object cannot be created directly; use \code{\link{getAnalysisResults}} +with suitable arguments to create the multi-arm analysis results of a closed combination test design. + This object cannot be created directly; use \code{\link{getAnalysisResults}} with suitable arguments to create the multi-arm analysis results of a closed combination test design. } @@ -30,6 +37,24 @@ with suitable arguments to create the multi-arm analysis results of a closed com \item{\code{rejected}}{Indicates whether a hypothesis is rejected or not.} +\item{\code{rejectedIntersections}}{The simulated number of rejected arms in the closed testing procedure.. Is a logical matrix.} + +\item{\code{intersectionTest}}{The multiple test used for intersection hypotheses in closed systems of hypotheses. Is a character vector of length 1.} + +\item{\code{indices}}{Indicates which stages are available for analysis.} + +\item{\code{adjustedStageWisePValues}}{The multiplicity adjusted p-values from the separate stages. Is a numeric matrix.} + +\item{\code{overallAdjustedTestStatistics}}{The overall adjusted test statistics.} + +\item{\code{separatePValues}}{The p-values from the separate stages. Is a numeric matrix.} + +\item{\code{conditionalErrorRate}}{The calculated conditional error rate.} + +\item{\code{secondStagePValues}}{For conditional Dunnett test, the conditional or unconditional p-value calculated for the second stage.} + +\item{\code{rejected}}{Indicates whether a hypothesis is rejected or not.} + \item{\code{rejectedIntersections}}{The simulated number of rejected arms in the closed testing procedure.. Is a logical matrix.} }} diff --git a/man/ConditionalPowerResults.Rd b/man/ConditionalPowerResults.Rd index 3a920396..7c846921 100644 --- a/man/ConditionalPowerResults.Rd +++ b/man/ConditionalPowerResults.Rd @@ -1,13 +1,20 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R +% Please edit documentation in R/class_analysis_results.R, +% R/class_analysis_results_r6.R \docType{class} \name{ConditionalPowerResults} \alias{ConditionalPowerResults} +\alias{ConditionalPowerResultsR6} \title{Conditional Power Results} \description{ +Class for conditional power calculations + Class for conditional power calculations } \details{ +This object cannot be created directly; use \code{\link[=getConditionalPower]{getConditionalPower()}} +with suitable arguments to create the results of a group sequential or a combination test design. + This object cannot be created directly; use \code{\link[=getConditionalPower]{getConditionalPower()}} with suitable arguments to create the results of a group sequential or a combination test design. } @@ -28,6 +35,22 @@ with suitable arguments to create the results of a group sequential or a combina \item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} +\item{\code{assumedStDev}}{The assumed standard deviation(s) for means analysis. Is a numeric vector.} + +\item{\code{nPlanned}}{The sample size planned for each of the subsequent stages. Is a numeric vector of length \code{kMax} containing whole numbers.} + +\item{\code{allocationRatioPlanned}}{The planned allocation ratio (\code{n1 / n2}) for the groups. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. Is a positive numeric vector of length 1.} + +\item{\code{iterations}}{The number of iterations used for simulations. Is a numeric vector of length 1 containing a whole number.} + +\item{\code{seed}}{The seed used for random number generation. Is a numeric vector of length 1.} + +\item{\code{simulated}}{Describes if the power for Fisher's combination test has been simulated. Only applicable when using Fisher designs. Is a logical vector of length 1.} + +\item{\code{conditionalPower}}{The conditional power at each stage of the trial. Is a numeric vector of length 1 containing a value between 0 and 1.} + +\item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} + \item{\code{assumedStDev}}{The assumed standard deviation(s) for means analysis. Is a numeric vector.} }} diff --git a/man/ConditionalPowerResultsEnrichmentMeans.Rd b/man/ConditionalPowerResultsEnrichmentMeans.Rd index 6f6b3c0e..fc15c00f 100644 --- a/man/ConditionalPowerResultsEnrichmentMeans.Rd +++ b/man/ConditionalPowerResultsEnrichmentMeans.Rd @@ -1,13 +1,20 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R +% Please edit documentation in R/class_analysis_results.R, +% R/class_analysis_results_r6.R \docType{class} \name{ConditionalPowerResultsEnrichmentMeans} \alias{ConditionalPowerResultsEnrichmentMeans} +\alias{ConditionalPowerResultsEnrichmentMeansR6} \title{Conditional Power Results Enrichment Means} \description{ +Class for conditional power calculations of enrichment means data + Class for conditional power calculations of enrichment means data } \details{ +This object cannot be created directly; use \code{\link{getConditionalPower}} +with suitable arguments to create the results of a group sequential or a combination test design. + This object cannot be created directly; use \code{\link{getConditionalPower}} with suitable arguments to create the results of a group sequential or a combination test design. } @@ -28,6 +35,22 @@ with suitable arguments to create the results of a group sequential or a combina \item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} +\item{\code{assumedStDevs}}{Assumed standard deviations to calculate conditional power in multi-arm trials or enrichment designs. Is a numeric vector.} + +\item{\code{nPlanned}}{The sample size planned for each of the subsequent stages. Is a numeric vector of length \code{kMax} containing whole numbers.} + +\item{\code{allocationRatioPlanned}}{The planned allocation ratio (\code{n1 / n2}) for the groups. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. Is a positive numeric vector of length 1.} + +\item{\code{iterations}}{The number of iterations used for simulations. Is a numeric vector of length 1 containing a whole number.} + +\item{\code{seed}}{The seed used for random number generation. Is a numeric vector of length 1.} + +\item{\code{simulated}}{Describes if the power for Fisher's combination test has been simulated. Only applicable when using Fisher designs. Is a logical vector of length 1.} + +\item{\code{conditionalPower}}{The conditional power at each stage of the trial. Is a numeric vector of length 1 containing a value between 0 and 1.} + +\item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} + \item{\code{assumedStDevs}}{Assumed standard deviations to calculate conditional power in multi-arm trials or enrichment designs. Is a numeric vector.} }} diff --git a/man/ConditionalPowerResultsEnrichmentRates.Rd b/man/ConditionalPowerResultsEnrichmentRates.Rd index 08d88514..0203ef5d 100644 --- a/man/ConditionalPowerResultsEnrichmentRates.Rd +++ b/man/ConditionalPowerResultsEnrichmentRates.Rd @@ -1,13 +1,20 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R +% Please edit documentation in R/class_analysis_results.R, +% R/class_analysis_results_r6.R \docType{class} \name{ConditionalPowerResultsEnrichmentRates} \alias{ConditionalPowerResultsEnrichmentRates} +\alias{ConditionalPowerResultsEnrichmentRatesR6} \title{Conditional Power Results Enrichment Rates} \description{ +Class for conditional power calculations of enrichment rates data + Class for conditional power calculations of enrichment rates data } \details{ +This object cannot be created directly; use \code{\link{getConditionalPower}} +with suitable arguments to create the results of a group sequential or a combination test design. + This object cannot be created directly; use \code{\link{getConditionalPower}} with suitable arguments to create the results of a group sequential or a combination test design. } @@ -28,6 +35,22 @@ with suitable arguments to create the results of a group sequential or a combina \item{\code{piTreatments}}{The assumed rates in the treatment groups for multi-arm and enrichment designs, i.e., designs with multiple subsets.} +\item{\code{piControls}}{The assumed rates in the control group for enrichment designs, i.e., designs with multiple subsets.} + +\item{\code{nPlanned}}{The sample size planned for each of the subsequent stages. Is a numeric vector of length \code{kMax} containing whole numbers.} + +\item{\code{allocationRatioPlanned}}{The planned allocation ratio (\code{n1 / n2}) for the groups. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. Is a positive numeric vector of length 1.} + +\item{\code{iterations}}{The number of iterations used for simulations. Is a numeric vector of length 1 containing a whole number.} + +\item{\code{seed}}{The seed used for random number generation. Is a numeric vector of length 1.} + +\item{\code{simulated}}{Describes if the power for Fisher's combination test has been simulated. Only applicable when using Fisher designs. Is a logical vector of length 1.} + +\item{\code{conditionalPower}}{The conditional power at each stage of the trial. Is a numeric vector of length 1 containing a value between 0 and 1.} + +\item{\code{piTreatments}}{The assumed rates in the treatment groups for multi-arm and enrichment designs, i.e., designs with multiple subsets.} + \item{\code{piControls}}{The assumed rates in the control group for enrichment designs, i.e., designs with multiple subsets.} }} diff --git a/man/ConditionalPowerResultsMeans.Rd b/man/ConditionalPowerResultsMeans.Rd index 2b0dcb98..6d580098 100644 --- a/man/ConditionalPowerResultsMeans.Rd +++ b/man/ConditionalPowerResultsMeans.Rd @@ -1,13 +1,20 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R +% Please edit documentation in R/class_analysis_results.R, +% R/class_analysis_results_r6.R \docType{class} \name{ConditionalPowerResultsMeans} \alias{ConditionalPowerResultsMeans} +\alias{ConditionalPowerResultsMeansR6} \title{Conditional Power Results Means} \description{ +Class for conditional power calculations of means data + Class for conditional power calculations of means data } \details{ +This object cannot be created directly; use \code{\link{getConditionalPower}} +with suitable arguments to create the results of a group sequential or a combination test design. + This object cannot be created directly; use \code{\link{getConditionalPower}} with suitable arguments to create the results of a group sequential or a combination test design. } @@ -28,6 +35,22 @@ with suitable arguments to create the results of a group sequential or a combina \item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} +\item{\code{assumedStDev}}{The assumed standard deviation(s) for means analysis. Is a numeric vector.} + +\item{\code{nPlanned}}{The sample size planned for each of the subsequent stages. Is a numeric vector of length \code{kMax} containing whole numbers.} + +\item{\code{allocationRatioPlanned}}{The planned allocation ratio (\code{n1 / n2}) for the groups. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. Is a positive numeric vector of length 1.} + +\item{\code{iterations}}{The number of iterations used for simulations. Is a numeric vector of length 1 containing a whole number.} + +\item{\code{seed}}{The seed used for random number generation. Is a numeric vector of length 1.} + +\item{\code{simulated}}{Describes if the power for Fisher's combination test has been simulated. Only applicable when using Fisher designs. Is a logical vector of length 1.} + +\item{\code{conditionalPower}}{The conditional power at each stage of the trial. Is a numeric vector of length 1 containing a value between 0 and 1.} + +\item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} + \item{\code{assumedStDev}}{The assumed standard deviation(s) for means analysis. Is a numeric vector.} }} diff --git a/man/ConditionalPowerResultsRates.Rd b/man/ConditionalPowerResultsRates.Rd index 0cf596a3..d259a9c3 100644 --- a/man/ConditionalPowerResultsRates.Rd +++ b/man/ConditionalPowerResultsRates.Rd @@ -1,13 +1,20 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R +% Please edit documentation in R/class_analysis_results.R, +% R/class_analysis_results_r6.R \docType{class} \name{ConditionalPowerResultsRates} \alias{ConditionalPowerResultsRates} +\alias{ConditionalPowerResultsRatesR6} \title{Conditional Power Results Rates} \description{ +Class for conditional power calculations of rates data + Class for conditional power calculations of rates data } \details{ +This object cannot be created directly; use \code{\link{getConditionalPower}} +with suitable arguments to create the results of a group sequential or a combination test design. + This object cannot be created directly; use \code{\link{getConditionalPower}} with suitable arguments to create the results of a group sequential or a combination test design. } @@ -28,6 +35,22 @@ with suitable arguments to create the results of a group sequential or a combina \item{\code{pi1}}{The assumed probability or probabilities in the active treatment group in two-group designs, or the alternative probability for a one-group design.} +\item{\code{pi2}}{The assumed probability in the reference group for two-group designs. Is a numeric vector of length 1 containing a value between 0 and 1.} + +\item{\code{nPlanned}}{The sample size planned for each of the subsequent stages. Is a numeric vector of length \code{kMax} containing whole numbers.} + +\item{\code{allocationRatioPlanned}}{The planned allocation ratio (\code{n1 / n2}) for the groups. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. Is a positive numeric vector of length 1.} + +\item{\code{iterations}}{The number of iterations used for simulations. Is a numeric vector of length 1 containing a whole number.} + +\item{\code{seed}}{The seed used for random number generation. Is a numeric vector of length 1.} + +\item{\code{simulated}}{Describes if the power for Fisher's combination test has been simulated. Only applicable when using Fisher designs. Is a logical vector of length 1.} + +\item{\code{conditionalPower}}{The conditional power at each stage of the trial. Is a numeric vector of length 1 containing a value between 0 and 1.} + +\item{\code{pi1}}{The assumed probability or probabilities in the active treatment group in two-group designs, or the alternative probability for a one-group design.} + \item{\code{pi2}}{The assumed probability in the reference group for two-group designs. Is a numeric vector of length 1 containing a value between 0 and 1.} }} diff --git a/man/ConditionalPowerResultsSurvival.Rd b/man/ConditionalPowerResultsSurvival.Rd index cbedeb4c..ed7f4036 100644 --- a/man/ConditionalPowerResultsSurvival.Rd +++ b/man/ConditionalPowerResultsSurvival.Rd @@ -1,13 +1,20 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R +% Please edit documentation in R/class_analysis_results.R, +% R/class_analysis_results_r6.R \docType{class} \name{ConditionalPowerResultsSurvival} \alias{ConditionalPowerResultsSurvival} +\alias{ConditionalPowerResultsSurvivalR6} \title{Conditional Power Results Survival} \description{ +Class for conditional power calculations of survival data + Class for conditional power calculations of survival data } \details{ +This object cannot be created directly; use \code{\link{getConditionalPower}} +with suitable arguments to create the results of a group sequential or a combination test design. + This object cannot be created directly; use \code{\link{getConditionalPower}} with suitable arguments to create the results of a group sequential or a combination test design. } @@ -26,6 +33,20 @@ with suitable arguments to create the results of a group sequential or a combina \item{\code{conditionalPower}}{The conditional power at each stage of the trial. Is a numeric vector of length 1 containing a value between 0 and 1.} +\item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} + +\item{\code{nPlanned}}{The sample size planned for each of the subsequent stages. Is a numeric vector of length \code{kMax} containing whole numbers.} + +\item{\code{allocationRatioPlanned}}{The planned allocation ratio (\code{n1 / n2}) for the groups. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. Is a positive numeric vector of length 1.} + +\item{\code{iterations}}{The number of iterations used for simulations. Is a numeric vector of length 1 containing a whole number.} + +\item{\code{seed}}{The seed used for random number generation. Is a numeric vector of length 1.} + +\item{\code{simulated}}{Describes if the power for Fisher's combination test has been simulated. Only applicable when using Fisher designs. Is a logical vector of length 1.} + +\item{\code{conditionalPower}}{The conditional power at each stage of the trial. Is a numeric vector of length 1 containing a value between 0 and 1.} + \item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} }} diff --git a/man/FieldSetR6.Rd b/man/FieldSetR6.Rd new file mode 100644 index 00000000..38faefea --- /dev/null +++ b/man/FieldSetR6.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_core_parameter_set_r6.R +\name{FieldSetR6} +\alias{FieldSetR6} +\title{Field Set} +\description{ +Basic class for field sets. +} +\details{ +The field set implements basic functions for a set of fields. +} +\keyword{internal} diff --git a/man/ParameterSetR6.Rd b/man/ParameterSetR6.Rd new file mode 100644 index 00000000..d39e1ae1 --- /dev/null +++ b/man/ParameterSetR6.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_core_parameter_set_r6.R +\name{ParameterSetR6} +\alias{ParameterSetR6} +\title{Parameter Set} +\description{ +Basic class for parameter sets. +} +\details{ +The parameter set implements basic functions for a set of parameters. +} +\keyword{internal} diff --git a/man/StageResults.Rd b/man/StageResults.Rd index c24c3345..367a5e28 100644 --- a/man/StageResults.Rd +++ b/man/StageResults.Rd @@ -1,13 +1,30 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_stage_results.R +% Please edit documentation in R/class_analysis_stage_results.R, +% R/class_analysis_stage_results_r6.R \docType{class} \name{StageResults} \alias{StageResults} +\alias{StageResultsR6} \title{Basic Stage Results} \description{ +Basic class for stage results. + Basic class for stage results. } \details{ +\code{StageResults} is the basic class for +\itemize{ +\item \code{\link{StageResultsMeans}}, +\item \code{\link{StageResultsRates}}, +\item \code{\link{StageResultsSurvival}}, +\item \code{\link{StageResultsMultiArmMeans}}, +\item \code{\link{StageResultsMultiArmRates}}, +\item \code{\link{StageResultsMultiArmSurvival}}, +\item \code{\link{StageResultsEnrichmentMeans}}, +\item \code{\link{StageResultsEnrichmentRates}}, and +\item \code{\link{StageResultsEnrichmentSurvival}}. +} + \code{StageResults} is the basic class for \itemize{ \item \code{\link{StageResultsMeans}}, @@ -40,6 +57,24 @@ Basic class for stage results. \item{\code{weightsFisher}}{The weights for Fisher's combination test. Is a numeric vector of length \code{kMax}.} +\item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} + +\item{\code{stages}}{The stage numbers of the trial. Is a numeric vector of length \code{kMax} containing whole numbers.} + +\item{\code{testStatistics}}{The stage-wise test statistics. Is a numeric vector of length \code{kMax}.} + +\item{\code{pValues}}{The stage-wise p-values. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{combInverseNormal}}{The test statistics over stages for the inverse normal test. Is a numeric vector of length \code{kMax}.} + +\item{\code{combFisher}}{The test statistics over stages for Fisher's combination test. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{effectSizes}}{The stage-wise effect sizes. Is a numeric vector of length \code{kMax}.} + +\item{\code{testActions}}{The test decisions at each stage of the trial. Is a character vector of length \code{kMax}.} + +\item{\code{weightsFisher}}{The weights for Fisher's combination test. Is a numeric vector of length \code{kMax}.} + \item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} }} diff --git a/man/StageResultsEnrichmentMeans.Rd b/man/StageResultsEnrichmentMeans.Rd index ef96ffa3..bf507069 100644 --- a/man/StageResultsEnrichmentMeans.Rd +++ b/man/StageResultsEnrichmentMeans.Rd @@ -1,13 +1,20 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_stage_results.R +% Please edit documentation in R/class_analysis_stage_results.R, +% R/class_analysis_stage_results_r6.R \docType{class} \name{StageResultsEnrichmentMeans} \alias{StageResultsEnrichmentMeans} +\alias{StageResultsEnrichmentMeansR6} \title{Stage Results Enrichment Means} \description{ +Class for stage results of enrichment means data + Class for stage results of enrichment means data } \details{ +This object cannot be created directly; use \code{getStageResults} +with suitable arguments to create the stage results of a dataset of enrichment means. + This object cannot be created directly; use \code{getStageResults} with suitable arguments to create the stage results of a dataset of enrichment means. } @@ -54,6 +61,48 @@ with suitable arguments to create the stage results of a dataset of enrichment m \item{\code{weightsFisher}}{The weights for Fisher's combination test. Is a numeric vector of length \code{kMax}.} +\item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} + +\item{\code{stages}}{The stage numbers of the trial. Is a numeric vector of length \code{kMax} containing whole numbers.} + +\item{\code{thetaH0}}{The difference or assumed effect under H0. Is a numeric vector of length 1.} + +\item{\code{direction}}{Specifies the direction of the alternative, is either "upper" or "lower". Only applicable for one-sided testing.} + +\item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} + +\item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} + +\item{\code{varianceOption}}{Defines the way to calculate the variance in multiple (i.e., >2) treatment arms or population enrichment designs when testing means. Available options for multiple arms: \code{"overallPooled", "pairwisePooled", "notPooled"}. Available options for enrichment designs: \code{"pooled", "pooledFromFull", "notPooled"}.} + +\item{\code{intersectionTest}}{The multiple test used for intersection hypotheses in closed systems of hypotheses. Is a character vector of length 1.} + +\item{\code{testStatistics}}{The stage-wise test statistics. Is a numeric vector of length \code{kMax}.} + +\item{\code{overallTestStatistics}}{The overall, i.e., cumulated test statistics. Is a numeric vector of length \code{kMax}.} + +\item{\code{pValues}}{The stage-wise p-values. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{overallPValues}}{The overall, i.e., cumulated p-values. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{overallStDevs}}{The overall, i.e., cumulative standard deviations. Is a numeric vector of length number of stages times number of groups.} + +\item{\code{overallPooledStDevs}}{The overall pooled standard deviations. Is a numeric matrix.} + +\item{\code{separatePValues}}{The p-values from the separate stages. Is a numeric matrix.} + +\item{\code{effectSizes}}{The stage-wise effect sizes. Is a numeric vector of length \code{kMax}.} + +\item{\code{singleStepAdjustedPValues}}{The adjusted p-value for testing multiple hypotheses per stage of the trial.} + +\item{\code{stratifiedAnalysis}}{For enrichment designs, typically a stratified analysis should be chosen. When testing means and rates, a non-stratified analysis can be performed on overall data. For survival data, only a stratified analysis is possible. Is a logical vector of length 1.} + +\item{\code{combInverseNormal}}{The test statistics over stages for the inverse normal test. Is a numeric vector of length \code{kMax}.} + +\item{\code{combFisher}}{The test statistics over stages for Fisher's combination test. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{weightsFisher}}{The weights for Fisher's combination test. Is a numeric vector of length \code{kMax}.} + \item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} }} diff --git a/man/StageResultsEnrichmentRates.Rd b/man/StageResultsEnrichmentRates.Rd index e15d30ef..1d418e86 100644 --- a/man/StageResultsEnrichmentRates.Rd +++ b/man/StageResultsEnrichmentRates.Rd @@ -1,13 +1,20 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_stage_results.R +% Please edit documentation in R/class_analysis_stage_results.R, +% R/class_analysis_stage_results_r6.R \docType{class} \name{StageResultsEnrichmentRates} \alias{StageResultsEnrichmentRates} +\alias{StageResultsEnrichmentRatesR6} \title{Stage Results Enrichment Rates} \description{ +Class for stage results of enrichment rates data. + Class for stage results of enrichment rates data. } \details{ +This object cannot be created directly; use \code{getStageResults} +with suitable arguments to create the stage results of a dataset of enrichment rates. + This object cannot be created directly; use \code{getStageResults} with suitable arguments to create the stage results of a dataset of enrichment rates. } @@ -30,6 +37,24 @@ with suitable arguments to create the stage results of a dataset of enrichment r \item{\code{weightsFisher}}{The weights for Fisher's combination test. Is a numeric vector of length \code{kMax}.} +\item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} + +\item{\code{stages}}{The stage numbers of the trial. Is a numeric vector of length \code{kMax} containing whole numbers.} + +\item{\code{testStatistics}}{The stage-wise test statistics. Is a numeric vector of length \code{kMax}.} + +\item{\code{pValues}}{The stage-wise p-values. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{combInverseNormal}}{The test statistics over stages for the inverse normal test. Is a numeric vector of length \code{kMax}.} + +\item{\code{combFisher}}{The test statistics over stages for Fisher's combination test. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{effectSizes}}{The stage-wise effect sizes. Is a numeric vector of length \code{kMax}.} + +\item{\code{testActions}}{The test decisions at each stage of the trial. Is a character vector of length \code{kMax}.} + +\item{\code{weightsFisher}}{The weights for Fisher's combination test. Is a numeric vector of length \code{kMax}.} + \item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} }} diff --git a/man/StageResultsEnrichmentSurvival.Rd b/man/StageResultsEnrichmentSurvival.Rd index 091fa8be..cabe6289 100644 --- a/man/StageResultsEnrichmentSurvival.Rd +++ b/man/StageResultsEnrichmentSurvival.Rd @@ -1,13 +1,20 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_stage_results.R +% Please edit documentation in R/class_analysis_stage_results.R, +% R/class_analysis_stage_results_r6.R \docType{class} \name{StageResultsEnrichmentSurvival} \alias{StageResultsEnrichmentSurvival} +\alias{StageResultsEnrichmentSurvivalR6} \title{Stage Results Enrichment Survival} \description{ +Class for stage results of enrichment survival data. + Class for stage results of enrichment survival data. } \details{ +This object cannot be created directly; use \code{getStageResults} +with suitable arguments to create the stage results of a dataset of enrichment survival. + This object cannot be created directly; use \code{getStageResults} with suitable arguments to create the stage results of a dataset of enrichment survival. } @@ -30,6 +37,24 @@ with suitable arguments to create the stage results of a dataset of enrichment s \item{\code{weightsFisher}}{The weights for Fisher's combination test. Is a numeric vector of length \code{kMax}.} +\item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} + +\item{\code{stages}}{The stage numbers of the trial. Is a numeric vector of length \code{kMax} containing whole numbers.} + +\item{\code{testStatistics}}{The stage-wise test statistics. Is a numeric vector of length \code{kMax}.} + +\item{\code{pValues}}{The stage-wise p-values. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{combInverseNormal}}{The test statistics over stages for the inverse normal test. Is a numeric vector of length \code{kMax}.} + +\item{\code{combFisher}}{The test statistics over stages for Fisher's combination test. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{effectSizes}}{The stage-wise effect sizes. Is a numeric vector of length \code{kMax}.} + +\item{\code{testActions}}{The test decisions at each stage of the trial. Is a character vector of length \code{kMax}.} + +\item{\code{weightsFisher}}{The weights for Fisher's combination test. Is a numeric vector of length \code{kMax}.} + \item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} }} diff --git a/man/StageResultsMeans.Rd b/man/StageResultsMeans.Rd index c6f7bcec..15e0f5f7 100644 --- a/man/StageResultsMeans.Rd +++ b/man/StageResultsMeans.Rd @@ -1,13 +1,20 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_stage_results.R +% Please edit documentation in R/class_analysis_stage_results.R, +% R/class_analysis_stage_results_r6.R \docType{class} \name{StageResultsMeans} \alias{StageResultsMeans} +\alias{StageResultsMeansR6} \title{Stage Results of Means} \description{ +Class for stage results of means. + Class for stage results of means. } \details{ +This object cannot be created directly; use \code{getStageResults} +with suitable arguments to create the stage results of a dataset of means. + This object cannot be created directly; use \code{getStageResults} with suitable arguments to create the stage results of a dataset of means. } @@ -42,6 +49,36 @@ with suitable arguments to create the stage results of a dataset of means. \item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} +\item{\code{...}}{Names of \code{dataInput}.} + +\item{\code{stages}}{The stage numbers of the trial. Is a numeric vector of length \code{kMax} containing whole numbers.} + +\item{\code{testStatistics}}{The stage-wise test statistics. Is a numeric vector of length \code{kMax}.} + +\item{\code{overallTestStatistics}}{The overall, i.e., cumulated test statistics. Is a numeric vector of length \code{kMax}.} + +\item{\code{pValues}}{The stage-wise p-values. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{overallPValues}}{The overall, i.e., cumulated p-values. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{effectSizes}}{The stage-wise effect sizes. Is a numeric vector of length \code{kMax}.} + +\item{\code{testActions}}{The test decisions at each stage of the trial. Is a character vector of length \code{kMax}.} + +\item{\code{direction}}{Specifies the direction of the alternative, is either "upper" or "lower". Only applicable for one-sided testing.} + +\item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} + +\item{\code{equalVariances}}{Describes if the variances in two treatment groups are assumed to be the same. Is a logical vector of length 1.} + +\item{\code{combFisher}}{The test statistics over stages for Fisher's combination test. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{weightsFisher}}{The weights for Fisher's combination test. Is a numeric vector of length \code{kMax}.} + +\item{\code{combInverseNormal}}{The test statistics over stages for the inverse normal test. Is a numeric vector of length \code{kMax}.} + +\item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} + \item{\code{...}}{Names of \code{dataInput}.} }} diff --git a/man/StageResultsMultiArmMeans.Rd b/man/StageResultsMultiArmMeans.Rd index bb86eedd..46708325 100644 --- a/man/StageResultsMultiArmMeans.Rd +++ b/man/StageResultsMultiArmMeans.Rd @@ -1,13 +1,20 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_stage_results.R +% Please edit documentation in R/class_analysis_stage_results.R, +% R/class_analysis_stage_results_r6.R \docType{class} \name{StageResultsMultiArmMeans} \alias{StageResultsMultiArmMeans} +\alias{StageResultsMultiArmMeansR6} \title{Stage Results Multi Arm Means} \description{ +Class for stage results of multi arm means data + Class for stage results of multi arm means data } \details{ +This object cannot be created directly; use \code{getStageResults} +with suitable arguments to create the stage results of a dataset of multi arm means. + This object cannot be created directly; use \code{getStageResults} with suitable arguments to create the stage results of a dataset of multi arm means. } @@ -58,6 +65,52 @@ with suitable arguments to create the stage results of a dataset of multi arm me \item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} +\item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} + +\item{\code{stages}}{The stage numbers of the trial. Is a numeric vector of length \code{kMax} containing whole numbers.} + +\item{\code{testStatistics}}{The stage-wise test statistics. Is a numeric vector of length \code{kMax}.} + +\item{\code{pValues}}{The stage-wise p-values. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{combInverseNormal}}{The test statistics over stages for the inverse normal test. Is a numeric vector of length \code{kMax}.} + +\item{\code{combFisher}}{The test statistics over stages for Fisher's combination test. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{effectSizes}}{The stage-wise effect sizes. Is a numeric vector of length \code{kMax}.} + +\item{\code{testActions}}{The test decisions at each stage of the trial. Is a character vector of length \code{kMax}.} + +\item{\code{weightsFisher}}{The weights for Fisher's combination test. Is a numeric vector of length \code{kMax}.} + +\item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} + +\item{\code{combInverseNormal}}{The test statistics over stages for the inverse normal test. Is a numeric vector of length \code{kMax}.} + +\item{\code{combFisher}}{The test statistics over stages for Fisher's combination test. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{overallTestStatistics}}{The overall, i.e., cumulated test statistics. Is a numeric vector of length \code{kMax}.} + +\item{\code{overallStDevs}}{The overall, i.e., cumulative standard deviations. Is a numeric vector of length number of stages times number of groups.} + +\item{\code{overallPooledStDevs}}{The overall pooled standard deviations. Is a numeric matrix.} + +\item{\code{overallPValues}}{The overall, i.e., cumulated p-values. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{testStatistics}}{The stage-wise test statistics. Is a numeric vector of length \code{kMax}.} + +\item{\code{separatePValues}}{The p-values from the separate stages. Is a numeric matrix.} + +\item{\code{effectSizes}}{The stage-wise effect sizes. Is a numeric vector of length \code{kMax}.} + +\item{\code{singleStepAdjustedPValues}}{The adjusted p-value for testing multiple hypotheses per stage of the trial.} + +\item{\code{intersectionTest}}{The multiple test used for intersection hypotheses in closed systems of hypotheses. Is a character vector of length 1.} + +\item{\code{varianceOption}}{Defines the way to calculate the variance in multiple (i.e., >2) treatment arms or population enrichment designs when testing means. Available options for multiple arms: \code{"overallPooled", "pairwisePooled", "notPooled"}. Available options for enrichment designs: \code{"pooled", "pooledFromFull", "notPooled"}.} + +\item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} + \item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} }} diff --git a/man/StageResultsMultiArmRates.Rd b/man/StageResultsMultiArmRates.Rd index ed93dd91..6f6e6a77 100644 --- a/man/StageResultsMultiArmRates.Rd +++ b/man/StageResultsMultiArmRates.Rd @@ -1,13 +1,20 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_stage_results.R +% Please edit documentation in R/class_analysis_stage_results.R, +% R/class_analysis_stage_results_r6.R \docType{class} \name{StageResultsMultiArmRates} \alias{StageResultsMultiArmRates} +\alias{StageResultsMultiArmRatesR6} \title{Stage Results Multi Arm Rates} \description{ +Class for stage results of multi arm rates data + Class for stage results of multi arm rates data } \details{ +This object cannot be created directly; use \code{getStageResults} +with suitable arguments to create the stage results of a dataset of multi arm rates. + This object cannot be created directly; use \code{getStageResults} with suitable arguments to create the stage results of a dataset of multi arm rates. } @@ -52,6 +59,46 @@ with suitable arguments to create the stage results of a dataset of multi arm ra \item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} +\item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} + +\item{\code{stages}}{The stage numbers of the trial. Is a numeric vector of length \code{kMax} containing whole numbers.} + +\item{\code{testStatistics}}{The stage-wise test statistics. Is a numeric vector of length \code{kMax}.} + +\item{\code{pValues}}{The stage-wise p-values. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{combInverseNormal}}{The test statistics over stages for the inverse normal test. Is a numeric vector of length \code{kMax}.} + +\item{\code{combFisher}}{The test statistics over stages for Fisher's combination test. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{effectSizes}}{The stage-wise effect sizes. Is a numeric vector of length \code{kMax}.} + +\item{\code{testActions}}{The test decisions at each stage of the trial. Is a character vector of length \code{kMax}.} + +\item{\code{weightsFisher}}{The weights for Fisher's combination test. Is a numeric vector of length \code{kMax}.} + +\item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} + +\item{\code{combInverseNormal}}{The test statistics over stages for the inverse normal test. Is a numeric vector of length \code{kMax}.} + +\item{\code{combFisher}}{The test statistics over stages for Fisher's combination test. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{overallTestStatistics}}{The overall, i.e., cumulated test statistics. Is a numeric vector of length \code{kMax}.} + +\item{\code{overallPValues}}{The overall, i.e., cumulated p-values. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{testStatistics}}{The stage-wise test statistics. Is a numeric vector of length \code{kMax}.} + +\item{\code{separatePValues}}{The p-values from the separate stages. Is a numeric matrix.} + +\item{\code{effectSizes}}{The stage-wise effect sizes. Is a numeric vector of length \code{kMax}.} + +\item{\code{singleStepAdjustedPValues}}{The adjusted p-value for testing multiple hypotheses per stage of the trial.} + +\item{\code{intersectionTest}}{The multiple test used for intersection hypotheses in closed systems of hypotheses. Is a character vector of length 1.} + +\item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} + \item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} }} diff --git a/man/StageResultsMultiArmSurvival.Rd b/man/StageResultsMultiArmSurvival.Rd index 446c4dab..04fb8640 100644 --- a/man/StageResultsMultiArmSurvival.Rd +++ b/man/StageResultsMultiArmSurvival.Rd @@ -1,13 +1,20 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_stage_results.R +% Please edit documentation in R/class_analysis_stage_results.R, +% R/class_analysis_stage_results_r6.R \docType{class} \name{StageResultsMultiArmSurvival} \alias{StageResultsMultiArmSurvival} +\alias{StageResultsMultiArmSurvivalR6} \title{Stage Results Multi Arm Survival} \description{ +Class for stage results of multi arm survival data + Class for stage results of multi arm survival data } \details{ +This object cannot be created directly; use \code{getStageResults} +with suitable arguments to create the stage results of a dataset of multi arm survival. + This object cannot be created directly; use \code{getStageResults} with suitable arguments to create the stage results of a dataset of multi arm survival. } @@ -50,6 +57,44 @@ with suitable arguments to create the stage results of a dataset of multi arm su \item{\code{intersectionTest}}{The multiple test used for intersection hypotheses in closed systems of hypotheses. Is a character vector of length 1.} +\item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} + +\item{\code{stages}}{The stage numbers of the trial. Is a numeric vector of length \code{kMax} containing whole numbers.} + +\item{\code{testStatistics}}{The stage-wise test statistics. Is a numeric vector of length \code{kMax}.} + +\item{\code{pValues}}{The stage-wise p-values. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{combInverseNormal}}{The test statistics over stages for the inverse normal test. Is a numeric vector of length \code{kMax}.} + +\item{\code{combFisher}}{The test statistics over stages for Fisher's combination test. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{effectSizes}}{The stage-wise effect sizes. Is a numeric vector of length \code{kMax}.} + +\item{\code{testActions}}{The test decisions at each stage of the trial. Is a character vector of length \code{kMax}.} + +\item{\code{weightsFisher}}{The weights for Fisher's combination test. Is a numeric vector of length \code{kMax}.} + +\item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} + +\item{\code{combInverseNormal}}{The test statistics over stages for the inverse normal test. Is a numeric vector of length \code{kMax}.} + +\item{\code{combFisher}}{The test statistics over stages for Fisher's combination test. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{overallTestStatistics}}{The overall, i.e., cumulated test statistics. Is a numeric vector of length \code{kMax}.} + +\item{\code{overallPValues}}{The overall, i.e., cumulated p-values. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{testStatistics}}{The stage-wise test statistics. Is a numeric vector of length \code{kMax}.} + +\item{\code{separatePValues}}{The p-values from the separate stages. Is a numeric matrix.} + +\item{\code{effectSizes}}{The stage-wise effect sizes. Is a numeric vector of length \code{kMax}.} + +\item{\code{singleStepAdjustedPValues}}{The adjusted p-value for testing multiple hypotheses per stage of the trial.} + +\item{\code{intersectionTest}}{The multiple test used for intersection hypotheses in closed systems of hypotheses. Is a character vector of length 1.} + \item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} }} diff --git a/man/StageResultsRates.Rd b/man/StageResultsRates.Rd index f327a9dc..6ce48420 100644 --- a/man/StageResultsRates.Rd +++ b/man/StageResultsRates.Rd @@ -1,13 +1,20 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_stage_results.R +% Please edit documentation in R/class_analysis_stage_results.R, +% R/class_analysis_stage_results_r6.R \docType{class} \name{StageResultsRates} \alias{StageResultsRates} +\alias{StageResultsRatesR6} \title{Stage Results of Rates} \description{ +Class for stage results of rates. + Class for stage results of rates. } \details{ +This object cannot be created directly; use \code{getStageResults} +with suitable arguments to create the stage results of a dataset of rates. + This object cannot be created directly; use \code{getStageResults} with suitable arguments to create the stage results of a dataset of rates. } @@ -42,6 +49,36 @@ with suitable arguments to create the stage results of a dataset of rates. \item{\code{combFisher}}{The test statistics over stages for Fisher's combination test. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} +\item{\code{...}}{Names of \code{dataInput}.} + +\item{\code{stages}}{The stage numbers of the trial. Is a numeric vector of length \code{kMax} containing whole numbers.} + +\item{\code{testStatistics}}{The stage-wise test statistics. Is a numeric vector of length \code{kMax}.} + +\item{\code{overallTestStatistics}}{The overall, i.e., cumulated test statistics. Is a numeric vector of length \code{kMax}.} + +\item{\code{pValues}}{The stage-wise p-values. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{overallPValues}}{The overall, i.e., cumulated p-values. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{effectSizes}}{The stage-wise effect sizes. Is a numeric vector of length \code{kMax}.} + +\item{\code{direction}}{Specifies the direction of the alternative, is either "upper" or "lower". Only applicable for one-sided testing.} + +\item{\code{testActions}}{The test decisions at each stage of the trial. Is a character vector of length \code{kMax}.} + +\item{\code{thetaH0}}{The difference or assumed effect under H0. Is a numeric vector of length 1.} + +\item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} + +\item{\code{weightsFisher}}{The weights for Fisher's combination test. Is a numeric vector of length \code{kMax}.} + +\item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} + +\item{\code{combInverseNormal}}{The test statistics over stages for the inverse normal test. Is a numeric vector of length \code{kMax}.} + +\item{\code{combFisher}}{The test statistics over stages for Fisher's combination test. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + \item{\code{...}}{Names of \code{dataInput}.} }} diff --git a/man/StageResultsSurvival.Rd b/man/StageResultsSurvival.Rd index 7c5b29ab..f6c2713a 100644 --- a/man/StageResultsSurvival.Rd +++ b/man/StageResultsSurvival.Rd @@ -1,13 +1,20 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_stage_results.R +% Please edit documentation in R/class_analysis_stage_results.R, +% R/class_analysis_stage_results_r6.R \docType{class} \name{StageResultsSurvival} \alias{StageResultsSurvival} +\alias{StageResultsSurvivalR6} \title{Stage Results of Survival Data} \description{ +Class for stage results survival data. + Class for stage results survival data. } \details{ +This object cannot be created directly; use \code{getStageResults} +with suitable arguments to create the stage results of a dataset of survival data. + This object cannot be created directly; use \code{getStageResults} with suitable arguments to create the stage results of a dataset of survival data. } @@ -48,6 +55,42 @@ with suitable arguments to create the stage results of a dataset of survival dat \item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} +\item{\code{...}}{Names of \code{dataInput}.} + +\item{\code{stages}}{The stage numbers of the trial. Is a numeric vector of length \code{kMax} containing whole numbers.} + +\item{\code{testStatistics}}{The stage-wise test statistics. Is a numeric vector of length \code{kMax}.} + +\item{\code{overallTestStatistics}}{The overall, i.e., cumulated test statistics. Is a numeric vector of length \code{kMax}.} + +\item{\code{separatePValues}}{The p-values from the separate stages. Is a numeric matrix.} + +\item{\code{singleStepAdjustedPValues}}{The adjusted p-value for testing multiple hypotheses per stage of the trial.} + +\item{\code{overallPValues}}{The overall, i.e., cumulated p-values. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{direction}}{Specifies the direction of the alternative, is either "upper" or "lower". Only applicable for one-sided testing.} + +\item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} + +\item{\code{intersectionTest}}{The multiple test used for intersection hypotheses in closed systems of hypotheses. Is a character vector of length 1.} + +\item{\code{combInverseNormal}}{The test statistics over stages for the inverse normal test. Is a numeric vector of length \code{kMax}.} + +\item{\code{combFisher}}{The test statistics over stages for Fisher's combination test. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} + +\item{\code{effectSizes}}{The stage-wise effect sizes. Is a numeric vector of length \code{kMax}.} + +\item{\code{testActions}}{The test decisions at each stage of the trial. Is a character vector of length \code{kMax}.} + +\item{\code{thetaH0}}{The difference or assumed effect under H0. Is a numeric vector of length 1.} + +\item{\code{weightsFisher}}{The weights for Fisher's combination test. Is a numeric vector of length \code{kMax}.} + +\item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} + +\item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} + \item{\code{...}}{Names of \code{dataInput}.} }} diff --git a/man/as.data.frame.AnalysisResultsR6.Rd b/man/as.data.frame.AnalysisResultsR6.Rd new file mode 100644 index 00000000..84cbe128 --- /dev/null +++ b/man/as.data.frame.AnalysisResultsR6.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_analysis_results_r6.R +\name{as.data.frame.AnalysisResultsR6} +\alias{as.data.frame.AnalysisResultsR6} +\title{Coerce AnalysisResults to a Data Frame} +\usage{ +\method{as.data.frame}{AnalysisResultsR6}( + x, + row.names = NULL, + optional = FALSE, + ..., + niceColumnNamesEnabled = FALSE +) +} +\arguments{ +\item{x}{An \code{\link{AnalysisResults}} object created by \code{\link[=getAnalysisResults]{getAnalysisResults()}}.} + +\item{...}{Ensures that all arguments (starting from the "...") are to be named and +that a warning will be displayed if unknown arguments are passed.} + +\item{niceColumnNamesEnabled}{Logical. If \code{TRUE}, nice looking column +names will be used; syntactic names (variable names) otherwise +(see \code{\link[base]{make.names}}).} +} +\value{ +Returns a \code{\link[base]{data.frame}}. +} +\description{ +Returns the \code{\link{AnalysisResults}} object as data frame. +} +\details{ +Coerces the analysis results to a data frame. +} +\keyword{internal} diff --git a/man/as.data.frame.ParameterSetR6.Rd b/man/as.data.frame.ParameterSetR6.Rd new file mode 100644 index 00000000..608c78ff --- /dev/null +++ b/man/as.data.frame.ParameterSetR6.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_core_parameter_set_r6.R +\name{as.data.frame.ParameterSetR6} +\alias{as.data.frame.ParameterSetR6} +\title{Coerce Parameter Set to a Data Frame} +\usage{ +\method{as.data.frame}{ParameterSetR6}( + x, + row.names = NULL, + optional = FALSE, + niceColumnNamesEnabled = FALSE, + includeAllParameters = FALSE, + ... +) +} +\arguments{ +\item{x}{A \code{\link{FieldSet}} object.} + +\item{niceColumnNamesEnabled}{Logical. If \code{TRUE}, nice looking column +names will be used; syntactic names (variable names) otherwise +(see \code{\link[base]{make.names}}).} + +\item{includeAllParameters}{Logical. If \code{TRUE}, all available +parameters will be included in the data frame; +a meaningful parameter selection otherwise, default is \code{FALSE}.} + +\item{...}{Ensures that all arguments (starting from the "...") are to be named and +that a warning will be displayed if unknown arguments are passed.} +} +\value{ +Returns a \code{\link[base]{data.frame}}. +} +\description{ +Returns the \code{ParameterSet} as data frame. +} +\details{ +Coerces the parameter set to a data frame. +} +\keyword{internal} diff --git a/man/as.data.frame.StageResultsR6.Rd b/man/as.data.frame.StageResultsR6.Rd new file mode 100644 index 00000000..eb6ebb47 --- /dev/null +++ b/man/as.data.frame.StageResultsR6.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_analysis_stage_results_r6.R +\name{as.data.frame.StageResultsR6} +\alias{as.data.frame.StageResultsR6} +\title{Coerce Stage Results to a Data Frame} +\usage{ +\method{as.data.frame}{StageResultsR6}( + x, + row.names = NULL, + optional = FALSE, + niceColumnNamesEnabled = FALSE, + includeAllParameters = FALSE, + type = 1, + ... +) +} +\arguments{ +\item{x}{A \code{\link{StageResults}} object.} + +\item{niceColumnNamesEnabled}{Logical. If \code{TRUE}, nice looking column +names will be used; syntactic names (variable names) otherwise +(see \code{\link[base]{make.names}}).} + +\item{includeAllParameters}{Logical. If \code{TRUE}, all available +parameters will be included in the data frame; +a meaningful parameter selection otherwise, default is \code{FALSE}.} + +\item{...}{Ensures that all arguments (starting from the "...") are to be named and +that a warning will be displayed if unknown arguments are passed.} +} +\value{ +Returns a \code{\link[base]{data.frame}}. +} +\description{ +Returns the \code{StageResults} as data frame. +} +\details{ +Coerces the stage results to a data frame. +} +\keyword{internal} diff --git a/man/as.matrix.FieldSetR6.Rd b/man/as.matrix.FieldSetR6.Rd new file mode 100644 index 00000000..81339699 --- /dev/null +++ b/man/as.matrix.FieldSetR6.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_core_parameter_set_r6.R +\name{as.matrix.FieldSetR6} +\alias{as.matrix.FieldSetR6} +\title{Coerce Field Set to a Matrix} +\usage{ +\method{as.matrix}{FieldSetR6}(x, ..., enforceRowNames = TRUE, niceColumnNamesEnabled = TRUE) +} +\arguments{ +\item{x}{A \code{\link{FieldSet}} object.} + +\item{...}{Ensures that all arguments (starting from the "...") are to be named and +that a warning will be displayed if unknown arguments are passed.} + +\item{enforceRowNames}{If \code{TRUE}, row names will be created +depending on the object type, default is \code{TRUE}.} + +\item{niceColumnNamesEnabled}{Logical. If \code{TRUE}, nice looking column +names will be used; syntactic names (variable names) otherwise +(see \code{\link[base]{make.names}}).} +} +\value{ +Returns a \code{\link[base]{matrix}}. +} +\description{ +Returns the \code{FrameSet} as matrix. +} +\details{ +Coerces the frame set to a matrix. +} +\keyword{internal} diff --git a/man/kable.ParameterSetR6.Rd b/man/kable.ParameterSetR6.Rd new file mode 100644 index 00000000..356e1ec1 --- /dev/null +++ b/man/kable.ParameterSetR6.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_core_parameter_set_r6.R +\name{kable.ParameterSetR6} +\alias{kable.ParameterSetR6} +\title{Create output in Markdown} +\usage{ +kable.ParameterSetR6(x, ...) +} +\arguments{ +\item{x}{A \code{ParameterSet}. If x does not inherit from class \code{\link{ParameterSet}}, +\code{knitr::kable(x)} will be returned.} + +\item{...}{Other arguments (see \code{\link[knitr]{kable}}).} +} +\description{ +The \code{kable()} function returns the output of the specified object formatted in Markdown. +} +\details{ +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. +} diff --git a/man/kable.Rd b/man/kable.Rd index 99efbe60..768182ea 100644 --- a/man/kable.Rd +++ b/man/kable.Rd @@ -1,9 +1,12 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_core_parameter_set.R +% Please edit documentation in R/class_core_parameter_set.R, +% R/class_core_parameter_set_r6.R \name{kable} \alias{kable} \title{Create tables in Markdown} \usage{ +kable(x, ...) + kable(x, ...) } \arguments{ @@ -12,8 +15,12 @@ kable(x, ...) \item{...}{Other arguments (see \code{\link[knitr]{kable}}).} } \description{ +The \code{kable()} function returns a single table for a single object that inherits from class \code{\link{ParameterSet}}. + The \code{kable()} function returns a single table for a single object that inherits from class \code{\link{ParameterSet}}. } \details{ +Generic to represent a parameter set in Markdown. + Generic to represent a parameter set in Markdown. } diff --git a/man/names.AnalysisResultsR6.Rd b/man/names.AnalysisResultsR6.Rd new file mode 100644 index 00000000..c5748e69 --- /dev/null +++ b/man/names.AnalysisResultsR6.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_analysis_results_r6.R +\name{names.AnalysisResultsR6} +\alias{names.AnalysisResultsR6} +\title{Names of a Analysis Results Object} +\usage{ +\method{names}{AnalysisResultsR6}(x) +} +\arguments{ +\item{x}{An \code{\link{AnalysisResults}} object created by \code{\link[=getAnalysisResults]{getAnalysisResults()}}.} +} +\value{ +Returns a \code{\link[base]{character}} vector containing the names of the \code{\link{AnalysisResults}} object. +} +\description{ +Function to get the names of an \code{\link{AnalysisResults}} object. +} +\details{ +Returns the names of an analysis results that can be accessed by the user. +} +\keyword{internal} diff --git a/man/names.FieldSetR6.Rd b/man/names.FieldSetR6.Rd new file mode 100644 index 00000000..11d54e2f --- /dev/null +++ b/man/names.FieldSetR6.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_core_parameter_set_r6.R +\name{names.FieldSetR6} +\alias{names.FieldSetR6} +\title{Names of a Field Set Object} +\usage{ +\method{names}{FieldSetR6}(x) +} +\arguments{ +\item{x}{A \code{\link{FieldSet}} object.} +} +\value{ +Returns a \code{\link[base]{character}} vector containing the names of the \code{\link{AnalysisResults}} object. +} +\description{ +Function to get the names of a \code{\link{FieldSet}} object. +} +\details{ +Returns the names of a field set that can be accessed by the user. +} +\keyword{internal} diff --git a/man/names.StageResultsR6.Rd b/man/names.StageResultsR6.Rd new file mode 100644 index 00000000..8250fbad --- /dev/null +++ b/man/names.StageResultsR6.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_analysis_stage_results_r6.R +\name{names.StageResultsR6} +\alias{names.StageResultsR6} +\title{Names of a Stage Results Object} +\usage{ +\method{names}{StageResultsR6}(x) +} +\arguments{ +\item{x}{A \code{\link{StageResults}} object.} +} +\value{ +Returns a \code{\link[base]{character}} vector containing the names of the \code{\link{AnalysisResults}} object. +} +\description{ +Function to get the names of a \code{\link{StageResults}} object. +} +\details{ +Returns the names of stage results that can be accessed by the user. +} +\keyword{internal} diff --git a/man/plot.AnalysisResultsR6.Rd b/man/plot.AnalysisResultsR6.Rd new file mode 100644 index 00000000..374064f4 --- /dev/null +++ b/man/plot.AnalysisResultsR6.Rd @@ -0,0 +1,139 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_analysis_results_r6.R +\name{plot.AnalysisResultsR6} +\alias{plot.AnalysisResultsR6} +\title{Analysis Results Plotting} +\usage{ +\method{plot}{AnalysisResultsR6}( + 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 +) +} +\arguments{ +\item{x}{The analysis results at given stage, obtained from \code{\link[=getAnalysisResults]{getAnalysisResults()}}.} + +\item{y}{Not available for this kind of plot (is only defined to be compatible to the generic plot function).} + +\item{...}{Optional \link[=param_three_dots_plot]{plot arguments}. Furthermore the following arguments can be defined: +\itemize{ +\item \code{thetaRange}: A range of assumed effect sizes if testing means or a survival design was specified. +Additionally, if testing means was selected, \code{assumedStDev} (assumed standard deviation) +can be specified (default is \code{1}). +\item \code{piTreatmentRange}: A range of assumed rates pi1 to calculate the conditional power. +Additionally, if a two-sample comparison was selected, \code{pi2} can be specified (default is the value from +\code{\link[=getAnalysisResults]{getAnalysisResults()}}). +\item \code{directionUpper}: Specifies the direction of the alternative, +only applicable for one-sided testing; default is \code{TRUE} +which means that larger values of the test statistics yield smaller p-values. +\item \code{\link[=param_thetaH0]{thetaH0}}: The null hypothesis value, default is \code{0} for +the normal and the binary case, it is \code{1} for the survival case. +For testing a rate in one sample, a value thetaH0 in (0, 1) has to be specified for +defining the null hypothesis H0: \code{pi = thetaH0}. +}} + +\item{type}{The plot type (default = 1). Note that at the moment only one type (the conditional power plot) is available.} + +\item{nPlanned}{The additional (i.e., "new" and not cumulative) sample size planned for each of the subsequent stages. +The argument must be a vector with length equal to the number of remaining stages and contain +the combined sample size from both treatment groups if two groups are considered. For survival outcomes, +it should contain the planned number of additional events. +For multi-arm designs, it is the per-comparison (combined) sample size. +For enrichment designs, it is the (combined) sample size for the considered sub-population.} + +\item{allocationRatioPlanned}{The planned allocation ratio \code{n1 / n2} for a two treatment groups +design, default is \code{1}. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. +For simulating means and rates for a two treatment groups design, it can be a vector of length kMax, the number of stages. +It can be a vector of length kMax, too, for multi-arm and enrichment designs. +In these cases, a change of allocating subjects to treatment groups over the stages can be assessed.} + +\item{main}{The main title, default is \code{"Dataset"}.} + +\item{xlab}{The x-axis label, default is \code{"Stage"}.} + +\item{ylab}{The y-axis label.} + +\item{legendTitle}{The legend title, default is \code{""}.} + +\item{palette}{The palette, default is \code{"Set1"}.} + +\item{legendPosition}{The position of the legend. +By default (\code{NA_integer_}) the algorithm tries to find a suitable position. +Choose one of the following values to specify the position manually: +\itemize{ +\item \code{-1}: no legend will be shown +\item \code{NA}: the algorithm tries to find a suitable position +\item \code{0}: legend position outside plot +\item \code{1}: legend position left top +\item \code{2}: legend position left center +\item \code{3}: legend position left bottom +\item \code{4}: legend position right top +\item \code{5}: legend position right center +\item \code{6}: legend position right bottom +}} + +\item{showSource}{Logical. If \code{TRUE}, the parameter names of the object will +be printed which were used to create the plot; that may be, e.g., +useful to check the values or to create own plots with the base R \code{plot} function. +Alternatively \code{showSource} can be defined as one of the following character values: +\itemize{ +\item \code{"commands"}: returns a character vector with plot commands +\item \code{"axes"}: returns a list with the axes definitions +\item \code{"test"}: all plot commands will be validated with \code{eval(parse())} and +returned as character vector (function does not stop if an error occurs) +\item \code{"validate"}: all plot commands will be validated with \code{eval(parse())} and +returned as character vector (function stops if an error occurs) +} +Note: no plot object will be returned if \code{showSource} is a character.} + +\item{grid}{An integer value specifying the output of multiple plots. +By default (\code{1}) a list of \code{ggplot} objects will be returned. +If a \code{grid} value > 1 was specified, a grid plot will be returned +if the number of plots is <= specified \code{grid} value; +a list of \code{ggplot} objects will be returned otherwise. +If \code{grid = 0} is specified, all plots will be created using \code{\link[base]{print}} command +and a list of \code{ggplot} objects will be returned invisible. +Note that one of the following packages must be installed to create a grid plot: +'ggpubr', 'gridExtra', or 'cowplot'.} + +\item{plotSettings}{An object of class \code{PlotSettings} created by \code{\link[=getPlotSettings]{getPlotSetting()s}}.} +} +\value{ +Returns a \code{ggplot2} object. +} +\description{ +Plots the conditional power together with the likelihood function. +} +\details{ +The conditional power is calculated only if effect size and sample size is specified. +} +\examples{ +\dontrun{ +design <- getDesignGroupSequential(kMax = 2) + +dataExample <- getDataset( + n = c(20, 30), + means = c(50, 51), + stDevs = c(130, 140) +) + +result <- getAnalysisResults(design = design, + dataInput = dataExample, thetaH0 = 20, + nPlanned = c(30), thetaH1 = 1.5, stage = 1) + +if (require(ggplot2)) plot(result, thetaRange = c(0, 100)) +} + +} diff --git a/man/plot.ParameterSetR6.Rd b/man/plot.ParameterSetR6.Rd new file mode 100644 index 00000000..3aa70716 --- /dev/null +++ b/man/plot.ParameterSetR6.Rd @@ -0,0 +1,78 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_core_parameter_set_r6.R +\name{plot.ParameterSetR6} +\alias{plot.ParameterSetR6} +\title{Parameter Set Plotting} +\usage{ +\method{plot}{ParameterSetR6}( + x, + y, + ..., + main = NA_character_, + xlab = NA_character_, + ylab = NA_character_, + type = 1L, + palette = "Set1", + legendPosition = NA_integer_, + showSource = FALSE, + plotSettings = NULL +) +} +\arguments{ +\item{x}{The object that inherits from \code{\link{ParameterSet}}.} + +\item{y}{Not available for this kind of plot (is only defined to be compatible to the generic plot function).} + +\item{...}{Optional plot arguments. At the moment \code{xlim} and \code{ylim} are implemented +for changing x or y axis limits without dropping data observations.} + +\item{main}{The main title.} + +\item{xlab}{The x-axis label.} + +\item{ylab}{The y-axis label.} + +\item{type}{The plot type (default = 1).} + +\item{palette}{The palette, default is \code{"Set1"}.} + +\item{legendPosition}{The position of the legend. +By default (\code{NA_integer_}) the algorithm tries to find a suitable position. +Choose one of the following values to specify the position manually: +\itemize{ +\item \code{-1}: no legend will be shown +\item \code{NA}: the algorithm tries to find a suitable position +\item \code{0}: legend position outside plot +\item \code{1}: legend position left top +\item \code{2}: legend position left center +\item \code{3}: legend position left bottom +\item \code{4}: legend position right top +\item \code{5}: legend position right center +\item \code{6}: legend position right bottom +}} + +\item{showSource}{Logical. If \code{TRUE}, the parameter names of the object will +be printed which were used to create the plot; that may be, e.g., +useful to check the values or to create own plots with the base R \code{plot} function. +Alternatively \code{showSource} can be defined as one of the following character values: +\itemize{ +\item \code{"commands"}: returns a character vector with plot commands +\item \code{"axes"}: returns a list with the axes definitions +\item \code{"test"}: all plot commands will be validated with \code{eval(parse())} and +returned as character vector (function does not stop if an error occurs) +\item \code{"validate"}: all plot commands will be validated with \code{eval(parse())} and +returned as character vector (function stops if an error occurs) +} +Note: no plot object will be returned if \code{showSource} is a character.} + +\item{plotSettings}{An object of class \code{PlotSettings} created by \code{\link[=getPlotSettings]{getPlotSetting()s}}.} +} +\value{ +Returns a \code{ggplot2} object. +} +\description{ +Plots an object that inherits from class \code{\link{ParameterSet}}. +} +\details{ +Generic function to plot a parameter set. +} diff --git a/man/plot.StageResultsR6.Rd b/man/plot.StageResultsR6.Rd new file mode 100644 index 00000000..3935065e --- /dev/null +++ b/man/plot.StageResultsR6.Rd @@ -0,0 +1,132 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_analysis_stage_results_r6.R +\name{plot.StageResultsR6} +\alias{plot.StageResultsR6} +\title{Stage Results Plotting} +\usage{ +\method{plot}{StageResultsR6}( + x, + y, + ..., + type = 1L, + nPlanned, + allocationRatioPlanned = 1, + main = NA_character_, + xlab = NA_character_, + ylab = NA_character_, + legendTitle = NA_character_, + palette = "Set1", + legendPosition = NA_integer_, + showSource = FALSE, + plotSettings = NULL +) +} +\arguments{ +\item{x}{The stage results at given stage, obtained from \code{\link[=getStageResults]{getStageResults()}} or +\code{\link[=getAnalysisResults]{getAnalysisResults()}}.} + +\item{y}{Not available for this kind of plot (is only defined to be compatible to the generic plot function).} + +\item{...}{Optional \link[=param_three_dots_plot]{plot arguments}. Furthermore the following arguments can be defined: +\itemize{ +\item \code{thetaRange}: A range of assumed effect sizes if testing means or a survival design was specified. +Additionally, if testing means was selected, an assumed standard deviation can be specified (default is 1). +\item \code{piTreatmentRange}: A range of assumed rates pi1 to calculate the conditional power. +Additionally, if a two-sample comparison was selected, pi2 can be specified (default is the value from +\code{\link[=getAnalysisResults]{getAnalysisResults()}}). +\item \code{directionUpper}: Specifies the direction of the alternative, +only applicable for one-sided testing; default is \code{TRUE} +which means that larger values of the test statistics yield smaller p-values. +\item \code{\link[=param_thetaH0]{thetaH0}}: The null hypothesis value, default is 0 for the normal and the binary case, +it is 1 for the survival case. +For testing a rate in one sample, a value thetaH0 in (0,1) has to be specified for +defining the null hypothesis H0: pi = thetaH0. +}} + +\item{type}{The plot type (default = 1). Note that at the moment only one type +(the conditional power plot) is available.} + +\item{nPlanned}{The additional (i.e., "new" and not cumulative) sample size planned for each of the subsequent stages. +The argument must be a vector with length equal to the number of remaining stages and contain +the combined sample size from both treatment groups if two groups are considered. For survival outcomes, +it should contain the planned number of additional events. +For multi-arm designs, it is the per-comparison (combined) sample size. +For enrichment designs, it is the (combined) sample size for the considered sub-population.} + +\item{allocationRatioPlanned}{The planned allocation ratio \code{n1 / n2} for a two treatment groups +design, default is \code{1}. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. +For simulating means and rates for a two treatment groups design, it can be a vector of length kMax, the number of stages. +It can be a vector of length kMax, too, for multi-arm and enrichment designs. +In these cases, a change of allocating subjects to treatment groups over the stages can be assessed.} + +\item{main}{The main title.} + +\item{xlab}{The x-axis label.} + +\item{ylab}{The y-axis label.} + +\item{legendTitle}{The legend title.} + +\item{palette}{The palette, default is \code{"Set1"}.} + +\item{legendPosition}{The position of the legend. +By default (\code{NA_integer_}) the algorithm tries to find a suitable position. +Choose one of the following values to specify the position manually: +\itemize{ +\item \code{-1}: no legend will be shown +\item \code{NA}: the algorithm tries to find a suitable position +\item \code{0}: legend position outside plot +\item \code{1}: legend position left top +\item \code{2}: legend position left center +\item \code{3}: legend position left bottom +\item \code{4}: legend position right top +\item \code{5}: legend position right center +\item \code{6}: legend position right bottom +}} + +\item{showSource}{Logical. If \code{TRUE}, the parameter names of the object will +be printed which were used to create the plot; that may be, e.g., +useful to check the values or to create own plots with the base R \code{plot} function. +Alternatively \code{showSource} can be defined as one of the following character values: +\itemize{ +\item \code{"commands"}: returns a character vector with plot commands +\item \code{"axes"}: returns a list with the axes definitions +\item \code{"test"}: all plot commands will be validated with \code{eval(parse())} and +returned as character vector (function does not stop if an error occurs) +\item \code{"validate"}: all plot commands will be validated with \code{eval(parse())} and +returned as character vector (function stops if an error occurs) +} +Note: no plot object will be returned if \code{showSource} is a character.} + +\item{plotSettings}{An object of class \code{PlotSettings} created by \code{\link[=getPlotSettings]{getPlotSetting()s}}.} +} +\value{ +Returns a \code{ggplot2} object. +} +\description{ +Plots the conditional power together with the likelihood function. +} +\details{ +Generic function to plot all kinds of stage results. +The conditional power is calculated only if effect size and sample size is specified. +} +\examples{ +design <- getDesignGroupSequential( + kMax = 4, alpha = 0.025, + informationRates = c(0.2, 0.5, 0.8, 1), + typeOfDesign = "WT", deltaWT = 0.25 +) + +dataExample <- getDataset( + n = c(20, 30, 30), + means = c(50, 51, 55), + stDevs = c(130, 140, 120) +) + +stageResults <- getStageResults(design, dataExample, thetaH0 = 20) + +\dontrun{ +if (require(ggplot2)) plot(stageResults, nPlanned = c(30), thetaRange = c(0, 100)) +} + +} diff --git a/man/print.FieldSetR6.Rd b/man/print.FieldSetR6.Rd new file mode 100644 index 00000000..47230409 --- /dev/null +++ b/man/print.FieldSetR6.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_core_parameter_set_r6.R +\name{print.FieldSetR6} +\alias{print.FieldSetR6} +\title{Print Field Set Values} +\usage{ +\method{print}{FieldSetR6}(x, ...) +} +\arguments{ +\item{x}{A \code{\link{FieldSet}} object.} + +\item{...}{Ensures that all arguments (starting from the "...") are to be named and +that a warning will be displayed if unknown arguments are passed.} +} +\description{ +\code{print} prints its \code{\link{FieldSet}} argument and returns it invisibly (via \code{invisible(x)}). +} +\details{ +Prints the field set. +} +\keyword{internal} diff --git a/man/print.ParameterSetR6.Rd b/man/print.ParameterSetR6.Rd new file mode 100644 index 00000000..572446af --- /dev/null +++ b/man/print.ParameterSetR6.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_core_parameter_set_r6.R +\name{print.ParameterSetR6} +\alias{print.ParameterSetR6} +\title{Print Parameter Set Values} +\usage{ +\method{print}{ParameterSetR6}(x, ..., markdown = FALSE) +} +\arguments{ +\item{x}{The \code{\link{ParameterSet}} object to print.} + +\item{...}{Ensures that all arguments (starting from the "...") are to be named and +that a warning will be displayed if unknown arguments are passed.} + +\item{markdown}{If \code{TRUE}, the object \code{x} will be printed using markdown syntax; +normal representation will be used otherwise (default is \code{FALSE})} +} +\description{ +\code{print} prints its \code{ParameterSet} argument and returns it invisibly (via \code{invisible(x)}). +} +\details{ +Prints the parameters and results of a parameter set. +} +\keyword{internal} diff --git a/man/summary.AnalysisResultsR6.Rd b/man/summary.AnalysisResultsR6.Rd new file mode 100644 index 00000000..e2b10a70 --- /dev/null +++ b/man/summary.AnalysisResultsR6.Rd @@ -0,0 +1,63 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_analysis_results_r6.R +\name{summary.AnalysisResultsR6} +\alias{summary.AnalysisResultsR6} +\title{Analysis Results Summary} +\usage{ +\method{summary}{AnalysisResultsR6}(object, ..., type = 1, digits = NA_integer_) +} +\arguments{ +\item{object}{An \code{\link{AnalysisResults}} object.} + +\item{...}{Ensures that all arguments (starting from the "...") are to be named and +that a warning will be displayed if unknown arguments are passed.} + +\item{digits}{Defines how many digits are to be used for numeric values. Must be a positive integer of length 1.} +} +\value{ +Returns a \code{\link{SummaryFactory}} object. +The following generics (R generic functions) are available for this result object: +\itemize{ +\item \code{\link[=names.FieldSet]{names()}} to obtain the field names, +\item \code{\link[=print.FieldSet]{print()}} to print the object +} +} +\description{ +Displays a summary of \code{\link{AnalysisResults}} object. +} +\details{ +Summarizes the parameters and results of an analysis results object. +} +\section{Summary options}{ + +The following options can be set globally: +\enumerate{ +\item \code{rpact.summary.output.size}: one of \code{c("small", "medium", "large")}; +defines how many details will be included into the summary; +default is \code{"large"}, i.e., all available details are displayed. +\item \code{rpact.summary.justify}: one of \code{c("right", "left", "centre")}; +shall the values be right-justified (the default), left-justified or centered. +\item \code{rpact.summary.width}: defines the maximum number of characters to be used per line (default is \code{83}). +\item \code{rpact.summary.intervalFormat}: defines how intervals will be displayed in the summary, +default is \code{"[\%s; \%s]"}. +\item \code{rpact.summary.digits}: defines how many digits are to be used for numeric values (default is \code{3}). +\item \code{rpact.summary.digits.probs}: defines how many digits are to be used for numeric values +(default is one more than value of \code{rpact.summary.digits}, i.e., \code{4}). +\item \code{rpact.summary.trim.zeroes}: if \code{TRUE} (default) zeroes will always displayed as "0", +e.g. "0.000" will become "0". +} +Example: \code{options("rpact.summary.intervalFormat" = "\%s - \%s")} +} + +\section{How to get help for generic functions}{ + +Click on the link of a generic in the list above to go directly to the help documentation of +the \code{rpact} specific implementation of the generic. +Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and +to identify the object specific name of it, e.g., +use \code{methods("plot")} to get all the methods for the \code{plot} generic. +There you can find, e.g., \code{plot.AnalysisResults} and +obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. +} + +\keyword{internal} diff --git a/man/summary.ParameterSetR6.Rd b/man/summary.ParameterSetR6.Rd new file mode 100644 index 00000000..e2e9bd89 --- /dev/null +++ b/man/summary.ParameterSetR6.Rd @@ -0,0 +1,69 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_core_parameter_set_r6.R +\name{summary.ParameterSetR6} +\alias{summary.ParameterSetR6} +\title{Parameter Set Summary} +\usage{ +\method{summary}{ParameterSetR6}( + object, + ..., + type = 1, + digits = NA_integer_, + output = c("all", "title", "overview", "body") +) +} +\arguments{ +\item{object}{A \code{\link{ParameterSet}} object.} + +\item{...}{Ensures that all arguments (starting from the "...") are to be named and +that a warning will be displayed if unknown arguments are passed.} + +\item{digits}{Defines how many digits are to be used for numeric values. Must be a positive integer of length 1.} +} +\value{ +Returns a \code{\link{SummaryFactory}} object. +The following generics (R generic functions) are available for this result object: +\itemize{ +\item \code{\link[=names.FieldSet]{names()}} to obtain the field names, +\item \code{\link[=print.FieldSet]{print()}} to print the object +} +} +\description{ +Displays a summary of \code{\link{ParameterSet}} object. +} +\details{ +Summarizes the parameters and results of a parameter set. +} +\section{Summary options}{ + +The following options can be set globally: +\enumerate{ +\item \code{rpact.summary.output.size}: one of \code{c("small", "medium", "large")}; +defines how many details will be included into the summary; +default is \code{"large"}, i.e., all available details are displayed. +\item \code{rpact.summary.justify}: one of \code{c("right", "left", "centre")}; +shall the values be right-justified (the default), left-justified or centered. +\item \code{rpact.summary.width}: defines the maximum number of characters to be used per line (default is \code{83}). +\item \code{rpact.summary.intervalFormat}: defines how intervals will be displayed in the summary, +default is \code{"[\%s; \%s]"}. +\item \code{rpact.summary.digits}: defines how many digits are to be used for numeric values (default is \code{3}). +\item \code{rpact.summary.digits.probs}: defines how many digits are to be used for numeric values +(default is one more than value of \code{rpact.summary.digits}, i.e., \code{4}). +\item \code{rpact.summary.trim.zeroes}: if \code{TRUE} (default) zeroes will always displayed as "0", +e.g. "0.000" will become "0". +} +Example: \code{options("rpact.summary.intervalFormat" = "\%s - \%s")} +} + +\section{How to get help for generic functions}{ + +Click on the link of a generic in the list above to go directly to the help documentation of +the \code{rpact} specific implementation of the generic. +Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and +to identify the object specific name of it, e.g., +use \code{methods("plot")} to get all the methods for the \code{plot} generic. +There you can find, e.g., \code{plot.AnalysisResults} and +obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. +} + +\keyword{internal} diff --git a/man/t-FieldSet-method.Rd b/man/t-FieldSet-method.Rd index 98654749..b0a971fa 100644 --- a/man/t-FieldSet-method.Rd +++ b/man/t-FieldSet-method.Rd @@ -1,18 +1,25 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_core_parameter_set.R +% Please edit documentation in R/class_core_parameter_set.R, +% R/class_core_parameter_set_r6.R \name{t,FieldSet-method} \alias{t,FieldSet-method} \title{Field Set Transpose} \usage{ +\S4method{t}{FieldSet}(x) + \S4method{t}{FieldSet}(x) } \arguments{ \item{x}{A \code{FieldSet}.} } \description{ +Given a \code{FieldSet} \code{x}, t returns the transpose of \code{x}. + Given a \code{FieldSet} \code{x}, t returns the transpose of \code{x}. } \details{ +Implementation of the base R generic function \code{\link[base]{t}} + Implementation of the base R generic function \code{\link[base]{t}} } \keyword{internal} From feedab59a062dac5c39cd2b78cd7d51753cc1598 Mon Sep 17 00:00:00 2001 From: Till Luca Jensen Date: Wed, 1 Nov 2023 14:55:46 +0100 Subject: [PATCH 03/28] added missing import --- R/f_core_assertions.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/f_core_assertions.R b/R/f_core_assertions.R index be446a36..31591420 100644 --- a/R/f_core_assertions.R +++ b/R/f_core_assertions.R @@ -1,3 +1,5 @@ +library(R6) + ## | ## | *Core assertions* ## | From 353f177e5acdf83eadb52acff0e3235a48666f1b Mon Sep 17 00:00:00 2001 From: Till Luca Jensen Date: Wed, 15 Nov 2023 14:38:52 +0100 Subject: [PATCH 04/28] fixed failing tests --- R/class_analysis_results_r6.R | 4 +- R/class_analysis_stage_results_r6.R | 171 ++++++++++++++++++++++++++-- R/class_core_parameter_set_r6.R | 4 +- R/f_analysis_base_means.R | 12 +- R/f_analysis_base_rates.R | 10 +- R/f_analysis_base_survival.R | 10 +- R/f_analysis_enrichment_means.R | 10 +- R/f_analysis_enrichment_rates.R | 10 +- R/f_analysis_enrichment_survival.R | 8 +- R/f_analysis_multiarm.R | 4 +- R/f_analysis_multiarm_means.R | 6 +- R/f_analysis_multiarm_rates.R | 12 +- R/f_analysis_multiarm_survival.R | 12 +- R/f_core_assertions.R | 4 +- R/f_core_utilities.R | 4 +- R/f_design_utilities.R | 1 + R/f_object_r_code.R | 20 ++-- 17 files changed, 226 insertions(+), 76 deletions(-) diff --git a/R/class_analysis_results_r6.R b/R/class_analysis_results_r6.R index 37ee7180..3c4c7728 100644 --- a/R/class_analysis_results_r6.R +++ b/R/class_analysis_results_r6.R @@ -302,7 +302,7 @@ ConditionalPowerResultsRatesR6 <- R6Class("ConditionalPowerResultsRatesR6", self$pi1 <- pi1 self$pi2 <- pi2 - super$initalize(...) + super$initialize(...) if ((is.null(self$conditionalPower) || length(self$conditionalPower) == 0) && !is.null(self$.design) && !is.null(self$.design$kMax) && length(self$.design$kMax) > 0) { @@ -1330,7 +1330,7 @@ AnalysisResultsGroupSequentialR6 <- R6Class("AnalysisResultsGroupSequentialR6", self$maxInformation <- maxInformation self$informationEpsilon <- informationEpsilon - super$initalize(design = design, dataInput = dataInput, ...) + super$initialize(design = design, dataInput = dataInput, ...) self$.setParameterType("maxInformation", C_PARAM_NOT_APPLICABLE) self$.setParameterType("informationEpsilon", C_PARAM_NOT_APPLICABLE) diff --git a/R/class_analysis_stage_results_r6.R b/R/class_analysis_stage_results_r6.R index a5268e6f..9a02df80 100644 --- a/R/class_analysis_stage_results_r6.R +++ b/R/class_analysis_stage_results_r6.R @@ -309,8 +309,40 @@ StageResultsMeansR6 <- R6Class("StageResultsMeansR6", overallSampleSizes2 = NULL, equalVariances = NULL, normalApproximation = NULL, - initialize = function(design, dataInput, ..., equalVariances = TRUE, normalApproximation = FALSE) { - callSuper(.design = design, .dataInput = dataInput, ...)#TODO + initialize = function(design, dataInput, ..., + combInverseNormal = NULL, + combFisher = NULL, + overallTestStatistics = NULL, + overallPValues = NULL, + effectSizes = NULL, + testStatistics = NULL, + overallMeans = NULL, + overallMeans1 = NULL, + overallMeans2 = NULL, + overallStDevs = NULL, + overallStDevs1 = NULL, + overallStDevs2 = NULL, + overallSampleSizes = NULL, + overallSampleSizes1 = NULL, + overallSampleSizes2 = NULL, + equalVariances = TRUE, normalApproximation = FALSE) { + super$initialize(.design = design, .dataInput = dataInput, ...)#TODO + + self$combInverseNormal <- combInverseNormal + self$combFisher <- combFisher + self$overallTestStatistics <- overallTestStatistics + self$overallPValues <- overallPValues + self$effectSizes <- effectSizes + self$testStatistics <- testStatistics + self$overallMeans <- overallMeans + self$overallMeans1 <- overallMeans1 + self$overallMeans2 <- overallMeans2 + self$overallStDevs <- overallStDevs + self$overallStDevs1 <- overallStDevs1 + self$overallStDevs2 <- overallStDevs2 + self$overallSampleSizes <- overallSampleSizes + self$overallSampleSizes1 <- overallSampleSizes1 + self$overallSampleSizes2 <- overallSampleSizes2 self$equalVariances <- equalVariances self$normalApproximation <- normalApproximation @@ -461,10 +493,30 @@ StageResultsMultiArmMeansR6 <- R6Class("StageResultsMultiArmMeansR6", varianceOption = NULL, normalApproximation = NULL, directionUpper = NULL, - initialize = function(design, dataInput, ..., varianceOption = C_VARIANCE_OPTION_MULTIARMED_DEFAULT, + initialize = function(design, dataInput, ..., + combInverseNormal = NULL, + combFisher = NULL, + overallTestStatistics = NULL, + overallStDevs = NULL, + overallPooledStDevs = NULL, + overallPValues = NULL, + testStatistics = NULL, + separatePValues = NULL, + effectSizes = NULL, + singleStepAdjustedPValues = NULL, + intersectionTest = NULL,varianceOption = C_VARIANCE_OPTION_MULTIARMED_DEFAULT, normalApproximation = FALSE, directionUpper = NULL) { super$initialize(...) - + self$combInverseNormal <- combInverseNormal + self$combFisher <- combFisher + self$overallTestStatistics <- overallTestStatistics + self$overallStDevs <- overallStDevs + self$overallPooledStDevs <- overallPooledStDevs + self$overallPValues <- overallPValues + self$testStatistics <- testStatistics + self$separatePValues <- separatePValues + self$effectSizes <- effectSizes + self$singleStepAdjustedPValues <- singleStepAdjustedPValues self$varianceOption <- varianceOption self$normalApproximation <- normalApproximation self$directionUpper <- directionUpper @@ -590,8 +642,38 @@ StageResultsRatesR6 <- R6Class("StageResultsRatesR6", overallSampleSizes1 = NULL, overallSampleSizes2 = NULL, normalApproximation = NULL, - initialize = function(design, dataInput, ..., normalApproximation = TRUE) { - callSuper(.design = design, .dataInput = dataInput, ...)#TODO + initialize = function(design, dataInput, ..., + combInverseNormal = NULL, + combFisher = NULL, + overallTestStatistics = NULL, + overallPValues = NULL, + effectSizes = NULL, + testStatistics = NULL, + overallPi1 = NULL, + overallPi2 = NULL, + overallEvents = NULL, + overallEvents1 = NULL, + overallEvents2 = NULL, + overallSampleSizes = NULL, + overallSampleSizes1 = NULL, + overallSampleSizes2 = NULL, + normalApproximation = TRUE) { + super$initialize(.design = design, .dataInput = dataInput, ...)#TODO + + self$combInverseNormal <- combInverseNormal + self$combFisher <- combFisher + self$overallTestStatistics <- overallTestStatistics + self$overallPValues <- overallPValues + self$effectSizes <- effectSizes + self$testStatistics <- testStatistics + self$overallPi1 <- overallPi1 + self$overallPi2 <- overallPi2 + self$overallEvents <- overallEvents + self$overallEvents1 <- overallEvents1 + self$overallEvents2 <- overallEvents2 + self$overallSampleSizes <- overallSampleSizes + self$overallSampleSizes1 <- overallSampleSizes1 + self$overallSampleSizes2 <- overallSampleSizes2 self$normalApproximation <- normalApproximation @@ -733,10 +815,34 @@ StageResultsMultiArmRatesR6 <- R6Class("StageResultsMultiArmRatesR6", normalApproximation = NULL, directionUpper = NULL, initialize = function(design, dataInput, ..., - normalApproximation = FALSE) { - callSuper(.design = design, .dataInput = dataInput, ...)#TODO + overallPiTreatments = NULL, + overallPiControl = NULL, + combInverseNormal = NULL, + combFisher = NULL, + overallTestStatistics = NULL, + overallPValues = NULL, + testStatistics = NULL, + separatePValues = NULL, + effectSizes = NULL, + singleStepAdjustedPValues = NULL, + intersectionTest = NULL, + normalApproximation = FALSE, + directionUpper = NULL) { + super$initialize(.design = design, .dataInput = dataInput, ...)#TODO + self$overallPiTreatments <- overallPiTreatments + self$overallPiControl <- overallPiControl + self$combInverseNormal <- combInverseNormal + self$combFisher <- combFisher + self$overallTestStatistics <- overallTestStatistics + self$overallPValues <- overallPValues + self$testStatistics <- testStatistics + self$separatePValues <- separatePValues + self$effectSizes <- effectSizes + self$singleStepAdjustedPValues <- singleStepAdjustedPValues + self$intersectionTest <- intersectionTest self$normalApproximation <- normalApproximation + self$directionUpper <- directionUpper self$init(design = design, dataInput = dataInput) @@ -851,8 +957,29 @@ StageResultsSurvivalR6 <- R6Class("StageResultsSurvivalR6", events = NULL, allocationRatios = NULL, testStatistics = NULL, - initialize = function(design, dataInput, ...) { - callSuper(.design = design, .dataInput = dataInput, ...)#TODO + initialize = function(design, dataInput, ..., + combInverseNormal = NULL, + combFisher = NULL, + overallPValues = NULL, + effectSizes = NULL, + overallTestStatistics = NULL, + overallEvents = NULL, + overallAllocationRatios = NULL, + events = NULL, + allocationRatios = NULL, + testStatistics = NULL) { + super$initialize(.design = design, .dataInput = dataInput, ...)#TODO + + self$combInverseNormal <- combInverseNormal + self$combFisher <- combFisher + self$overallPValues <- overallPValues + self$effectSizes <- effectSizes + self$overallTestStatistics <- overallTestStatistics + self$overallEvents <- overallEvents + self$overallAllocationRatios <- overallAllocationRatios + self$events <- events + self$allocationRatios <- allocationRatios + self$testStatistics <- testStatistics self$init(design = design, dataInput = dataInput) @@ -964,8 +1091,28 @@ StageResultsMultiArmSurvivalR6 <- R6Class("StageResultsMultiArmSurvivalR6", intersectionTest = NULL, directionUpper = NULL, initialize = function(design, dataInput, ..., - normalApproximation = FALSE) { - callSuper(.design = design, .dataInput = dataInput, ...) #TODO + combInverseNormal = NULL, + combFisher = NULL, + overallTestStatistics = NULL, + overallPValues = NULL, + testStatistics = NULL, + separatePValues = NULL, + effectSizes = NULL, + singleStepAdjustedPValues = NULL, + intersectionTest = NULL, + directionUpper = NULL) { + super$initialize(.design = design, .dataInput = dataInput, ...) #TODO + + self$combInverseNormal <- combInverseNormal + self$combFisher <- combFisher + self$overallTestStatistics <- overallTestStatistics + self$overallPValues <- overallPValues + self$testStatistics <- testStatistics + self$separatePValues <- separatePValues + self$effectSizes <- effectSizes + self$singleStepAdjustedPValues <- singleStepAdjustedPValues + self$intersectionTest <- intersectionTest + self$directionUpper <- directionUpper self$init(design = design, dataInput = dataInput) diff --git a/R/class_core_parameter_set_r6.R b/R/class_core_parameter_set_r6.R index fbab605f..86e08c96 100644 --- a/R/class_core_parameter_set_r6.R +++ b/R/class_core_parameter_set_r6.R @@ -707,6 +707,7 @@ ParameterSetR6 <- R6Class("ParameterSetR6", returnParametersAsCharacter = TRUE, tableColumnNames = tableColumnNames ) + result <- as.matrix(dataFrame) if (.isTrialDesignPlan(self)) { dimnames(result)[[1]] <- paste(" ", c(1:nrow(dataFrame))) @@ -1303,6 +1304,7 @@ ParameterSetR6 <- R6Class("ParameterSetR6", } if (parameterSet$.containsMultidimensionalParameters(parameterNames)) { + return(.addDelayedInformationRates(.getAsDataFrameMultidimensional( parameterSet, parameterNames, niceColumnNamesEnabled, includeAllParameters, returnParametersAsCharacter, tableColumnNames, @@ -1321,7 +1323,7 @@ ParameterSetR6 <- R6Class("ParameterSetR6", if (length(parameterNames) == 0) { return(data.frame()) } - + return(.addDelayedInformationRates(.getAsDataFrameUnidimensional( parameterSet, parameterNames, niceColumnNamesEnabled, includeAllParameters, returnParametersAsCharacter, tableColumnNames diff --git a/R/f_analysis_base_means.R b/R/f_analysis_base_means.R index 498f8547..e9065fd1 100644 --- a/R/f_analysis_base_means.R +++ b/R/f_analysis_base_means.R @@ -64,7 +64,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsInverseNormal(design = design, dataInput = dataInput) + results <- AnalysisResultsInverseNormalR6$new(design = design, dataInput = dataInput) .getAnalysisResultsMeansAll( results = results, design = design, dataInput = dataInput, @@ -93,7 +93,7 @@ NULL ), c("stage", "stDevH1")), ... ) - results <- AnalysisResultsGroupSequential(design = design, dataInput = dataInput) + results <- AnalysisResultsGroupSequentialR6$new(design = design, dataInput = dataInput) stDevH1 <- .getOptionalArgument("stDevH1", ...) if (!is.null(stDevH1)) { @@ -135,7 +135,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsFisher(design = design, dataInput = dataInput) + results <- AnalysisResultsFisherR6$new(design = design, dataInput = dataInput) .setValueAndParameterType(results, "iterations", as.integer(iterations), C_ITERATIONS_DEFAULT) .setValueAndParameterType(results, "seed", seed, NA_real_) @@ -474,7 +474,7 @@ NULL } if (dataInput$getNumberOfGroups() == 1) { - stageResults <- StageResultsMeans( + stageResults <- StageResultsMeansR6$new( design = design, dataInput = dataInput, stage = as.integer(stage), @@ -500,7 +500,7 @@ NULL equalVariances = equalVariances ) } else if (dataInput$getNumberOfGroups() == 2) { - stageResults <- StageResultsMeans( + stageResults <- StageResultsMeansR6$new( design = design, dataInput = dataInput, stage = as.integer(stage), @@ -1190,7 +1190,7 @@ NULL design <- stageResults$.design - results <- ConditionalPowerResultsMeans( + results <- ConditionalPowerResultsMeansR6$new( .stageResults = stageResults, .design = design, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaH1, assumedStDev = assumedStDev diff --git a/R/f_analysis_base_rates.R b/R/f_analysis_base_rates.R index 22dc3ba8..03adfbf3 100644 --- a/R/f_analysis_base_rates.R +++ b/R/f_analysis_base_rates.R @@ -76,7 +76,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsInverseNormal(design = design, dataInput = dataInput) + results <- AnalysisResultsInverseNormalR6$new(design = design, dataInput = dataInput) .getAnalysisResultsRatesAll( results = results, design = design, dataInput = dataInput, @@ -105,7 +105,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsGroupSequential(design = design, dataInput = dataInput) + results <- AnalysisResultsGroupSequentialR6$new(design = design, dataInput = dataInput) .getAnalysisResultsRatesAll( results = results, design = design, dataInput = dataInput, @@ -136,7 +136,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsFisher(design = design, dataInput = dataInput) + results <- AnalysisResultsFisherR6$new(design = design, dataInput = dataInput) .setValueAndParameterType(results, "iterations", as.integer(iterations), C_ITERATIONS_DEFAULT) .setValueAndParameterType(results, "seed", seed, NA_real_) @@ -570,7 +570,7 @@ NULL direction <- ifelse(directionUpper, C_DIRECTION_UPPER, C_DIRECTION_LOWER) - stageResults <- StageResultsRates( + stageResults <- StageResultsRatesR6$new( design = design, dataInput = dataInput, stage = as.integer(stage), @@ -1102,7 +1102,7 @@ NULL pi2 <- .assertIsValidPi2(pi2, stageResults, stage) } - results <- ConditionalPowerResultsRates( + results <- ConditionalPowerResultsRatesR6$new( .stageResults = stageResults, .design = stageResults$.design, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, pi1 = pi1, pi2 = pi2 diff --git a/R/f_analysis_base_survival.R b/R/f_analysis_base_survival.R index cecec341..20dfadf7 100644 --- a/R/f_analysis_base_survival.R +++ b/R/f_analysis_base_survival.R @@ -61,7 +61,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsInverseNormal(design = design, dataInput = dataInput) + results <- AnalysisResultsInverseNormalR6$new(design = design, dataInput = dataInput) .getAnalysisResultsSurvivalAll( results = results, design = design, dataInput = dataInput, @@ -89,7 +89,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsGroupSequential(design = design, dataInput = dataInput) + results <- AnalysisResultsGroupSequentialR6$new(design = design, dataInput = dataInput) .getAnalysisResultsSurvivalAll( results = results, design = design, dataInput = dataInput, @@ -119,7 +119,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsFisher(design = design, dataInput = dataInput) + results <- AnalysisResultsFisherR6$new(design = design, dataInput = dataInput) .setValueAndParameterType(results, "iterations", as.integer(iterations), C_ITERATIONS_DEFAULT) .setValueAndParameterType(results, "seed", seed, NA_real_) @@ -348,7 +348,7 @@ NULL combFisher[k] <- prod(pValues[1:k]^weightsFisher[1:k]) } - stageResults <- StageResultsSurvival( + stageResults <- StageResultsSurvivalR6$new( design = design, dataInput = dataInput, stage = as.integer(stage), @@ -903,7 +903,7 @@ NULL .getConditionalPowerSurvival <- function(..., stageResults, nPlanned = NA_real_, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, thetaH1 = NA_real_) { - results <- ConditionalPowerResultsSurvival( + results <- ConditionalPowerResultsSurvivalR6$new( .stageResults = stageResults, .design = stageResults$.design, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaH1 diff --git a/R/f_analysis_enrichment_means.R b/R/f_analysis_enrichment_means.R index e9e19985..a481f38b 100644 --- a/R/f_analysis_enrichment_means.R +++ b/R/f_analysis_enrichment_means.R @@ -253,7 +253,7 @@ NULL ) } - stageResults <- StageResultsEnrichmentMeans( + stageResults <- StageResultsEnrichmentMeansR6$new( design = design, dataInput = dataInput, thetaH0 = thetaH0, @@ -444,7 +444,7 @@ NULL ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck(design, powerCalculationEnabled = TRUE), "stage"), ... ) - results <- AnalysisResultsEnrichmentInverseNormal(design = design, dataInput = dataInput) + results <- AnalysisResultsEnrichmentInverseNormalR6$new(design = design, dataInput = dataInput) results <- .getAnalysisResultsMeansEnrichmentAll( results = results, design = design, dataInput = dataInput, @@ -486,7 +486,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsEnrichmentFisher(design = design, dataInput = dataInput) + results <- AnalysisResultsEnrichmentFisherR6$new(design = design, dataInput = dataInput) .setValueAndParameterType(results, "iterations", as.integer(iterations), C_ITERATIONS_DEFAULT) .setValueAndParameterType(results, "seed", seed, NA_real_) @@ -965,7 +965,7 @@ NULL assumedStDevs <- stDevsH1 } - results <- ConditionalPowerResultsEnrichmentMeans( + results <- ConditionalPowerResultsEnrichmentMeansR6$new( .design = design, .stageResults = stageResults, thetaH1 = thetaH1, @@ -1291,7 +1291,7 @@ NULL stdErr <- stageResults$overallStDevs[stage] * sqrt(1 / stageResults$.overallSampleSizes1[, stage] + 1 / stageResults$.overallSampleSizes2[, stage]) - results <- ConditionalPowerResultsEnrichmentMeans( + results <- ConditionalPowerResultsEnrichmentMeansR6$new( .design = design, .stageResults = stageResults, assumedStDevs = assumedStDevs, diff --git a/R/f_analysis_enrichment_rates.R b/R/f_analysis_enrichment_rates.R index 03867216..3f71dddd 100644 --- a/R/f_analysis_enrichment_rates.R +++ b/R/f_analysis_enrichment_rates.R @@ -234,7 +234,7 @@ NULL ) } - stageResults <- StageResultsEnrichmentRates( + stageResults <- StageResultsEnrichmentRatesR6$new( design = design, dataInput = dataInput, thetaH0 = thetaH0, @@ -391,7 +391,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsEnrichmentInverseNormal(design = design, dataInput = dataInput) + results <- AnalysisResultsEnrichmentInverseNormalR6$new(design = design, dataInput = dataInput) results <- .getAnalysisResultsRatesEnrichmentAll( results = results, design = design, dataInput = dataInput, @@ -428,7 +428,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsEnrichmentFisher(design = design, dataInput = dataInput) + results <- AnalysisResultsEnrichmentFisherR6$new(design = design, dataInput = dataInput) .setValueAndParameterType(results, "iterations", as.integer(iterations), C_ITERATIONS_DEFAULT) .setValueAndParameterType(results, "seed", seed, NA_real_) @@ -825,7 +825,7 @@ NULL piControl <- piControlH1 } - results <- ConditionalPowerResultsEnrichmentRates( + results <- ConditionalPowerResultsEnrichmentRatesR6$new( .design = design, .stageResults = stageResults, piControls = piControls, @@ -1165,7 +1165,7 @@ NULL stdErr <- sqrt(stageResults$overallPisTreatment[, stage] * (1 - stageResults$overallPisTreatment[, stage])) / sqrt(stageResults$.overallSampleSizes2[, stage]) - results <- ConditionalPowerResultsEnrichmentRates( + results <- ConditionalPowerResultsEnrichmentRatesR6$new( .design = design, .stageResults = stageResults, piControls = piControls, diff --git a/R/f_analysis_enrichment_survival.R b/R/f_analysis_enrichment_survival.R index d92a679a..a71adfda 100644 --- a/R/f_analysis_enrichment_survival.R +++ b/R/f_analysis_enrichment_survival.R @@ -173,7 +173,7 @@ NULL ) } - stageResults <- StageResultsEnrichmentSurvival( + stageResults <- StageResultsEnrichmentSurvivalR6$new( design = design, dataInput = dataInput, intersectionTest = intersectionTest, @@ -335,7 +335,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsEnrichmentInverseNormal(design = design, dataInput = dataInput) + results <- AnalysisResultsEnrichmentInverseNormalR6$new(design = design, dataInput = dataInput) results <- .getAnalysisResultsSurvivalEnrichmentAll( results = results, design = design, dataInput = dataInput, @@ -373,7 +373,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsEnrichmentFisher(design = design, dataInput = dataInput) + results <- AnalysisResultsEnrichmentFisherR6$new(design = design, dataInput = dataInput) .setValueAndParameterType(results, "iterations", as.integer(iterations), C_ITERATIONS_DEFAULT) .setValueAndParameterType(results, "seed", seed, NA_real_) @@ -781,7 +781,7 @@ NULL gMax <- stageResults$getGMax() kMax <- design$kMax - results <- ConditionalPowerResultsEnrichmentSurvival( + results <- ConditionalPowerResultsEnrichmentSurvivalR6$new( .design = design, .stageResults = stageResults, thetaH1 = thetaH1, diff --git a/R/f_analysis_multiarm.R b/R/f_analysis_multiarm.R index 4ae2baed..36dbb2c1 100644 --- a/R/f_analysis_multiarm.R +++ b/R/f_analysis_multiarm.R @@ -486,7 +486,7 @@ getClosedCombinationTestResults <- function(stageResults) { .assertIsTrialDesignInverseNormalOrFisher(stageResults$.design) result <- .performClosedCombinationTest(stageResults = stageResults) - return(ClosedCombinationTestResults( + return(ClosedCombinationTestResultsR6$new( .design = result$.design, .enrichment = grepl("Enrichment", .getClassName(stageResults)), intersectionTest = result$intersectionTest, @@ -743,7 +743,7 @@ getClosedConditionalDunnettTestResults <- function(stageResults, ..., stage = st .assertIsTrialDesignConditionalDunnett(design) result <- .getClosedConditionalDunnettTestResults(stageResults = stageResults, design = design, stage = stage) - return(ClosedCombinationTestResults( + return(ClosedCombinationTestResultsR6$new( .design = result$.design, .enrichment = grepl("Enrichment", .getClassName(stageResults)), intersectionTest = result$intersectionTest, diff --git a/R/f_analysis_multiarm_means.R b/R/f_analysis_multiarm_means.R index 6ad9825d..b3abac04 100644 --- a/R/f_analysis_multiarm_means.R +++ b/R/f_analysis_multiarm_means.R @@ -97,7 +97,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsMultiArmFisher(design = design, dataInput = dataInput) + results <- AnalysisResultsMultiArmFisherR6$new(design = design, dataInput = dataInput) results <- .getAnalysisResultsMeansMultiArmAll( results = results, design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, directionUpper = directionUpper, @@ -133,7 +133,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsConditionalDunnett(design = design, dataInput = dataInput) + results <- AnalysisResultsConditionalDunnettR6$new(design = design, dataInput = dataInput) results <- .getAnalysisResultsMeansMultiArmAll( results = results, design = design, @@ -1380,7 +1380,7 @@ NULL sqrt(1 / stageResults$.dataInput$getOverallSampleSizes(stage = stage, group = gMax + 1) + 1 / stageResults$.dataInput$getOverallSampleSizes(stage = stage, group = (1:gMax))) - results <- ConditionalPowerResultsMultiArmMeans( + results <- ConditionalPowerResultsMultiArmMeansR6$new( .design = design, .stageResults = stageResults, assumedStDevs = assumedStDevs, diff --git a/R/f_analysis_multiarm_rates.R b/R/f_analysis_multiarm_rates.R index c7182b5b..17c5cffb 100644 --- a/R/f_analysis_multiarm_rates.R +++ b/R/f_analysis_multiarm_rates.R @@ -80,7 +80,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsMultiArmInverseNormal(design = design, dataInput = dataInput) + results <- AnalysisResultsMultiArmInverseNormalR6$new(design = design, dataInput = dataInput) results <- .getAnalysisResultsRatesMultiArmAll( results = results, design = design, dataInput = dataInput, @@ -115,7 +115,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsMultiArmFisher(design = design, dataInput = dataInput) + results <- AnalysisResultsMultiArmFisherR6$new(design = design, dataInput = dataInput) results <- .getAnalysisResultsRatesMultiArmAll( results = results, design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, directionUpper = directionUpper, @@ -147,7 +147,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsConditionalDunnett(design = design, dataInput = dataInput) + results <- AnalysisResultsConditionalDunnettR6$new(design = design, dataInput = dataInput) results <- .getAnalysisResultsRatesMultiArmAll( results = results, design = design, @@ -328,7 +328,7 @@ NULL ) } - stageResults <- StageResultsMultiArmRates( + stageResults <- StageResultsMultiArmRatesR6$new( design = design, dataInput = dataInput, intersectionTest = intersectionTest, @@ -923,7 +923,7 @@ NULL piControl <- piControlH1 } - results <- ConditionalPowerResultsMultiArmRates( + results <- ConditionalPowerResultsMultiArmRatesR6$new( .design = design, .stageResults = stageResults, piControl = piControl, @@ -1331,7 +1331,7 @@ NULL stdErr <- sqrt(stageResults$overallPiTreatments[, stage] * (1 - stageResults$overallPiTreatments[, stage])) / sqrt(stageResults$.dataInput$getOverallSampleSizes(stage = stage, group = (1:gMax))) - results <- ConditionalPowerResultsMultiArmRates( + results <- ConditionalPowerResultsMultiArmRatesR6$new( .design = design, .stageResults = stageResults, piControl = piControl, diff --git a/R/f_analysis_multiarm_survival.R b/R/f_analysis_multiarm_survival.R index 902c246c..ad99d895 100644 --- a/R/f_analysis_multiarm_survival.R +++ b/R/f_analysis_multiarm_survival.R @@ -79,7 +79,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsMultiArmInverseNormal(design = design, dataInput = dataInput) + results <- AnalysisResultsMultiArmInverseNormalR6$new(design = design, dataInput = dataInput) results <- .getAnalysisResultsSurvivalMultiArmAll( results = results, design = design, dataInput = dataInput, @@ -113,7 +113,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsMultiArmFisher(design = design, dataInput = dataInput) + results <- AnalysisResultsMultiArmFisherR6$new(design = design, dataInput = dataInput) results <- .getAnalysisResultsSurvivalMultiArmAll( results = results, design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, directionUpper = directionUpper, @@ -145,7 +145,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsConditionalDunnett(design = design, dataInput = dataInput) + results <- AnalysisResultsConditionalDunnettR6$new(design = design, dataInput = dataInput) results <- .getAnalysisResultsSurvivalMultiArmAll( results = results, design = design, @@ -286,7 +286,7 @@ NULL ) .assertIsValidIntersectionTestMultiArm(design, intersectionTest) - stageResults <- StageResultsMultiArmSurvival( + stageResults <- StageResultsMultiArmSurvivalR6$new( design = design, dataInput = dataInput, intersectionTest = intersectionTest, @@ -801,7 +801,7 @@ NULL gMax <- stageResults$getGMax() kMax <- design$kMax - results <- ConditionalPowerResultsMultiArmSurvival( + results <- ConditionalPowerResultsMultiArmSurvivalR6$new( .design = design, .stageResults = stageResults, thetaH1 = thetaH1, @@ -1144,7 +1144,7 @@ NULL stdErr <- 2 / sqrt(stageResults$.dataInput$getOverallEvents(stage = stage, group = (1:gMax))) - results <- ConditionalPowerResultsMultiArmSurvival( + results <- ConditionalPowerResultsMultiArmSurvivalR6$new( .design = design, .stageResults = stageResults, nPlanned = nPlanned, diff --git a/R/f_core_assertions.R b/R/f_core_assertions.R index 31591420..4b4f76f3 100644 --- a/R/f_core_assertions.R +++ b/R/f_core_assertions.R @@ -1,4 +1,4 @@ -library(R6) +library("R6") ## | ## | *Core assertions* @@ -39,7 +39,7 @@ NULL } .isParameterSet <- function(x) { - return((isS4(x) || is.R6(x)) && (inherits(x, "ParameterSet") || inherits(x, "ParameterSetR6"))) + return((isS4(x) || R6::is.R6(x)) && (inherits(x, "ParameterSet") || inherits(x, "ParameterSetR6"))) } .assertIsParameterSetClass <- function(x, objectName = "x") { diff --git a/R/f_core_utilities.R b/R/f_core_utilities.R index 38ae74db..8cf0564b 100644 --- a/R/f_core_utilities.R +++ b/R/f_core_utilities.R @@ -1,4 +1,4 @@ -library(R6) +library("R6") ## | ## | *Core utilities* @@ -765,7 +765,7 @@ NULL stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'parameterSet' must be not null") } - if (!ifelse(is.R6(parameterSet), parameterName %in% names(parameterSet), parameterName %in% names(getClass(class(parameterSet))@fieldClasses))) { #names(.self$getRefClass()$fields()) + if (!ifelse(R6::is.R6(parameterSet), parameterName %in% names(parameterSet), parameterName %in% names(getClass(class(parameterSet))@fieldClasses))) { #names(.self$getRefClass()$fields()) stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, diff --git a/R/f_design_utilities.R b/R/f_design_utilities.R index 432d1c7c..30ef3b5e 100644 --- a/R/f_design_utilities.R +++ b/R/f_design_utilities.R @@ -1054,6 +1054,7 @@ getMedianByPi <- function(piValue, } .addDelayedInformationRates <- function(dataFrame) { + #print(dataFrame) if (all(c("informationRates", "delayedInformation", "kMax", "stages") %in% colnames(dataFrame))) { kMax <- max(dataFrame$kMax) if (kMax > 1) { diff --git a/R/f_object_r_code.R b/R/f_object_r_code.R index 429b85df..4bb35506 100644 --- a/R/f_object_r_code.R +++ b/R/f_object_r_code.R @@ -157,7 +157,7 @@ NULL return("getDataset") } - if (inherits(obj, "AnalysisResults")) { + if (inherits(obj, "AnalysisResults") || inherits(obj, "AnalysisResultsR6")) { return("getAnalysisResults") } @@ -213,11 +213,11 @@ NULL return("getAccrualTime") } - if (inherits(obj, "StageResults")) { + if (inherits(obj, "StageResults") || inherits(obj, "StageResultsR6")) { return("getStageResults") } - if (inherits(obj, "ConditionalPowerResults")) { + if (inherits(obj, "ConditionalPowerResults") || inherits(obj, "ConditionalPowerResultsR6")) { return("getConditionalPower") } @@ -391,7 +391,7 @@ getObjectRCode <- function(obj, ..., if (is.null(leadingArguments)) { leadingArguments <- character(0) } - if (!inherits(obj, "ConditionalPowerResults") && + if (!(inherits(obj, "ConditionalPowerResults") || inherits(obj, "ConditionalPowerResultsR6")) && !is.null(obj[[".design"]]) && (is.null(leadingArguments) || !any(grepl("design", leadingArguments)))) { preconditionDesign <- getObjectRCode(obj$.design, @@ -497,7 +497,7 @@ getObjectRCode <- function(obj, ..., } leadingArguments <- c(leadingArguments, "selectArmsFunction = selectArmsFunction") } - if (inherits(obj, "ConditionalPowerResults") && + if ((inherits(obj, "ConditionalPowerResults") || inherits(obj, "ConditionalPowerResultsR6")) && !is.null(obj[[".stageResults"]]) && (is.null(leadingArguments) || !any(grepl("stageResults", leadingArguments)))) { precond <- getObjectRCode(obj$.stageResults, @@ -554,7 +554,7 @@ getObjectRCode <- function(obj, ..., objNames <- objNames[objNames != "effectList"] - if (inherits(obj, "ParameterSet")) { + if (inherits(obj, "ParameterSet") || inherits(obj, "ParameterSetR6")) { if (includeDefaultParameters) { objNames <- obj$.getInputParameters() } else { @@ -579,7 +579,7 @@ getObjectRCode <- function(obj, ..., objNames <- objNames[objNames != "allocationRatioPlanned"] # allocation1 and allocation2 are used instead } - if (inherits(obj, "AnalysisResults") && grepl("Fisher", .getClassName(obj))) { + if ((inherits(obj, "AnalysisResults") || inherits(obj, "AnalysisResultsR6")) && grepl("Fisher", .getClassName(obj))) { if (!is.null(obj[["seed"]]) && length(obj$seed) == 1 && !is.na(obj$seed)) { if (!("iterations" %in% objNames)) { objNames <- c(objNames, "iterations") @@ -684,7 +684,7 @@ getObjectRCode <- function(obj, ..., optimumAllocationRatio <- obj[["optimumAllocationRatio"]] if (!is.null(optimumAllocationRatio) && isTRUE(optimumAllocationRatio)) { value <- 0 - } else if (inherits(obj, "ParameterSet")) { + } else if ((inherits(obj, "ParameterSet") || inherits(obj, "ParameterSetR6"))) { if (obj$.getParameterType("allocationRatioPlanned") == "g") { value <- 0 } @@ -772,9 +772,9 @@ getObjectRCode <- function(obj, ..., .getArgumentValueRCode(obj$maxNumberOfSubjects[1], "maxNumberOfSubjects") )) } - } else if (inherits(obj, "AnalysisResults")) { + } else if (inherits(obj, "AnalysisResults") || inherits(obj, "AnalysisResultsR6")) { arguments <- c(arguments, paste0("stage = ", obj$.stageResults$stage)) - } else if (inherits(obj, "StageResults")) { + } else if (inherits(obj, "StageResults") || inherits(obj, "StageResultsR6")) { arguments <- c(arguments, paste0("stage = ", obj$stage)) } From 6790e873271af4a9ba95f920a64ef0a5f348d660 Mon Sep 17 00:00:00 2001 From: Till Luca Jensen Date: Wed, 29 Nov 2023 14:20:43 +0100 Subject: [PATCH 05/28] fixed summary --- R/class_analysis_results_r6.R | 2 +- R/class_core_parameter_set_r6.R | 2 +- R/class_summary_r6.R | 3621 +++++++++++++++++++++++++++++++ R/f_analysis_base_rates.R | 10 +- 4 files changed, 3628 insertions(+), 7 deletions(-) create mode 100644 R/class_summary_r6.R diff --git a/R/class_analysis_results_r6.R b/R/class_analysis_results_r6.R index 3c4c7728..cc93395c 100644 --- a/R/class_analysis_results_r6.R +++ b/R/class_analysis_results_r6.R @@ -1201,7 +1201,7 @@ AnalysisResultsEnrichmentR6 <- R6Class("AnalysisResultsEnrichmentR6", #' @keywords internal #' summary.AnalysisResultsR6 <- function(object, ..., type = 1, digits = NA_integer_) { - return(summary.ParameterSet(object = object, ..., type = type, digits = digits)) + return(summary.ParameterSetR6(object = object, ..., type = type, digits = digits)) } #' diff --git a/R/class_core_parameter_set_r6.R b/R/class_core_parameter_set_r6.R index 86e08c96..bb8b6158 100644 --- a/R/class_core_parameter_set_r6.R +++ b/R/class_core_parameter_set_r6.R @@ -1621,7 +1621,7 @@ summary.ParameterSetR6 <- function(object, ..., type = 1, digits = NA_integer_, } if (type == 1 && (inherits(object, "TrialDesign") || inherits(object, "TrialDesignPlan") || - inherits(object, "SimulationResults") || inherits(object, "AnalysisResults") || + inherits(object, "SimulationResults") || (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) || inherits(object, "TrialDesignCharacteristics") || inherits(object, "PerformanceScore"))) { output <- match.arg(output) diff --git a/R/class_summary_r6.R b/R/class_summary_r6.R new file mode 100644 index 00000000..f365b2d4 --- /dev/null +++ b/R/class_summary_r6.R @@ -0,0 +1,3621 @@ +## | +## | *Summary classes and functions* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | rpact package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File version: $Revision: 7408 $ +## | Last changed: $Date: 2023-11-09 10:36:19 +0100 (Do, 09 Nov 2023) $ +## | Last changed by: $Author: pahlke $ +## | + +#' @include f_core_utilities.R +#' @include f_core_assertions.R +NULL + + +SummaryItemR6 <- R6Class("SummaryItemR6", + public = list( + title = NULL, + values = NULL, + legendEntry = NULL, + initialize = function(title = NA_character_, values = NA_character_, ...) { + self$title <- title + self$values <- values + #callSuper(...) TODO LEGENDENTRyy + if (!is.null(legendEntry) && length(legendEntry) > 0) { + if (is.null(names(legendEntry))) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("legendEntry"), " must be a named list") + } + for (l in legendEntry) { + if (length(l) == 0) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("legendEntry"), " must be not empty") + } + } + } + }, + show = function() { + cat(self$title, "=", self$values, "\n") + }, + toList = function() { + result <- list() + result[[self$title]] <- self$values + } + ) +) + +#' +#' @title +#' Summary Factory Plotting +#' +#' @param x The summary factory object. +#' @param y Not available for this kind of plot (is only defined to be compatible to the generic plot function). +#' @param showSummary Show the summary before creating the plot output, default is \code{FALSE}. +#' @inheritParams param_three_dots_plot +#' +#' @description +#' Plots a summary factory. +#' +#' @details +#' Generic function to plot all kinds of summary factories. +#' +#' @template return_object_ggplot +#' +#' @export +#' +plot.SummaryFactoryR6 <- function(x, y, ..., showSummary = FALSE) { + fCall <- match.call(expand.dots = FALSE) + if (isTRUE(showSummary) || .isSummaryPipe(fCall)) { + markdown <- .getOptionalArgument("markdown", ..., optionalArgumentDefaultValue = NA) + if (is.na(markdown)) { + markdown <- .isMarkdownEnabled() + } + if (markdown) { + if (.isQuartoEnabled()) { + #cat("#| results: 'asis'\n\n") + } + + x$.catMarkdownText() + } else { + x$show() + } + } + plot(x = x$object, y = y, ...) +} + +#' +#' @title +#' Print Summary Factory in Markdown Code Chunks +#' +#' @description +#' The function `knit_print.SummaryFactory` is the default printing function for rpact summary objects in knitr. +#' The chunk option `render` uses this function by default. +#' To fall back to the normal printing behavior set the chunk option `render = normal_print`. +#' For more information see \code{\link[knitr]{knit_print}}. +#' +#' @param x A \code{SummaryFactory}. +#' @param ... Other arguments (see \code{\link[knitr]{knit_print}}). +#' +#' @details +#' Generic function to print a summary object 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. +#' +#' @export +#' +knit_print.SummaryFactoryR6 <- function(x, ...) { + result <- paste0(utils::capture.output(x$.catMarkdownText()), collapse = "\n") + + if (isTRUE(base::attr(x$object, "printObject"))) { + sep <- base::attr(x$object, "printObjectSeparator") + if (is.null(sep) || !is.character(sep)) { + sep <- "\n-----\n\n" + } + result <- paste0(result, sep, + paste0(utils::capture.output(x$object$.catMarkdownText()), collapse = "\n")) + } + + return(knitr::asis_output(result)) +} + +#' +#' @title +#' Summary Factory Printing +#' +#' @param x The summary factory object. +#' @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}) +#' @param sep The separator line between the summary and the print output. +#' @inheritParams param_three_dots_plot +#' +#' @description +#' Prints the result object stored inside a summary factory. +#' +#' @details +#' Generic function to print all kinds of summary factories. +#' +#' @export +#' +print.SummaryFactoryR6 <- function(x, ..., + markdown = NA, + sep = "\n-----\n\n") { + + if (is.na(markdown)) { + markdown <- .isMarkdownEnabled() + } + + if (markdown) { + result <- paste0(utils::capture.output(x$.catMarkdownText()), collapse = "\n") + cat(result, "\n") + return(invisible()) + } + + x$show() +} + +#' @name SummaryFactory +#' +#' @title +#' Summary Factory +#' +#' @description +#' Basic class for summaries +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +SummaryFactoryR6 <- R6Class("SummaryFactoryR6", + inherit = ParameterSetR6, + public = list( + object = NULL, + title = NULL, + header = NULL, + summaryItems = NULL, + intervalFormat = NULL, + justify = NULL, + output = NULL, + initialize = function(..., intervalFormat = "[%s; %s]", output = "all") { + #callSuper(...) TODO + self$intervalFormat <- intervalFormat + self$output <- output + self$summaryItems <- list() + self$justify <- getOption("rpact.summary.justify", "right") + }, + show = function(showType = 1, digits = NA_integer_) { + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + }, + .show = function(showType = 1, digits = NA_integer_, ..., consoleOutputEnabled = TRUE) { + if (self$output %in% c("all", "title")) { + if (is.null(self$title) || length(self$title) == 0) { + self$title <- .createSummaryTitleObject(self$object) + } + if (!is.null(self$title) && length(self$title) == 1 && trimws(self$title) != "") { + self$self$.cat(self$title, "\n\n", + heading = 1, + consoleOutputEnabled = consoleOutputEnabled + ) + } + } + + if (self$output %in% c("all", "overview")) { + if (is.null(self$header) || length(self$header) == 0) { + self$header <- .createSummaryHeaderObject(self$object, self, digits) + } + if (!is.null(self$header) && length(self$header) == 1 && trimws(self$header) != "") { + self$.cat(self$header, "\n\n", + consoleOutputEnabled = consoleOutputEnabled + ) + } + } + + if (!(self$output %in% c("all", "body"))) { + return(invisible()) + } + + legendEntries <- c() + legendEntriesUnique <- c() + summaryItemNames <- c() + for (summaryItem in self$summaryItems) { + if (!is.null(summaryItem$title) && length(summaryItem$title) == 1 && !is.na(summaryItem$title)) { + summaryItemNames <- c(summaryItemNames, summaryItem$title) + } + if (length(summaryItem$legendEntry) > 0) { + a <- sort(names(summaryItem$legendEntry)) + for (aa in a) { + if (!(aa %in% legendEntriesUnique)) { + legendEntriesUnique <- c(legendEntriesUnique, aa) + b <- summaryItem$legendEntry[[aa]] + legendEntries <- c(legendEntries, paste0(" ", aa, ": ", b)) + } + } + } + } + summaryItemNames <- paste0(format(summaryItemNames), " ") + + na <- ifelse(.isDataset(self$object), "NA", NA_character_) + tableColumns <- 0 + maxValueWidth <- 1 + if (length(self$summaryItems) > 0) { + for (i in 1:length(self$summaryItems)) { + validValues <- na.omit(self$summaryItems[[i]]$values) + if (length(validValues) > 0) { + w <- max(nchar(validValues)) + maxValueWidth <- max(maxValueWidth, w) + tableColumns <- max(tableColumns, 1 + length(validValues)) + } + } + spaceString <- paste0(rep(" ", maxValueWidth + 1), collapse = "") + for (i in 1:length(self$summaryItems)) { + itemTitle <- self$summaryItems[[i]]$title + if (!is.null(itemTitle) && length(itemTitle) == 1 && !is.na(itemTitle)) { + summaryItemName <- summaryItemNames[i] + values <- self$summaryItems[[i]]$values + values <- trimws(values) + indices <- !grepl("(\\])$", values) + values[indices] <- paste0(values[indices], " ") + values <- format(c(spaceString, values), justify = self$justify)[2:(length(values) + 1)] + self$.cat(summaryItemName, values, "\n", + tableColumns = tableColumns, + consoleOutputEnabled = consoleOutputEnabled, na = na + ) + if (!consoleOutputEnabled && trimws(summaryItemName) == "Stage") { + self$.cat(rep("----- ", tableColumns), "\n", + tableColumns = tableColumns, + consoleOutputEnabled = consoleOutputEnabled, na = na + ) + } + } + } + } + + if (length(legendEntries) > 0) { + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat("Legend:\n", consoleOutputEnabled = consoleOutputEnabled) + if (!consoleOutputEnabled) { + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) + } + for (legendEntry in legendEntries) { + self$.cat(legendEntry, "\n", consoleOutputEnabled = consoleOutputEnabled) + } + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) + } + }, + addItem = function(title, values, legendEntry = list()) { + if (!is.character(values)) { + values <- as.character(values) + } + tryCatch( + { + self$addSummaryItem(SummaryItem(title = title, values = values, legendEntry = legendEntry)) + }, + error = function(e) { + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to add summary item '", title, + "' = ", .arrayToString(values), " (class: ", .getClassName(values), "): ", e$message + ) + } + ) + }, + addSummaryItem = function(summaryItem) { + if (!(inherits(summaryItem, "SummaryItem") || inherits(summaryItem, "SummaryItemR6"))) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'summaryItem' must be an instance of class 'SummaryItem' (was '", .getClassName(summaryItem), "')" + ) + } + self$summaryItems <- c(self$summaryItems, summaryItem) + }, + .getFormattedParameterValue = function(valuesToShow, valuesToShow2) { + naText <- getOption("rpact.summary.na", "") + if (length(valuesToShow) == length(valuesToShow2) && !all(is.na(valuesToShow2))) { + for (variantIndex in 1:length(valuesToShow)) { + value1 <- as.character(valuesToShow[variantIndex]) + value2 <- as.character(valuesToShow2[variantIndex]) + if (grepl("^ *NA *$", value1)) { + value1 <- naText + } + if (grepl("^ *NA *$", value2)) { + value2 <- naText + } + if (trimws(value1) == "" && trimws(value2) == "") { + valuesToShow[variantIndex] <- naText + } else { + valuesToShow[variantIndex] <- sprintf(self$intervalFormat, value1, value2) + } + } + } else { + valuesToShow[is.na(valuesToShow) | trimws(valuesToShow) == "NA"] <- naText + } + + return(valuesToShow) + }, + addParameter = function(parameterSet, ..., + parameterName = NULL, values = NULL, parameterCaption, + roundDigits = NA_integer_, ceilingEnabled = FALSE, cumsumEnabled = FALSE, + twoSided = FALSE, transpose = FALSE, smoothedZeroFormat = FALSE, + parameterCaptionSingle = parameterCaption, legendEntry = list(), + enforceFirstCase = FALSE, formatRepeatedPValues = FALSE) { + if (!is.null(parameterName) && length(parameterName) == 1 && + (inherits(parameterSet, "ParameterSet") || inherits(parameterSet, "ParameterSetR6")) && + parameterSet$.getParameterType(parameterName) == C_PARAM_NOT_APPLICABLE) { + if (.getLogicalEnvironmentVariable("RPACT_DEVELOPMENT_MODE")) { + warning( + "Failed to add parameter ", .arrayToString(parameterName), " (", + .arrayToString(values), ") stored in ", + .getClassName(parameterSet), " because the parameter has type C_PARAM_NOT_APPLICABLE" + ) + } + + return(invisible()) + } + + parameterName1 <- parameterName[1] + if (!is.null(parameterName1) && is.character(parameterName1) && is.null(values)) { + values <- parameterSet[[parameterName1]] + if (is.null(values)) { + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, .getClassName(parameterSet), + " does not contain a field '", parameterName1, "'" + ) + } + } + + parameterName2 <- NA_character_ + values2 <- NA_real_ + if (!is.null(parameterName) && length(parameterName) > 1) { + parameterName2 <- parameterName[2] + values2 <- parameterSet[[parameterName2]] + parameterName <- parameterName[1] + if (is.null(values2)) { + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, .getClassName(parameterSet), + " does not contain a field '", parameterName2, "'" + ) + } + } + + if (is.null(values) && is.null(parameterName1)) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'parameterName' or 'values' must be defined") + } + + if (transpose) { + if (!is.matrix(values)) { + values <- as.matrix(values) + } else { + values <- t(values) + } + } + + if (is.list(parameterSet) && is.matrix(values)) { + parameterSet <- parameterSet[["parameterSet"]] + if (is.null(parameterSet)) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'parameterSet' must be added to list") + } + } + + parameterNames <- "" + numberOfVariants <- 1 + numberOfStages <- ifelse(is.matrix(values), ncol(values), length(values)) + if (inherits(parameterSet, "ParameterSet") || inherits(parameterSet, "ParameterSetR6")) { + parameterNames <- parameterSet$.getVisibleFieldNamesOrdered() + numberOfVariants <- .getMultidimensionalNumberOfVariants(parameterSet, parameterNames) + numberOfStages <- parameterSet$.getMultidimensionalNumberOfStages(parameterNames) + } + + stages <- parameterSet[["stages"]] + if (is.null(stages) && !is.null(parameterSet[[".stageResults"]])) { + stages <- parameterSet[[".stageResults"]][["stages"]] + } + if (is.null(stages) && (inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResultsR6"))) { + stages <- parameterSet[[".design"]][["stages"]] + } + if (!is.null(stages) && length(stages) > 0) { + numberOfStages <- max(na.omit(stages)) + if (is.matrix(values) && nrow(values) > 0) { + numberOfVariants <- nrow(values) + } + if (is.matrix(values) && ncol(values) > 0) { + numberOfStages <- ncol(values) + } + } + + if (!is.null(parameterSet[[".piecewiseSurvivalTime"]]) && + isTRUE(parameterSet[[".piecewiseSurvivalTime"]]$delayedResponseEnabled)) { + numberOfVariants <- 1 + } + + if (twoSided) { + values <- 2 * values + } + + caseCondition <- list( + and1 = enforceFirstCase, + and2 = inherits(parameterSet, "Dataset"), + and3 = list( + or1 = list( + and1 = !transpose, + and2 = numberOfVariants == 1 + ), + or2 = list( + and1 = !is.matrix(values), + and2 = (!transpose && ncol(values) == 1), + and3 = (transpose && nrow(values) == 1) + ), + or3 = list( + and1 = .isTrialDesign(parameterSet), + and2 = (numberOfStages > 1 && numberOfStages == length(values)), + and3 = length(values) != numberOfVariants, + and4 = length(values) == 1, + and5 = parameterName %in% c( + "futilityBoundsEffectScale", + "futilityBoundsEffectScaleLower", + "futilityBoundsEffectScaleUpper", + "futilityPerStage" + ) + ) + ) + ) + + if (.isConditionTrue(caseCondition, "or", showDebugMessages = FALSE)) { + valuesToShow <- .getSummaryValuesFormatted( + parameterSet, parameterName1, values, + roundDigits = roundDigits, + ceilingEnabled = ceilingEnabled, cumsumEnabled = cumsumEnabled, + smoothedZeroFormat = smoothedZeroFormat, + formatRepeatedPValues = formatRepeatedPValues + ) + + if (parameterName1 %in% c("piControl", "overallPiControl", "overallPooledStDevs")) { + valuesToShow <- self$.getInnerValues(valuesToShow, transpose = TRUE) + } else { + valuesToShow <- self$.getInnerValues(valuesToShow, transpose = transpose) + } + + valuesToShow2 <- NA_real_ + if (!all(is.na(values2))) { + valuesToShow2 <- .getSummaryValuesFormatted(parameterSet, + parameterName1, values2, + roundDigits = roundDigits, + ceilingEnabled = ceilingEnabled, cumsumEnabled = cumsumEnabled, + smoothedZeroFormat = smoothedZeroFormat, + formatRepeatedPValues = formatRepeatedPValues + ) + valuesToShow2 <- self$.getInnerValues(valuesToShow2, transpose = transpose) + } + + valuesToShow <- self$.getFormattedParameterValue(valuesToShow, valuesToShow2) + self$addItem(parameterCaptionSingle, valuesToShow, legendEntry) + } else { + if (!(inherits(parameterSet, "ParameterSet") || inherits(parameterSet, "ParameterSetR6"))) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "for varied values 'parameterSet' must be an instance of ", + "class 'ParameterSet' (was '", .getClassName(parameterSet), "')" + ) + } + + transposed <- !transpose && grepl("MultiArm|Enrichment", .getClassName(parameterSet)) && + (!is.matrix(values) || ncol(values) > 1) + + userDefinedEffectMatrix <- FALSE + if (grepl("MultiArm|Enrichment", .getClassName(parameterSet)) || + (inherits(parameterSet, "AnalysisResultsConditionalDunnett") || inherits(parameterSet, "AnalysisResultsConditionalDunnettR6")) || + (inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResultsR6")) || + (inherits(parameterSet, "ConditionalPowerResults") || inherits(parameterSet, "ConditionalPowerResultsR6"))) { + if (grepl("SimulationResults(MultiArm|Enrichment)", .getClassName(parameterSet)) && + parameterName %in% c( + "rejectAtLeastOne", + "earlyStop", + "futilityPerStage", + "successPerStage", + "expectedNumberOfSubjects", + "expectedNumberOfEvents", + "singleNumberOfEventsPerStage", + "numberOfActiveArms", + "numberOfPopulations", + "conditionalPowerAchieved" + )) { + transposed <- TRUE + userDefinedEffectMatrix <- + parameterSet$.getParameterType("effectMatrix") == C_PARAM_USER_DEFINED + if (userDefinedEffectMatrix) { + legendEntry[["[j]"]] <- "effect matrix row j (situation to consider)" + } + if (grepl("Survival", .getClassName(parameterSet)) && !grepl("Enrichment", .getClassName(parameterSet))) { + legendEntry[["(i)"]] <- "results of treatment arm i vs. control arm" + } + + if (grepl("SimulationResultsEnrichment", .getClassName(parameterSet))) { + variedParameterName <- .getSummaryVariedParameterNameEnrichment(parameterSet) + variedParameterValues <- parameterSet$effectList[[variedParameterName]] + if (variedParameterName == "piTreatments") { + variedParameterCaption <- "pi(treatment)" + } else { + variedParameterCaption <- C_PARAMETER_NAMES[[variedParameterName]] + if (is.matrix(variedParameterValues) && ncol(variedParameterValues) == 1) { + variedParameterCaption <- sub("s$", "", variedParameterCaption) + } + } + if (is.matrix(variedParameterValues)) { + numberOfVariants <- nrow(variedParameterValues) + } else { + numberOfVariants <- length(variedParameterValues) + } + } else { + variedParameterName <- .getVariedParameterSimulationMultiArm(parameterSet) + variedParameterValues <- parameterSet[[variedParameterName]] + variedParameterCaption <- C_PARAMETER_NAMES[[variedParameterName]] + numberOfVariants <- length(variedParameterValues) + } + variedParameterCaption <- tolower(variedParameterCaption) + } else if (self$.isEnrichmentObject(parameterSet)) { + transposed <- TRUE + variedParameterCaption <- "populations" + if (parameterName1 %in% c( + "indices", "conditionalErrorRate", "secondStagePValues", + "adjustedStageWisePValues", "overallAdjustedTestStatistics", "rejectedIntersections" + )) { + if (.isEnrichmentAnalysisResults(parameterSet)) { + variedParameterValues <- parameterSet$.closedTestResults$.getHypothesisPopulationVariants() + } else { + variedParameterValues <- parameterSet$.getHypothesisPopulationVariants() + } + } else { + variedParameterValues <- c(paste0("S", 1:(numberOfVariants - 1)), "F") + } + numberOfVariants <- length(variedParameterValues) + legendEntry[["S[i]"]] <- "population i" + legendEntry[["F"]] <- "full population" + } else if (!(inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResultsR6")) || + parameterName %in% c("rejected", "separatePValues")) { + if ((inherits(parameterSet, "AnalysisResultsConditionalDunnett") || inherits(parameterSet, "AnalysisResultsConditionalDunnettR6")) && + (!is.matrix(values) || ncol(values) > 1)) { + transposed <- TRUE + } + + if ((inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResultsR6")) && + parameterSet$.getParameterType("adjustedStageWisePValues") != "g" && + parameterName == "separatePValues") { + transposed <- TRUE + } + + if ((inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResultsR6")) && + parameterName %in% c("rejected")) { + transposed <- TRUE + } + + if ((inherits(parameterSet, "ConditionalPowerResults") || inherits(parameterSet, "ConditionalPowerResultsR6")) && + parameterName %in% c("conditionalPower", "values")) { + transposed <- TRUE + } + + variedParameterCaption <- "arm" + variedParameterValues <- 1:numberOfVariants + legendEntry[["(i)"]] <- "results of treatment arm i vs. control arm" + } else { + transposed <- TRUE + variedParameterCaption <- "arms" + variedParameterValues <- parameterSet$.getHypothesisTreatmentArmVariants() + numberOfVariants <- length(variedParameterValues) + legendEntry[["(i, j, ...)"]] <- "comparison of treatment arms 'i, j, ...' vs. control arm" + } + } else { + if (inherits(parameterSet, "Dataset")) { + variedParameter <- "groups" + } else if (inherits(parameterSet, "PerformanceScore")) { + variedParameter <- ".alternative" + } else { + variedParameter <- parameterSet$.getVariedParameter(parameterNames, numberOfVariants) + } + if (length(variedParameter) == 0 || variedParameter == "") { + warning( + "Failed to get varied parameter from ", .getClassName(parameterSet), + " (", length(parameterNames), " parameter names; numberOfVariants: ", numberOfVariants, ")" + ) + return(invisible()) + } + + variedParameterCaption <- parameterSet$.getDataFrameColumnCaption(variedParameter, + tableColumnNames = C_TABLE_COLUMN_NAMES, niceColumnNamesEnabled = TRUE + ) + variedParameterCaption <- tolower(variedParameterCaption) + + if (variedParameterCaption == "alternative" || variedParameterCaption == ".alternative") { + legendEntry[["alt."]] <- "alternative" + variedParameterCaption <- "alt." + } else if (variedParameterCaption == "hazard ratio") { + legendEntry[["HR"]] <- "hazard ratio" + variedParameterCaption <- "HR" + } else if (grepl("\\(1\\)$", variedParameterCaption)) { + groups <- parameterSet[["groups"]] + if (!is.null(groups) && length(groups) == 1 && groups == 1) { + variedParameterCaption <- sub(" \\(1\\)$", "", variedParameterCaption) + } + } + + variedParameterValues <- round(parameterSet[[variedParameter]], 3) + } + + for (variantIndex in 1:numberOfVariants) { + colValues <- self$.getColumnValues(parameterName, values, variantIndex, transposed) + colValues <- .getSummaryValuesFormatted(parameterSet, parameterName1, + colValues, + roundDigits = roundDigits, + ceilingEnabled = ceilingEnabled, cumsumEnabled = cumsumEnabled, + smoothedZeroFormat = smoothedZeroFormat, + formatRepeatedPValues = formatRepeatedPValues + ) + colValues2 <- NA_real_ + if (!all(is.na(values2))) { + colValues2 <- self$.getColumnValues(parameterName, values2, variantIndex, transposed) + colValues2 <- .getSummaryValuesFormatted(parameterSet, parameterName2, colValues2, + roundDigits = roundDigits, ceilingEnabled = ceilingEnabled, + cumsumEnabled = cumsumEnabled, + smoothedZeroFormat = smoothedZeroFormat, + formatRepeatedPValues = formatRepeatedPValues + ) + } + colValues <- self$.getFormattedParameterValue(valuesToShow = colValues, valuesToShow2 = colValues2) + + if (numberOfVariants == 1) { + self$addItem(parameterCaption, colValues, legendEntry) + } else if (self$.isEnrichmentObject(parameterSet)) { + self$addItem(paste0( + parameterCaption, " ", + variedParameterValues[variantIndex] + ), colValues, legendEntry) + } else if ( + (grepl("MultiArm|Enrichment", .getClassName(parameterSet)) && + !grepl("Simulation", .getClassName(parameterSet))) || + (inherits(parameterSet, "AnalysisResultsConditionalDunnett") || inherits(parameterSet, "AnalysisResultsConditionalDunnettR6")) || + (inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResultsR6")) || + (inherits(parameterSet, "ConditionalPowerResults") || inherits(parameterSet, "ConditionalPowerResultsR6"))) { + spacePrefix <- ifelse(parameterCaption %in% c("pi", "lambda", "median"), "", " ") + self$addItem(paste0( + parameterCaption, spacePrefix, + "(", variedParameterValues[variantIndex], ")" + ), colValues, legendEntry) + } else if (userDefinedEffectMatrix) { + self$addItem(paste0(parameterCaption, " [", variantIndex, "]"), colValues, legendEntry) + } else { + if (is.matrix(variedParameterValues) && ncol(variedParameterValues) > 1) { + variedParameterValuesFormatted <- + .arrayToString(variedParameterValues[variantIndex, ], vectorLookAndFeelEnabled = TRUE) + } else { + variedParameterValuesFormatted <- variedParameterValues[variantIndex] + } + self$addItem( + paste0( + parameterCaption, ", ", + variedParameterCaption, " = ", variedParameterValuesFormatted + ), + colValues, legendEntry + ) + } + } + } + }, + .isEnrichmentObject = function(parameterSet) { + return( + .isEnrichmentAnalysisResults(parameterSet) || + .isEnrichmentStageResults(parameterSet) || + .isEnrichmentConditionalPowerResults(parameterSet) || + ((inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResultsR6")) && + isTRUE(parameterSet$.enrichment)) + ) + }, + .getInnerValues = function(values, transpose = FALSE) { + if (!is.matrix(values)) { + return(values) + } + + if (nrow(values) == 1 && ncol(values) == 1) { + return(values[1, 1]) + } + + if (transpose) { + return(values[1, ]) + } + + return(values[, 1]) + }, + .getColumnValues = function(parameterName, values, variantIndex, transposed = FALSE) { + tryCatch( + { + if (transposed) { + if (!is.matrix(values)) { + return(values) + } + + if (nrow(values) == 0) { + return("") + } + + if (nrow(values) == 1 && ncol(values) == 1) { + colValues <- values[1, 1] + } else if (nrow(values) == 1) { + colValues <- values[1, variantIndex] + } else if (ncol(values) == 1) { + colValues <- values[variantIndex, 1] + } else { + colValues <- values[variantIndex, ] + } + return(colValues) + } + + if (length(values) <= 1 && !is.matrix(values)) { + colValues <- values + } else if (is.matrix(values)) { + if (nrow(values) == 1 && ncol(values) == 1) { + colValues <- values[1, 1] + } else if (ncol(values) == 1) { + colValues <- values[variantIndex, 1] + } else if (nrow(values) == 1) { + colValues <- values[1, variantIndex] + } else { + if (ncol(values) == 0) { + return("") + } + + colValues <- values[, variantIndex] + } + } else { + colValues <- values[variantIndex] + } + return(colValues) + }, + error = function(e) { + stop( + ".getColumnValues(", dQuote(parameterName), "): ", e$message, + "; .getClassName(values) = ", .getClassName(values), + "; dim(values) = ", .arrayToString(dim(values), vectorLookAndFeelEnabled = TRUE), + "; variantIndex = ", variantIndex, + "; transposed = ", transposed + ) + } + ) + } + ) +) + +.formatSummaryValues <- function(values, digits, smoothedZeroFormat = FALSE, formatRepeatedPValues = FALSE) { + if (is.na(digits)) { + digits <- 3 + } + + if (digits < 1) { + formattedValue <- as.character(values) + formattedValue[is.na(formattedValue) | trimws(formattedValue) == "NA"] <- getOption("rpact.summary.na", "") + return(formattedValue) + } + + if (sum(is.na(values)) == length(values)) { + formattedValue <- rep(getOption("rpact.summary.na", ""), length(values)) + return(formattedValue) + } + + threshold <- 10^-digits + text <- "<0." + if (digits > 1) { + for (i in 1:(digits - 1)) { + text <- paste0(text, "0") + } + } + text <- paste0(text, "1") + + if (smoothedZeroFormat) { + values[abs(values) < 1e-15] <- 0 + } + indices <- (!is.na(values) & values > 1e-10 & abs(values) < threshold) + values[!is.na(values) & !indices] <- round(values[!is.na(values) & !indices], digits) + if (sum(indices) > 0) { + values[indices] <- threshold + formattedValue <- .getFormattedValue(values, digits = digits, nsmall = digits, scientific = FALSE) + formattedValue[indices] <- text + } else { + formattedValue <- .getFormattedValue(values, digits = digits, nsmall = digits, scientific = FALSE) + formattedValue <- format(formattedValue, scientific = FALSE) + } + + if (formatRepeatedPValues) { + formattedValue[!is.na(formattedValue) & + nchar(gsub("\\D", "", (formattedValue))) > 0 & formattedValue > 0.4999] <- ">0.5" + } + + if (as.logical(getOption("rpact.summary.trim.zeroes", TRUE))) { + zeroes <- grepl("^0\\.0*$", formattedValue) + if (sum(zeroes) > 0) { + formattedValue[zeroes] <- "0" + } + } + + formattedValue[is.na(formattedValue) | trimws(formattedValue) == "NA"] <- getOption("rpact.summary.na", "") + + return(formattedValue) +} + +.getSummaryValuesFormatted <- function(fieldSet, parameterName, values, + roundDigits = NA_integer_, ceilingEnabled = FALSE, cumsumEnabled = FALSE, + smoothedZeroFormat = FALSE, formatRepeatedPValues = FALSE) { + if (!is.numeric(values)) { + return(values) + } + + if (cumsumEnabled) { + values <- cumsum(values) + } + + if (ceilingEnabled) { + values <- ceiling(values) + } else { + tryCatch( + { + formatFunctionName <- NULL + + if (!is.null(parameterName) && length(parameterName) == 1 && !is.na(parameterName)) { + if (parameterName == "futilityBounds") { + values[!is.na(values) & values <= -6] <- -Inf + } else if (parameterName %in% c("criticalValues", "decisionCriticalValue", "overallAdjustedTestStatistics")) { + design <- fieldSet + if (!.isTrialDesign(design)) { + design <- fieldSet[[".design"]] + } + if (!is.null(design) && .isTrialDesignFisher(design)) { + roundDigits <- 0 + } + } + if (!is.na(roundDigits) && roundDigits == 0) { + if (inherits(fieldSet, "Dataset") && + grepl("samplesize|event", tolower(parameterName))) { + } else { + if (inherits(fieldSet, "FieldSet") || inherits(fieldSet, "FieldSetR6")) { + formatFunctionName <- fieldSet$.parameterFormatFunctions[[parameterName]] + } + if (is.null(formatFunctionName)) { + formatFunctionName <- C_PARAMETER_FORMAT_FUNCTIONS[[parameterName]] + } + } + } + } + + if (!is.null(formatFunctionName)) { + values <- eval(call(formatFunctionName, values)) + } else { + values <- .formatSummaryValues(values, + digits = roundDigits, + smoothedZeroFormat = smoothedZeroFormat, + formatRepeatedPValues = formatRepeatedPValues + ) + } + }, + error = function(e) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to show parameter '", parameterName, "': ", e$message) + } + ) + } + + return(format(values)) +} + +.createSummaryTitleObject <- function(object) { + design <- NULL + designPlan <- NULL + if (inherits(object, "TrialDesignCharacteristics")) { + design <- object$.design + } else if (.isTrialDesignPlan(object) || inherits(object, "SimulationResults")) { + design <- object$.design + designPlan <- object + } else if (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) { + return(.createSummaryTitleAnalysisResults(object$.design, object)) + } else if (.isTrialDesign(object)) { + design <- object + } + if (!is.null(design)) { + return(.createSummaryTitleDesign(design, designPlan)) + } + return("") +} + +.createSummaryTitleAnalysisResults <- function(design, analysisResults) { + kMax <- design$kMax + + title <- "" + if (kMax == 1) { + title <- paste0(title, "Fixed sample analysis results") + } else { + title <- paste0(title, "Sequential analysis results with a maximum of ", kMax, " looks") + } + + if (!is.null(analysisResults)) { + if (.isMultiArmAnalysisResults(analysisResults)) { + title <- "Multi-arm analysis results for a " + } else if (.isEnrichmentAnalysisResults(analysisResults)) { + title <- "Enrichment analysis results for a " + } else { + title <- "Analysis results for a " + } + + if (grepl("Means", .getClassName(analysisResults$.dataInput))) { + title <- paste0(title, "continuous endpoint") + } else if (grepl("Rates", .getClassName(analysisResults$.dataInput))) { + title <- paste0(title, "binary endpoint") + } else if (grepl("Survival", .getClassName(analysisResults$.dataInput))) { + title <- paste0(title, "survival endpoint") + } + + if (.isMultiHypothesesAnalysisResults(analysisResults)) { + gMax <- analysisResults$.stageResults$getGMax() + if (.isMultiArmAnalysisResults(analysisResults)) { + title <- paste0(title, " (", gMax, " active arms vs. control)") + } else if (.isEnrichmentAnalysisResults(analysisResults)) { + title <- paste0(title, " (", gMax, " populations)") + } + } + } else if (kMax > 1) { + prefix <- ifelse(design$.isDelayedResponseDesign(), "delayed response ", "") + title <- .concatenateSummaryText(title, + paste0("(", prefix, design$.toString(startWithUpperCase = FALSE), ")"), + sep = " " + ) + } + + return(title) +} + +.createSummaryTitleDesign <- function(design, designPlan) { + kMax <- design$kMax + + title <- "" + if (kMax == 1) { + title <- paste0(title, "Fixed sample analysis") + } else { + title <- paste0(title, "Sequential analysis with a maximum of ", kMax, " looks") + } + if (!is.null(designPlan)) { + if (inherits(designPlan, "SimulationResults")) { + title <- "Simulation of a " + } else if (designPlan$.isSampleSizeObject()) { + title <- "Sample size calculation for a " + } else if (designPlan$.isPowerObject()) { + title <- "Power calculation for a " + } + + if (grepl("Means", .getClassName(designPlan))) { + title <- paste0(title, "continuous endpoint") + } else if (grepl("Rates", .getClassName(designPlan))) { + title <- paste0(title, "binary endpoint") + } else if (grepl("Survival", .getClassName(designPlan))) { + title <- paste0(title, "survival endpoint") + } + + if (grepl("MultiArm", .getClassName(designPlan)) && + !is.null(designPlan[["activeArms"]]) && designPlan$activeArms > 1) { + title <- .concatenateSummaryText(title, "(multi-arm design)", sep = " ") + } else if (grepl("Enrichment", .getClassName(designPlan))) { + title <- .concatenateSummaryText(title, "(enrichment design)", sep = " ") + } + } else if (kMax > 1) { + prefix <- ifelse(design$.isDelayedResponseDesign(), "delayed response ", "") + title <- .concatenateSummaryText(title, + paste0("(", prefix, design$.toString(startWithUpperCase = FALSE), ")"), + sep = " " + ) + } + + return(title) +} + +.isRatioComparisonEnabled <- function(object) { + if (!is.null(object[["meanRatio"]]) && isTRUE(object[["meanRatio"]])) { + return(TRUE) + } + + if (!is.null(object[["riskRatio"]]) && isTRUE(object[["riskRatio"]])) { + return(TRUE) + } + + return(FALSE) +} + +.getSummaryObjectSettings <- function(object) { + multiArmEnabled <- grepl("MultiArm", .getClassName(object)) + enrichmentEnabled <- grepl("Enrichment", .getClassName(object)) + simulationEnabled <- grepl("Simulation", .getClassName(object)) + ratioEnabled <- FALSE + populations <- NA_integer_ + if ((inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) || (inherits(object, "StageResults") || inherits(object, "StageResultsR6"))) { + groups <- object$.dataInput$getNumberOfGroups() + meansEnabled <- grepl("Means", .getClassName(object$.dataInput)) + ratesEnabled <- grepl("Rates", .getClassName(object$.dataInput)) + survivalEnabled <- grepl("Survival", .getClassName(object$.dataInput)) + } else { + meansEnabled <- grepl("Means", .getClassName(object)) + ratesEnabled <- grepl("Rates", .getClassName(object)) + survivalEnabled <- grepl("Survival", .getClassName(object)) + if (simulationEnabled && multiArmEnabled) { + groups <- object$activeArms + } else if (simulationEnabled && enrichmentEnabled) { + groups <- 2 + populations <- object$populations + } else { + # for analysis multi-arm / enrichment always 2 groups are applicable + groups <- ifelse(multiArmEnabled || enrichmentEnabled || survivalEnabled, 2, object[["groups"]]) + } + ratioEnabled <- .isRatioComparisonEnabled(object) + } + + return(list( + meansEnabled = meansEnabled, + ratesEnabled = ratesEnabled, + survivalEnabled = survivalEnabled, + groups = groups, + populations = populations, + multiArmEnabled = multiArmEnabled, + enrichmentEnabled = enrichmentEnabled, + simulationEnabled = simulationEnabled, + ratioEnabled = ratioEnabled + )) +} + +.createSummaryHypothesisText <- function(object, summaryFactory) { + if (!(inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) && !inherits(object, "TrialDesignPlan") && + !inherits(object, "SimulationResults")) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'object' must be an instance of class 'AnalysisResults', 'TrialDesignPlan' ", + "or 'SimulationResults' (is '", .getClassName(object), "')" + ) + } + + design <- object[[".design"]] + if (is.null(design)) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'.design' must be defined in specified ", .getClassName(object)) + } + + settings <- .getSummaryObjectSettings(object) + sided <- ifelse(settings$multiArmEnabled || settings$enrichmentEnabled, 1, design$sided) + directionUpper <- object[["directionUpper"]] + if (is.null(directionUpper) || length(directionUpper) != 1 || is.na(directionUpper)) { + directionUpper <- TRUE + } + + comparisonH0 <- " = " + comparisonH1 <- NA_character_ + if ((inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) && !is.null(directionUpper)) { + comparisonH1 <- ifelse(sided == 2, " != ", ifelse(directionUpper, " > ", " < ")) + } + + if (!is.null(object[["thetaH0"]])) { + thetaH0 <- round(object$thetaH0, 3) + } else { + thetaH0 <- ifelse(settings$survivalEnabled, 1, 0) + } + + treatmentArmIndex <- ifelse(settings$groups > 1, "(i)", "(treatment)") + controlArmIndex <- ifelse(settings$groups > 1, "(i)", "(control)") + + if (settings$multiArmEnabled || settings$enrichmentEnabled) { + if ((settings$survivalEnabled) && (settings$multiArmEnabled)) { + treatmentArmIndex <- "(i)" + controlArmIndex <- "" + } else if ((settings$survivalEnabled) && (settings$enrichmentEnabled)) { + treatmentArmIndex <- "" + controlArmIndex <- "" + } else if (settings$groups == 1) { + treatmentArmIndex <- "(treatment)" + controlArmIndex <- "(control)" + } else { + if (settings$enrichmentEnabled) { + treatmentArmIndex <- "(treatment)" + } else { + treatmentArmIndex <- "(i)" + } + controlArmIndex <- "(control)" + } + } else { + if (settings$groups == 1 || settings$survivalEnabled) { + treatmentArmIndex <- "" + controlArmIndex <- "" + } else { + treatmentArmIndex <- "(1)" + controlArmIndex <- "(2)" + } + } + + value <- "?" + if (settings$meansEnabled) { + value <- "mu" + } else if (settings$ratesEnabled) { + value <- "pi" + } else if (settings$survivalEnabled) { + value <- "hazard ratio" + } + + calcSep <- ifelse(settings$ratioEnabled, " / ", " - ") + hypothesis <- "" + if (!settings$survivalEnabled && (settings$multiArmEnabled || settings$enrichmentEnabled || settings$groups == 2)) { + hypothesis <- paste0( + hypothesis, "H0: ", value, treatmentArmIndex, + calcSep, value, controlArmIndex, comparisonH0, thetaH0 + ) + if (!is.na(comparisonH1)) { + hypothesis <- paste0(hypothesis, " against ") + hypothesis <- paste0( + hypothesis, "H1: ", value, treatmentArmIndex, + calcSep, value, controlArmIndex, comparisonH1, thetaH0 + ) + } + } else { + hypothesis <- paste0(hypothesis, "H0: ", value, treatmentArmIndex, comparisonH0, thetaH0) + if (!is.na(comparisonH1)) { + hypothesis <- paste0(hypothesis, " against ") + hypothesis <- paste0(hypothesis, "H1: ", value, treatmentArmIndex, comparisonH1, thetaH0) + } + } + hypothesis <- .concatenateSummaryText( + hypothesis, + .createSummaryHypothesisPowerDirectionText(object, sided, directionUpper) + ) + return(hypothesis) +} + +.createSummaryHypothesisPowerDirectionText <- function(object, sided, directionUpper) { + if (sided == 2 || is.null(directionUpper)) { + return("") + } + + directionUpper <- unique(directionUpper) + if (length(directionUpper) != 1) { + return("") + } + + if (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) { + return("") + } + + if (.isTrialDesignPlan(object) && object$.objectType != "power") { + return("") + } + + if (directionUpper) { + return("power directed towards larger values") + } else { + return("power directed towards smaller values") + } +} + +.addSummaryLineBreak <- function(text, newLineLength) { + maxLineLength <- as.integer(getOption("rpact.summary.width", 83)) + lines <- strsplit(text, "\n", fixed = TRUE)[[1]] + lastLine <- lines[length(lines)] + if (nchar(lastLine) + newLineLength > maxLineLength) { + text <- paste0(text, "\n") + } + return(text) +} + +.concatenateSummaryText <- function(a, b, sep = ", ") { + .assertIsSingleCharacter(a, "a") + .assertIsSingleCharacter(b, "b") + if (is.na(b) || nchar(trimws(b)) == 0) { + return(a) + } + + if (a == "") { + return(b) + } + + a <- paste0(a, sep) + a <- .addSummaryLineBreak(a, nchar(b)) + return(paste0(a, b)) +} + +.createSummaryHeaderObject <- function(object, summaryFactory, digits = NA_integer_) { + if (inherits(object, "TrialDesignCharacteristics")) { + return(.createSummaryHeaderDesign(object$.design, NULL, summaryFactory)) + } + + if (.isTrialDesignPlan(object) || inherits(object, "SimulationResults")) { + return(.createSummaryHeaderDesign(object$.design, object, summaryFactory)) + } + + if (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) { + return(.createSummaryHeaderAnalysisResults(object$.design, object, summaryFactory, digits)) + } + + if (.isTrialDesign(object)) { + return(.createSummaryHeaderDesign(object, NULL, summaryFactory)) + } + + return("") +} + +.addAllocationRatioToHeader <- function(parameterSet, header, sep = ", ") { + if (!.isTrialDesignPlanSurvival(parameterSet) && !grepl("Simulation", .getClassName(parameterSet))) { + numberOfGroups <- 1 + if (inherits(parameterSet, "TrialDesignPlan")) { + numberOfGroups <- parameterSet$groups + } else if (inherits(parameterSet, "AnalysisResults") || inherits(parameterSet, "AnalysisResultsR6")) { + numberOfGroups <- parameterSet$.dataInput$getNumberOfGroups() + } + if (numberOfGroups == 1) { + return(header) + } + } + + prefix <- "" + if (!is.null(parameterSet[["optimumAllocationRatio"]]) && + length(parameterSet$optimumAllocationRatio) == 1 && + parameterSet$optimumAllocationRatio) { + if (length(unique(parameterSet$allocationRatioPlanned)) > 1) { + return(.concatenateSummaryText(header, "optimum planned allocation ratio", sep = sep)) + } + prefix <- "optimum " + } + + allocationRatioPlanned <- round(unique(parameterSet$allocationRatioPlanned), 3) + if (identical(allocationRatioPlanned, 1) && prefix == "") { + return(header) + } + + if (!all(is.na(allocationRatioPlanned))) { + return(.concatenateSummaryText(header, + paste0( + prefix, "planned allocation ratio = ", + .arrayToString(allocationRatioPlanned, vectorLookAndFeelEnabled = length(allocationRatioPlanned) > 1) + ), + sep = sep + )) + } else { + return(header) + } +} + +.createSummaryHeaderAnalysisResults <- function(design, analysisResults, summaryFactory, digits) { + digitSettings <- .getSummaryDigits(digits) + digitsGeneral <- digitSettings$digitsGeneral + + stageResults <- analysisResults$.stageResults + dataInput <- analysisResults$.dataInput + + multiArmEnabled <- .isMultiArmAnalysisResults(analysisResults) + enrichmentEnabled <- .isEnrichmentAnalysisResults(analysisResults) + multiHypothesesEnabled <- .isMultiHypothesesAnalysisResults(analysisResults) + + header <- "" + if (design$kMax == 1) { + header <- paste0(header, "Fixed sample analysis.") + } else { + header <- paste0(header, "Sequential analysis with ", design$kMax, " looks") + header <- .concatenateSummaryText(header, + paste0("(", design$.toString(startWithUpperCase = FALSE), ")."), + sep = " " + ) + } + header <- paste0(header, "\n") + + header <- paste0(header, "The results were calculated using a ") + if (stageResults$isDatasetMeans()) { + if (dataInput$getNumberOfGroups() == 1) { + header <- paste0(header, "one-sample t-test") + } else if (dataInput$getNumberOfGroups() == 2) { + header <- paste0(header, "two-sample t-test") + } else { + header <- paste0(header, "multi-arm t-test") + } + } else if (stageResults$isDatasetRates()) { + if (dataInput$getNumberOfGroups() == 1) { + header <- paste0(header, "one-sample test for rates") + } else if (dataInput$getNumberOfGroups() == 2) { + header <- paste0(header, "two-sample test for rates") + } else { + header <- paste0(header, "multi-arm test for rates") + } + } else if (stageResults$isDatasetSurvival()) { + if (dataInput$getNumberOfGroups() == 2) { + header <- paste0(header, "two-sample logrank test") + } else { + header <- paste0(header, "multi-arm logrank test") + } + } + + 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") + } else if (stageResults$intersectionTest == "Bonferroni") { + header <- .concatenateSummaryText(header, "Bonferroni intersection test") + } else if (stageResults$intersectionTest == "Simes") { + header <- .concatenateSummaryText(header, "Simes intersection test") + } else if (stageResults$intersectionTest == "Sidak") { + header <- .concatenateSummaryText(header, "Sidak intersection test") + } else if (stageResults$intersectionTest == "Hierarchical") { + header <- .concatenateSummaryText(header, "Hierarchical intersection test") + } else if (stageResults$intersectionTest == "SpiessensDebois") { + header <- .concatenateSummaryText(header, "Spiessens and Debois intersection test") + } + } + + if (!is.null(stageResults[["normalApproximation"]]) && stageResults$normalApproximation) { + header <- .concatenateSummaryText(header, "normal approximation test") + } else if (stageResults$isDatasetRates()) { + if (dataInput$getNumberOfGroups() == 1) { + header <- .concatenateSummaryText(header, "exact test") + } else { + header <- .concatenateSummaryText(header, "exact test of Fisher") + } + } else { + # header <- .concatenateSummaryText(header, "exact t test") + } + + if (stageResults$isDatasetMeans() && multiHypothesesEnabled) { + if (stageResults$varianceOption == "overallPooled") { + header <- .concatenateSummaryText(header, "overall pooled variances option") + } else if (stageResults$varianceOption == "pairwisePooled") { + header <- .concatenateSummaryText(header, "pairwise pooled variances option") + } else if (stageResults$varianceOption == "pooledFromFull") { + header <- .concatenateSummaryText(header, "pooled from full population variances option") + } else if (stageResults$varianceOption == "pooled") { + header <- .concatenateSummaryText(header, "pooled variances option") + } else if (stageResults$varianceOption == "notPooled") { + header <- .concatenateSummaryText(header, "not pooled variances option") + } + } + + if ((inherits(stageResults, "StageResultsMeans") || inherits(stageResults, "StageResultsMeansR6")) && (dataInput$getNumberOfGroups() == 2)) { + if (stageResults$equalVariances) { + header <- .concatenateSummaryText(header, "equal variances option") + } else { + header <- .concatenateSummaryText(header, "unequal variances option") + } + } + + if (.isTrialDesignConditionalDunnett(design)) { + if (design$secondStageConditioning) { + header <- .concatenateSummaryText(header, "conditional second stage p-values") + } else { + header <- .concatenateSummaryText(header, "unconditional second stage p-values") + } + } + + if (enrichmentEnabled) { + header <- .concatenateSummaryText(header, paste0( + ifelse(analysisResults$stratifiedAnalysis, "", "non-"), "stratified analysis" + )) + } + + header <- paste0(header, ".\n", .createSummaryHypothesisText(analysisResults, summaryFactory)) + + if (stageResults$isDatasetMeans()) { + header <- .getSummaryHeaderEntryAnalysisResults(header, analysisResults, + paramName1 = "thetaH1", + paramName2 = ifelse(multiHypothesesEnabled, "assumedStDevs", "assumedStDev"), + paramCaption1 = "assumed effect", + paramCaption2 = "assumed standard deviation", + shortcut1 = "thetaH1", + shortcut2 = "sd", + digits1 = digitsGeneral, + digits2 = digitsGeneral + ) + } else if (stageResults$isDatasetRates()) { + header <- .getSummaryHeaderEntryAnalysisResults(header, analysisResults, + paramName1 = ifelse(enrichmentEnabled, "piTreatments", ifelse(multiArmEnabled, "piTreatments", "pi1")), + paramName2 = ifelse(enrichmentEnabled, "piControls", ifelse(multiArmEnabled, "piControl", "pi2")), + paramCaption1 = "assumed treatment rate", + paramCaption2 = "assumed control rate", + shortcut1 = "pi", + shortcut2 = "pi" + ) + } else if (stageResults$isDatasetSurvival()) { + header <- .getSummaryHeaderEntryAnalysisResults(header, analysisResults, + paramName1 = "thetaH1", + paramCaption1 = "assumed effect", + shortcut1 = "thetaH1", + digits1 = digitsGeneral + ) + } + + header <- paste0(header, ".") + return(header) +} + +.getSummaryHeaderEntryValueAnalysisResults <- function(shortcut, value, analysisResults) { + if (is.matrix(value)) { + stage <- analysisResults$.stageResults$stage + if (stage <= ncol(value)) { + value <- value[, stage] + } + } + + value[!is.na(value)] <- round(value[!is.na(value)], 2) + + if ((is.matrix(value) && nrow(value) > 1) || length(value) > 1) { + treatmentNames <- 1:length(value) + if (.isEnrichmentAnalysisResults(analysisResults)) { + populations <- paste0("S", treatmentNames) + gMax <- analysisResults$.stageResults$getGMax() + populations[treatmentNames == gMax] <- "F" + treatmentNames <- populations + } + value <- paste0(paste(paste0(shortcut, "(", treatmentNames, ") = ", value)), collapse = ", ") + } + return(value) +} + +.getSummaryHeaderEntryAnalysisResults <- function(header, analysisResults, ..., + paramName1, paramName2 = NA_character_, + paramCaption1, paramCaption2 = NA_character_, + shortcut1, shortcut2 = NA_character_, + digits1 = 2, digits2 = 2) { + if (analysisResults$.design$kMax == 1) { + return(header) + } + + if (length(analysisResults$nPlanned) == 0 || all(is.na(analysisResults$nPlanned))) { + return(header) + } + + paramValue1 <- analysisResults[[paramName1]] + case1 <- analysisResults$.getParameterType(paramName1) != C_PARAM_NOT_APPLICABLE && + !all(is.na(paramValue1)) + if (!is.na(paramCaption1) && analysisResults$.getParameterType(paramName1) == C_PARAM_GENERATED) { + paramCaption1 <- sub("assumed ", "overall ", paramCaption1) + } + + case2 <- FALSE + if (!is.na(paramName2)) { + paramValue2 <- analysisResults[[paramName2]] + case2 <- analysisResults$.getParameterType(paramName2) != C_PARAM_NOT_APPLICABLE && + !all(is.na(paramValue2)) + if (!is.na(paramCaption2) && analysisResults$.getParameterType(paramName2) == C_PARAM_GENERATED) { + paramCaption2 <- sub("assumed ", "overall ", paramCaption2) + } + } + + if (!case1 && !case2) { + return(header) + } + + if (.isTrialDesignFisher(analysisResults$.design) && + length(analysisResults$nPlanned[!is.na(analysisResults$nPlanned)]) > 1) { + header <- .concatenateSummaryText(header, paste0( + "The conditional power simulation with planned sample size and ", + analysisResults$iterations, " iterations is based on" + ), sep = ". ") + } else { + header <- .concatenateSummaryText(header, + "The conditional power calculation with planned sample size is based on", + sep = ". " + ) + } + + header <- .addAllocationRatioToHeader(analysisResults, header, sep = " ") + + sepPrefix <- ifelse(length(analysisResults$allocationRatioPlanned) == 0 || + identical(unique(analysisResults$allocationRatioPlanned), 1), "", ",") + + if (case1) { + if (!any(is.na(paramValue1)) && length(unique(paramValue1)) == 1) { + paramValue1 <- paramValue1[1] + } + if (length(paramValue1) == 1) { + header <- .concatenateSummaryText(header, + paste0(paramCaption1, " = ", ifelse(is.na(paramValue1), paramValue1, round(paramValue1, digits1))), + sep = paste0(sepPrefix, " ") + ) + } else { + header <- .concatenateSummaryText(header, + paste0(paramCaption1, ": ", .getSummaryHeaderEntryValueAnalysisResults( + shortcut1, paramValue1, analysisResults + )), + sep = paste0(sepPrefix, " ") + ) + } + } + + if (case2) { + if (length(paramValue2) == 1) { + header <- .concatenateSummaryText(header, + paste0(paramCaption2, " = ", ifelse(is.na(paramValue2), paramValue2, round(paramValue2, digits2))), + sep = ifelse(case1, paste0(sepPrefix, " and "), " ") + ) + } else { + header <- .concatenateSummaryText(header, + paste0(paramCaption2, ": ", .getSummaryHeaderEntryValueAnalysisResults( + shortcut2, paramValue2, analysisResults + )), + sep = ifelse(case1, paste0(sepPrefix, " and "), " ") + ) + } + } + return(header) +} + +.addEnrichmentEffectListToHeader <- function(header, designPlan) { + if (!grepl("SimulationResultsEnrichment", .getClassName(designPlan)) || + is.null(designPlan[["effectList"]])) { + return(header) + } + + + subGroups <- designPlan$effectList$subGroups + header <- .concatenateSummaryText(header, paste0( + "subgroup", + ifelse(length(subGroups) != 1, "s", ""), + " = ", + .arrayToString(subGroups, vectorLookAndFeelEnabled = TRUE) + )) + + prevalences <- designPlan$effectList$prevalences + header <- .concatenateSummaryText(header, paste0( + "prevalence", + ifelse(length(prevalences) != 1, "s", ""), + " = ", + .arrayToString(round(prevalences, 3), vectorLookAndFeelEnabled = TRUE) + )) + + if (!is.null(designPlan$effectList[["piControls"]])) { + piControls <- designPlan$effectList$piControls + if (length(piControls) > 0) { + if (length(unique(piControls)) == 1) { + piControls <- piControls[1] + } + controlRateText <- paste0( + "control rate", ifelse(length(piControls) == 1, "", "s"), " pi(control) = ", + .arrayToString(round(piControls, 3), vectorLookAndFeelEnabled = (length(unique(piControls)) > 1)) + ) + header <- .concatenateSummaryText(header, controlRateText) + } + } + + return(header) +} + +.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" + } else { + designType <- C_TYPE_OF_DESIGN_LIST[[design$typeOfDesign]] + } + header <- .firstCharacterToUpperCase(designType) + header <- paste0(header, " design") + if (design$.isDelayedResponseDesign()) { + header <- paste0(header, " with delayed response") + } + if (design$kMax > 1 && .isTrialDesignInverseNormalOrGroupSequential(design)) { + if (design$typeOfDesign == C_TYPE_OF_DESIGN_WT) { + header <- .concatenateSummaryText(header, + paste0("(deltaWT = ", round(design$deltaWT, 3), ")"), + sep = " " + ) + } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_WT_OPTIMUM) { + header <- .concatenateSummaryText(header, + paste0("(", design$optimizationCriterion, ", deltaWT = ", round(design$deltaWT, 3), ")"), + sep = " " + ) + } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_PT) { + header <- .concatenateSummaryText(header, + paste0("(deltaPT1 = ", round(design$deltaPT1, 3), ""), + sep = " " + ) + header <- .concatenateSummaryText(header, + paste0("deltaPT0 = ", round(design$deltaPT0, 3), ")"), + sep = ", " + ) + } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_HP) { + header <- .concatenateSummaryText(header, + paste0("(constant bounds = ", round(design$constantBoundsHP, 3), ")"), + sep = " " + ) + } else if (design$typeOfDesign %in% c(C_TYPE_OF_DESIGN_AS_KD, C_TYPE_OF_DESIGN_AS_HSD)) { + header <- .concatenateSummaryText(header, + paste0("(gammaA = ", round(design$gammaA, 3), ")"), + sep = " " + ) + } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_AS_USER) { + header <- .concatenateSummaryText(header, + paste0("(", .arrayToString(round(design$userAlphaSpending, 3)), ")"), + sep = " " + ) + } + + if (grepl("^as", design$typeOfDesign) && design$typeBetaSpending != C_TYPE_OF_DESIGN_BS_NONE) { + typeBetaSpending <- C_TYPE_OF_DESIGN_BS_LIST[[design$typeBetaSpending]] + header <- .concatenateSummaryText(header, typeBetaSpending, sep = " and ") + if (design$typeBetaSpending %in% c(C_TYPE_OF_DESIGN_BS_KD, C_TYPE_OF_DESIGN_BS_HSD)) { + header <- .concatenateSummaryText(header, + paste0("(gammaB = ", round(design$gammaB, 3), ")"), + sep = " " + ) + } else if (design$typeBetaSpending == C_TYPE_OF_DESIGN_BS_USER) { + header <- .concatenateSummaryText(header, + paste0("(", .arrayToString(round(design$userBetaSpending, 3)), ")"), + sep = " " + ) + } + } + } + if (!.isDelayedInformationEnabled(design = design) && + ((.isTrialDesignInverseNormalOrGroupSequential(design) && any(design$futilityBounds > -6, na.rm = TRUE)) || + (.isTrialDesignFisher(design) && any(design$alpha0Vec < 1)))) { + header <- .concatenateSummaryText( + header, + 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 <- .concatenateSummaryText(header, "undefined endpoint") + + if (design$kMax > 1 && .isTrialDesignInverseNormalOrGroupSequential(design)) { + outputSize <- getOption("rpact.summary.output.size", C_SUMMARY_OUTPUT_SIZE_DEFAULT) + designCharacteristics <- NULL + tryCatch( + { + designCharacteristics <- getDesignCharacteristics(design) + }, + error = function(e) { + .logError("Cannot add design characteristics to summary: ", e$message) + } + ) + if (!is.null(designCharacteristics)) { + header <- .concatenateSummaryText( + header, + paste0("inflation factor ", round(designCharacteristics$inflationFactor, 4)) + ) + if (outputSize == "large") { + header <- .concatenateSummaryText( + header, + paste0("ASN H1 ", round(designCharacteristics$averageSampleNumber1, 4)) + ) + header <- .concatenateSummaryText( + header, + paste0("ASN H01 ", round(designCharacteristics$averageSampleNumber01, 4)) + ) + header <- .concatenateSummaryText( + header, + paste0("ASN H0 ", round(designCharacteristics$averageSampleNumber0, 4)) + ) + } + } + } + + header <- paste0(header, ".") + return(header) + } + + header <- "" + if (design$kMax == 1) { + 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 ", "") + header <- .concatenateSummaryText(header, + paste0("(", prefix, design$.toString(startWithUpperCase = FALSE), ")"), + 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 <- paste0(header, "\n") + + header <- paste0(header, "The ", ifelse(inherits(designPlan, "SimulationResults") || + designPlan$.isPowerObject(), "results were ", "sample size was ")) + header <- paste0(header, ifelse(inherits(designPlan, "SimulationResults"), "simulated", "calculated")) + header <- paste0(header, " for a ") + settings <- .getSummaryObjectSettings(designPlan) + if (settings$meansEnabled) { + if (settings$multiArmEnabled && settings$groups > 1) { + header <- .concatenateSummaryText(header, "multi-arm comparisons for means", sep = "") + } else if (settings$enrichmentEnabled && settings$populations > 1) { + header <- .concatenateSummaryText(header, "population enrichment comparisons for means", sep = "") + } else if (settings$groups == 1 && !settings$multiArmEnabled) { + header <- .concatenateSummaryText(header, "one-sample t-test", sep = "") + } else if (settings$groups == 2 || settings$multiArmEnabled) { + header <- .concatenateSummaryText(header, "two-sample t-test", sep = "") + } + } else if (settings$ratesEnabled) { + if (settings$multiArmEnabled && settings$groups > 1) { + header <- .concatenateSummaryText(header, "multi-arm comparisons for rates", sep = "") + } else if (settings$enrichmentEnabled && settings$populations > 1) { + header <- .concatenateSummaryText(header, "population enrichment comparisons for rates", sep = "") + } else if (settings$groups == 1 && !settings$multiArmEnabled) { + header <- .concatenateSummaryText(header, "one-sample test for rates", sep = "") + } else if (settings$groups == 2 || settings$multiArmEnabled) { + header <- .concatenateSummaryText(header, "two-sample test for rates", sep = "") + } + } else if (settings$survivalEnabled) { + if (settings$multiArmEnabled && settings$groups > 1) { + header <- .concatenateSummaryText(header, "multi-arm logrank test", sep = "") + } else if (settings$enrichmentEnabled && settings$populations > 1) { + header <- .concatenateSummaryText(header, "population enrichment logrank test", sep = "") + } else if (settings$groups == 2 || settings$multiArmEnabled) { + header <- .concatenateSummaryText(header, "two-sample logrank test", sep = "") + } + } + + part <- "" + if (settings$multiArmEnabled && settings$groups > 1) { + part <- .concatenateSummaryText(part, paste0(settings$groups, " treatments vs. control")) + } else if (settings$enrichmentEnabled) { + if (settings$groups == 2) { + part <- .concatenateSummaryText(part, "treatment vs. control") + } else if (settings$groups > 2) { + part <- .concatenateSummaryText(part, paste0(settings$groups, " treatments vs. control")) + } + part <- .concatenateSummaryText(part, paste0( + settings$populations, " population", + ifelse(settings$populations == 1, "", "s") + )) + } + if (!is.null(designPlan) && (.isTrialDesignPlan(designPlan) || inherits(designPlan, "SimulationResults")) && + !settings$multiArmEnabled && !settings$enrichmentEnabled && !settings$survivalEnabled) { + if (settings$ratesEnabled) { + if (settings$groups == 1) { + part <- .concatenateSummaryText(part, ifelse(designPlan$normalApproximation, + "normal approximation", "exact test" + )) + } else { + part <- .concatenateSummaryText(part, ifelse(designPlan$normalApproximation, + "normal approximation", "exact test of Fisher" + )) + } + } else if (designPlan$normalApproximation) { + part <- .concatenateSummaryText(part, "normal approximation") + } + } + if (part != "") { + header <- .concatenateSummaryText(header, paste0("(", part, ")"), sep = " ") + } + if (settings$meansEnabled && (.isTrialDesignInverseNormalOrGroupSequential(design) || + inherits(designPlan, "SimulationResults"))) { + header <- .concatenateSummaryText(header, .createSummaryHypothesisText(designPlan, summaryFactory)) + if (!is.null(designPlan[["alternative"]]) && length(designPlan$alternative) == 1) { + alternativeText <- paste0("H1: effect = ", round(designPlan$alternative, 3)) + } else if (!is.null(designPlan[["muMaxVector"]]) && length(designPlan$muMaxVector) == 1) { + alternativeText <- paste0("H1: mu_max = ", round(designPlan$muMaxVector, 3)) + } else if (!is.null(designPlan[["effectList"]]) && !is.null(designPlan$effectList[["effects"]]) && + isTRUE(nrow(designPlan$effectList$effects) == 1)) { + alternativeText <- paste0( + "H1: effects = ", + .arrayToString(designPlan$effectList$effects, mode = "vector") + ) + } else { + alternativeText <- "H1: effect as specified" + } + header <- .concatenateSummaryText(header, alternativeText) + + header <- .addEnrichmentEffectListToHeader(header, designPlan) + + if (grepl("SimulationResultsEnrichment", .getClassName(designPlan))) { + stDevs <- designPlan$effectList$stDevs + if (length(unique(stDevs)) == 1) { + stDevs <- unique(stDevs) + } + s <- ifelse(length(stDevs) != 1, "s", "") + stDevCaption <- ifelse(.isRatioComparisonEnabled(designPlan), + paste0("coefficient", s, " of variation"), + paste0("standard deviation", s) + ) + header <- .concatenateSummaryText(header, paste0( + stDevCaption, " = ", + .arrayToString(round(stDevs, 3), vectorLookAndFeelEnabled = TRUE) + )) + } else { + stDevCaption <- ifelse(.isRatioComparisonEnabled(designPlan), "coefficient of variation", "standard deviation") + header <- .concatenateSummaryText(header, paste0(stDevCaption, " = ", round(designPlan$stDev, 3))) + } + header <- .addAdditionalArgumentsToHeader(header, designPlan, settings) + } else if (settings$ratesEnabled && (.isTrialDesignInverseNormalOrGroupSequential(design) || + inherits(designPlan, "SimulationResults"))) { + if (settings$groups == 1) { + if (!is.null(designPlan[["pi1"]]) && length(designPlan$pi1) == 1) { + treatmentRateText <- paste0("H1: treatment rate pi = ", round(designPlan$pi1, 3)) + } else { + treatmentRateText <- "H1: treatment rate pi as specified" + } + + header <- paste0(header, ",\n", .createSummaryHypothesisText(designPlan, summaryFactory)) + header <- .concatenateSummaryText(header, treatmentRateText) + header <- .addAdditionalArgumentsToHeader(header, designPlan, settings) + } else { + if (!is.null(designPlan[["pi1"]]) && length(designPlan$pi1) == 1) { + treatmentRateText <- paste0("H1: treatment rate pi(1) = ", round(designPlan$pi1, 3)) + } else if (!is.null(designPlan[["piMaxVector"]]) && length(designPlan$piMaxVector) == 1) { + treatmentRateText <- paste0( + "H1: treatment rate pi_max = ", + .arrayToString(round(designPlan$piMaxVector, 3), vectorLookAndFeelEnabled = TRUE) + ) + } else if (settings$enrichmentEnabled && !is.null(designPlan[["effectList"]]) && + !is.null(designPlan$effectList[["piTreatments"]])) { + piTreatments <- designPlan$effectList[["piTreatments"]] + if (is.matrix(piTreatments) && nrow(piTreatments) == 1) { + treatmentRateText <- paste0( + "H1: assumed treatment rate pi(treatment) = ", + .arrayToString(round(designPlan$effectList$piTreatments, 3), vectorLookAndFeelEnabled = TRUE) + ) + } else { + treatmentRateText <- paste0("H1: assumed treatment rate pi(treatment) as specified") + } + } else { + treatmentRateText <- paste0( + "H1: treatment rate pi", + ifelse(settings$multiArmEnabled, "_max", "(1)"), " as specified" + ) + } + + controlRateText <- NA_character_ + if (settings$multiArmEnabled && !is.null(designPlan[["piControl"]])) { + controlRateText <- paste0("control rate pi(control) = ", round(designPlan$piControl, 3)) + } else if (settings$enrichmentEnabled && !is.null(designPlan[["piControls"]])) { + controlRateText <- paste0( + "control rates pi(control) = ", + .arrayToString(round(designPlan$piControls, 3), vectorLookAndFeelEnabled = TRUE) + ) + } else if (settings$enrichmentEnabled && !is.null(designPlan[["effectList"]]) && + !is.null(designPlan$effectList[["piControls"]])) { + # controlRateText will be created in .addEnrichmentEffectListToHeader() + } else if (!is.null(designPlan[["pi2"]])) { + controlRateText <- paste0("control rate pi(2) = ", round(designPlan$pi2, 3)) + } else { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to identify case to build ", sQuote("controlRateText")) + } + header <- paste0(header, ",\n", .createSummaryHypothesisText(designPlan, summaryFactory)) + header <- .concatenateSummaryText(header, treatmentRateText) + if (!is.na(controlRateText)) { + header <- .concatenateSummaryText(header, controlRateText) + } + header <- .addEnrichmentEffectListToHeader(header, designPlan) + header <- .addAdditionalArgumentsToHeader(header, designPlan, settings) + } + } else if (settings$survivalEnabled && (.isTrialDesignInverseNormalOrGroupSequential(design) || + inherits(designPlan, "SimulationResults"))) { + parameterNames <- designPlan$.getVisibleFieldNamesOrdered() + numberOfVariants <- .getMultidimensionalNumberOfVariants(designPlan, parameterNames) + + if (grepl("SimulationResultsEnrichment", .getClassName(designPlan))) { + userDefinedParam <- "hazardRatios" + paramName <- "hazard ratios" + paramValue <- designPlan$effectList$hazardRatios + } else { + userDefinedParam <- "pi1" + for (param in c("pi1", "lambda1", "median1", "hazardRatio")) { + if (designPlan$.getParameterType(param) == C_PARAM_USER_DEFINED && + length(designPlan[[param]]) == numberOfVariants) { + userDefinedParam <- param + } + } + paramValue <- designPlan[[userDefinedParam]] + + if (is.null(paramValue) || length(paramValue) == 0 || all(is.na(paramValue))) { + userDefinedParam <- "hazardRatio" + } + paramName <- "treatment pi(1)" + if (userDefinedParam == "lambda1") { + paramName <- "treatment lambda(1)" + } else if (userDefinedParam == "median1") { + paramName <- "treatment median(1)" + } else if (userDefinedParam == "hazardRatio") { + paramName <- ifelse(grepl("SimulationResultsMultiArm", .getClassName(designPlan)), "omega_max", "hazard ratio") + } + } + + if (length(designPlan[[userDefinedParam]]) == 1) { + treatmentRateText <- paste0("H1: ", paramName, " = ", round(designPlan[[userDefinedParam]], 3)) + } else if (!is.null(designPlan[["omegaMaxVector"]]) && length(designPlan$omegaMaxVector) == 1) { + treatmentRateText <- paste0("H1: omega_max = ", round(designPlan$omegaMaxVector, 3)) + } else if (!is.null(designPlan[["hazardRatio"]]) && (length(designPlan$hazardRatio) == 1) || + (inherits(designPlan, "SimulationResults") && !is.null(designPlan[[".piecewiseSurvivalTime"]]) && + designPlan$.piecewiseSurvivalTime$piecewiseSurvivalEnabled)) { + treatmentRateText <- paste0( + "H1: hazard ratio = ", + .arrayToString(round(designPlan$hazardRatio, 3), vectorLookAndFeelEnabled = TRUE) + ) + } else if (settings$enrichmentEnabled && !is.null(designPlan[["effectList"]]) && + !is.null(designPlan$effectList[["hazardRatios"]]) && + is.matrix(designPlan$effectList$hazardRatios) && + nrow(designPlan$effectList$hazardRatios) == 1) { + treatmentRateText <- paste0( + "H1: hazard ratios = ", + .arrayToString(round(designPlan$effectList$hazardRatios, 3), vectorLookAndFeelEnabled = TRUE) + ) + } else { + treatmentRateText <- paste0("H1: ", paramName, " as specified") + } + if (userDefinedParam %in% c("hazardRatio", "pi1") && + (designPlan$.getParameterType("pi2") == C_PARAM_USER_DEFINED || + designPlan$.getParameterType("pi2") == C_PARAM_DEFAULT_VALUE) && + length(designPlan$pi2) == 1) { + treatmentRateText <- paste0(treatmentRateText, ", control pi(2) = ", round(designPlan$pi2, 3)) + } else if (userDefinedParam %in% c("hazardRatio", "lambda1") && + (designPlan$.getParameterType("lambda2") == C_PARAM_USER_DEFINED || + designPlan$.getParameterType("lambda2") == C_PARAM_DEFAULT_VALUE) && + length(designPlan$lambda2) == 1) { + treatmentRateText <- paste0(treatmentRateText, ", control lambda(2) = ", round(designPlan$lambda2, 3)) + } else if (userDefinedParam %in% c("hazardRatio", "median1") && + (designPlan$.getParameterType("median2") == C_PARAM_USER_DEFINED || + designPlan$.getParameterType("median2") == C_PARAM_GENERATED) && + length(designPlan$median2) == 1) { + treatmentRateText <- paste0(treatmentRateText, ", control median(2) = ", round(designPlan$median2, 3)) + } else if (!is.null(designPlan[[".piecewiseSurvivalTime"]]) && + designPlan$.piecewiseSurvivalTime$piecewiseSurvivalEnabled) { + treatmentRateText <- paste0(treatmentRateText, ", piecewise survival distribution") + treatmentRateText <- paste0( + treatmentRateText, ", \n", + "piecewise survival time = ", .arrayToString(round(designPlan$piecewiseSurvivalTime, 4), vectorLookAndFeelEnabled = TRUE), ", \n", + "control lambda(2) = ", .arrayToString(round(designPlan$lambda2, 4), vectorLookAndFeelEnabled = TRUE) + ) + } + header <- paste0(header, ", \n", .createSummaryHypothesisText(designPlan, summaryFactory)) + header <- .concatenateSummaryText(header, treatmentRateText) + 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(header, paste0("simulation runs = ", designPlan$maxNumberOfIterations)) + header <- .concatenateSummaryText(header, paste0("seed = ", designPlan$seed)) + } + header <- paste0(header, ".") + return(header) +} + +.addAdditionalArgumentsToHeader <- function(header, designPlan, settings) { + if (designPlan$.design$kMax > 1) { + if (settings$survivalEnabled) { + if (!is.null(designPlan[["plannedEvents"]])) { + header <- .concatenateSummaryText(header, paste0( + "planned cumulative events = ", + .arrayToString(designPlan$plannedEvents, + vectorLookAndFeelEnabled = (length(designPlan$plannedEvents) > 1) + ) + )) + } + } else { + if (!is.null(designPlan[["plannedSubjects"]])) { + header <- .concatenateSummaryText(header, paste0( + "planned cumulative sample size = ", + .arrayToString(designPlan$plannedSubjects, + vectorLookAndFeelEnabled = (length(designPlan$plannedSubjects) > 1) + ) + )) + } + } + + if (!is.null(designPlan[["maxNumberOfSubjects"]]) && + designPlan$.getParameterType("maxNumberOfSubjects") == C_PARAM_USER_DEFINED) { + header <- .concatenateSummaryText(header, paste0( + "maximum number of subjects = ", + ceiling(designPlan$maxNumberOfSubjects[1]) + )) + } + + if (settings$survivalEnabled) { + if (!is.null(designPlan[["maxNumberOfEvents"]]) && + designPlan$.getParameterType("maxNumberOfEvents") == C_PARAM_USER_DEFINED) { + header <- .concatenateSummaryText(header, paste0( + "maximum number of events = ", + ceiling(designPlan$maxNumberOfEvents[1]) + )) + } + } + } else { + if (settings$survivalEnabled) { + if (!is.null(designPlan[["plannedEvents"]])) { + header <- .concatenateSummaryText(header, paste0( + "planned events = ", + .arrayToString(designPlan$plannedEvents, + vectorLookAndFeelEnabled = (length(designPlan$plannedEvents) > 1) + ) + )) + } + } else { + if (!is.null(designPlan[["plannedSubjects"]])) { + header <- .concatenateSummaryText(header, paste0( + "planned sample size = ", + .arrayToString(designPlan$plannedSubjects, + vectorLookAndFeelEnabled = (length(designPlan$plannedSubjects) > 1) + ) + )) + } + } + + if (!is.null(designPlan[["maxNumberOfSubjects"]]) && + designPlan$.getParameterType("maxNumberOfSubjects") == C_PARAM_USER_DEFINED) { + header <- .concatenateSummaryText(header, paste0( + "number of subjects = ", + ceiling(designPlan$maxNumberOfSubjects[1]) + )) + } + + if (settings$survivalEnabled) { + if (!is.null(designPlan[["maxNumberOfEvents"]]) && + designPlan$.getParameterType("maxNumberOfEvents") == C_PARAM_USER_DEFINED) { + header <- .concatenateSummaryText(header, paste0( + "number of events = ", + designPlan$maxNumberOfEvents[1] + )) + } + } + } + + header <- .addAllocationRatioToHeader(designPlan, header) + + if (settings$survivalEnabled) { + if (!is.null(designPlan[["eventTime"]]) && !is.na(designPlan[["eventTime"]])) { + header <- .concatenateSummaryText(header, paste0( + "event time = ", + .arrayToString(designPlan$eventTime, + vectorLookAndFeelEnabled = (length(designPlan$eventTime) > 1) + ) + )) + } + if (!is.null(designPlan[["accrualTime"]])) { + header <- .concatenateSummaryText(header, paste0( + "accrual time = ", + .arrayToString(designPlan$accrualTime, + vectorLookAndFeelEnabled = (length(designPlan$accrualTime) > 1) + ) + )) + } + if (!is.null(designPlan[["accrualTime"]]) && + length(designPlan$accrualIntensity) == length(designPlan$accrualTime)) { + header <- .concatenateSummaryText(header, paste0( + "accrual intensity = ", + .arrayToString(designPlan$accrualIntensity, + digits = 1, + vectorLookAndFeelEnabled = (length(designPlan$accrualIntensity) > 1) + ) + )) + } + if (!is.null(designPlan[["dropoutTime"]])) { + if (designPlan$dropoutRate1 > 0 || designPlan$dropoutRate2 > 0) { + header <- .concatenateSummaryText(header, paste0( + "dropout rate(1) = ", + .arrayToString(designPlan$dropoutRate1, + vectorLookAndFeelEnabled = (length(designPlan$dropoutRate1) > 1) + ) + )) + header <- .concatenateSummaryText(header, paste0( + "dropout rate(2) = ", + .arrayToString(designPlan$dropoutRate2, + vectorLookAndFeelEnabled = (length(designPlan$dropoutRate2) > 1) + ) + )) + header <- .concatenateSummaryText(header, paste0( + "dropout time = ", + .arrayToString(designPlan$dropoutTime, + vectorLookAndFeelEnabled = (length(designPlan$dropoutTime) > 1) + ) + )) + } + } + } + + if (settings$multiArmEnabled && designPlan$activeArms > 1) { + header <- .addShapeToHeader(header, designPlan) + header <- .addSelectionToHeader(header, designPlan) + } + + if (settings$enrichmentEnabled && settings$populations > 1) { + header <- .addSelectionToHeader(header, designPlan) + } + + functionName <- ifelse(settings$survivalEnabled, "calcEventsFunction", "calcSubjectsFunction") + userDefinedFunction <- !is.null(designPlan[[functionName]]) && + designPlan$.getParameterType(functionName) == C_PARAM_USER_DEFINED + + if (userDefinedFunction || (!is.null(designPlan[["conditionalPower"]]) && !is.na(designPlan$conditionalPower))) { + if (userDefinedFunction) { + header <- .concatenateSummaryText( + header, + paste0("sample size reassessment: user defined '", functionName, "'") + ) + if ((!is.null(designPlan[["conditionalPower"]]) && !is.na(designPlan$conditionalPower))) { + header <- .concatenateSummaryText( + header, + paste0("conditional power = ", designPlan$conditionalPower) + ) + } + } else { + if ((!is.null(designPlan[["conditionalPower"]]) && !is.na(designPlan$conditionalPower))) { + header <- .concatenateSummaryText( + header, + paste0("sample size reassessment: conditional power = ", designPlan$conditionalPower) + ) + } + } + + paramName1 <- ifelse(settings$survivalEnabled, "minNumberOfEventsPerStage", "minNumberOfSubjectsPerStage") + paramName2 <- ifelse(settings$survivalEnabled, "maxNumberOfEventsPerStage", "maxNumberOfSubjectsPerStage") + paramCaption <- ifelse(settings$survivalEnabled, "events", "subjects") + if (!is.null(designPlan[[paramName1]])) { + header <- .concatenateSummaryText(header, paste0( + "minimum ", paramCaption, " per stage = ", + .arrayToString(designPlan[[paramName1]], + vectorLookAndFeelEnabled = (length(designPlan[[paramName1]]) > 1) + ) + )) + } + if (!is.null(designPlan[[paramName2]])) { + header <- .concatenateSummaryText(header, paste0( + "maximum ", paramCaption, " per stage = ", + .arrayToString(designPlan[[paramName2]], + vectorLookAndFeelEnabled = (length(designPlan[[paramName2]]) > 1) + ) + )) + } + + if (settings$meansEnabled) { + if (!is.na(designPlan$thetaH1)) { + header <- .concatenateSummaryText( + header, + paste0("theta H1 = ", round(designPlan$thetaH1, 3)) + ) + } + if (!is.na(designPlan$stDevH1)) { + header <- .concatenateSummaryText( + header, + paste0("standard deviation H1 = ", round(designPlan$stDevH1, 3)) + ) + } + } else if (settings$ratesEnabled) { + if (settings$multiArmEnabled || settings$enrichmentEnabled) { + if (settings$multiArmEnabled && !is.na(designPlan$piTreatmentsH1)) { + header <- .concatenateSummaryText( + header, + paste0("pi(treatment)H1 = ", round(designPlan$piTreatmentsH1, 3)) + ) + } else if (settings$enrichmentEnabled) { + piTreatmentH1 <- designPlan[["piTreatmentH1"]] + if (is.null(piTreatmentH1)) { + piTreatmentH1 <- designPlan[["piTreatmentsH1"]] + } + if (!is.null(piTreatmentH1) && !is.na(piTreatmentH1)) { + header <- .concatenateSummaryText( + header, + paste0("pi(treatment)H1 = ", round(piTreatmentH1, 3)) + ) + } + } + if (!is.na(designPlan$piControlH1)) { + header <- .concatenateSummaryText( + header, + paste0("pi(control)H1 = ", round(designPlan$piControlH1, 3)) + ) + } + } else { + if (!is.na(designPlan$pi1H1)) { + header <- .concatenateSummaryText( + header, + paste0("pi(treatment)H1 = ", round(designPlan$pi1H1, 3)) + ) + } + if (!is.na(designPlan$pi2H1)) { + header <- .concatenateSummaryText( + header, + paste0("pi(control)H1 = ", round(designPlan$pi2H1, 3)) + ) + } + } + } + + if (settings$survivalEnabled && !is.null(designPlan[["thetaH1"]]) && !is.na(designPlan$thetaH1)) { + header <- .concatenateSummaryText(header, paste0("thetaH1 = ", round(designPlan$thetaH1, 3))) + } + } + + return(header) +} + +.addShapeToHeader <- function(header, designPlan) { + header <- .concatenateSummaryText(header, paste0("effect shape = ", .formatCamelCase(designPlan$typeOfShape))) + if (designPlan$typeOfShape == "sigmoidEmax") { + header <- .concatenateSummaryText(header, paste0("slope = ", designPlan$slope)) + header <- .concatenateSummaryText(header, paste0("ED50 = ", designPlan$gED50)) + } + + return(header) +} + +.addSelectionToHeader <- function(header, designPlan) { + header <- .concatenateSummaryText(header, paste0("intersection test = ", designPlan$intersectionTest)) + + if (designPlan$.design$kMax > 1) { + typeOfSelectionText <- paste0("selection = ", .formatCamelCase(designPlan$typeOfSelection)) + if (designPlan$typeOfSelection == "rBest") { + typeOfSelectionText <- paste0(typeOfSelectionText, ", r = ", designPlan$rValue) + } else if (designPlan$typeOfSelection == "epsilon") { + typeOfSelectionText <- paste0(typeOfSelectionText, " rule, eps = ", designPlan$epsilonValue) + } + if (!is.null(designPlan$threshold) && length(designPlan$threshold) == 1 && designPlan$threshold > -Inf) { + typeOfSelectionText <- paste0(typeOfSelectionText, ", threshold = ", designPlan$threshold) + } + header <- .concatenateSummaryText(header, typeOfSelectionText) + + header <- .concatenateSummaryText( + header, + paste0("effect measure based on ", .formatCamelCase(designPlan$effectMeasure)) + ) + } + + header <- .concatenateSummaryText( + header, + paste0("success criterion: ", .formatCamelCase(designPlan$successCriterion)) + ) + + return(header) +} + +.createSummary <- function(object, digits = NA_integer_, output = c("all", "title", "overview", "body")) { + output <- match.arg(output) + if (inherits(object, "TrialDesignCharacteristics")) { + return(.createSummaryDesignPlan(object, digits = digits, output = output, showStageLevels = TRUE)) + } + + if (.isTrialDesign(object) || .isTrialDesignPlan(object) || inherits(object, "SimulationResults")) { + return(.createSummaryDesignPlan(object, digits = digits, output = output, showStageLevels = !.isTrialDesignPlan(object))) + } + + if (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) { + return(.createSummaryAnalysisResults(object, digits = digits, output = output)) + } + + if (inherits(object, "PerformanceScore")) { + return(.createSummaryPerformanceScore(object, digits = digits, output = output)) + } + + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "function 'summary' not implemented yet for class ", .getClassName(object)) +} + +.createSummaryPerformanceScore <- function(object, digits = NA_integer_, output = c("all", "title", "overview", "body")) { + .createSummaryDesignPlan(object$.simulationResults, + digits = digits, output = output, + showStageLevels = TRUE, performanceScore = object + ) +} + +.getSummaryParameterCaptionCriticalValues <- function(design) { + parameterCaption <- ifelse(.isTrialDesignFisher(design), + "Efficacy boundary (p product scale)", "Efficacy boundary (z-value scale)" + ) + parameterCaption <- ifelse(.isDelayedInformationEnabled(design = design), + "Upper bounds of continuation", parameterCaption + ) + return(parameterCaption) +} + +.getSummaryParameterCaptionFutilityBounds <- function(design) { + bindingInfo <- ifelse(design$bindingFutility, "binding", "non-binding") + parameterCaption <- ifelse(.isDelayedInformationEnabled(design = design), + paste0("Lower bounds of continuation (", bindingInfo, ")"), + paste0("Futility boundary (z-value scale)") + ) + return(parameterCaption) +} + +#' +#' Main function for creating a summary of an analysis result +#' +#' @noRd +#' +.createSummaryAnalysisResults <- function(object, digits = NA_integer_, output = c("all", "title", "overview", "body")) { + output <- match.arg(output) + if (!(inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6"))) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'object' must be a valid analysis result object (is class ", .getClassName(object), ")" + ) + } + + digitSettings <- .getSummaryDigits(digits) + digits <- digitSettings$digits + digitsSampleSize <- digitSettings$digitsSampleSize + digitsGeneral <- digitSettings$digitsGeneral + digitsProbabilities <- digitSettings$digitsProbabilities + + outputSize <- getOption("rpact.summary.output.size", C_SUMMARY_OUTPUT_SIZE_DEFAULT) + + intervalFormat <- getOption("rpact.summary.intervalFormat", "[%s; %s]") + .assertIsValidSummaryIntervalFormat(intervalFormat) + + multiArmEnabled <- .isMultiArmAnalysisResults(object) + enrichmentEnabled <- .isEnrichmentAnalysisResults(object) + multiHypothesesEnabled <- .isMultiHypothesesAnalysisResults(object) + + analysisResults <- object + design <- analysisResults$.design + stageResults <- analysisResults$.stageResults + dataInput <- analysisResults$.dataInput + closedTestResults <- NULL + conditionalPowerResults <- NULL + if (multiHypothesesEnabled) { + closedTestResults <- analysisResults$.closedTestResults + if (length(analysisResults$nPlanned) > 0 && !all(is.na(analysisResults$nPlanned))) { + conditionalPowerResults <- analysisResults$.conditionalPowerResults + } + } + + summaryFactory <- c() + if(is.R6(object)) { + summaryFactory <- SummaryFactoryR6$new(object = object, intervalFormat = intervalFormat, output = output) + } else { + summaryFactory <- SummaryFactory(object = object, intervalFormat = intervalFormat, output = output) + } + + .addDesignInformationToSummary(design, object, summaryFactory, output = output) + + if (!.isTrialDesignConditionalDunnett(design)) { + summaryFactory$addParameter(design, + parameterName = "criticalValues", + parameterCaption = .getSummaryParameterCaptionCriticalValues(design), + roundDigits = digitsProbabilities - ifelse(.isTrialDesignFisher(design) || digitsProbabilities <= 1, 0, 1), + smoothedZeroFormat = !.isTrialDesignFisher(design) + ) + } + + if (.isTrialDesignFisher(design)) { + if (any(design$alpha0Vec < 1)) { + summaryFactory$addParameter(design, + parameterName = "alpha0Vec", + parameterCaption = "Futility boundary (separate p-value scale)", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + } else if (!.isTrialDesignConditionalDunnett(design)) { + if (any(design$futilityBounds > -6)) { + summaryFactory$addParameter(design, + parameterName = "futilityBounds", + parameterCaption = .getSummaryParameterCaptionFutilityBounds(design), + roundDigits = ifelse(digitsProbabilities > 1, digitsProbabilities - 1, digitsProbabilities), + smoothedZeroFormat = TRUE + ) + } + } + + if (design$kMax > 1 && !.isTrialDesignConditionalDunnett(design)) { + summaryFactory$addParameter(design, + parameterName = "alphaSpent", + parameterCaption = "Cumulative alpha spent", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + + if (!.isTrialDesignConditionalDunnett(design)) { + summaryFactory$addParameter(design, + parameterName = "stageLevels", + parameterCaption = "Stage level", roundDigits = digitsProbabilities, + smoothedZeroFormat = TRUE + ) + } + + summaryFactory$addParameter(stageResults, + parameterName = "effectSizes", + parameterCaption = ifelse(stageResults$isDatasetRates() && dataInput$getNumberOfGroups() == 1, + "Cumulative treatment rate", "Cumulative effect size" + ), roundDigits = digitsGeneral + ) + + if (stageResults$isDatasetMeans()) { + parameterCaption <- ifelse(stageResults$isOneSampleDataset(), + "Cumulative standard deviation", "Cumulative (pooled) standard deviation" + ) + parameterName <- ifelse((inherits(stageResults, "StageResultsMultiArmMeans") || inherits(stageResults, "StageResultsMultiArmMeansR6")) && + !(inherits(stageResults, "StageResultsEnrichmentMeans") || inherits(stageResults, "StageResultsEnrichmentMeansR6")), + "overallPooledStDevs", "overallStDevs" + ) + summaryFactory$addParameter(stageResults, + parameterName = parameterName, + parameterCaption = parameterCaption, roundDigits = digitsGeneral, + enforceFirstCase = (parameterName == "overallPooledStDevs") + ) + } else if (stageResults$isDatasetRates()) { + if (outputSize != "small" && dataInput$getNumberOfGroups() > 1) { + treatmentRateParamName <- "overallPi1" + controlRateParamName <- "overallPi2" + if (.isEnrichmentStageResults(stageResults)) { + treatmentRateParamName <- "overallPisTreatment" + controlRateParamName <- "overallPisControl" + } else if (.isMultiArmStageResults(stageResults)) { + treatmentRateParamName <- "overallPiTreatments" + controlRateParamName <- "overallPiControl" + } + summaryFactory$addParameter(stageResults, + parameterName = treatmentRateParamName, + parameterCaption = "Cumulative treatment rate", roundDigits = digitsGeneral + ) + summaryFactory$addParameter(stageResults, + parameterName = controlRateParamName, + parameterCaption = "Cumulative control rate", roundDigits = digitsGeneral, enforceFirstCase = TRUE + ) + } + } + + if (.isTrialDesignGroupSequential(design)) { + summaryFactory$addParameter(stageResults, + parameterName = "overallTestStatistics", + parameterCaption = "Overall test statistic", + roundDigits = ifelse(digitsProbabilities > 1, digitsProbabilities - 1, digitsProbabilities), + smoothedZeroFormat = TRUE + ) + summaryFactory$addParameter(stageResults, + parameterName = ifelse(multiHypothesesEnabled, "separatePValues", "overallPValues"), + parameterCaption = "Overall p-value", roundDigits = digitsProbabilities + ) + } else { + summaryFactory$addParameter(stageResults, + parameterName = "testStatistics", + parameterCaption = "Stage-wise test statistic", + roundDigits = ifelse(digitsProbabilities > 1, digitsProbabilities - 1, digitsProbabilities), + smoothedZeroFormat = TRUE + ) + summaryFactory$addParameter(stageResults, + parameterName = ifelse(multiHypothesesEnabled, "separatePValues", "pValues"), + parameterCaption = "Stage-wise p-value", roundDigits = digitsProbabilities + ) + } + + if (!is.null(closedTestResults)) { + if (outputSize == "large") { + if (.isTrialDesignConditionalDunnett(design)) { + summaryFactory$addParameter(closedTestResults, + parameterName = "conditionalErrorRate", + parameterCaption = "Conditional error rate", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + summaryFactory$addParameter(closedTestResults, + parameterName = "secondStagePValues", + parameterCaption = "Second stage p-value", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } else { + summaryFactory$addParameter(closedTestResults, + parameterName = "adjustedStageWisePValues", + parameterCaption = "Adjusted stage-wise p-value", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + summaryFactory$addParameter(closedTestResults, + parameterName = "overallAdjustedTestStatistics", + parameterCaption = "Overall adjusted test statistic", + roundDigits = digitsProbabilities - ifelse(.isTrialDesignFisher(design) || digitsProbabilities <= 1, 0, 1), + smoothedZeroFormat = !.isTrialDesignFisher(design) + ) + } + } else if (outputSize == "medium") { + legendEntry <- list("(i, j, ...)" = "comparison of treatment arms 'i, j, ...' vs. control arm") + gMax <- stageResults$getGMax() + if (.isTrialDesignConditionalDunnett(design)) { + summaryFactory$addParameter(closedTestResults, + parameterName = "adjustedStageWisePValues", + values = closedTestResults$conditionalErrorRate[1, ], + parameterCaption = paste0( + "Conditional error rate (", + paste0(1:gMax, collapse = ", "), ")" + ), roundDigits = digitsProbabilities, + smoothedZeroFormat = TRUE, + legendEntry = legendEntry + ) + summaryFactory$addParameter(closedTestResults, + parameterName = "overallAdjustedTestStatistics", + values = closedTestResults$secondStagePValues[1, ], + parameterCaption = paste0( + "Second stage p-value (", + paste0(1:gMax, collapse = ", "), ")" + ), + roundDigits = digitsProbabilities + ifelse(.isTrialDesignFisher(design), 1, 0), + smoothedZeroFormat = !.isTrialDesignFisher(design), + legendEntry = legendEntry + ) + } else { + summaryFactory$addParameter(closedTestResults, + parameterName = "adjustedStageWisePValues", + values = closedTestResults$adjustedStageWisePValues[1, ], + parameterCaption = paste0( + "Adjusted stage-wise p-value (", + paste0(1:gMax, collapse = ", "), ")" + ), roundDigits = digitsProbabilities, + smoothedZeroFormat = TRUE, legendEntry = legendEntry + ) + summaryFactory$addParameter(closedTestResults, + parameterName = "overallAdjustedTestStatistics", + values = closedTestResults$overallAdjustedTestStatistics[1, ], + parameterCaption = paste0( + "Overall adjusted test statistic (", + paste0(1:gMax, collapse = ", "), ")" + ), + roundDigits = digitsProbabilities - ifelse(.isTrialDesignFisher(design) || digitsProbabilities <= 1, 0, 1), + smoothedZeroFormat = !.isTrialDesignFisher(design), + legendEntry = legendEntry + ) + } + } + } + + if (multiHypothesesEnabled) { + summaryFactory$addParameter(closedTestResults, + parameterName = "rejected", + parameterCaption = "Test action: reject", roundDigits = digitsGeneral + ) + } else { + if (.isTrialDesignFisher(design)) { + summaryFactory$addParameter(stageResults, + parameterName = "combFisher", + parameterCaption = "Fisher combination", roundDigits = 0 + ) + } else if (.isTrialDesignInverseNormal(design)) { + summaryFactory$addParameter(stageResults, + parameterName = "combInverseNormal", + parameterCaption = "Inverse normal combination", + roundDigits = ifelse(digitsProbabilities > 1, digitsProbabilities - 1, digitsProbabilities), + smoothedZeroFormat = TRUE + ) + } + summaryFactory$addParameter(analysisResults, + parameterName = "testActions", + parameterCaption = "Test action", roundDigits = digitsGeneral + ) + } + + if (design$kMax > 1 && !.isTrialDesignConditionalDunnett(design)) { + summaryFactory$addParameter(analysisResults, + parameterName = "conditionalRejectionProbabilities", + parameterCaption = "Conditional rejection probability", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + + if (design$kMax > 1) { + if (!is.null(conditionalPowerResults)) { + summaryFactory$addParameter(conditionalPowerResults, + parameterName = "nPlanned", + parameterCaption = "Planned sample size", roundDigits = -1 + ) + } else if (analysisResults$.getParameterType("nPlanned") != C_PARAM_NOT_APPLICABLE) { + summaryFactory$addParameter(analysisResults, + parameterName = "nPlanned", + parameterCaption = "Planned sample size", roundDigits = -1 + ) + } + } + + if (design$kMax > 1) { + if (!is.null(conditionalPowerResults)) { + summaryFactory$addParameter(conditionalPowerResults, + parameterName = "conditionalPower", + parameterCaption = "Conditional power", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } else if (!multiHypothesesEnabled && analysisResults$.getParameterType("nPlanned") != C_PARAM_NOT_APPLICABLE) { + parameterName <- "conditionalPower" + if (!is.null(analysisResults[["conditionalPowerSimulated"]]) && + length(analysisResults[["conditionalPowerSimulated"]]) > 0) { + parameterName <- "conditionalPowerSimulated" + } + summaryFactory$addParameter(analysisResults, + parameterName = parameterName, + parameterCaption = "Conditional power", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + } + + ciLevel <- round((1 - design$alpha * (3 - design$sided)) * 100, 2) + if (.isTrialDesignConditionalDunnett(design)) { + parameterCaptionRepeatedPValues <- "Overall p-value" + parameterCaptionRepeatedCI <- paste0(ciLevel, "% overall confidence interval") + } else { + parameterCaptionRepeatedPValues <- ifelse(design$kMax == 1, + ifelse(design$sided == 1, "One-sided p-value", "Two-sided p-value"), + "Repeated p-value" + ) + parameterCaptionRepeatedCI <- paste0( + ciLevel, "% ", + ifelse(design$kMax == 1, "confidence interval", "repeated confidence interval") + ) + } + + summaryFactory$addParameter(analysisResults, + parameterName = c("repeatedConfidenceIntervalLowerBounds", "repeatedConfidenceIntervalUpperBounds"), + parameterCaption = parameterCaptionRepeatedCI, + roundDigits = digitsGeneral + ) + + summaryFactory$addParameter(analysisResults, + parameterName = "repeatedPValues", + parameterCaption = parameterCaptionRepeatedPValues, + roundDigits = digitsProbabilities, formatRepeatedPValues = TRUE + ) + + if (!multiHypothesesEnabled && !is.null(analysisResults[["finalStage"]]) && !all(is.na(analysisResults$finalStage))) { + summaryFactory$addParameter(analysisResults, + parameterName = "finalPValues", + parameterCaption = "Final p-value", roundDigits = digitsProbabilities + ) + summaryFactory$addParameter(analysisResults, + parameterName = c("finalConfidenceIntervalLowerBounds", "finalConfidenceIntervalUpperBounds"), + parameterCaption = "Final confidence interval", roundDigits = digitsGeneral + ) + summaryFactory$addParameter(analysisResults, + parameterName = "medianUnbiasedEstimates", + parameterCaption = "Median unbiased estimate", roundDigits = digitsGeneral + ) + } + + return(summaryFactory) +} + +.getSummaryDigits <- function(digits = NA_integer_) { + if (is.na(digits)) { + digits <- as.integer(getOption("rpact.summary.digits", 3)) + } + .assertIsSingleInteger(digits, "digits", validateType = FALSE, naAllowed = TRUE) + .assertIsInClosedInterval(digits, "digits", lower = -1, upper = 12, naAllowed = TRUE) + + digitsSampleSize <- 1 + if (digits > 0) { + digitsGeneral <- digits + digitsProbabilities <- NA_integer_ + tryCatch( + { + digitsProbabilities <- as.integer(getOption("rpact.summary.digits.probs", digits + 1)) + }, + warning = function(e) { + } + ) + if (is.na(digitsProbabilities)) { + digitsProbabilities <- digits + 1 + } + .assertIsSingleInteger(digitsProbabilities, "digitsProbabilities", validateType = FALSE, naAllowed = FALSE) + .assertIsInClosedInterval(digitsProbabilities, "digitsProbabilities", lower = -1, upper = 12, naAllowed = FALSE) + } else { + digitsSampleSize <- digits + digitsGeneral <- digits + digitsProbabilities <- digits + } + return(list( + digits = digits, + digitsSampleSize = digitsSampleSize, + digitsGeneral = digitsGeneral, + digitsProbabilities = digitsProbabilities + )) +} + +.getSummaryValuesInPercent <- function(values, percentFormatEnabled = TRUE, digits = 1) { + if (!percentFormatEnabled) { + return(as.character(round(values, digits + 2))) + } + return(paste0(round(100 * values, digits), "%")) +} + +.addDesignInformationToSummary <- function(design, designPlan, summaryFactory, + output = c("all", "title", "overview", "body")) { + if (!(output %in% c("all", "overview"))) { + return(invisible(summaryFactory)) + } + + if (design$kMax == 1) { + summaryFactory$addItem("Stage", "Fixed") + return(invisible(summaryFactory)) + } + + summaryFactory$addItem("Stage", c(1:design$kMax)) + + if (.isTrialDesignConditionalDunnett(design)) { + summaryFactory$addItem( + "Fixed information at interim", + .getSummaryValuesInPercent(design$informationAtInterim, FALSE) + ) + return(invisible(summaryFactory)) + } + + informationRatesCaption <- ifelse(inherits(designPlan, "SimulationResults") || + (inherits(designPlan, "AnalysisResults") || inherits(designPlan, "AnalysisResultsR6")), "Fixed weight", "Information") + + if (inherits(designPlan, "SimulationResults") || (inherits(designPlan, "AnalysisResults") || inherits(designPlan, "AnalysisResultsR6"))) { + if (.isTrialDesignFisher(design)) { + weights <- .getWeightsFisher(design) + } else if (.isTrialDesignInverseNormal(design)) { + weights <- .getWeightsInverseNormal(design) + } else { + weights <- design$informationRates + } + summaryFactory$addItem(informationRatesCaption, .getSummaryValuesInPercent(weights, FALSE)) + } else { + summaryFactory$addItem( + paste0( + informationRatesCaption, + ifelse(inherits(designPlan, "SimulationResults"), "", " rate") + ), + .getSummaryValuesInPercent(design$informationRates) + ) + } + if (design$.isDelayedResponseDesign()) { + summaryFactory$addItem("Delayed information", .getSummaryValuesInPercent(design$delayedInformation, TRUE)) + } + + return(invisible(summaryFactory)) +} + +.addDesignParameterToSummary <- function(design, designPlan, + designCharacteristics, summaryFactory, digitsGeneral, digitsProbabilities) { + if (design$kMax > 1 && !inherits(designPlan, "SimulationResults") && + !.isTrialDesignConditionalDunnett(design)) { + summaryFactory$addParameter(design, + parameterName = "alphaSpent", + parameterCaption = "Cumulative alpha spent", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + if (design$.getParameterType("betaSpent") == C_PARAM_GENERATED) { + summaryFactory$addParameter(design, + parameterName = "betaSpent", + parameterCaption = "Cumulative beta spent", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + } + + if (!is.null(designPlan)) { + if (!grepl("SimulationResults(MultiArm|Enrichment)", .getClassName(designPlan))) { + outputSize <- getOption("rpact.summary.output.size", C_SUMMARY_OUTPUT_SIZE_DEFAULT) + if (outputSize == "large" && inherits(designPlan, "SimulationResults")) { + summaryFactory$addParameter(designPlan, + parameterName = "conditionalPowerAchieved", + parameterCaption = "Conditional power (achieved)", + roundDigits = digitsProbabilities + ) + } + } + } else { + powerObject <- NULL + if (!is.null(designCharacteristics)) { + powerObject <- designCharacteristics + } else if (design$.getParameterType("power") == C_PARAM_GENERATED) { + powerObject <- design + } + if (!is.null(powerObject)) { + summaryFactory$addParameter(powerObject, + parameterName = "power", + parameterCaption = ifelse(design$kMax == 1, "Power", "Overall power"), + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + if (design$kMax > 1 && .isTrialDesignInverseNormalOrGroupSequential(design)) { + tryCatch( + { + designCharacteristics <- getDesignCharacteristics(design) + }, + error = function(e) { + designCharacteristics <- NULL + } + ) + if (!is.null(designCharacteristics) && + !any(is.na(designCharacteristics$futilityProbabilities)) && + any(designCharacteristics$futilityProbabilities > 0)) { + summaryFactory$addParameter(designCharacteristics, + parameterName = "futilityProbabilities", + parameterCaption = "Futility probabilities under H1", + roundDigits = digitsGeneral, smoothedZeroFormat = TRUE + ) + } + } + } + + if (design$.isDelayedResponseDesign()) { + summaryFactory$addParameter(design, + parameterName = "decisionCriticalValues", + parameterCaption = "Decision critical values", + roundDigits = digitsGeneral, + smoothedZeroFormat = TRUE + ) + + outputSize <- getOption("rpact.summary.output.size", C_SUMMARY_OUTPUT_SIZE_DEFAULT) + if (outputSize == "large") { + summaryFactory$addParameter(design, + parameterName = "reversalProbabilities", + parameterCaption = "Reversal probabilities", + roundDigits = digitsProbabilities, + smoothedZeroFormat = TRUE + ) + } + } + + if (.isTrialDesignConditionalDunnett(design)) { + summaryFactory$addParameter(design, + parameterName = "alpha", + parameterCaption = "Significance level", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } else if (!is.null(designPlan) && !inherits(designPlan, "SimulationResults")) { + summaryFactory$addParameter(design, + parameterName = "stageLevels", + twoSided = design$sided == 2, + parameterCaption = paste0(ifelse(design$sided == 2, "Two", "One"), "-sided local significance level"), + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + return(summaryFactory) +} + +#' +#' Main function for creating a summary of a design or design plan +#' +#' @noRd +#' +.createSummaryDesignPlan <- function(object, digits = NA_integer_, + output = c("all", "title", "overview", "body"), showStageLevels = FALSE, + performanceScore = NULL) { + output <- match.arg(output) + designPlan <- NULL + if (.isTrialDesignPlan(object) || inherits(object, "SimulationResults")) { + design <- object$.design + designPlan <- object + } else if (inherits(object, "TrialDesignCharacteristics")) { + design <- object$.design + # designPlan <- object + } else if (.isTrialDesign(object)) { + design <- object + } else { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'object' must be a valid design, design plan, ", + "or simulation result object (is class ", .getClassName(object), ")" + ) + } + + digitSettings <- .getSummaryDigits(digits) + digits <- digitSettings$digits + digitsSampleSize <- digitSettings$digitsSampleSize + digitsGeneral <- digitSettings$digitsGeneral + digitsProbabilities <- digitSettings$digitsProbabilities + + outputSize <- getOption("rpact.summary.output.size", C_SUMMARY_OUTPUT_SIZE_DEFAULT) + + intervalFormat <- getOption("rpact.summary.intervalFormat", "[%s; %s]") + .assertIsValidSummaryIntervalFormat(intervalFormat) + + summaryFactory <- c() + if(is.R6(object)) { + summaryFactory <- SummaryFactoryR6$new(object = object, intervalFormat = intervalFormat, output = output) + } else { + summaryFactory <- SummaryFactory(object = object, intervalFormat = intervalFormat, output = output) + } + + + if (output %in% c("all", "title", "overview")) { + .addDesignInformationToSummary(design, designPlan, summaryFactory, output = output) + } + + if (!(output %in% c("all", "body"))) { + return(summaryFactory) + } + + if (!.isTrialDesignConditionalDunnett(design)) { + summaryFactory$addParameter(design, + parameterName = "criticalValues", + parameterCaption = .getSummaryParameterCaptionCriticalValues(design), + roundDigits = digitsGeneral + ) + + if (showStageLevels) { + summaryFactory$addParameter(design, + parameterName = "stageLevels", + parameterCaption = "Stage levels (one-sided)", + roundDigits = digitsProbabilities, + smoothedZeroFormat = TRUE + ) + } + } + + if (.isTrialDesignFisher(design)) { + if (any(design$alpha0Vec < 1)) { + summaryFactory$addParameter(design, + parameterName = "alpha0Vec", + parameterCaption = "Futility boundary (separate p-value scale)", + roundDigits = digitsGeneral + ) + } + } else if (!.isTrialDesignConditionalDunnett(design)) { + if (any(design$futilityBounds > C_FUTILITY_BOUNDS_DEFAULT, na.rm = TRUE)) { + summaryFactory$addParameter(design, + parameterName = "futilityBounds", + parameterCaption = .getSummaryParameterCaptionFutilityBounds(design), + roundDigits = digitsGeneral + ) + } + } + + designCharacteristics <- NULL + if (design$kMax > 1 && .isTrialDesignInverseNormalOrGroupSequential(design)) { + tryCatch( + { + designCharacteristics <- getDesignCharacteristics(design) + }, + error = function(e) { + designCharacteristics <- NULL + } + ) + } + + if (is.null(designPlan)) { + return(.addDesignParameterToSummary( + design, + designPlan, + designCharacteristics, + summaryFactory, + digitsGeneral, + digitsProbabilities + )) + } + + simulationEnabled <- grepl("SimulationResults", .getClassName(designPlan)) + multiArmEnabled <- grepl("MultiArm", .getClassName(designPlan)) + enrichmentEnabled <- grepl("Enrichment", .getClassName(designPlan)) + baseEnabled <- grepl("(TrialDesignPlan|SimulationResults)(Means|Rates|Survival)", .getClassName(designPlan)) + planningEnabled <- .isTrialDesignPlan(designPlan) + simulationEnabled <- .isSimulationResults(designPlan) + survivalEnabled <- grepl("Survival", .getClassName(designPlan)) + + probsH0 <- NULL + probsH1 <- NULL + if (design$kMax > 1) { + if (!is.null(designCharacteristics) && + .isTrialDesignInverseNormalOrGroupSequential(design) && + length(designCharacteristics$shift) == 1 && + !is.na(designCharacteristics$shift) && + designCharacteristics$shift >= 1) { + probsH0 <- getPowerAndAverageSampleNumber(design, theta = 0, nMax = designCharacteristics$shift) + probsH1 <- getPowerAndAverageSampleNumber(design, theta = 1, nMax = designCharacteristics$shift) + } + if (!is.null(designPlan[["rejectPerStage"]])) { + probsH1 <- list( + earlyStop = designPlan$rejectPerStage[1:(design$kMax - 1), ] + as.vector(designPlan$futilityPerStage), + rejectPerStage = designPlan$rejectPerStage, + futilityPerStage = designPlan$futilityPerStage + ) + numberOfVariants <- 1 + if ((inherits(designPlan, "ParameterSet") || inherits(designPlan, "ParameterSetR6"))) { + parameterNames <- designPlan$.getVisibleFieldNamesOrdered() + numberOfVariants <- .getMultidimensionalNumberOfVariants(designPlan, parameterNames) + } + if (numberOfVariants > 1 && is.matrix(probsH1$earlyStop) && ncol(probsH1$earlyStop) == 1) { + probsH1$earlyStop <- matrix(rep(probsH1$earlyStop, numberOfVariants), ncol = numberOfVariants) + probsH1$rejectPerStage <- matrix(rep(probsH1$rejectPerStage, numberOfVariants), ncol = numberOfVariants) + probsH1$futilityPerStage <- matrix(rep(probsH1$futilityPerStage, numberOfVariants), ncol = numberOfVariants) + } + } + } + + if (simulationEnabled && (multiArmEnabled || enrichmentEnabled)) { + # simulation multi-arm #1:rejectAtLeastOne per mu_max + summaryFactory$addParameter(designPlan, + parameterName = "rejectAtLeastOne", + parameterCaption = "Reject at least one", roundDigits = digitsProbabilities, + smoothedZeroFormat = TRUE, transpose = TRUE, + legendEntry = { + if (multiArmEnabled) list("(i)" = "treatment arm i") else list() + } + ) + + # simulation multi-arm #2: rejectedArmsPerStage + if (outputSize == "large" && multiArmEnabled) { + .addSimulationMultiArmArrayParameter(designPlan, + parameterName = "rejectedArmsPerStage", + parameterCaption = ifelse(design$kMax == 1, "Rejected arms", "Rejected arms per stage"), + summaryFactory, roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + # simulation enrichment #2: rejectedPopulationsPerStage + if (outputSize == "large" && enrichmentEnabled) { + .addSimulationArrayToSummary(designPlan, + parameterName = "rejectedPopulationsPerStage", + parameterCaption = ifelse(design$kMax == 1, "Rejected populations", "Rejected populations per stage"), + summaryFactory, digitsSampleSize = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + + # simulation multi-arm #3: successPerStage + summaryFactory$addParameter(designPlan, + parameterName = "successPerStage", + parameterCaption = "Success per stage", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE, transpose = TRUE + ) + + # simulation multi-arm #4: futilityPerStage + if (!planningEnabled && !baseEnabled && any(designPlan$futilityPerStage != 0)) { + summaryFactory$addParameter(designPlan, + parameterName = "futilityPerStage", + parameterCaption = "Exit probability for futility", # (under H1) + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE, transpose = TRUE + ) + } + + if (survivalEnabled) { + summaryFactory$addParameter(designPlan, + parameterName = "expectedNumberOfEvents", + parameterCaption = "Expected number of events", + roundDigits = digitsSampleSize, transpose = TRUE + ) + } else { + summaryFactory$addParameter(designPlan, + parameterName = "expectedNumberOfSubjects", + parameterCaption = "Expected number of subjects", + roundDigits = digitsSampleSize, transpose = TRUE + ) + } + + # simulation multi-arm #5: earlyStop per mu_max + if (outputSize %in% c("medium", "large")) { + summaryFactory$addParameter(designPlan, + parameterName = "earlyStop", + parameterCaption = "Overall exit probability", # (under H1) + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE, transpose = TRUE + ) + } + + # simulation multi-arm / enrichment #6: sampleSizes + if (outputSize %in% c("medium", "large")) { + if (survivalEnabled) { + if (enrichmentEnabled) { + parameterName <- "singleNumberOfEventsPerStage" + parameterCaption <- "Single number of events" + } else { + parameterName <- "eventsPerStage" + parameterCaption <- "Cumulative number of events" + } + } else { + parameterName <- "sampleSizes" + parameterCaption <- "Stagewise number of subjects" + } + .addSimulationArrayToSummary( + designPlan, + parameterName, + parameterCaption, + summaryFactory, + digitsSampleSize, + smoothedZeroFormat = TRUE + ) + } + + # simulation multi-arm #7: selectedArms + if (multiArmEnabled && outputSize %in% c("medium", "large")) { + .addSimulationMultiArmArrayParameter( + designPlan = designPlan, + parameterName = "selectedArms", + parameterCaption = "Selected arms", + summaryFactory = summaryFactory, + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + + # simulation enrichment #7: selectedPopulations + if (enrichmentEnabled && outputSize %in% c("medium", "large")) { + .addSimulationArrayToSummary( + designPlan = designPlan, + parameterName = "selectedPopulations", + parameterCaption = "Selected populations", + summaryFactory = summaryFactory, + digitsSampleSize = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + + # simulation multi-arm #8: numberOfActiveArms + if (multiArmEnabled && outputSize %in% c("medium", "large")) { + summaryFactory$addParameter(designPlan, + parameterName = "numberOfActiveArms", + parameterCaption = "Number of active arms", + roundDigits = digitsGeneral, transpose = TRUE + ) + } + + # simulation enrichment #8: numberOfPopulations + if (enrichmentEnabled && outputSize %in% c("medium", "large")) { + summaryFactory$addParameter(designPlan, + parameterName = "numberOfPopulations", + parameterCaption = "Number of populations", + roundDigits = digitsGeneral, transpose = TRUE + ) + } + + if (outputSize == "large") { + summaryFactory$addParameter(designPlan, + parameterName = "conditionalPowerAchieved", + parameterCaption = "Conditional power (achieved)", + roundDigits = digitsProbabilities, transpose = TRUE + ) + } + } + + if (baseEnabled) { + parameterName <- "rejectPerStage" + if (design$kMax == 1) { + parameterName <- "overallReject" + } + if (any(!is.na(designPlan[[parameterName]]))) { + summaryFactory$addParameter(designPlan, + parameterName = parameterName, + parameterCaption = ifelse(design$kMax == 1, "Power", "Overall power"), + roundDigits = digitsProbabilities, cumsumEnabled = TRUE, smoothedZeroFormat = TRUE + ) + } + + if (inherits(designPlan, "SimulationResults")) { + parameterName1 <- ifelse(survivalEnabled, "numberOfSubjects", "sampleSizes") + parameterName2 <- "eventsPerStage" + } else { + if (design$kMax == 1 && (designPlan$.isSampleSizeObject() || + .isTrialDesignPlanMeans(designPlan) || .isTrialDesignPlanRates(designPlan))) { + parameterName1 <- "nFixed" + parameterName2 <- "eventsFixed" + } else if (design$kMax == 1 && designPlan$.isPowerObject()) { + parameterName1 <- "expectedNumberOfSubjects" + parameterName2 <- "expectedNumberOfEvents" + } else { + parameterName1 <- "numberOfSubjects" + parameterName2 <- "eventsPerStage" + } + } + + if (design$kMax > 1) { + summaryFactory$addParameter(designPlan, + parameterName = ifelse(inherits(designPlan, "TrialDesignPlan") && designPlan$.isSampleSizeObject(), + "expectedNumberOfSubjectsH1", "expectedNumberOfSubjects" + ), + parameterCaption = "Expected number of subjects", + roundDigits = digitsSampleSize, transpose = TRUE + ) + } + + if (outputSize %in% c("medium", "large")) { + subjectsCaption <- ifelse(design$kMax > 1 && inherits(designPlan, "SimulationResults") && + !survivalEnabled, "Stagewise number of subjects", "Number of subjects") + summaryFactory$addParameter(designPlan, + parameterName = parameterName1, + parameterCaption = subjectsCaption, roundDigits = digitsSampleSize + ) + } + + 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 = parameterName2, + parameterCaption = ifelse(design$kMax == 1, + "Number of events", "Cumulative number of events" + ), + roundDigits = digitsSampleSize, cumsumEnabled = FALSE + ) + } + + if (outputSize == "large") { + summaryFactory$addParameter(designPlan, + parameterName = "analysisTime", + parameterCaption = "Analysis time", roundDigits = digitsSampleSize + ) + } + + summaryFactory$addParameter(designPlan, + parameterName = "studyDuration", + parameterCaption = "Expected study duration", + roundDigits = digitsSampleSize, smoothedZeroFormat = TRUE, transpose = TRUE + ) + } + } + + if (!is.null(designPlan[["allocationRatioPlanned"]]) && + length(unique(designPlan$allocationRatioPlanned)) > 1) { + summaryFactory$addParameter(designPlan, + parameterName = "allocationRatioPlanned", + parameterCaption = "Optimum allocation ratio", roundDigits = digitsGeneral + ) + } + + .addDesignParameterToSummary( + design, designPlan, designCharacteristics, + summaryFactory, digitsGeneral, digitsProbabilities + ) + + if (baseEnabled && !planningEnabled && !is.null(designPlan[["futilityPerStage"]]) && + !any(is.na(designPlan[["futilityPerStage"]])) && + any(designPlan$futilityPerStage != 0) && any(designPlan$futilityPerStage > 1e-08)) { + summaryFactory$addParameter(designPlan, + parameterName = "futilityPerStage", + parameterCaption = "Exit probability for futility", # (under H1) + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + + if (baseEnabled && simulationEnabled && design$kMax > 1) { + values <- NULL + if (!is.null(probsH1)) { + values <- probsH1$rejectPerStage + } + summaryFactory$addParameter(designPlan, + parameterName = "rejectPerStage", + values = values, + parameterCaption = "Exit probability for efficacy", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + + # sample size and power only + if (planningEnabled) { + legendEntry <- list("(t)" = "treatment effect scale") + + if (ncol(designPlan$criticalValuesEffectScale) > 0) { + summaryFactory$addParameter(designPlan, + parameterName = "criticalValuesEffectScale", + parameterCaption = ifelse(.isDelayedInformationEnabled(design = design), + "Upper bounds of continuation (t)", "Efficacy boundary (t)" + ), + roundDigits = digitsGeneral, legendEntry = legendEntry + ) + } else if (ncol(designPlan$criticalValuesEffectScaleUpper) > 0) { + summaryFactory$addParameter(designPlan, + parameterName = "criticalValuesEffectScaleLower", + parameterCaption = "Lower efficacy boundary (t)", + roundDigits = digitsGeneral, legendEntry = legendEntry + ) + summaryFactory$addParameter(designPlan, + parameterName = "criticalValuesEffectScaleUpper", + parameterCaption = "Upper efficacy boundary (t)", + roundDigits = digitsGeneral, legendEntry = legendEntry + ) + } + + if (ncol(designPlan$futilityBoundsEffectScale) > 0 && + !all(is.na(designPlan$futilityBoundsEffectScale))) { + summaryFactory$addParameter(designPlan, + parameterName = "futilityBoundsEffectScale", + parameterCaption = ifelse(.isDelayedInformationEnabled(design = design), + "Lower bounds of continuation (t)", "Futility boundary (t)" + ), + roundDigits = digitsGeneral, legendEntry = legendEntry + ) + } else if (ncol(designPlan$futilityBoundsEffectScaleUpper) > 0 && + (any(!is.na(designPlan$futilityBoundsEffectScaleLower)) || + any(!is.na(designPlan$futilityBoundsEffectScaleUpper)))) { + summaryFactory$addParameter(designPlan, + parameterName = "futilityBoundsEffectScaleLower", + parameterCaption = "Lower futility boundary (t)", + roundDigits = digitsGeneral, legendEntry = legendEntry + ) + summaryFactory$addParameter(designPlan, + parameterName = "futilityBoundsEffectScaleUpper", + parameterCaption = "Upper futility boundary (t)", + roundDigits = digitsGeneral, legendEntry = legendEntry + ) + } + + if (!is.null(probsH1) && !is.null(probsH0) && design$kMax > 1) { + probsH0$earlyStop <- matrix(probsH0$earlyStop[1:(design$kMax - 1), 1], ncol = 1) + probsH0$rejectPerStage <- matrix(probsH0$rejectPerStage[1:(design$kMax - 1), 1], ncol = 1) + + if (is.matrix(probsH1$rejectPerStage)) { + if (design$kMax > 1 && designPlan$.isSampleSizeObject()) { + probsH1$rejectPerStage <- probsH1$rejectPerStage[1:(design$kMax - 1), 1] + } else { + probsH1$rejectPerStage <- matrix(probsH1$rejectPerStage[1:(design$kMax - 1), ], + ncol = ncol(probsH1$rejectPerStage) + ) + } + } else { + probsH1$rejectPerStage <- probsH1$rejectPerStage[1:(design$kMax - 1)] + } + + if (any(design$futilityBounds > -6)) { + if (is.matrix(probsH1$earlyStop)) { + probsH1$earlyStop <- matrix(probsH1$earlyStop[1:(design$kMax - 1), ], + ncol = ncol(probsH1$earlyStop) + ) + } else { + probsH1$earlyStop <- probsH1$earlyStop[1:(design$kMax - 1)] + } + summaryFactory$addParameter(probsH0, + parameterName = "earlyStop", + parameterCaption = "Overall exit probability (under H0)", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + x <- designPlan + if (is.null(x)) { + x <- design + } + summaryFactory$addParameter(x, + parameterName = "earlyStop", + values = probsH1$earlyStop, + parameterCaption = "Overall exit probability (under H1)", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + summaryFactory$addParameter(probsH0, + parameterName = "rejectPerStage", + parameterCaption = "Exit probability for efficacy (under H0)", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + if (designPlan$.isPowerObject()) { + summaryFactory$addParameter(designPlan, + parameterName = "rejectPerStage", + values = probsH1$rejectPerStage, + parameterCaption = "Exit probability for efficacy (under H1)", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } else { + summaryFactory$addParameter(probsH1, + parameterName = "rejectPerStage", + parameterCaption = "Exit probability for efficacy (under H1)", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + + if (any(design$futilityBounds > -6)) { + summaryFactory$addParameter(probsH0, + parameterName = "futilityPerStage", + parameterCaption = "Exit probability for futility (under H0)", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + x <- designPlan + if (is.null(x)) { + x <- design + } + futilityPerStage <- probsH1$futilityPerStage + if (.isTrialDesignPlan(x) && x$.isSampleSizeObject() && ncol(futilityPerStage) > 1) { + futilityPerStage <- futilityPerStage[, 1] + } + summaryFactory$addParameter(x, + parameterName = "futilityPerStage", + values = futilityPerStage, + parameterCaption = "Exit probability for futility (under H1)", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + } + } + + if (!is.null(performanceScore)) { + print(performanceScore) + summaryFactory$addParameter(performanceScore, + parameterName = "performanceScore", + parameterCaption = "Performance score", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + + return(summaryFactory) +} + +.getSummaryVariedParameterNameEnrichment <- function(designPlan) { + if (grepl("Rates", .getClassName(designPlan))) { + return("piTreatments") + } + if (grepl("Survival", .getClassName(designPlan))) { + return("hazardRatios") + } + return("effects") +} + +.getSummaryGroup <- function(parameterCaption, + numberOfVariedParams, + variedParamNumber, + designPlan) { + if (numberOfVariedParams <= 1) { + return(list( + groupCaption = parameterCaption, + legendEntry = list() + )) + } + + enrichmentEnabled <- grepl("SimulationResultsEnrichment", .getClassName(designPlan)) + if (enrichmentEnabled) { + variedParameterName <- .getSummaryVariedParameterNameEnrichment(designPlan) + variedParameterValues <- designPlan$effectList[[variedParameterName]] + if (variedParameterName == "piTreatments") { + variedParameterCaption <- "pi(treatment)" + } else { + variedParameterCaption <- C_PARAMETER_NAMES[[variedParameterName]] + } + if (is.matrix(variedParameterValues) && ncol(variedParameterValues) == 1) { + variedParameterCaption <- sub("s$", "", variedParameterCaption) + } + } else { + variedParameterName <- .getVariedParameterSimulationMultiArm(designPlan) + variedParameterValues <- designPlan[[variedParameterName]] + variedParameterCaption <- C_PARAMETER_NAMES[[variedParameterName]] + } + + userDefinedEffectMatrix <- !enrichmentEnabled && + designPlan$.getParameterType("effectMatrix") == C_PARAM_USER_DEFINED + + if (userDefinedEffectMatrix) { + return(list( + groupCaption = paste0(parameterCaption, " [", variedParamNumber, "]"), + legendEntry = list("[j]" = "effect matrix row j (situation to consider)") + )) + } + if (is.matrix(variedParameterValues)) { + values <- variedParameterValues[variedParamNumber, ] + if (length(values) > 1) { + values <- .arrayToString(values, vectorLookAndFeelEnabled = TRUE) + } + } else { + values <- variedParameterValues[variedParamNumber] + } + if (is.numeric(values)) { + values <- round(values, 2) + } + return(list( + groupCaption = paste0( + parameterCaption, ", ", + tolower(variedParameterCaption), " = ", values + ), + legendEntry = list() + )) +} + +.getSummaryGroupCaption <- function(designPlan, parameterName, numberOfGroups, groupNumber) { + listItemPrefix <- getOption("rpact.summary.list.item.prefix", C_SUMMARY_LIST_ITEM_PREFIX_DEFAULT) + + if (grepl("Enrichment", .getClassName(designPlan))) { + categoryCaption <- .getCategoryCaptionEnrichment(designPlan, parameterName, groupNumber) + categoryCaption <- sub("^F$", "Full population F", categoryCaption) + categoryCaption <- sub("^R$", "Remaining population R", categoryCaption) + categoryCaption <- sub("^S", "Subset S", categoryCaption) + + return(paste0(listItemPrefix, categoryCaption)) + } + + treatmentCaption <- ifelse(numberOfGroups > 2, paste0("Treatment arm ", groupNumber), "Treatment arm") + + if (!grepl("Survival", .getClassName(designPlan)) || + (inherits(designPlan, "SimulationResultsMultiArmSurvival") && + parameterName == "singleNumberOfEventsPerStage")) { + return(ifelse(groupNumber == numberOfGroups, + paste0(listItemPrefix, "Control arm"), + paste0(listItemPrefix, treatmentCaption) + )) + } + + return(paste0(listItemPrefix, treatmentCaption, " vs. control")) +} + +.addSimulationArrayToSummary <- function(designPlan, + parameterName, parameterCaption, summaryFactory, + digitsSampleSize, smoothedZeroFormat = FALSE) { + arrayData <- designPlan[[parameterName]] + if (is.null(arrayData)) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, class(designPlan)[1], " does not contain the field ", sQuote(parameterName)) + } + + numberOfVariedParams <- dim(arrayData)[2] + numberOfGroups <- dim(arrayData)[3] + for (variedParamNumber in 1:numberOfVariedParams) { + summaryGroup <- .getSummaryGroup( + parameterCaption, + numberOfVariedParams, + variedParamNumber, + designPlan + ) + groupCaption <- summaryGroup$groupCaption + legendEntry <- summaryGroup$legendEntry + if (numberOfGroups > 1) { + summaryFactory$addItem(groupCaption, "", legendEntry = legendEntry) + } + + for (groupNumber in 1:numberOfGroups) { + dataPerGroupAndStage <- arrayData[, variedParamNumber, groupNumber] + if (numberOfGroups > 1) { + groupCaption <- .getSummaryGroupCaption( + designPlan, + parameterName, numberOfGroups, groupNumber + ) + } + summaryFactory$addParameter(designPlan, + parameterName = parameterName, + values = dataPerGroupAndStage, parameterCaption = groupCaption, + roundDigits = digitsSampleSize, + smoothedZeroFormat = smoothedZeroFormat, + enforceFirstCase = TRUE + ) + } + } +} + +.addSimulationMultiArmArrayParameter <- function(designPlan, parameterName, parameterCaption, + summaryFactory, roundDigits, smoothedZeroFormat = FALSE) { + arrayData <- designPlan[[parameterName]] + if (is.array(arrayData) && length(dim(arrayData)) == 3) { + totalNumberOfGroups <- dim(designPlan[[ifelse(grepl("Survival", .getClassName(designPlan)), + "eventsPerStage", "sampleSizes" + )]])[3] + + numberOfGroups <- dim(arrayData)[3] + if (parameterName == "selectedArms" && !grepl("Survival", .getClassName(designPlan))) { # remove control group + numberOfGroups <- numberOfGroups - 1 + } + numberOfVariedParams <- dim(arrayData)[2] + + for (variedParamNumber in 1:numberOfVariedParams) { + summaryGroup <- .getSummaryGroup( + parameterCaption, + numberOfVariedParams, + variedParamNumber, + designPlan + ) + groupCaption <- summaryGroup$groupCaption + legendEntry <- summaryGroup$legendEntry + if (numberOfGroups > 1) { + summaryFactory$addItem(groupCaption, "", legendEntry = legendEntry) + } + + for (groupNumber in 1:numberOfGroups) { + dataPerGroupAndStage <- arrayData[, variedParamNumber, groupNumber] + if (numberOfGroups > 1) { + groupCaption <- .getSummaryGroupCaption( + designPlan, + parameterName, totalNumberOfGroups, groupNumber + ) + } + summaryFactory$addParameter(designPlan, + parameterName = parameterName, + values = dataPerGroupAndStage, parameterCaption = groupCaption, + roundDigits = roundDigits, smoothedZeroFormat = smoothedZeroFormat, + enforceFirstCase = TRUE + ) + } + } + } else { + data <- designPlan[[parameterName]] + numberOfGroups <- ncol(data) + for (groupNumber in 1:numberOfGroups) { + dataPerGroupAndStage <- data[, groupNumber] + summaryFactory$addParameter(designPlan, + parameterName = parameterName, + values = dataPerGroupAndStage, + parameterCaption = ifelse(groupNumber == numberOfGroups, + paste0(parameterCaption, ", control"), + paste0(parameterCaption, ", treatment ", groupNumber) + ), + roundDigits = roundDigits, smoothedZeroFormat = smoothedZeroFormat + ) + } + } +} diff --git a/R/f_analysis_base_rates.R b/R/f_analysis_base_rates.R index 03adfbf3..b0b4f034 100644 --- a/R/f_analysis_base_rates.R +++ b/R/f_analysis_base_rates.R @@ -76,7 +76,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsInverseNormalR6$new(design = design, dataInput = dataInput) + results <- AnalysisResultsInverseNormalR6$new(design = design, dataInput = dataInput)#R6$new .getAnalysisResultsRatesAll( results = results, design = design, dataInput = dataInput, @@ -105,7 +105,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsGroupSequentialR6$new(design = design, dataInput = dataInput) + results <- AnalysisResultsGroupSequentialR6$new(design = design, dataInput = dataInput)#R6$new .getAnalysisResultsRatesAll( results = results, design = design, dataInput = dataInput, @@ -136,7 +136,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsFisherR6$new(design = design, dataInput = dataInput) + results <- AnalysisResultsFisherR6$new(design = design, dataInput = dataInput)#R6$new .setValueAndParameterType(results, "iterations", as.integer(iterations), C_ITERATIONS_DEFAULT) .setValueAndParameterType(results, "seed", seed, NA_real_) @@ -570,7 +570,7 @@ NULL direction <- ifelse(directionUpper, C_DIRECTION_UPPER, C_DIRECTION_LOWER) - stageResults <- StageResultsRatesR6$new( + stageResults <- StageResultsRatesR6$new(#R6$new design = design, dataInput = dataInput, stage = as.integer(stage), @@ -1102,7 +1102,7 @@ NULL pi2 <- .assertIsValidPi2(pi2, stageResults, stage) } - results <- ConditionalPowerResultsRatesR6$new( + results <- ConditionalPowerResultsRatesR6$new(#R6$new .stageResults = stageResults, .design = stageResults$.design, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, pi1 = pi1, pi2 = pi2 From 27843eeafb0ec59a37bb25d23c7075db802891ae Mon Sep 17 00:00:00 2001 From: Till Luca Jensen Date: Wed, 29 Nov 2023 14:37:24 +0100 Subject: [PATCH 06/28] added proper object handling --- R/class_summary_r6.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/class_summary_r6.R b/R/class_summary_r6.R index f365b2d4..5b58d9e1 100644 --- a/R/class_summary_r6.R +++ b/R/class_summary_r6.R @@ -2373,7 +2373,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", } } - summaryFactory <- c() + summaryFactory <- NULL if(is.R6(object)) { summaryFactory <- SummaryFactoryR6$new(object = object, intervalFormat = intervalFormat, output = output) } else { @@ -2907,7 +2907,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", intervalFormat <- getOption("rpact.summary.intervalFormat", "[%s; %s]") .assertIsValidSummaryIntervalFormat(intervalFormat) - summaryFactory <- c() + summaryFactory <- NULL if(is.R6(object)) { summaryFactory <- SummaryFactoryR6$new(object = object, intervalFormat = intervalFormat, output = output) } else { From 794394f662ae4a3464174308d78a015bd0a8b4d9 Mon Sep 17 00:00:00 2001 From: Till Luca Jensen Date: Wed, 24 Jan 2024 14:00:13 +0100 Subject: [PATCH 07/28] added R6 classes --- DESCRIPTION | 1 + R/class_analysis_dataset.R | 4 +- R/class_analysis_results.R | 12 +- R/class_analysis_results_r6.R | 6 +- R/class_analysis_stage_results.R | 188 +- R/class_analysis_stage_results_r6.R | 2 +- R/class_core_parameter_set.R | 490 ---- R/class_core_parameter_set_r6.R | 20 +- R/class_core_plot_settings.R | 39 - R/class_core_plot_settings_r6.R | 764 ++++++ R/class_design.R | 57 +- R/class_design_plan.R | 12 +- R/class_design_plan_r6.R | 2153 +++++++++++++++++ R/class_design_power_and_asn.R | 2 +- R/class_design_r6.R | 1251 ++++++++++ R/class_design_set.R | 14 +- R/class_design_set_r6.R | 983 ++++++++ R/class_event_probabilities.R | 8 +- R/class_performance_score.R | 4 +- R/class_simulation_results.R | 4 +- R/class_summary_r6.R | 10 +- R/class_time.R | 6 +- R/f_core_assertions.R | 16 +- R/f_core_constants.R | 8 +- R/f_core_plot.R | 28 +- R/f_core_utilities.R | 8 +- R/f_design_fisher_combination_test.R | 2 +- R/f_design_group_sequential.R | 9 +- R/f_design_sample_size_calculator.R | 9 +- R/f_design_utilities.R | 4 +- R/f_object_r_code.R | 20 +- load_source_files.R | 183 ++ tests/testthat/helper-f_core_assertions.R | 2 +- .../testthat/test-class_core_plot_settings.R | 10 +- 34 files changed, 5453 insertions(+), 876 deletions(-) create mode 100644 R/class_core_plot_settings_r6.R create mode 100644 R/class_design_plan_r6.R create mode 100644 R/class_design_r6.R create mode 100644 R/class_design_set_r6.R create mode 100644 load_source_files.R diff --git a/DESCRIPTION b/DESCRIPTION index b3cad51d..66fcb367 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -135,3 +135,4 @@ Collate: 'f_simulation_performance_score.R' 'parameter_descriptions.R' 'pkgname.R' + \ No newline at end of file diff --git a/R/class_analysis_dataset.R b/R/class_analysis_dataset.R index 827d24c4..ff706983 100644 --- a/R/class_analysis_dataset.R +++ b/R/class_analysis_dataset.R @@ -1364,7 +1364,7 @@ Dataset <- setRefClass("Dataset", contains = "ParameterSet", fields = list( .data = "data.frame", - .plotSettings = "PlotSettings", + .plotSettings = "ANY", .id = "integer", .description = "character", .floatingPointNumbersEnabled = "logical", @@ -1382,7 +1382,7 @@ Dataset <- setRefClass("Dataset", .floatingPointNumbersEnabled = floatingPointNumbersEnabled, .enrichmentEnabled = enrichmentEnabled, ... ) - .plotSettings <<- PlotSettings() + .plotSettings <<- PlotSettingsR6$new() .parameterNames <<- .getParameterNames(dataset = .self) .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS diff --git a/R/class_analysis_results.R b/R/class_analysis_results.R index c5e3e268..ee651680 100644 --- a/R/class_analysis_results.R +++ b/R/class_analysis_results.R @@ -47,7 +47,7 @@ ConditionalPowerResults <- setRefClass("ConditionalPowerResults", contains = "ParameterSet", fields = list( - .plotSettings = "PlotSettings", + .plotSettings = "ANY", .design = "TrialDesign", .stageResults = "StageResults", .plotData = "list", @@ -61,7 +61,7 @@ ConditionalPowerResults <- setRefClass("ConditionalPowerResults", initialize = function(...) { callSuper(...) - .plotSettings <<- PlotSettings() + .plotSettings <<- PlotSettingsR6$new() .parameterNames <<- C_PARAMETER_NAMES .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS @@ -515,7 +515,7 @@ ConditionalPowerResultsEnrichmentSurvival <- setRefClass("ConditionalPowerResult ClosedCombinationTestResults <- setRefClass("ClosedCombinationTestResults", contains = "ParameterSet", fields = list( - .plotSettings = "PlotSettings", + .plotSettings = "ANY", .design = "TrialDesign", .enrichment = "logical", intersectionTest = "character", @@ -532,7 +532,7 @@ ClosedCombinationTestResults <- setRefClass("ClosedCombinationTestResults", initialize = function(...) { callSuper(...) - .plotSettings <<- PlotSettings() + .plotSettings <<- PlotSettingsR6$new() .parameterNames <<- C_PARAMETER_NAMES .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS @@ -696,7 +696,7 @@ ClosedCombinationTestResults <- setRefClass("ClosedCombinationTestResults", AnalysisResults <- setRefClass("AnalysisResults", contains = "ParameterSet", fields = list( - .plotSettings = "PlotSettings", + .plotSettings = "ANY", .design = "TrialDesign", .dataInput = "Dataset", .stageResults = "StageResults", @@ -713,7 +713,7 @@ AnalysisResults <- setRefClass("AnalysisResults", initialize = function(design, dataInput, ...) { callSuper(.design = design, .dataInput = dataInput, ...) - .plotSettings <<- PlotSettings() + .plotSettings <<- PlotSettingsR6$new() .parameterNames <<- .getParameterNames(design = design, analysisResults = .self) .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS }, diff --git a/R/class_analysis_results_r6.R b/R/class_analysis_results_r6.R index cc93395c..244d5c1e 100644 --- a/R/class_analysis_results_r6.R +++ b/R/class_analysis_results_r6.R @@ -69,7 +69,7 @@ ConditionalPowerResultsR6 <- R6Class("ConditionalPowerResultsR6", super$initialize(...) - self$.plotSettings <- PlotSettings() + self$.plotSettings <- PlotSettingsR6$new() self$.parameterNames <- C_PARAMETER_NAMES self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS @@ -564,7 +564,7 @@ ClosedCombinationTestResultsR6 <- R6Class("ClosedCombinationTestResultsR6", super$initialize(...) - self$.plotSettings <- PlotSettings() + self$.plotSettings <- PlotSettingsR6$new() self$.parameterNames <- C_PARAMETER_NAMES self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS @@ -750,7 +750,7 @@ AnalysisResultsR6 <- R6Class("AnalysisResultsR6", super$initialize(...) - self$.plotSettings <- PlotSettings() + self$.plotSettings <- PlotSettingsR6$new() self$.parameterNames <- .getParameterNames(design = design, analysisResults = self) self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS }, diff --git a/R/class_analysis_stage_results.R b/R/class_analysis_stage_results.R index b8bfde8e..b9071261 100644 --- a/R/class_analysis_stage_results.R +++ b/R/class_analysis_stage_results.R @@ -65,7 +65,7 @@ StageResults <- setRefClass("StageResults", contains = "ParameterSet", fields = list( - .plotSettings = "PlotSettings", + .plotSettings = "ANY", .design = "TrialDesign", .dataInput = "Dataset", stage = "integer", @@ -84,7 +84,7 @@ StageResults <- setRefClass("StageResults", .design <<- design .dataInput <<- dataInput - .plotSettings <<- PlotSettings() + .plotSettings <<- PlotSettingsR6$new() if (!missing(design)) { stages <<- c(1:design$kMax) if (design$kMax == C_KMAX_DEFAULT) { @@ -1243,75 +1243,6 @@ as.data.frame.StageResults <- function(x, row.names = NULL, return(stageResults) } -.getTreatmentArmsToShow <- function(x, ...) { - dataInput <- x - if (!inherits(dataInput, "Dataset")) { - dataInput <- x[[".dataInput"]] - } - if (is.null(dataInput) || !inherits(dataInput, "Dataset")) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to get 'dataInput' from ", .getClassName(x)) - } - - numberOfTreatments <- dataInput$getNumberOfGroups() - if (numberOfTreatments > 1) { - validComparisons <- 1L:as.integer(numberOfTreatments - 1) - } else { - validComparisons <- 1L - } - - treatmentArmsToShow <- .getOptionalArgument("treatmentArms", ...) - if (!is.null(treatmentArmsToShow)) { - treatmentArmsToShow <- as.integer(na.omit(treatmentArmsToShow)) - } - if (is.null(treatmentArmsToShow) || length(treatmentArmsToShow) == 0 || - all(is.na(treatmentArmsToShow)) || !is.numeric(treatmentArmsToShow)) { - treatmentArmsToShow <- validComparisons - } else if (!all(treatmentArmsToShow %in% validComparisons)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'treatmentArms' (", - .arrayToString(treatmentArmsToShow), ") must be a vector ", - "containing one or more values of ", .arrayToString(validComparisons) - ) - } - treatmentArmsToShow <- sort(unique(treatmentArmsToShow)) - return(treatmentArmsToShow) -} - -.getPopulationsToShow <- function(x, ..., gMax) { - dataInput <- x - if (!inherits(dataInput, "Dataset")) { - dataInput <- x[[".dataInput"]] - } - if (is.null(dataInput) || !inherits(dataInput, "Dataset")) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to get 'dataInput' from ", .getClassName(x)) - } - - numberOfPopulations <- gMax - if (numberOfPopulations > 1) { - validComparisons <- 1L:as.integer(numberOfPopulations) - } else { - validComparisons <- 1L - } - - populationsToShow <- .getOptionalArgument("populations", ...) - - if (!is.null(populationsToShow)) { - populationsToShow <- as.integer(na.omit(populationsToShow)) - } - if (is.null(populationsToShow) || length(populationsToShow) == 0 || - all(is.na(populationsToShow)) || !is.numeric(populationsToShow)) { - populationsToShow <- validComparisons - } else if (!all(populationsToShow %in% validComparisons)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'populations' (", - .arrayToString(populationsToShow), ") must be a vector ", - "containing one or more values of ", .arrayToString(validComparisons) - ) - } - populationsToShow <- sort(unique(populationsToShow)) - return(populationsToShow) -} - #' #' @title #' Stage Results Plotting @@ -1567,117 +1498,4 @@ plot.StageResults <- function(x, y, ..., type = 1L, legendTitle = legendTitle, palette = palette, legendPosition = legendPosition, numberOfPairedLines = 2L, plotSettings = plotSettings )) -} - -.createAnalysisResultsPlotObject <- function(x, ..., data, plotData, - main = NA_character_, xlab = NA_character_, ylab = NA_character_, - legendTitle = NA_character_, palette = "Set1", legendPosition = NA_integer_, - numberOfPairedLines = NA_integer_, plotSettings = NULL) { - ciModeEnabled <- !is.null(data[["lower"]]) && !is.null(data[["upper"]]) - - if (!ciModeEnabled) { - p <- ggplot2::ggplot(data, ggplot2::aes( - x = .data[["xValues"]], y = .data[["yValues"]], - colour = factor(.data[["categories"]]), - linetype = factor(.data[["categories"]]) - )) - } else { - p <- ggplot2::ggplot(data, ggplot2::aes( - x = .data[["xValues"]], y = .data[["yValues"]], - colour = factor(.data[["categories"]]) - )) - } - - if (is.null(plotSettings)) { - plotSettings <- x$getPlotSettings() - } - - p <- plotSettings$setTheme(p) - p <- plotSettings$hideGridLines(p) - - # set main title - mainTitle <- ifelse(!is.call(main) && !isS4(main) && is.na(main), plotData$main, main) - p <- plotSettings$setMainTitle(p, mainTitle, subtitle = plotData$sub) - - # set legend - if (is.na(legendPosition)) { - legendPosition <- C_POSITION_LEFT_TOP - } - p <- plotSettings$setLegendPosition(p, legendPosition = legendPosition) - p <- plotSettings$setLegendBorder(p) - p <- plotSettings$setLegendTitle(p, legendTitle) - p <- plotSettings$setLegendLabelSize(p) - - # set axes labels - p <- plotSettings$setAxesLabels(p, - xAxisLabel = plotData$xlab, yAxisLabel1 = plotData$ylab, - xlab = xlab, ylab = ylab - ) - - # plot lines and points - if (!ciModeEnabled) { - if (is.na(numberOfPairedLines)) { - numberOfPairedLines <- 2 - if (x$.isMultiArm()) { - numberOfPairedLines <- length(unique(data$treatmentArms)) - 1 - } else if (x$.isEnrichment()) { - numberOfPairedLines <- length(unique(data$populations)) - 1 - } - } - - p <- plotSettings$plotValues(p, plotPointsEnabled = FALSE, pointBorder = 1) - n <- length(unique(data$categories)) / numberOfPairedLines - if (n > 1) { - lineTypeValues <- rep(1:numberOfPairedLines, n) - colorTypes <- sort(rep(1:n, numberOfPairedLines)) - for (i in c(1, 3)) { - colorTypes[colorTypes >= i] <- colorTypes[colorTypes >= i] + 1 - } - p <- p + ggplot2::scale_color_manual(name = legendTitle, values = colorTypes) - p <- p + ggplot2::scale_linetype_manual(name = legendTitle, values = lineTypeValues) - } else { - colorValues <- c(2, 4) - if (!x$.isMultiArm()) { - colorValues <- c(2, 2) # use only one color - } - p <- p + ggplot2::scale_color_manual(name = legendTitle, values = colorValues) - p <- p + ggplot2::scale_linetype_manual(name = legendTitle, values = c(1, 2)) - } - } - - # plot confidence intervall - else { - pd <- ggplot2::position_dodge(0.15) - - p <- p + ggplot2::geom_errorbar( - data = data, - ggplot2::aes(ymin = .data[["lower"]], ymax = .data[["upper"]]), - width = 0.15, position = pd, size = 0.8 - ) - p <- p + ggplot2::geom_line(position = pd, linetype = "longdash") - p <- p + ggplot2::geom_point(position = pd, size = 2.0) - - - stage <- unique(data$xValues) - kMax <- list(...)[["kMax"]] - if (length(stage) == 1 && !is.null(kMax)) { - stages <- 1:kMax - p <- p + ggplot2::scale_x_continuous(breaks = stages) - } else if (length(stage) > 1 && all(stage %in% 1:10)) { - p <- p + ggplot2::scale_x_continuous(breaks = stage) - } - } - - p <- plotSettings$setAxesAppearance(p) - p <- plotSettings$enlargeAxisTicks(p) - - companyAnnotationEnabled <- .getOptionalArgument("companyAnnotationEnabled", ...) - if (is.null(companyAnnotationEnabled) || !is.logical(companyAnnotationEnabled)) { - companyAnnotationEnabled <- FALSE - } - - p <- plotSettings$addCompanyAnnotation(p, enabled = companyAnnotationEnabled) - - # start plot generation - return(p) -} +} \ No newline at end of file diff --git a/R/class_analysis_stage_results_r6.R b/R/class_analysis_stage_results_r6.R index 9a02df80..8edb30d0 100644 --- a/R/class_analysis_stage_results_r6.R +++ b/R/class_analysis_stage_results_r6.R @@ -90,7 +90,7 @@ StageResultsR6 <- R6Class("StageResultsR6", self$.design <- design self$.dataInput <- dataInput - self$.plotSettings <- PlotSettings() + self$.plotSettings <- PlotSettingsR6$new() if (!missing(design)) { self$stages <- c(1:design$kMax) if (design$kMax == C_KMAX_DEFAULT) { diff --git a/R/class_core_parameter_set.R b/R/class_core_parameter_set.R index 3f597f73..a83aa8db 100644 --- a/R/class_core_parameter_set.R +++ b/R/class_core_parameter_set.R @@ -905,479 +905,6 @@ ParameterSet <- setRefClass("ParameterSet", ) ) -.getMultidimensionalNumberOfVariants <- function(parameterSet, parameterNames) { - if (!is.null(parameterSet[["effectList"]])) { - effectMatrixName <- .getSimulationEnrichmentEffectMatrixName(parameterSet) - return(nrow(parameterSet$effectList[[effectMatrixName]])) - } - - parameterNames <- parameterNames[!(parameterNames %in% c( - "accrualTime", "accrualIntensity", - "plannedSubjects", "plannedEvents", - "minNumberOfSubjectsPerStage", "maxNumberOfSubjectsPerStage", - "minNumberOfEventsPerStage", "maxNumberOfEventsPerStage", - "piecewiseSurvivalTime", "lambda2", "adaptations", - "adjustedStageWisePValues", "overallAdjustedTestStatistics" - ))] - if (!is.null(parameterSet[[".piecewiseSurvivalTime"]]) && - parameterSet$.piecewiseSurvivalTime$piecewiseSurvivalEnabled) { - parameterNames <- parameterNames[!(parameterNames %in% c("lambda1"))] - } - - n <- 1 - for (parameterName in parameterNames) { - parameterValues <- parameterSet[[parameterName]] - if (!is.null(parameterValues) && (is.matrix(parameterValues) || !is.array(parameterValues))) { - if (is.matrix(parameterValues)) { - if (parameterSet$.isMultiHypothesesObject()) { - if (nrow(parameterValues) > n && ncol(parameterValues) > 0) { - n <- nrow(parameterValues) - } - } else if (nrow(parameterValues) > 0 && ncol(parameterValues) > n) { - n <- ncol(parameterValues) - } - } else if (length(parameterValues) > n && - !parameterSet$.isMultiHypothesesObject()) { - n <- length(parameterValues) - } - } - } - return(n) -} - -.getDataFrameColumnValues <- function(parameterSet, - parameterName, - numberOfVariants, - numberOfStages, - includeAllParameters, - mandatoryParameterNames) { - if (parameterSet$.getParameterType(parameterName) == C_PARAM_TYPE_UNKNOWN && - parameterName != "futilityStop") { - return(NULL) - } - - if (!includeAllParameters && - parameterSet$.getParameterType(parameterName) == C_PARAM_NOT_APPLICABLE && - !(parameterName %in% mandatoryParameterNames)) { - return(NULL) - } - - parameterValues <- parameterSet[[parameterName]] - if (is.null(parameterValues) || length(parameterValues) == 0) { - return(NULL) - } - - if (is.function(parameterValues)) { - return(NULL) - } - - if (is.array(parameterValues) && !is.matrix(parameterValues)) { - return(NULL) - } - - if (parameterName %in% c("adjustedStageWisePValues", "overallAdjustedTestStatistics")) { - return(NULL) - } - - if (!is.matrix(parameterValues)) { - if (length(parameterValues) == 1) { - return(rep(parameterValues, numberOfVariants * numberOfStages)) - } - - if (parameterSet$.isMultiHypothesesObject()) { - if (length(parameterValues) == numberOfStages) { - return(as.vector(sapply(FUN = rep, X = parameterValues, times = numberOfVariants))) - } - } - - if (length(parameterValues) == numberOfVariants) { - return(rep(parameterValues, numberOfStages)) - } - - if (length(parameterValues) == numberOfStages && - parameterName %in% c( - "plannedEvents", "plannedSubjects", - "minNumberOfEventsPerStage", "maxNumberOfEventsPerStage", - "minNumberOfSubjectsPerStage", "maxNumberOfSubjectsPerStage", - "allocationRatioPlanned" - )) { - values <- c() - for (stage in 1:numberOfStages) { - values <- c(values, rep(parameterValues[stage], numberOfVariants)) - } - return(values) - } - - if (parameterName %in% c( - "accrualTime", "accrualIntensity", - "plannedEvents", "plannedSubjects", - "minNumberOfEventsPerStage", "maxNumberOfEventsPerStage", - "minNumberOfSubjectsPerStage", "maxNumberOfSubjectsPerStage", - "piecewiseSurvivalTime", "lambda2" - )) { - return(NULL) - } - - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, - "parameter '", parameterName, "' has an invalid ", - "dimension (length is ", length(parameterValues), ")" - ) - } else if (parameterName == "effectMatrix") { - # return effect matrix row if 'effectMatrix' is user defined - if (parameterSet$.getParameterType("effectMatrix") == C_PARAM_USER_DEFINED) { - return(1:ncol(parameterValues)) - } - - return(parameterValues[nrow(parameterValues), ]) - } - - if (grepl("futility|alpha0Vec|earlyStop", parameterName) && - nrow(parameterValues) == numberOfStages - 1) { - parameterValues <- rbind(parameterValues, rep(NA_real_, ncol(parameterValues))) - } - - if (nrow(parameterValues) == numberOfStages && ncol(parameterValues) == 1) { - columnValues <- c() - for (parameterValue in parameterValues) { - columnValues <- c(columnValues, rep(parameterValue, numberOfVariants)) - } - return(columnValues) - } - - if (nrow(parameterValues) == numberOfStages && ncol(parameterValues) == numberOfVariants) { - columnValues <- c() - for (i in 1:nrow(parameterValues)) { - for (j in 1:ncol(parameterValues)) { - columnValues <- c(columnValues, parameterValues[i, j]) - } - } - return(columnValues) - } - - # applicable for analysis enrichment - if (parameterSet$.isMultiHypothesesObject()) { - if (nrow(parameterValues) %in% c(1, numberOfVariants) && - ncol(parameterValues) %in% c(1, numberOfStages)) { - columnValues <- c() - for (j in 1:ncol(parameterValues)) { - for (i in 1:nrow(parameterValues)) { - columnValues <- c(columnValues, parameterValues[i, j]) - } - } - if (nrow(parameterValues) == 1) { - columnValues <- as.vector(sapply(FUN = rep, X = columnValues, times = numberOfVariants)) - } - if (ncol(parameterValues) == 1) { - columnValues <- rep(columnValues, numberOfStages) - } - return(columnValues) - } - } - - if (nrow(parameterValues) == 1 && ncol(parameterValues) == 1) { - return(rep(parameterValues[1, 1], numberOfStages * numberOfVariants)) - } - - if (nrow(parameterValues) == 1 && ncol(parameterValues) == numberOfVariants) { - return(rep(parameterValues[1, ], numberOfStages)) - } - - if (nrow(parameterValues) == numberOfStages && ncol(parameterValues) == 1) { - return(rep(parameterValues[, 1], numberOfVariants)) - } - - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, - "parameter '", parameterName, "' has an invalid ", - "dimension (", nrow(parameterValues), " x ", ncol(parameterValues), "); ", - "expected was (", numberOfStages, " x ", numberOfVariants, ")" - ) -} - -.getAsDataFrameMultidimensional <- function(parameterSet, - parameterNames, - niceColumnNamesEnabled, - includeAllParameters, - returnParametersAsCharacter, - tableColumnNames, - mandatoryParameterNames) { - numberOfVariants <- .getMultidimensionalNumberOfVariants(parameterSet, parameterNames) - numberOfStages <- parameterSet$.getMultidimensionalNumberOfStages(parameterNames) - - stagesCaption <- parameterSet$.getDataFrameColumnCaption( - "stages", - tableColumnNames, niceColumnNamesEnabled - ) - - dataFrame <- data.frame( - stages = sort(rep(1:numberOfStages, numberOfVariants)) - ) - names(dataFrame) <- stagesCaption - - if (parameterSet$.isEnrichmentObject()) { - populations <- character(0) - for (i in 1:numberOfVariants) { - populations <- c(populations, ifelse(i == numberOfVariants, "F", paste0("S", i))) - } - dataFrame$populations <- rep(populations, numberOfStages) - populationsCaption <- parameterSet$.getDataFrameColumnCaption( - "populations", - tableColumnNames, niceColumnNamesEnabled - ) - names(dataFrame) <- c(stagesCaption, populationsCaption) - } - - variedParameter <- parameterSet$.getVariedParameter(parameterNames, numberOfVariants) - tryCatch( - { - if (!is.null(variedParameter) && variedParameter != "stages") { - variedParameterCaption <- parameterSet$.getDataFrameColumnCaption( - variedParameter, - tableColumnNames, niceColumnNamesEnabled - ) - dataFrame[[variedParameterCaption]] <- rep(parameterSet[[variedParameter]], numberOfStages) - } - }, - error = function(e) { - warning( - ".getAsDataFrameMultidimensional: ", - "failed to add 'variedParameterCaption' to data.frame; ", e$message - ) - } - ) - - usedParameterNames <- character(0) - for (parameterName in parameterNames) { - tryCatch( - { - if (!(parameterName %in% c("stages", "adaptations", "effectList")) && - !grepl("Function$", parameterName) && - (is.null(variedParameter) || parameterName != variedParameter)) { - columnValues <- .getDataFrameColumnValues( - parameterSet, parameterName, - numberOfVariants, numberOfStages, - includeAllParameters, mandatoryParameterNames - ) - if (!is.null(columnValues)) { - columnCaption <- parameterSet$.getDataFrameColumnCaption( - parameterName, - tableColumnNames, niceColumnNamesEnabled - ) - dataFrame[[columnCaption]] <- columnValues - if (returnParametersAsCharacter) { - parameterSet$.formatDataFrameParametersAsCharacter( - dataFrame, - parameterName, columnValues, columnCaption - ) - } - usedParameterNames <- c(usedParameterNames, parameterName) - } - } - - if (parameterName == "effectList") { - effectMatrixName <- .getSimulationEnrichmentEffectMatrixName(parameterSet) - effectMatrixNameSingular <- sub("s$", "", effectMatrixName) - effectMatrix <- parameterSet$effectList[[effectMatrixName]] - if (ncol(effectMatrix) == 1) { - dataFrame[[effectMatrixNameSingular]] <- rep(effectMatrix, numberOfStages) - } else { - for (j in 1:ncol(effectMatrix)) { - dataFrame[[paste0(effectMatrixNameSingular, j)]] <- rep(effectMatrix[, j], numberOfStages) - } - } - dataFrame$situation <- rep(1:nrow(effectMatrix), numberOfStages) - usedParameterNames <- c(usedParameterNames, parameterName) - } - }, - error = function(e) { - warning( - ".getAsDataFrameMultidimensional: failed to add parameter ", - sQuote(parameterName), " to data.frame; ", e$message - ) - } - ) - } - - if (includeAllParameters) { - extraParameterNames <- names(parameterSet) - extraParameterNames <- extraParameterNames[!grepl("^\\.", extraParameterNames)] - extraParameterNames <- extraParameterNames[!(extraParameterNames %in% parameterNames)] - extraParameterNames <- unique(c(parameterNames[!(parameterNames %in% usedParameterNames)], extraParameterNames)) - for (extraParameter in extraParameterNames) { - tryCatch( - { - if (parameterSet$.getParameterType(extraParameter) != C_PARAM_TYPE_UNKNOWN) { - value <- parameterSet[[extraParameter]] - if (!is.null(value) && length(value) > 0 && - !is.matrix(value) && !is.array(value) && !is.data.frame(value) && - (is.numeric(value) || is.character(value) || is.logical(value))) { - columnCaption <- parameterSet$.getDataFrameColumnCaption( - extraParameter, - tableColumnNames, niceColumnNamesEnabled - ) - - if (length(value) == 1) { - dataFrame[[columnCaption]] <- rep(value, nrow(dataFrame)) - } else { - dataFrame[[columnCaption]] <- rep(.arrayToString(value, maxLength = 10), nrow(dataFrame)) - } - } - } - }, - error = function(e) { - warning( - ".getAsDataFrameMultidimensional: failed to add extra parameter ", - sQuote(parameterName), " to data.frame; ", e$message - ) - } - ) - } - } - - return(dataFrame) -} - -.getAsDataFrameUnidimensional <- function(parameterSet, parameterNames, niceColumnNamesEnabled, - includeAllParameters, returnParametersAsCharacter, tableColumnNames) { - numberOfStages <- parameterSet$.getUnidimensionalNumberOfStages(parameterNames) - dataFrame <- NULL - for (parameterName in parameterNames) { - tryCatch( - { - parameterCaption <- ifelse(niceColumnNamesEnabled && - !is.null(tableColumnNames[[parameterName]]), - tableColumnNames[[parameterName]], parameterName - ) - parameterValues <- parameterSet[[parameterName]] - if (parameterName == "futilityBounds") { - parameterValues[parameterValues == C_FUTILITY_BOUNDS_DEFAULT] <- -Inf - } - if (length(parameterValues) == 1) { - parameterValues <- rep(parameterValues, numberOfStages) - } else { - while (length(parameterValues) < numberOfStages) { - parameterValues <- c(parameterValues, NA) - } - } - if (includeAllParameters || ( - parameterSet$.getParameterType(parameterName) != C_PARAM_NOT_APPLICABLE && - sum(is.na(parameterValues)) < length(parameterValues))) { - if (is.null(dataFrame)) { - dataFrame <- data.frame(x = parameterValues) - names(dataFrame) <- parameterCaption - } else { - dataFrame[[parameterCaption]] <- parameterValues - } - } - if (returnParametersAsCharacter) { - parameterSet$.formatDataFrameParametersAsCharacter( - dataFrame, - parameterName, parameterValues, parameterCaption - ) - } - }, - error = function(e) { - .logError("Failed to add parameter '%s' to data.frame: %s", parameterName, e) - } - ) - } - - return(dataFrame) -} - -.getAsDataFrame <- function(..., - parameterSet, - parameterNames, - niceColumnNamesEnabled = FALSE, - includeAllParameters = FALSE, - handleParameterNamesAsToBeExcluded = FALSE, - returnParametersAsCharacter = FALSE, - tableColumnNames = C_TABLE_COLUMN_NAMES, - mandatoryParameterNames = character(0)) { - parameterNamesToBeExcluded <- c() - if (handleParameterNamesAsToBeExcluded) { - parameterNamesToBeExcluded <- parameterNames - parameterNames <- parameterSet$.getVisibleFieldNamesOrdered() - if (!is.null(parameterNamesToBeExcluded) && length(parameterNamesToBeExcluded) > 0) { - parameterNames <- parameterNames[!(parameterNames %in% parameterNamesToBeExcluded)] - } - } else if (is.null(parameterNames)) { - parameterNames <- parameterSet$.getVisibleFieldNamesOrdered() - } - parameterNames <- parameterNames[!grepl("^\\.", parameterNames)] - - parametersToIgnore <- character(0) - if (!is.null(parameterSet[[".piecewiseSurvivalTime"]]) && - parameterSet$.piecewiseSurvivalTime$piecewiseSurvivalEnabled) { - parametersToIgnore <- c( - parametersToIgnore, - "lambda1", "lambda2", "median1", "median2", - "pi1", "pi2", "piecewiseSurvivalTime" - ) - parametersToIgnore <- intersect(parametersToIgnore, parameterNames) - } - - if (parameterSet$.getParameterType("hazardRatio") == C_PARAM_GENERATED && - !is.null(parameterSet[[".piecewiseSurvivalTime"]]) && - isTRUE(parameterSet$.piecewiseSurvivalTime$piecewiseSurvivalEnabled)) { - parametersToIgnore <- c(parametersToIgnore, "hazardRatio") - } - - if (!inherits(parameterSet, "AccrualTime")) { - accrualTime <- parameterSet[["accrualTime"]] - if (!is.null(accrualTime) && length(accrualTime) > 1) { - parametersToIgnore <- c(parametersToIgnore, c("accrualTime", "accrualIntensity")) - } - } - - if (length(parametersToIgnore) > 0) { - parameterNames <- parameterNames[!(parameterNames %in% parametersToIgnore)] - } - - if (parameterSet$.containsMultidimensionalParameters(parameterNames)) { - return(.addDelayedInformationRates(.getAsDataFrameMultidimensional( - parameterSet, parameterNames, niceColumnNamesEnabled, - includeAllParameters, returnParametersAsCharacter, tableColumnNames, - mandatoryParameterNames - ))) - } - - # remove matrices - for (parameterName in parameterNames) { - parameterValues <- parameterSet[[parameterName]] - if (is.matrix(parameterValues) && nrow(parameterValues) != 1 && ncol(parameterValues) != 1) { - parameterNames <- parameterNames[parameterNames != parameterName] - } - } - - if (length(parameterNames) == 0) { - return(data.frame()) - } - - return(.addDelayedInformationRates(.getAsDataFrameUnidimensional( - parameterSet, parameterNames, niceColumnNamesEnabled, - includeAllParameters, returnParametersAsCharacter, tableColumnNames - ))) -} - -.getCategoryCaptionEnrichment <- function(parameterSet, parameterName, categoryNumber) { - categoryCaption <- categoryNumber - if (parameterName %in% c("sampleSizes", "singleNumberOfEventsPerStage")) { - categoryCaption <- parameterSet$effectList$subGroups[categoryNumber] - maxNumberOfDigits <- max(nchar(sub("\\D*", "", parameterSet$effectList$subGroups))) - if (parameterSet$populations > 2 && grepl(paste0("^S\\d{1,", maxNumberOfDigits - 1, "}$"), categoryCaption)) { - categoryCaption <- paste0(categoryCaption, " only") - } - } else { - if (parameterSet$populations <= 2) { - categoryCaption <- ifelse(categoryNumber == parameterSet$populations, "F", "S") - } else { - categoryCaption <- ifelse(categoryNumber == parameterSet$populations, "F", paste0("S", categoryNumber)) - } - } - return(categoryCaption) -} #' #' @title @@ -1541,23 +1068,6 @@ as.matrix.FieldSet <- function(x, ..., enforceRowNames = TRUE, niceColumnNamesEn return(result) } -.setStagesAsFirstColumn <- function(data) { - columnNames <- colnames(data) - index <- grep("^(S|s)tages?$", columnNames) - if (length(index) == 0 || index == 1) { - return(data) - } - - stageName <- columnNames[index[1]] - stageNumbers <- data[, stageName] - if (is.null(stageNumbers) || length(stageNumbers) == 0) { - return(data) - } - - data <- data[, c(stageName, columnNames[columnNames != stageName])] - - return(data) -} #' #' @title diff --git a/R/class_core_parameter_set_r6.R b/R/class_core_parameter_set_r6.R index bb8b6158..89f7ab18 100644 --- a/R/class_core_parameter_set_r6.R +++ b/R/class_core_parameter_set_r6.R @@ -1441,13 +1441,13 @@ as.data.frame.ParameterSetR6 <- function(x, row.names = NULL, #' #' @export #' -setMethod( - "t", "FieldSet",#TODO - function(x) { - x <- as.matrix(x, niceColumnNamesEnabled = TRUE) - return(t(x)) - } -) +#setMethod( +# "t", "FieldSet",#TODO +# function(x) { +# x <- as.matrix(x, niceColumnNamesEnabled = TRUE) +# return(t(x)) +# } +#) #' #' @title @@ -1616,13 +1616,13 @@ as.matrix.FieldSetR6 <- function(x, ..., enforceRowNames = TRUE, niceColumnNames summary.ParameterSetR6 <- function(object, ..., type = 1, digits = NA_integer_, output = c("all", "title", "overview", "body")) { .warnInCaseOfUnknownArguments(functionName = "summary", ...) - if (type == 1 && inherits(object, "SummaryFactory")) { + if (type == 1 && (inherits(object, "SummaryFactory") || inherits(object, "SummaryFactoryR6"))) { return(object) } - if (type == 1 && (inherits(object, "TrialDesign") || inherits(object, "TrialDesignPlan") || + if (type == 1 && (inherits(object, "TrialDesign") || inherits(object, "TrialDesignR6") || inherits(object, "TrialDesignPlan") || inherits(object, "TrialDesignPlanR6") || inherits(object, "SimulationResults") || (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) || - inherits(object, "TrialDesignCharacteristics") || + inherits(object, "TrialDesignCharacteristics") || inherits(object, "TrialDesignCharacteristicsR6") || inherits(object, "PerformanceScore"))) { output <- match.arg(output) return(.createSummary(object, digits = digits, output = output)) diff --git a/R/class_core_plot_settings.R b/R/class_core_plot_settings.R index 0a2f757c..8772948f 100644 --- a/R/class_core_plot_settings.R +++ b/R/class_core_plot_settings.R @@ -223,45 +223,6 @@ PlotSubTitleItems <- setRefClass("PlotSubTitleItems", ) ) -#' -#' @title -#' Get Plot Settings -#' -#' @description -#' Returns a plot settings object. -#' -#' @param lineSize The line size, default is \code{0.8}. -#' @param pointSize The point size, default is \code{3}. -#' @param pointColor The point color (character), default is \code{NA_character_}. -#' @param mainTitleFontSize The main title font size, default is \code{14}. -#' @param axesTextFontSize The axes text font size, default is \code{10}. -#' @param legendFontSize The legend font size, default is \code{11}. -#' @param scalingFactor The scaling factor, default is \code{1}. -#' -#' @details -#' Returns an object of class \code{PlotSettings} that collects typical plot settings. -#' -#' @export -#' -#' @keywords internal -#' -getPlotSettings <- function(lineSize = 0.8, - pointSize = 3, - pointColor = NA_character_, - mainTitleFontSize = 14, - axesTextFontSize = 10, - legendFontSize = 11, - scalingFactor = 1) { - return(PlotSettings( - lineSize = lineSize, - pointSize = pointSize, - pointColor = pointColor, - mainTitleFontSize = mainTitleFontSize, - axesTextFontSize = axesTextFontSize, - legendFontSize = legendFontSize, - scalingFactor = scalingFactor - )) -} #' #' @name PlotSettings diff --git a/R/class_core_plot_settings_r6.R b/R/class_core_plot_settings_r6.R new file mode 100644 index 00000000..a4fdc5e1 --- /dev/null +++ b/R/class_core_plot_settings_r6.R @@ -0,0 +1,764 @@ +## | +## | *Plot setting classes* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | rpact package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File version: $Revision: 7126 $ +## | Last changed: $Date: 2023-06-23 14:26:39 +0200 (Fr, 23 Jun 2023) $ +## | Last changed by: $Author: pahlke $ +## | + +PlotSubTitleItemR6 <- R6Class("PlotSubTitleItemR6", + public = list( + title = NULL, + subscript = NULL, + value = NULL, + digits = NULL, + initialize = function(..., title, value, subscript = NA_character_, digits = 3L) { + #callSuper( + # title = trimws(title), value = value, + # subscript = trimws(subscript), digits = digits, ... + #)#TODO + + self$title <- trimws(title) + self$value <- value + self$subscript <- trimws(subscript) + self$digits <- digits + + self$value <- round(value, digits) + }, + show = function() { + cat(self$toString(), "\n") + }, + toQuote = function() { + if (!is.null(self$subscript) && length(self$subscript) == 1 && !is.na(self$subscript)) { + return(bquote(" " * .(self$title)[.(self$subscript)] == .(self$value))) + } + + return(bquote(" " * .(self$title) == .(self$value))) + }, + toString = function() { + if (!is.null(self$subscript) && length(self$subscript) == 1 && !is.na(self$subscript)) { + if (grepl("^(\\d+)|max|min$", self$subscript)) { + return(paste0(self$title, "_", self$subscript, " = ", self$value)) + } + return(paste0(self$title, "(", trimws(self$subscript), ") = ", self$value)) + } + + return(paste(self$title, "=", self$value)) + } + ) +) + +PlotSubTitleItemsR6 <- R6Class("PlotSubTitleItemsR6", + public = list( + title = NULL, + subtitle = NULL, + items = NULL, + initialize = function(..., title = NULL, subtitle = NULL) { + self$title <- title + self$subtitle <- subtitle + + self$items <- list() + }, + show = function() { + cat(self$title, "\n") + if (length(self$subtitle) == 1 && !is.na(self$subtitle)) { + cat(self$subtitle, "\n") + } + s <- self$toString() + if (length(s) == 1 && !is.na(s) && nchar(s) > 0) { + cat(s, "\n") + } + }, + addItem = function(item) { + self$items <- c(self$items, item) + }, + add = function(title, value, subscript = NA_character_, ..., digits = 3L) { + titleTemp <- title + if (length(self$items) == 0) { + titleTemp <- .formatCamelCase(titleTemp, title = TRUE) + } + + titleTemp <- paste0(" ", titleTemp) + if (length(subscript) == 1 && !is.na(subscript)) { + subscript <- paste0(as.character(subscript), " ") + } else { + titleTemp <- paste0(titleTemp, " ") + } + self$addItem(PlotSubTitleItemR6$new(title = titleTemp, value = value, subscript = subscript, digits = digits)) + }, + toString = function() { + if (is.null(self$items) || length(self$items) == 0) { + return(NA_character_) + } + + s <- character(0) + for (item in self$items) { + s <- c(s, item$toString()) + } + return(paste0(s, collapse = ", ")) + }, + toHtml = function() { + htmlStr <- self$title + if (length(self$subtitle) == 1 && !is.na(self$subtitle)) { + htmlStr <- paste0(htmlStr, "
", self$subtitle, "") + } + s <- self$toString() + if (length(s) == 1 && !is.na(s) && nchar(s) > 0) { + htmlStr <- paste0(htmlStr, "
", s, "") + } + return(htmlStr) + }, + toQuote = function() { + quotedItems <- self$.getQuotedItems() + if (is.null(quotedItems)) { + if (length(self$subtitle) > 0) { + return(bquote(atop( + bold(.(self$title)), + atop(.(self$subtitle)) + ))) + } + + return(self$title) + } + + if (length(self$subtitle) > 0) { + return(bquote(atop( + bold(.(self$title)), + atop(.(self$subtitle) * "," ~ .(quotedItems)) + ))) + } + + return(bquote(atop( + bold(.(self$title)), + atop(.(self$quotedItems)) + ))) + }, + .getQuotedItems = function() { + item1 <- NULL + item2 <- NULL + item3 <- NULL + item4 <- NULL + if (length(self$items) > 0) { + item1 <- self$items[[1]] + } + if (length(self$items) > 1) { + item2 <- self$items[[2]] + } + if (length(self$items) > 2) { + item3 <- self$items[[3]] + } + if (length(self$items) > 3) { + item4 <- self$items[[4]] + } + + if (!is.null(item1) && !is.null(item2) && !is.null(item3) && !is.null(item4)) { + if (length(item1$subscript) == 1 && !is.na(item1$subscript) && + length(item2$subscript) == 1 && !is.na(item2$subscript)) { + return(bquote(" " * .(item1$title)[.(item1$subscript)] == .(item1$value) * "," ~ .(item2$title)[.(item2$subscript)] == .(item2$value) * "," ~ .(item3$title) == .(item3$value) * "," ~ .(item4$title) == .(item4$value) * "")) + } + + if (length(item1$subscript) == 1 && !is.na(item1$subscript)) { + return(bquote(" " * .(item1$title)[.(item1$subscript)] == .(item1$value) * "," ~ .(item2$title) == .(item2$value) * "," ~ .(item3$title) == .(item3$value) * "," ~ .(item4$title) == .(item4$value) * "")) + } + + if (length(item2$subscript) == 1 && !is.na(item2$subscript)) { + return(bquote(" " * .(item1$title) == .(item1$value) * "," ~ .(item2$title)[.(item2$subscript)] == .(item2$value) * "," ~ .(item3$title) == .(item3$value) * "," ~ .(item4$title) == .(item4$value) * "")) + } + + return(bquote(" " * .(item1$title) == .(item1$value) * "," ~ .(item2$title) == .(item2$value) * "," ~ .(item3$title) == .(item3$value) * "," ~ .(item4$title) == .(item4$value) * "")) + } + + if (!is.null(item1) && !is.null(item2) && !is.null(item3)) { + if (length(item1$subscript) == 1 && !is.na(item1$subscript) && + length(item2$subscript) == 1 && !is.na(item2$subscript)) { + return(bquote(" " * .(item1$title)[.(item1$subscript)] == .(item1$value) * "," ~ .(item2$title)[.(item2$subscript)] == .(item2$value) * "," ~ .(item3$title) == .(item3$value) * "")) + } + + if (length(item1$subscript) == 1 && !is.na(item1$subscript)) { + return(bquote(" " * .(item1$title)[.(item1$subscript)] == .(item1$value) * "," ~ .(item2$title) == .(item2$value) * "," ~ .(item3$title) == .(item3$value) * "")) + } + + if (length(item2$subscript) == 1 && !is.na(item2$subscript)) { + return(bquote(" " * .(item1$title) == .(item1$value) * "," ~ .(item2$title)[.(item2$subscript)] == .(item2$value) * "," ~ .(item3$title) == .(item3$value) * "")) + } + + return(bquote(" " * .(item1$title) == .(item1$value) * "," ~ .(item2$title) == .(item2$value) * "," ~ .(item3$title) == .(item3$value) * "")) + } + + if (!is.null(item1) && !is.null(item2)) { + if (length(item1$subscript) == 1 && !is.na(item1$subscript) && + length(item2$subscript) == 1 && !is.na(item2$subscript)) { + return(bquote(" " * .(item1$title)[.(item1$subscript)] == .(item1$value) * "," ~ .(item2$title)[.(item2$subscript)] == .(item2$value) * "")) + } + + if (length(item1$subscript) == 1 && !is.na(item1$subscript)) { + return(bquote(" " * .(item1$title)[.(item1$subscript)] == .(item1$value) * "," ~ .(item2$title) == .(item2$value) * "")) + } + + if (length(item2$subscript) == 1 && !is.na(item2$subscript)) { + return(bquote(" " * .(item1$title) == .(item1$value) * "," ~ .(item2$title)[.(item2$subscript)] == .(item2$value) * "")) + } + + return(bquote(" " * .(item1$title) == .(item1$value) * "," ~ .(item2$title) == .(item2$value) * "")) + } + + if (!is.null(item1)) { + if (length(item1$subscript) == 1 && !is.na(item1$subscript)) { + return(bquote(" " * .(item1$title)[.(item1$subscript)] == .(item1$value) * "")) + } + + return(bquote(" " * .(item1$title) == .(item1$value) * "")) + } + + return(NULL) + } + ) +) + +#' +#' @title +#' Get Plot Settings +#' +#' @description +#' Returns a plot settings object. +#' +#' @param lineSize The line size, default is \code{0.8}. +#' @param pointSize The point size, default is \code{3}. +#' @param pointColor The point color (character), default is \code{NA_character_}. +#' @param mainTitleFontSize The main title font size, default is \code{14}. +#' @param axesTextFontSize The axes text font size, default is \code{10}. +#' @param legendFontSize The legend font size, default is \code{11}. +#' @param scalingFactor The scaling factor, default is \code{1}. +#' +#' @details +#' Returns an object of class \code{PlotSettings} that collects typical plot settings. +#' +#' @export +#' +#' @keywords internal +#' +getPlotSettings <- function(lineSize = 0.8, + pointSize = 3, + pointColor = NA_character_, + mainTitleFontSize = 14, + axesTextFontSize = 10, + legendFontSize = 11, + scalingFactor = 1) { + return(PlotSettingsR6$new( + lineSize = lineSize, + pointSize = pointSize, + pointColor = pointColor, + mainTitleFontSize = mainTitleFontSize, + axesTextFontSize = axesTextFontSize, + legendFontSize = legendFontSize, + scalingFactor = scalingFactor + )) +} + +#' +#' @name PlotSettings +#' +#' @title +#' Plot Settings +#' +#' @description +#' Class for plot settings. +#' +#' @field lineSize The line size. +#' @field pointSize The point size. +#' @field pointColor The point color, e.g., "red" or "blue". +#' @field mainTitleFontSize The main tile font size. +#' @field axesTextFontSize The text font size. +#' @field legendFontSize The legend font size. +#' @field scalingFactor The scaling factor. +#' +#' @details +#' Collects typical plot settings in an object. +#' +#' @keywords internal +#' +#' @include class_core_parameter_set.R +#' +#' @importFrom methods new +#' +PlotSettingsR6 <- R6Class("PlotSettingsR6", + inherit = ParameterSetR6, + public = list( + .legendLineBreakIndex = NULL, + .pointSize = NULL, + .legendFontSize = NULL, + .htmlTitle = NULL, + .scalingEnabled = NULL, + .pointScalingCorrectionEnabled = NULL, + .pointBorderEnabled = NULL, + lineSize = NULL, + pointSize = NULL, + pointColor = NULL, + mainTitleFontSize = NULL, + axesTextFontSize = NULL, + legendFontSize = NULL, + scalingFactor = NULL, + initialize = function(lineSize = 0.8, + pointSize = 3, + pointColor = NA_character_, + mainTitleFontSize = 14, + axesTextFontSize = 10, + legendFontSize = 11, + scalingFactor = 1, + ...) { + #callSuper( + # lineSize = lineSize, + # pointSize = pointSize, + # pointColor = pointColor, + # mainTitleFontSize = mainTitleFontSize, + # axesTextFontSize = axesTextFontSize, + # legendFontSize = legendFontSize, + # scalingFactor = scalingFactor, + # ... + #)#TODO + + super$initialize() + self$lineSize <- lineSize + self$pointSize <- pointSize + self$pointColor <- pointColor + self$mainTitleFontSize <- mainTitleFontSize + self$axesTextFontSize <- axesTextFontSize + self$legendFontSize <- legendFontSize + self$scalingFactor <- scalingFactor + + self$.legendLineBreakIndex <- 15 + self$.pointSize <- pointSize + self$.legendFontSize <- legendFontSize + self$.htmlTitle <- NA_character_ + self$.scalingEnabled <- TRUE + self$.pointScalingCorrectionEnabled <- TRUE + self$.pointBorderEnabled <- TRUE + + self$.parameterNames <- list( + "lineSize" = "Line size", + "pointSize" = "Point size", + "pointColor" = "Point color", + "mainTitleFontSize" = "Main title font size", + "axesTextFontSize" = "Axes text font size", + "legendFontSize" = "Legend font size", + "scalingFactor" = "Scaling factor" + ) + }, + #clone = function() { + # return(PlotSettingsR6$new( + # lineSize = self$lineSize, + # pointSize = self$pointSize, + # pointColor = self$pointColor, + # mainTitleFontSize = self$mainTitleFontSize, + # axesTextFontSize = self$axesTextFontSize, + # legendFontSize = self$legendFontSize, + # scalingFactor = self$scalingFactor + # )) + #},#TODO + show = function(showType = 1, digits = NA_integer_) { + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + }, + .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { + "Method for automatically printing plot setting objects" + self$.resetCat() + self$.showParametersOfOneGroup( + parameters = self$.getVisibleFieldNames(), + title = "Plot settings", orderByParameterName = FALSE, + consoleOutputEnabled = consoleOutputEnabled + ) + }, + setColorPalette = function(p, palette, mode = c("colour", "fill", "all")) { + "Sets the color palette" + + mode <- match.arg(mode) + + # l = 45: make colors slightly darker + if (is.null(palette) || is.na(palette)) { + if (mode %in% c("colour", "all")) { + p <- p + ggplot2::scale_colour_hue(l = 45) + } + if (mode %in% c("fill", "all")) { + p <- p + ggplot2::scale_fill_hue(l = 45) + } + } else if (is.character(palette)) { + if (mode %in% c("colour", "all")) { + p <- p + ggplot2::scale_colour_brewer(palette = palette) + } + if (mode %in% c("fill", "all")) { + p <- p + ggplot2::scale_fill_brewer(palette = palette) + } + } else if (palette == 0) { + if (mode %in% c("colour", "all")) { + p <- p + ggplot2::scale_colour_grey() + } + if (mode %in% c("fill", "all")) { + p <- p + ggplot2::scale_fill_grey() + } + } else { + if (mode %in% c("colour", "all")) { + p <- p + ggplot2::scale_colour_hue(l = 45) + } + if (mode %in% c("fill", "all")) { + p <- p + ggplot2::scale_fill_hue(l = 45) + } + } + return(p) + }, + enlargeAxisTicks = function(p) { + "Enlarges the axis ticks" + p <- p + ggplot2::theme(axis.ticks.length = ggplot2::unit(self$scaleSize(0.3), "cm")) + return(p) + }, + setAxesAppearance = function(p) { + "Sets the font size and face of the axes titles and texts" + p <- p + ggplot2::theme(axis.title.x = ggplot2::element_text(size = self$scaleSize(self$axesTextFontSize + 1), face = "bold")) + p <- p + ggplot2::theme(axis.title.y = ggplot2::element_text(size = self$scaleSize(self$axesTextFontSize + 1), face = "bold")) + p <- p + ggplot2::theme(axis.text.x = ggplot2::element_text(size = self$scaleSize(self$axesTextFontSize))) + p <- p + ggplot2::theme(axis.text.y = ggplot2::element_text(size = self$scaleSize(self$axesTextFontSize))) + return(p) + }, + + # Sets the axes labels + setAxesLabels = function(p, xAxisLabel = NULL, yAxisLabel1 = NULL, yAxisLabel2 = NULL, + xlab = NA_character_, ylab = NA_character_, + scalingFactor1 = 1, scalingFactor2 = 1) { + if (is.null(xAxisLabel) && !is.na(xlab)) { + xAxisLabel <- xlab + } + + plotLabsType <- getOption("rpact.plot.labs.type", "quote") + if (plotLabsType == "quote" && !is.null(xAxisLabel)) { + if (xAxisLabel == "Theta") { + xAxisLabel <- bquote(bold("Theta" ~ Theta)) + } else if (xAxisLabel == "pi1") { + xAxisLabel <- bquote(bold("pi"["1"])) + } else if (xAxisLabel == "pi2") { + xAxisLabel <- bbquote(bold("pi"["2"])) + } else if (xAxisLabel == "Theta") { + xAxisLabel <- bquote(bold("Theta" ~ Theta)) + } + } + + p <- p + ggplot2::xlab(xAxisLabel) + if (sum(is.na(ylab)) == 0) { + yAxisLabel1 <- ylab[1] + if (length(ylab) == 2) { + yAxisLabel2 <- ylab[2] + } + } + p <- p + ggplot2::ylab(yAxisLabel1) + + p <- self$setSecondYAxisOnRightSide(p, yAxisLabel1, yAxisLabel2, scalingFactor1, scalingFactor2) + + return(p) + }, + setSecondYAxisOnRightSide = function(p, yAxisLabel1, yAxisLabel2, scalingFactor1 = 1, scalingFactor2 = 1) { + if (!is.null(yAxisLabel2) && scalingFactor1 != scalingFactor2) { + p <- p + ggplot2::scale_y_continuous(yAxisLabel1, + sec.axis = ggplot2::sec_axis(~ . * scalingFactor1 / scalingFactor2, name = yAxisLabel2) + ) + } + return(p) + }, + setLegendTitle = function(p, legendTitle, mode = c("colour", "fill")) { + mode <- match.arg(mode) + + if (!is.null(legendTitle) && !is.na(legendTitle) && trimws(legendTitle) != "") { + if (mode == "colour") { + p <- p + ggplot2::labs(colour = .getTextLineWithLineBreak(legendTitle, + lineBreakIndex = self$scaleSize(self$.legendLineBreakIndex) + )) + } else { + p <- p + ggplot2::labs(fill = .getTextLineWithLineBreak(legendTitle, + lineBreakIndex = self$scaleSize(self$.legendLineBreakIndex) + )) + } + p <- p + ggplot2::theme(legend.title = ggplot2::element_text( + colour = "black", size = self$scaleSize(self$legendFontSize + 1), face = "bold" + )) + } else { + p <- p + ggplot2::theme(legend.title = ggplot2::element_blank()) + p <- p + ggplot2::labs(colour = NULL) + } + return(p) + }, + setLegendLabelSize = function(p) { + p <- p + ggplot2::theme(legend.text = ggplot2::element_text(size = self$scaleSize(self$legendFontSize))) + return(p) + }, + setLegendPosition = function(p, legendPosition) { + .assertIsValidLegendPosition(legendPosition) + + switch(as.character(legendPosition), + "-1" = { + p <- p + ggplot2::theme(legend.position = "none") + }, + "0" = { + p <- p + ggplot2::theme(aspect.ratio = 1) + }, + "1" = { + p <- p + ggplot2::theme(legend.position = c(0.05, 1), legend.justification = c(0, 1)) + }, + "2" = { + p <- p + ggplot2::theme(legend.position = c(0.05, 0.5), legend.justification = c(0, 0.5)) + }, + "3" = { + p <- p + ggplot2::theme(legend.position = c(0.05, 0.05), legend.justification = c(0, 0)) + }, + "4" = { + p <- p + ggplot2::theme(legend.position = c(0.95, 1), legend.justification = c(1, 1)) + }, + "5" = { + p <- p + ggplot2::theme(legend.position = c(0.95, 0.5), legend.justification = c(1, 0.5)) + }, + "6" = { + p <- p + ggplot2::theme(legend.position = c(0.95, 0.05), legend.justification = c(1, 0)) + } + ) + + return(p) + }, + setLegendBorder = function(p) { + "Sets the legend border" + if (packageVersion("ggplot2") >= "3.4.0") { + p <- p + ggplot2::theme( + legend.background = + ggplot2::element_rect(fill = "white", colour = "black", linewidth = self$scaleSize(0.4)) + ) + } else { + p <- p + ggplot2::theme( + legend.background = + ggplot2::element_rect(fill = "white", colour = "black", size = self$scaleSize(0.4)) + ) + } + return(p) + }, + adjustPointSize = function(adjustingValue) { + .assertIsInClosedInterval(adjustingValue, "adjustingValue", lower = 0.1, upper = 2) + self$pointSize <- self$.pointSize * adjustingValue + }, + adjustLegendFontSize = function(adjustingValue) { + "Adjusts the legend font size, e.g., run \\cr + \\code{adjustLegendFontSize(-2)} # makes the font size 2 points smaller" + .assertIsInClosedInterval(adjustingValue, "adjustingValue", lower = 0.1, upper = 2) + self$legendFontSize <- self$.legendFontSize * adjustingValue + }, + scaleSize = function(size, pointEnabled = FALSE) { + if (isFALSE(self$.scalingEnabled)) { + return(size) + } + + if (pointEnabled) { + if (isFALSE(self$.pointScalingCorrectionEnabled)) { + return(size) + } + + return(size * self$scalingFactor^2) + } + + return(size * self$scalingFactor) + }, + setMainTitle = function(p, mainTitle, subtitle = NA_character_) { + "Sets the main title" + + caption <- NA_character_ + if (!is.null(mainTitle) && (inherits(mainTitle, "PlotSubTitleItems") || inherits(mainTitle, "PlotSubTitleItemsR6"))) { + plotLabsType <- getOption("rpact.plot.labs.type", "quote") + if (plotLabsType == "quote") { + mainTitle <- mainTitle$toQuote() + } else { + items <- mainTitle + mainTitle <- items$title + if (length(items$subtitle) == 1 && !is.na(items$subtitle)) { + if (length(subtitle) == 1 && !is.na(subtitle)) { + subtitle <- paste0(subtitle, ", ", items$subtitle) + } else { + subtitle <- items$subtitle + } + } + s <- items$toString() + if (length(s) == 1 && !is.na(s) && nchar(s) > 0) { + plotLabsCaptionEnabled <- as.logical(getOption("rpact.plot.labs.caption.enabled", "true")) + if (isTRUE(plotLabsCaptionEnabled)) { + caption <- s + } else { + if (length(subtitle) == 1 && !is.na(subtitle)) { + subtitle <- paste0(subtitle, ", ", s) + } else { + subtitle <- s + } + } + } + + if (plotLabsType == "html") { + self$.htmlTitle <- items$toHtml() + } + } + } + + subtitleFontSize <- NA_real_ + if (length(subtitle) == 1 && !is.na(subtitle)) { + if (is.na(caption)) { + caption <- ggplot2::waiver() + } + p <- p + ggplot2::labs(title = mainTitle, subtitle = subtitle, caption = caption) + targetWidth <- 130 + subtitleFontSize <- targetWidth / nchar(subtitle) * 8 + if (subtitleFontSize > self$scaleSize(self$mainTitleFontSize) - 2) { + subtitleFontSize <- self$scaleSize(self$mainTitleFontSize) - 2 + } + } else if (length(caption) == 1 && !is.na(caption)) { + p <- p + ggplot2::labs(title = mainTitle, caption = caption) + } else { + p <- p + ggplot2::ggtitle(mainTitle) + } + + p <- p + ggplot2::theme(plot.title = ggplot2::element_text( + hjust = 0.5, size = self$scaleSize(self$mainTitleFontSize), face = "bold" + )) + + if (!is.na(subtitleFontSize)) { + p <- p + ggplot2::theme( + plot.subtitle = ggplot2::element_text( + hjust = 0.5, + size = self$scaleSize(subtitleFontSize) + ) + ) + } + + return(p) + }, + setMarginAroundPlot = function(p, margin = 0.2) { + "Sets the margin around the plot, e.g., run \\cr + \\code{setMarginAroundPlot(p, .2)} or \\cr + \\code{setMarginAroundPlot(p, c(.1, .2, .1, .2)}" + if (length(margin == 1)) { + margin <- base::rep(margin, 4) + } + if (!(length(margin) %in% c(1, 4))) { + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'margin' (", .arrayToString(margin), + ") must be a numeric vector with length 1 or 4" + ) + } + p <- p + ggplot2::theme(plot.margin = ggplot2::unit(margin, "cm")) + return(p) + }, + expandAxesRange = function(p, x = NA_real_, y = NA_real_) { + "Expands the axes range" + if (!is.na(x)) { + p <- p + ggplot2::expand_limits(x = x) + } + if (!is.na(y)) { + p <- p + ggplot2::expand_limits(y = y) + } + return(p) + }, + hideGridLines = function(p) { + "Hides the grid lines" + p <- p + ggplot2::theme(panel.grid.major.x = ggplot2::element_blank()) + p <- p + ggplot2::theme(panel.grid.minor.x = ggplot2::element_blank()) + p <- p + ggplot2::theme(panel.grid.major.y = ggplot2::element_blank()) + p <- p + ggplot2::theme(panel.grid.minor.y = ggplot2::element_blank()) + return(p) + }, + setTheme = function(p) { + "Sets the theme" + p <- p + ggplot2::theme_bw() + p <- p + ggplot2::theme( + panel.border = ggplot2::element_blank(), + axis.line = ggplot2::element_line(colour = "black") + ) + return(p) + }, + plotPoints = function(p, pointBorder, ..., mapping = NULL) { + # plot white border around the points + if (pointBorder > 0 && self$.pointBorderEnabled) { + p <- p + ggplot2::geom_point( + mapping = mapping, + color = "white", + size = self$scaleSize(self$pointSize, TRUE), + alpha = 1, + shape = 21, + stroke = pointBorder / 2.25, + show.legend = FALSE + ) + } + + if (!is.null(self$pointColor) && length(self$pointColor) == 1 && !is.na(self$pointColor)) { + p <- p + ggplot2::geom_point( + mapping = mapping, + color = self$pointColor, + size = self$scaleSize(self$pointSize, TRUE), + alpha = 1, + shape = 19, + show.legend = FALSE + ) + } else { + p <- p + ggplot2::geom_point( + mapping = mapping, + size = self$scaleSize(self$pointSize, TRUE), alpha = 1, + shape = 19, show.legend = FALSE + ) + } + return(p) + }, + plotValues = function(p, ..., plotLineEnabled = TRUE, + plotPointsEnabled = TRUE, pointBorder = 4) { + if (plotLineEnabled) { + if (packageVersion("ggplot2") >= "3.4.0") { + p <- p + ggplot2::geom_line(linewidth = self$scaleSize(self$lineSize)) + } else { + p <- p + ggplot2::geom_line(size = self$scaleSize(self$lineSize)) + } + } + if (plotPointsEnabled) { + p <- self$plotPoints(p, pointBorder) + } + return(p) + }, + mirrorYValues = function(p, yValues, plotLineEnabled = TRUE, + plotPointsEnabled = TRUE, pointBorder = 4) { + if (plotLineEnabled) { + if (packageVersion("ggplot2") >= "3.4.0") { + p <- p + ggplot2::geom_line(ggplot2::aes(y = -yValues), linewidth = self$scaleSize(self$lineSize)) + } else { + p <- p + ggplot2::geom_line(ggplot2::aes(y = -yValues), size = self$scaleSize(self$lineSize)) + } + } + if (plotPointsEnabled) { + p <- self$plotPoints(p, pointBorder, mapping = ggplot2::aes(y = -yValues)) + } + return(p) + }, + addCompanyAnnotation = function(p, enabled = TRUE) { + if (!enabled) { + return(p) + } + + label <- "www.rpact.org" + p <- p + ggplot2::annotate("label", + x = -Inf, y = Inf, hjust = -0.1, vjust = 1, + label = label, size = self$scaleSize(2.8), colour = "white", fill = "white" + ) + + p <- p + ggplot2::annotate("text", + x = -Inf, y = Inf, label = label, + hjust = -.12, vjust = 1, colour = "lightgray", size = self$scaleSize(2.7) + ) + return(p) + } + ) +) diff --git a/R/class_design.R b/R/class_design.R index 528329cd..395fea90 100644 --- a/R/class_design.R +++ b/R/class_design.R @@ -65,7 +65,7 @@ NULL TrialDesign <- setRefClass("TrialDesign", contains = "ParameterSet", fields = list( - .plotSettings = "PlotSettings", + .plotSettings = "ANY", kMax = "integer", alpha = "numeric", stages = "integer", @@ -99,7 +99,7 @@ TrialDesign <- setRefClass("TrialDesign", tolerance = tolerance ) - .plotSettings <<- PlotSettings() + .plotSettings <<- PlotSettingsR6$new() if (inherits(.self, "TrialDesignConditionalDunnett")) { .parameterNames <<- C_PARAMETER_NAMES @@ -1160,59 +1160,6 @@ plot.TrialDesignCharacteristics <- function(x, y, ...) { plot(x = x$.design, y = y, ...) } -.plotTrialDesign <- function(..., x, y, main, - xlab, ylab, type, palette, - theta, nMax, plotPointsEnabled, - legendPosition, showSource, designName, plotSettings = NULL) { - .assertGgplotIsInstalled() - - .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) - if (any(.isTrialDesignFisher(x)) && !(type %in% c(1, 3, 4))) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'type' (", type, ") is not allowed for Fisher designs; must be 1, 3 or 4" - ) - } - - .warnInCaseOfUnknownArguments( - functionName = "plot", - ignore = c("xlim", "ylim", "companyAnnotationEnabled", "variedParameters"), ... - ) - - if ((type < 5 || type > 9) && !identical(theta, seq(-1, 1, 0.01))) { - warning("'theta' (", .reconstructSequenceCommand(theta), ") will be ignored for plot type ", type, call. = FALSE) - } - - if (!missing(y) && !is.null(y) && length(y) == 1 && inherits(y, "TrialDesign")) { - args <- list(...) - variedParameters <- args[["variedParameters"]] - if (is.null(variedParameters)) { - if (.isTrialDesignInverseNormalOrGroupSequential(x) && - .isTrialDesignInverseNormalOrGroupSequential(y) && - x$typeOfDesign != y$typeOfDesign) { - variedParameters <- "typeOfDesign" - } else { - stop( - C_EXCEPTION_TYPE_MISSING_ARGUMENT, - "'variedParameters' needs to be specified, e.g., variedParameters = \"typeOfDesign\"" - ) - } - } - designSet <- getDesignSet(designs = c(x, y), variedParameters = variedParameters) - } else { - designSet <- TrialDesignSet(design = x, singleDesign = TRUE) - if (!is.null(plotSettings)) { - designSet$.plotSettings <- plotSettings - } - } - - .plotTrialDesignSet( - x = designSet, y = y, main = main, xlab = xlab, ylab = ylab, type = type, - palette = palette, theta = theta, nMax = nMax, - plotPointsEnabled = plotPointsEnabled, legendPosition = legendPosition, - showSource = showSource, designSetName = designName, ... - ) -} #' #' @title diff --git a/R/class_design_plan.R b/R/class_design_plan.R index 64edc527..068222cb 100644 --- a/R/class_design_plan.R +++ b/R/class_design_plan.R @@ -97,15 +97,15 @@ C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_SURVIVAL <- list( TrialDesignPlan <- setRefClass("TrialDesignPlan", contains = "ParameterSet", fields = list( - .plotSettings = "PlotSettings", - .design = "TrialDesign", + .plotSettings = "ANY", + .design = "ANY", .objectType = "character" # "sampleSize" or "power" ), methods = list( initialize = function(design, ...) { callSuper(.design = design, ...) - .plotSettings <<- PlotSettings() + .plotSettings <<- PlotSettingsR6$new() .parameterNames <<- .getParameterNames(design = design, designPlan = .self) .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS @@ -1190,7 +1190,7 @@ TrialDesignPlanSurvival <- setRefClass("TrialDesignPlanSurvival", } } - designSet <- TrialDesignSet(design = designMaster, singleDesign = TRUE) + designSet <- TrialDesignSetR6$new(design = designMaster, singleDesign = TRUE) designSet$.plotSettings <- designPlan$.plotSettings designPlanName <- paste0(designPlanName, "$.design") return(.plotTrialDesignSet( @@ -1364,7 +1364,7 @@ TrialDesignPlanSurvival <- setRefClass("TrialDesignPlanSurvival", } else { xParameterName <- "informationRates" yParameterNames <- "stageLevels" - designPlan <- TrialDesignSet(design = designMaster, singleDesign = TRUE) + designPlan <- TrialDesignSetR6$new(design = designMaster, singleDesign = TRUE) xParameterNameSrc <- ".design$informationRates" yParameterNamesSrc <- ".design$stageLevels" } @@ -1396,7 +1396,7 @@ TrialDesignPlanSurvival <- setRefClass("TrialDesignPlanSurvival", } else { xParameterName <- "informationRates" yParameterNames <- "alphaSpent" - designPlan <- TrialDesignSet(design = designMaster, singleDesign = TRUE) + designPlan <- TrialDesignSetR6$new(design = designMaster, singleDesign = TRUE) xParameterNameSrc <- ".design$informationRates" yParameterNamesSrc <- ".design$alphaSpent" } diff --git a/R/class_design_plan_r6.R b/R/class_design_plan_r6.R new file mode 100644 index 00000000..476aa28c --- /dev/null +++ b/R/class_design_plan_r6.R @@ -0,0 +1,2153 @@ +## | +## | *Trial design plan classes* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | rpact package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File version: $Revision: 7352 $ +## | Last changed: $Date: 2023-10-12 07:56:59 +0200 (Do, 12 Okt 2023) $ +## | Last changed by: $Author: pahlke $ +## | + +#' @include f_core_constants.R +#' @include f_design_utilities.R +NULL + +C_VARIABLE_DESIGN_PLAN_PARAMETERS <- c("lambda1", "pi1", "median1", "alternative", "hazardRatio") + +C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS <- list( + normalApproximation = FALSE, + meanRatio = FALSE, + thetaH0 = 0, + alternative = seq(0.2, 1, 0.2), + stDev = 1, + groups = 2L, + allocationRatioPlanned = 1 +) + +C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES <- list( + normalApproximation = TRUE, + riskRatio = FALSE, + thetaH0 = 0, + pi1 = C_PI_1_SAMPLE_SIZE_DEFAULT, + pi2 = C_PI_2_DEFAULT, + groups = 2L, + allocationRatioPlanned = 1 +) + +C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_SURVIVAL <- list( + typeOfComputation = "Schoenfeld", + thetaH0 = 1, + pi2 = C_PI_2_DEFAULT, + pi1 = C_PI_1_SAMPLE_SIZE_DEFAULT, + allocationRatioPlanned = 1, + accountForObservationTimes = NA, + eventTime = 12, + accrualTime = C_ACCRUAL_TIME_DEFAULT, + accrualIntensity = C_ACCRUAL_INTENSITY_DEFAULT, + kappa = 1, + piecewiseSurvivalTime = NA_real_, + lambda2 = NA_real_, + lambda1 = NA_real_, + followUpTime = C_FOLLOW_UP_TIME_DEFAULT, + maxNumberOfSubjects = 0, + dropoutRate1 = 0, + dropoutRate2 = 0, + dropoutTime = 12 +) + +#' +#' @name TrialDesignPlan +#' +#' @title +#' Basic Trial Design Plan +#' +#' @description +#' Basic class for trial design plans. +#' +#' @details +#' \code{TrialDesignPlan} is the basic class for +#' \itemize{ +#' \item \code{\link{TrialDesignPlanMeans}}, +#' \item \code{\link{TrialDesignPlanRates}}, and +#' \item \code{\link{TrialDesignPlanSurvival}}. +#' } +#' +#' @include f_core_constants.R +#' @include f_core_utilities.R +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include class_design.R +#' @include class_design_set.R +#' @include f_core_plot.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +TrialDesignPlanR6 <- R6Class("TrialDesignPlanR6", + inherit = ParameterSetR6, + public = list( + .plotSettings = NULL, + .design = NULL, + .objectType = NULL, # "sampleSize" or "power" + initialize = function(design, ...) { + self$.design <- design + + super$initialize(...)#TODO + + self$.plotSettings <- PlotSettingsR6$new() + self$.parameterNames <- .getParameterNames(design = design, designPlan = self) + self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS + + if (.isTrialDesignPlanMeans(self)) { + defaultValueList <- C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS + } else if (.isTrialDesignPlanRates(self)) { + defaultValueList <- C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES + } else if (.isTrialDesignPlanSurvival(self)) { + defaultValueList <- C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_SURVIVAL + } + for (parameterName in self$.getVisibleFieldNames()) { + defaultValue <- defaultValueList[[parameterName]] + existingValue <- self[[parameterName]] + if (all(is.na(existingValue))) { + self$.setParameterType(parameterName, C_PARAM_DEFAULT_VALUE) + } else if (!is.null(defaultValue) && length(defaultValue) == length(existingValue) && + !any(is.na(defaultValue)) && !any(is.na(existingValue)) && + sum(defaultValue == existingValue) == length(defaultValue)) { + self$.setParameterType(parameterName, C_PARAM_DEFAULT_VALUE) + } else { + self$.setParameterType(parameterName, C_PARAM_USER_DEFINED) + } + } + self$.setParameterType("optimumAllocationRatio", C_PARAM_NOT_APPLICABLE) + }, + .setSampleSizeObject = function(objectType) { + if (length(objectType) == 0 || !(objectType %in% c("sampleSize", "power"))) { + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'.objectType' (", objectType, + ") must be specified as 'sampleSize' or 'power'" + ) + } + self$.objectType <- objectType + }, + .isSampleSizeObject = function() { + if (length(self$.objectType) == 0 || !(self$.objectType %in% c("sampleSize", "power"))) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'.objectType' must be specified as 'sampleSize' or 'power'") + } + return(self$.objectType == "sampleSize") + }, + .isPowerObject = function() { + if (length(self$.objectType) == 0 || !(self$.objectType %in% c("sampleSize", "power"))) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'.objectType' must be specified as 'sampleSize' or 'power'") + } + return(self$.objectType == "power") + }, + getPlotSettings = function() { + return(self$.plotSettings) + }, + show = function(showType = 1, digits = NA_integer_) { + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + }, + .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { + "Method for automatically printing trial plan objects" + self$.resetCat() + if (showType == 3) { + .createSummary(self, digits = digits)$.show( + showType = 1, + digits = digits, consoleOutputEnabled = consoleOutputEnabled + ) + } else if (showType == 2) { + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + } else { + self$.cat("Design plan parameters and output for ", self$.toString(), ":\n\n", + heading = 1, + consoleOutputEnabled = consoleOutputEnabled + ) + + self$.showParametersOfOneGroup(.getDesignParametersToShow(self), "Design parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + + self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Sample size and output", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + + if (inherits(self, "TrialDesignPlanSurvival") || inherits(self, "TrialDesignPlanSurvivalR6") || self$groups == 2 || self$.design$kMax > 1) {#TODO Groups???? + self$.cat("Legend:\n", + heading = 2, + consoleOutputEnabled = consoleOutputEnabled + ) + if (inherits(self, "TrialDesignPlanSurvival") || inherits(self, "TrialDesignPlanSurvivalR6") || self$groups == 2) { + self$.cat(" (i): values of treatment arm i\n", + consoleOutputEnabled = consoleOutputEnabled + ) + } + if (self$.design$kMax > 1) { + self$.cat(" [k]: values at stage k\n", consoleOutputEnabled = consoleOutputEnabled) + } + } + + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) + } + }, + getAlpha = function() { + return(self$.design$alpha) + }, + getBeta = function() { + if (.isTrialDesignInverseNormalOrGroupSequential(self$.design)) { + return(self$.design$beta) + } + return(NA_real_) + }, + getSided = function() { + return(self$.design$sided) + }, + getTwoSidedPower = function() { + if (.isTrialDesignInverseNormalOrGroupSequential(self$.design)) { + return(self$.design$twoSidedPower) + } + return(NA) + }, + .toString = function(startWithUpperCase = FALSE) { + if (.isTrialDesignPlanMeans(self)) { + s <- "means" + } else if (.isTrialDesignPlanRates(self)) { + s <- "rates" + } else if (.isTrialDesignPlanSurvival(self)) { + s <- "survival data" + } else { + s <- paste0("unknown data class '", .getClassName(self), "'") + } + return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) #TODO correct closure of s? + } + ) +) + +#' +#' @title +#' Coerce Trial Design Plan to a Data Frame +#' +#' @description +#' Returns the \code{\link{TrialDesignPlan}} as data frame. +#' +#' @param x A \code{\link{TrialDesignPlan}} object. +#' @inheritParams param_niceColumnNamesEnabled +#' @inheritParams param_includeAllParameters +#' @inheritParams param_three_dots +#' +#' @details +#' Coerces the design plan to a data frame. +#' +#' @template return_dataframe +#' +#' @examples +#' as.data.frame(getSampleSizeMeans()) +#' +#' @export +#' +#' @keywords internal +#' +as.data.frame.TrialDesignPlanR6 <- function(x, row.names = NULL, + optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ...) { + return(.getAsDataFrame( + parameterSet = x, + parameterNames = NULL, + niceColumnNamesEnabled = niceColumnNamesEnabled, + includeAllParameters = includeAllParameters + )) +} + +#' +#' @name TrialDesignPlanMeans +#' +#' @title +#' Trial Design Plan Means +#' +#' @description +#' Trial design plan for means. +#' +#' @template field_meanRatio +#' @template field_thetaH0 +#' @template field_normalApproximation +#' @template field_alternative +#' @template field_stDev +#' @template field_groups +#' @template field_allocationRatioPlanned +#' @template field_optimumAllocationRatio +#' @template field_directionUpper +#' @template field_effect +#' @template field_overallReject +#' @template field_rejectPerStage +#' @template field_futilityStop +#' @template field_futilityPerStage +#' @template field_earlyStop +#' @template field_expectedNumberOfSubjects +#' @template field_nFixed +#' @template field_nFixed1 +#' @template field_nFixed2 +#' @template field_informationRates +#' @template field_maxNumberOfSubjects +#' @template field_maxNumberOfSubjects1 +#' @template field_maxNumberOfSubjects2 +#' @template field_numberOfSubjects +#' @template field_numberOfSubjects1 +#' @template field_numberOfSubjects2 +#' @template field_expectedNumberOfSubjectsH0 +#' @template field_expectedNumberOfSubjectsH01 +#' @template field_expectedNumberOfSubjectsH1 +#' @template field_criticalValuesEffectScale +#' @template field_criticalValuesEffectScaleLower +#' @template field_criticalValuesEffectScaleUpper +#' @template field_criticalValuesPValueScale +#' @template field_futilityBoundsEffectScale +#' @template field_futilityBoundsEffectScaleLower +#' @template field_futilityBoundsEffectScaleUpper +#' @template field_futilityBoundsPValueScale +#' +#' @details +#' This object cannot be created directly; use \code{\link[=getSampleSizeMeans]{getSampleSizeMeans()}} +#' with suitable arguments to create a design plan for a dataset of means. +#' +#' @include class_core_parameter_set.R +#' @include class_design.R +#' @include class_design_set.R +#' @include f_core_constants.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +TrialDesignPlanMeansR6 <- R6Class("TrialDesignPlanMeansR6", + inherit = TrialDesignPlanR6, + public = list( + meanRatio = NULL, + thetaH0 = NULL, + normalApproximation = NULL, + alternative = NULL, + stDev = NULL, + groups = NULL, + allocationRatioPlanned = NULL, + optimumAllocationRatio = NULL, + directionUpper = NULL, + effect = NULL, + overallReject = NULL, + rejectPerStage = NULL, + futilityStop = NULL, + futilityPerStage = NULL, + earlyStop = NULL, + expectedNumberOfSubjects = NULL, + nFixed = NULL, + nFixed1 = NULL, + nFixed2 = NULL, + informationRates = NULL, + maxNumberOfSubjects = NULL, + maxNumberOfSubjects1 = NULL, + maxNumberOfSubjects2 = NULL, + numberOfSubjects = NULL, + numberOfSubjects1 = NULL, + numberOfSubjects2 = NULL, + expectedNumberOfSubjectsH0 = NULL, + expectedNumberOfSubjectsH01 = NULL, + expectedNumberOfSubjectsH1 = NULL, + criticalValuesEffectScale = NULL, + criticalValuesEffectScaleLower = NULL, + criticalValuesEffectScaleUpper = NULL, + criticalValuesPValueScale = NULL, + futilityBoundsEffectScale = NULL, + futilityBoundsEffectScaleLower = NULL, + futilityBoundsEffectScaleUpper = NULL, + futilityBoundsPValueScale = NULL, + initialize = function(..., + normalApproximation = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS[["normalApproximation"]], + meanRatio = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS[["meanRatio"]], + thetaH0 = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS[["thetaH0"]], + alternative = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS[["alternative"]], + stDev = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS[["stDev"]], + groups = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS[["groups"]], + allocationRatioPlanned = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS[["allocationRatioPlanned"]]) { + + super$initialize(...)#TODO + + self$normalApproximation <- normalApproximation + self$meanRatio <- meanRatio + self$thetaH0 <- thetaH0 + self$alternative <- alternative + self$stDev <- stDev + self$groups <- groups + self$allocationRatioPlanned <- allocationRatioPlanned + + self$optimumAllocationRatio <- FALSE + visibleFieldNames <- self$.getVisibleFieldNames() + startIndex <- which(visibleFieldNames == "directionUpper") + for (i in startIndex:length(visibleFieldNames)) { + self$.setParameterType(visibleFieldNames[i], C_PARAM_NOT_APPLICABLE) + } + + if (self$groups == 1) { + self$.setParameterType("meanRatio", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("allocationRatioPlanned", C_PARAM_NOT_APPLICABLE) + } + + self$.setParameterType("maxNumberOfSubjects1", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("maxNumberOfSubjects2", C_PARAM_NOT_APPLICABLE) + + self$.setParameterType("criticalValuesEffectScale", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("criticalValuesEffectScaleLower", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("criticalValuesEffectScaleUpper", C_PARAM_NOT_APPLICABLE) + + self$.setParameterType("futilityBoundsEffectScale", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("futilityBoundsEffectScaleLower", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("futilityBoundsEffectScaleUpper", C_PARAM_NOT_APPLICABLE) + }, + show = function(showType = 1, digits = NA_integer_) { + "Method for automatically printing trial plan objects" + super$show(showType = showType, digits = digits) + } + ) +) + +#' +#' @name TrialDesignPlanRates +#' +#' @title +#' Trial Design Plan Rates +#' +#' @description +#' Trial design plan for rates. +#' +#' @template field_riskRatio +#' @template field_thetaH0 +#' @template field_normalApproximation +#' @template field_pi1 +#' @template field_pi2 +#' @template field_groups +#' @template field_allocationRatioPlanned +#' @template field_optimumAllocationRatio +#' @template field_directionUpper +#' @template field_effect +#' @template field_overallReject +#' @template field_rejectPerStage +#' @template field_futilityStop +#' @template field_futilityPerStage +#' @template field_earlyStop +#' @template field_expectedNumberOfSubjects +#' @template field_nFixed +#' @template field_nFixed1 +#' @template field_nFixed2 +#' @template field_informationRates +#' @template field_maxNumberOfSubjects +#' @template field_maxNumberOfSubjects1 +#' @template field_maxNumberOfSubjects2 +#' @template field_numberOfSubjects +#' @template field_numberOfSubjects1 +#' @template field_numberOfSubjects2 +#' @template field_expectedNumberOfSubjectsH0 +#' @template field_expectedNumberOfSubjectsH01 +#' @template field_expectedNumberOfSubjectsH1 +#' @template field_criticalValuesEffectScale +#' @template field_criticalValuesEffectScaleLower +#' @template field_criticalValuesEffectScaleUpper +#' @template field_criticalValuesPValueScale +#' @template field_futilityBoundsEffectScale +#' @template field_futilityBoundsEffectScaleLower +#' @template field_futilityBoundsEffectScaleUpper +#' @template field_futilityBoundsPValueScale +#' +#' @details +#' This object cannot be created directly; use \code{\link[=getSampleSizeRates]{getSampleSizeRates()}} +#' with suitable arguments to create a design plan for a dataset of rates. +#' +#' @include class_core_parameter_set.R +#' @include class_design.R +#' @include class_design_set.R +#' @include f_core_constants.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +TrialDesignPlanRatesR6 <- R6Class("TrialDesignPlanRatesR6", + inherit = TrialDesignPlanR6, + public = list( + riskRatio = NULL, + thetaH0 = NULL, + normalApproximation = NULL, + pi1 = NULL, + pi2 = NULL, + groups = NULL, + allocationRatioPlanned = NULL, + optimumAllocationRatio = NULL, + directionUpper = NULL, + effect = NULL, + expectedNumberOfSubjects = NULL, + nFixed = NULL, + nFixed1 = NULL, + nFixed2 = NULL, + overallReject = NULL, + rejectPerStage = NULL, + futilityStop = NULL, + futilityPerStage = NULL, + earlyStop = NULL, + informationRates = NULL, + maxNumberOfSubjects = NULL, + maxNumberOfSubjects1 = NULL, + maxNumberOfSubjects2 = NULL, + numberOfSubjects = NULL, + numberOfSubjects1 = NULL, + numberOfSubjects2 = NULL, + expectedNumberOfSubjectsH0 = NULL, + expectedNumberOfSubjectsH01 = NULL, + expectedNumberOfSubjectsH1 = NULL, + criticalValuesEffectScale = NULL, + criticalValuesEffectScaleLower = NULL, + criticalValuesEffectScaleUpper = NULL, + criticalValuesPValueScale = NULL, + futilityBoundsEffectScale = NULL, + futilityBoundsEffectScaleLower = NULL, + futilityBoundsEffectScaleUpper = NULL, + futilityBoundsPValueScale = NULL, + initialize = function(..., + normalApproximation = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["normalApproximation"]], + riskRatio = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["riskRatio"]], + thetaH0 = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["thetaH0"]], + pi1 = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["pi1"]], + pi2 = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["pi2"]], + groups = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["groups"]], + allocationRatioPlanned = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["allocationRatioPlanned"]]) { + super$initialize(...) #TODO + + self$normalApproximation <- normalApproximation + self$riskRatio <- riskRatio + self$thetaH0 <- thetaH0 + self$pi1 <- pi1 + self$pi2 <- pi2 + self$groups <- groups + self$allocationRatioPlanned <- allocationRatioPlanned + + self$optimumAllocationRatio <- FALSE + visibleFieldNames <- self$.getVisibleFieldNames() + startIndex <- which(visibleFieldNames == "directionUpper") + for (i in startIndex:length(visibleFieldNames)) { + self$.setParameterType(visibleFieldNames[i], C_PARAM_NOT_APPLICABLE) + } + + if (self$groups == 1) { + self$.setParameterType("meanRatio", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("allocationRatioPlanned", C_PARAM_NOT_APPLICABLE) + } + + self$.setParameterType("maxNumberOfSubjects1", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("maxNumberOfSubjects2", C_PARAM_NOT_APPLICABLE) + + self$.setParameterType("criticalValuesEffectScale", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("criticalValuesEffectScaleLower", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("criticalValuesEffectScaleUpper", C_PARAM_NOT_APPLICABLE) + + self$.setParameterType("futilityBoundsEffectScale", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("futilityBoundsEffectScaleLower", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("futilityBoundsEffectScaleUpper", C_PARAM_NOT_APPLICABLE) + }, + show = function(showType = 1, digits = NA_integer_) { + "Method for automatically printing trial plan objects" + super$show(showType = showType, digits = digits) + } + ) +) + +#' +#' @name TrialDesignPlanSurvival +#' +#' @title +#' Trial Design Plan Survival +#' +#' @description +#' Trial design plan for survival data. +#' +#' @template field_thetaH0 +#' @template field_typeOfComputation +#' @template field_directionUpper +#' @template field_pi1_survival +#' @template field_pi2_survival +#' @template field_median1 +#' @template field_median2 +#' @template field_lambda1 +#' @template field_lambda2 +#' @template field_hazardRatio +#' @template field_maxNumberOfSubjects +#' @template field_maxNumberOfSubjects1 +#' @template field_maxNumberOfSubjects2 +#' @template field_maxNumberOfEvents +#' @template field_allocationRatioPlanned +#' @template field_optimumAllocationRatio +#' @template field_accountForObservationTimes +#' @template field_eventTime +#' @template field_accrualTime +#' @template field_totalAccrualTime +#' @template field_accrualIntensity +#' @template field_accrualIntensityRelative +#' @template field_kappa +#' @template field_piecewiseSurvivalTime +#' @template field_followUpTime +#' @template field_dropoutRate1 +#' @template field_dropoutRate2 +#' @template field_dropoutTime +#' @template field_chi +#' @template field_expectedNumberOfEvents +#' @template field_eventsFixed +#' @template field_nFixed +#' @template field_nFixed1 +#' @template field_nFixed2 +#' @template field_overallReject +#' @template field_rejectPerStage +#' @template field_futilityStop +#' @template field_futilityPerStage +#' @template field_earlyStop +#' @template field_informationRates +#' @template field_analysisTime +#' @template field_studyDurationH1 +#' @template field_studyDuration +#' @template field_maxStudyDuration +#' @template field_eventsPerStage +#' @template field_expectedEventsH0 +#' @template field_expectedEventsH01 +#' @template field_expectedEventsH1 +#' @template field_numberOfSubjects +#' @template field_numberOfSubjects1 +#' @template field_numberOfSubjects2 +#' @template field_expectedNumberOfSubjectsH1 +#' @template field_expectedNumberOfSubjects +#' @template field_criticalValuesEffectScale +#' @template field_criticalValuesEffectScaleLower +#' @template field_criticalValuesEffectScaleUpper +#' @template field_criticalValuesPValueScale +#' @template field_futilityBoundsEffectScale +#' @template field_futilityBoundsEffectScaleLower +#' @template field_futilityBoundsEffectScaleUpper +#' @template field_futilityBoundsPValueScale +#' +#' @details +#' This object cannot be created directly; use \code{\link[=getSampleSizeSurvival]{getSampleSizeSurvival()}} +#' with suitable arguments to create a design plan for a dataset of survival data. +#' +#' @include class_core_parameter_set.R +#' @include class_design.R +#' @include class_design_set.R +#' @include class_time.R +#' @include f_core_constants.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +TrialDesignPlanSurvivalR6 <- R6Class("TrialDesignPlanSurvivalR6", + inherit = TrialDesignPlanR6, + public = list( + .piecewiseSurvivalTime = NULL, + .accrualTime = NULL, + .calculateFollowUpTime = NULL, + thetaH0 = NULL, + typeOfComputation = NULL, + directionUpper = NULL, + pi1 = NULL, + pi2 = NULL, + median1 = NULL, + median2 = NULL, + lambda1 = NULL, + lambda2 = NULL, + hazardRatio = NULL, + maxNumberOfSubjects = NULL, + maxNumberOfSubjects1 = NULL, + maxNumberOfSubjects2 = NULL, + maxNumberOfEvents = NULL, + allocationRatioPlanned = NULL, + optimumAllocationRatio = NULL, + accountForObservationTimes = NULL, + eventTime = NULL, + accrualTime = NULL, + totalAccrualTime = NULL, + accrualIntensity = NULL, + accrualIntensityRelative = NULL, + kappa = NULL, + piecewiseSurvivalTime = NULL, + followUpTime = NULL, + dropoutRate1 = NULL, + dropoutRate2 = NULL, + dropoutTime = NULL, + chi = NULL, + expectedNumberOfEvents = NULL, + eventsFixed = NULL, + nFixed = NULL, + nFixed1 = NULL, + nFixed2 = NULL, + overallReject = NULL, + rejectPerStage = NULL, + futilityStop = NULL, + futilityPerStage = NULL, + earlyStop = NULL, + informationRates = NULL, + analysisTime = NULL, + studyDurationH1 = NULL, + studyDuration = NULL, + maxStudyDuration = NULL, + eventsPerStage = NULL, + expectedEventsH0 = NULL, + expectedEventsH01 = NULL, + expectedEventsH1 = NULL, + numberOfSubjects = NULL, + numberOfSubjects1 = NULL, + numberOfSubjects2 = NULL, + expectedNumberOfSubjectsH1 = NULL, + expectedNumberOfSubjects = NULL, + criticalValuesEffectScale = NULL, + criticalValuesEffectScaleLower = NULL, + criticalValuesEffectScaleUpper = NULL, + criticalValuesPValueScale = NULL, + futilityBoundsEffectScale = NULL, + futilityBoundsEffectScaleLower = NULL, + futilityBoundsEffectScaleUpper = NULL, + futilityBoundsPValueScale = NULL, + initialize = function(...,typeOfComputation = NULL, + thetaH0 = NULL, + allocationRatioPlanned = NULL, + accountForObservationTimes = NULL, + eventTime = NULL, + accrualTime = NULL, + accrualIntensity = NULL, + kappa = NULL, + followUpTime = NULL, + maxNumberOfSubjects = NULL, + dropoutRate1 = NULL, + dropoutRate2 = NULL, + dropoutTime = NULL, + hazardRatio = NULL) { + + + self$typeOfComputation <- typeOfComputation + self$thetaH0 <- thetaH0 + self$allocationRatioPlanned <- allocationRatioPlanned + self$accountForObservationTimes <- accountForObservationTimes + self$eventTime <- eventTime + self$accrualTime <- accrualTime + self$accrualIntensity <- accrualIntensity + self$kappa <- kappa + self$followUpTime <- followUpTime + self$maxNumberOfSubjects <- maxNumberOfSubjects + self$dropoutRate1 <- dropoutRate1 + self$dropoutRate2 <- dropoutRate2 + self$dropoutTime <- dropoutTime + self$hazardRatio <- hazardRatio + + super$initialize(...) + + self$optimumAllocationRatio <- FALSE + visibleFieldNames <- self$.getVisibleFieldNames() + startIndex <- which(visibleFieldNames == "hazardRatio") + for (i in startIndex:length(visibleFieldNames)) { + self$.setParameterType(visibleFieldNames[i], C_PARAM_NOT_APPLICABLE) + } + + self$.setParameterType("maxNumberOfSubjects", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("maxNumberOfSubjects1", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("maxNumberOfSubjects2", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("median1", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("median2", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("accountForObservationTimes", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("chi", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("maxStudyDuration", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("accrualIntensityRelative", C_PARAM_NOT_APPLICABLE) + + self$.setParameterType("criticalValuesEffectScale", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("criticalValuesEffectScaleLower", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("criticalValuesEffectScaleUpper", C_PARAM_NOT_APPLICABLE) + + self$.setParameterType("futilityBoundsEffectScale", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("futilityBoundsEffectScaleLower", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("futilityBoundsEffectScaleUpper", C_PARAM_NOT_APPLICABLE) + + # set default values + for (parameterName in c( + "eventTime", "accrualTime", "accrualIntensity", + "kappa", "piecewiseSurvivalTime", "lambda1", "lambda2", + "followUpTime", "dropoutTime" + )) { + self$.setDefaultValue(parameterName) + } + }, + .setDefaultValue = function(argumentName) { + if (is.null(self[[argumentName]]) || all(is.na(self[[argumentName]]))) { + self[[argumentName]] <- C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_SURVIVAL[[argumentName]] + self$.setParameterType(argumentName, C_PARAM_DEFAULT_VALUE) + } + }, + show = function(showType = 1, digits = NA_integer_) { + "Method for automatically printing trial plan objects" + super$show(showType = showType, digits = digits) + }, + .warnInCaseArgumentExists = function(argument, argumentName) { + if (!all(is.na(argument)) && any(argument > 0)) { + warning(sprintf( + "Specified '%s' (%s) not taken into account", + argumentName, .arrayToString(argument) + ), call. = FALSE) + } + } + ) +) + +.addPlotSubTitleItems <- function(designPlan, designMaster, items, type) { + if (type %in% c(1, 3, 4)) { + return(invisible()) + } + + if (.isTrialDesignPlanMeans(designPlan)) { + nMax <- designPlan$maxNumberOfSubjects[1] # use first value for plotting + + if (!(type %in% c(5))) { + items$add("N", round(nMax, 1), "max") + } + + if ((type %in% c(5)) && !(items$title == "Sample Size")) { + items$add("N", round(nMax, 1), "max") + } + + if (designPlan$meanRatio) { + items$add("coefficient of variation", designPlan$stDev) + } else { + items$add("standard deviation", designPlan$stDev) + } + + if (designPlan$groups == 1) { + if (type %in% c(2, (5:9))) { + items$add("H0: mu", designPlan$thetaH0) + items$add("allocation ratio", round(designPlan$allocationRatioPlanned, 2)) + } + } else { + if (type %in% c(2, (5:9))) { + if (designPlan$meanRatio) { + items$add("H0: mean ratio", designPlan$thetaH0) + } else { + items$add("H0: mean difference", designPlan$thetaH0) + } + items$add("allocation ratio", round(designPlan$allocationRatioPlanned, 2)) + } + } + } else if (.isTrialDesignPlanRates(designPlan)) { + nMax <- designPlan$maxNumberOfSubjects[1] # use first value for plotting + + if (!(type %in% c(5))) { + items$add("N", round(nMax, 1), "max") + } + + if ((type %in% c(5)) && !(items$title == "Sample Size")) { + items$add("N", round(nMax, 1), "max") + } + + if (designPlan$groups == 2 && !(type %in% c(3, 4)) && + length(designPlan$pi2) == 1 && !is.na(designPlan$pi2)) { + items$add("pi", designPlan$pi2, 2) + } + + if (designPlan$groups == 1) { + if (type %in% c(2, (5:9))) { + items$add("H0: pi", designPlan$thetaH0) + } + } else { + if (type %in% c(2, (5:9))) { + if (designPlan$riskRatio) { + items$add("H0: risk ratio", designPlan$thetaH0) + } else { + items$add("H0: risk difference", designPlan$thetaH0) + } + items$add("allocation ratio", round(designPlan$allocationRatioPlanned, 2)) + } + } + } else if (.isTrialDesignPlanSurvival(designPlan)) { + if (designPlan$.isPowerObject() && !(type %in% (13:14))) { + items$add("maximum number of events", designPlan$maxNumberOfEvents[1]) + } + if (type %in% (10:12)) { + items$add("maximum number of subjects", designPlan$maxNumberOfSubjects[1]) + } + if (type %in% c(2, (5:12))) { + items$add("H0: hazard ratio", designPlan$thetaH0) + items$add("allocation ratio", round(designPlan$allocationRatioPlanned, 2)) + } + } +} + +.assertIsValidVariedParameterVectorForPlotting <- function(designPlan, plotType) { + if (.isTrialDesignPlanMeans(designPlan)) { + if (is.null(designPlan$alternative) || any(is.na(designPlan$alternative)) || + length(designPlan$alternative) <= 1) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "plot type ", plotType, + " is only available if 'alternative' with length > 1 is defined" + ) + } + } else if (.isTrialDesignPlanRates(designPlan)) { + if (is.null(designPlan$pi1) || any(is.na(designPlan$pi1)) || + length(designPlan$pi1) <= 1) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "plot type ", plotType, + " is only available if 'pi1' with length > 1 is defined" + ) + } + } else if (.isTrialDesignPlanSurvival(designPlan)) { + if (is.null(designPlan$hazardRatio) || any(is.na(designPlan$hazardRatio)) || + length(designPlan$hazardRatio) <= 1) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "plot type ", plotType, + " is only available if 'hazardRatio' with length > 1 is defined" + ) + } + } +} + +.plotTrialDesignPlan <- function(designPlan, type = 1L, main = NA_character_, + xlab = NA_character_, ylab = NA_character_, palette = "Set1", + theta = seq(-1, 1, 0.02), plotPointsEnabled = NA, + legendPosition = NA_integer_, showSource = FALSE, + designPlanName = NA_character_, plotSettings = NULL, ...) { + .assertGgplotIsInstalled() + .assertIsTrialDesignPlan(designPlan) + .assertIsValidLegendPosition(legendPosition) + .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) + theta <- .assertIsValidThetaRange(thetaRange = theta) + + survivalDesignPlanEnabled <- .isTrialDesignPlanSurvival(designPlan) + + nMax <- ifelse(survivalDesignPlanEnabled, designPlan$maxNumberOfEvents[1], + designPlan$maxNumberOfSubjects[1] + ) # use first value for plotting + + if (is.null(plotSettings)) { + plotSettings <- designPlan$.plotSettings + } + + designMaster <- designPlan$.design + + if (designMaster$kMax == 1 && (type %in% c(1:4))) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, + ") is not available for 'kMax' = 1" + ) + } + + if (designPlan$.isSampleSizeObject()) { + if (survivalDesignPlanEnabled) { + if (!(type %in% c(1:5, 13, 14))) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, + ") is not allowed; must be 1, 2, 3, 4, 5, 13 or 14" + ) + } + } else { + if (!(type %in% c(1:5))) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, + ") is not allowed; must be 1, 2, 3, 4, 5" + ) + } + } + } + + if (is.na(plotPointsEnabled)) { + plotPointsEnabled <- type < 4 + } + + ratioEnabled <- (survivalDesignPlanEnabled || + (.isTrialDesignPlanMeans(designPlan) && designPlan$meanRatio) || + (.isTrialDesignPlanRates(designPlan) && designPlan$riskRatio)) + + variedParameters <- logical(0) + + showSourceHint <- "" + if (type %in% c(5:12)) { + if (.isTrialDesignPlanMeans(designPlan) && length(designPlan$alternative) == 2 && + designPlan$.getParameterType("alternative") == C_PARAM_USER_DEFINED) { + if (!is.logical(showSource) || isTRUE(showSource)) { + showSourceHint <- .getVariedParameterHint(designPlan$alternative, "alternative") + } + designPlan <- designPlan$clone( + alternative = + .getVariedParameterVector(designPlan$alternative, "alternative") + ) + } else if ((.isTrialDesignPlanRates(designPlan) || survivalDesignPlanEnabled) && + length(designPlan$pi1) == 2 && + designPlan$.getParameterType("pi1") == C_PARAM_USER_DEFINED) { + if (!is.logical(showSource) || isTRUE(showSource)) { + showSourceHint <- .getVariedParameterHint(designPlan$pi1, "pi1") + } + designPlan <- designPlan$clone( + pi1 = + .getVariedParameterVector(designPlan$pi1, "pi1") + ) + } else if (survivalDesignPlanEnabled && length(designPlan$hazardRatio) == 2 && + designPlan$.getParameterType("hazardRatio") == C_PARAM_USER_DEFINED) { + if (!is.logical(showSource) || isTRUE(showSource)) { + showSourceHint <- .getVariedParameterHint(designPlan$hazardRatio, "hazardRatio") + } + designPlan <- designPlan$clone( + hazardRatio = + .getVariedParameterVector(designPlan$hazardRatio, "hazardRatio") + ) + } + } + + srcCmd <- NULL + + reducedParam <- NULL + if (type %in% c(1:4)) { + reducedParam <- .warnInCaseOfUnusedValuesForPlotting(designPlan) + } + + if (type == 1) { # Boundary plot + if (survivalDesignPlanEnabled) { + if (is.na(main)) { + main <- PlotSubTitleItems(title = "Boundaries Z Scale") + .addPlotSubTitleItems(designPlan, designMaster, main, type) + if (!is.null(reducedParam)) { + main$add(reducedParam$title, reducedParam$value, reducedParam$subscript) + } + } + + if (designMaster$sided == 1) { + designPlan <- data.frame( + eventsPerStage = designPlan$eventsPerStage[, 1], + criticalValues = designMaster$criticalValues, + futilityBounds = c(designMaster$futilityBounds, designMaster$criticalValues[designMaster$kMax]) + ) + } else { + designPlan <- data.frame( + eventsPerStage = designPlan$eventsPerStage[, 1], + criticalValues = designMaster$criticalValues, + criticalValuesMirrored = -designMaster$criticalValues + ) + } + + xParameterName <- "eventsPerStage" + if (designMaster$sided == 1) { + if (any(designMaster$futilityBounds > C_FUTILITY_BOUNDS_DEFAULT)) { + yParameterNames <- c("futilityBounds", "criticalValues") + } else { + yParameterNames <- "criticalValues" + } + yParameterNamesSrc <- yParameterNames + } else { + yParameterNames <- c("criticalValues", "criticalValuesMirrored") + yParameterNamesSrc <- c("criticalValues", paste0("-", designPlanName, "$.design$criticalValues")) + } + + if (is.na(legendPosition)) { + legendPosition <- C_POSITION_RIGHT_TOP + } + + srcCmd <- .showPlotSourceInformation( + objectName = paste0(designPlanName, "$.design"), + xParameterName = paste0(designPlanName, "$", xParameterName, "[, 1]"), + yParameterNames = yParameterNamesSrc, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + } else { + if (is.na(main)) { + main <- PlotSubTitleItems(title = "Boundaries") + .addPlotSubTitleItems(designPlan, designMaster, main, type) + if (!is.null(reducedParam)) { + main$add(reducedParam$title, reducedParam$value, reducedParam$subscript) + } + } + + designSet <- TrialDesignSetR6$new(design = designMaster, singleDesign = TRUE) + designSet$.plotSettings <- designPlan$.plotSettings + designPlanName <- paste0(designPlanName, "$.design") + return(.plotTrialDesignSet( + x = designSet, y = NULL, main = main, + xlab = xlab, ylab = ylab, type = type, + palette = palette, theta = theta, nMax = nMax, + plotPointsEnabled = plotPointsEnabled, legendPosition = legendPosition, + designSetName = designPlanName, showSource = showSource, + plotSettings = plotSettings # , ... + )) + } + } else if (type == 2) { # Effect Scale Boundary plot + if (is.na(main)) { + main <- PlotSubTitleItems(title = "Boundaries Effect Scale") + .addPlotSubTitleItems(designPlan, designMaster, main, type) + if (!is.null(reducedParam)) { + main$add(reducedParam$title, reducedParam$value, reducedParam$subscript) + } + } + + if (is.na(ylab)) { + if (.isTrialDesignPlanMeans(designPlan)) { + if (designPlan$groups == 1) { + ylab <- "Mean" + } else if (!designPlan$meanRatio) { + ylab <- "Mean Difference" + } else { + ylab <- "Mean Ratio" + } + } else if (.isTrialDesignPlanRates(designPlan)) { + if (designPlan$groups == 1) { + ylab <- "Rate" + } else if (!designPlan$riskRatio) { + ylab <- "Rate Difference" + } else { + ylab <- "Risk Ratio" + } + } else if (survivalDesignPlanEnabled) { + ylab <- "Hazard Ratio" + } + } + + groupedPlotEnabled <- FALSE + yParameterNamesSrc <- c() + if (designMaster$sided == 1) { + if (any(designMaster$futilityBounds > C_FUTILITY_BOUNDS_DEFAULT)) { + data <- data.frame( + criticalValuesEffectScale = designPlan$criticalValuesEffectScale[, 1], + futilityBoundsEffectScale = c( + designPlan$futilityBoundsEffectScale[, 1], + designPlan$criticalValuesEffectScale[designMaster$kMax, 1] + ) + ) + yParameterNamesSrc <- c(yParameterNamesSrc, "criticalValuesEffectScale[, 1]") + yParameterNamesSrc <- c(yParameterNamesSrc, paste0( + "c(", designPlanName, "$futilityBoundsEffectScale[, 1], ", + designPlanName, "$criticalValuesEffectScale[nrow(", designPlanName, "$criticalValuesEffectScale), 1])" + )) + } else { + data <- data.frame( + criticalValuesEffectScale = designPlan$criticalValuesEffectScale[, 1] + ) + yParameterNamesSrc <- c(yParameterNamesSrc, "criticalValuesEffectScale[, 1]") + } + } else if (designMaster$typeOfDesign == C_TYPE_OF_DESIGN_PT) { + data <- data.frame( + criticalValues = designPlan$criticalValuesEffectScaleUpper[, 1], + criticalValuesMirrored = designPlan$criticalValuesEffectScaleLower[, 1], + futilityBounds = c( + designPlan$futilityBoundsEffectScaleUpper[, 1], + designPlan$criticalValuesEffectScaleUpper[designMaster$kMax, 1] + ), + futilityBoundsMirrored = c( + designPlan$futilityBoundsEffectScaleLower[, 1], + designPlan$criticalValuesEffectScaleLower[designMaster$kMax, 1] + ) + ) + yParameterNamesSrc <- c(yParameterNamesSrc, "criticalValuesEffectScaleUpper[, 1]") + yParameterNamesSrc <- c(yParameterNamesSrc, "criticalValuesEffectScaleLower[, 1]") + yParameterNamesSrc <- c(yParameterNamesSrc, paste0( + "c(", designPlanName, "$futilityBoundsEffectScaleUpper[, 1], ", + designPlanName, "$criticalValuesEffectScaleUpper[nrow(", designPlanName, "$criticalValuesEffectScaleUpper), 1])" + )) + yParameterNamesSrc <- c(yParameterNamesSrc, paste0( + "c(", designPlanName, "$futilityBoundsEffectScaleLower[, 1], ", + designPlanName, "$criticalValuesEffectScaleLower[nrow(", designPlanName, "$criticalValuesEffectScaleLower), 1])" + )) + groupedPlotEnabled <- TRUE + } else { + data <- data.frame( + criticalValuesEffectScale = designPlan$criticalValuesEffectScaleUpper[, 1], + criticalValuesEffectScaleMirrored = designPlan$criticalValuesEffectScaleLower[, 1] + ) + yParameterNamesSrc <- c(yParameterNamesSrc, "criticalValuesEffectScaleUpper[, 1]") + yParameterNamesSrc <- c(yParameterNamesSrc, "criticalValuesEffectScaleLower[, 1]") + } + + if (survivalDesignPlanEnabled) { + xParameterName <- "eventsPerStage" + xParameterNameSrc <- paste0(designPlanName, "$", xParameterName, "[, 1]") + data <- cbind(data.frame(eventsPerStage = designPlan$eventsPerStage[, 1]), data) + } else { + xParameterName <- "informationRates" + xParameterNameSrc <- paste0(designPlanName, "$.design$", xParameterName) + data <- cbind(data.frame(informationRates = designMaster$informationRates), data) + } + if (designMaster$sided == 1 || designMaster$typeOfDesign == C_TYPE_OF_DESIGN_PT) { + if (any(designMaster$futilityBounds > C_FUTILITY_BOUNDS_DEFAULT)) { + yParameterNames <- c("futilityBoundsEffectScale", "criticalValuesEffectScale") + } else { + yParameterNames <- "criticalValuesEffectScale" + } + } else { + yParameterNames <- c("criticalValuesEffectScale", "criticalValuesEffectScaleMirrored") + } + + if (is.na(legendPosition)) { + legendPosition <- C_POSITION_RIGHT_TOP + } + + if (is.na(legendPosition)) { + legendPosition <- C_POSITION_RIGHT_TOP + } + + srcCmd <- .showPlotSourceInformation( + objectName = designPlanName, + xParameterName = xParameterNameSrc, + yParameterNames = yParameterNamesSrc, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + + if (groupedPlotEnabled) { + tableColumnNames <- C_TABLE_COLUMN_NAMES + criticalValuesName <- designPlan$.getDataFrameColumnCaption("criticalValuesEffectScale", tableColumnNames, TRUE) + futilityBoundsName <- designPlan$.getDataFrameColumnCaption("futilityBoundsEffectScale", tableColumnNames, TRUE) + + designPlan <- data.frame( + xValues = rep(data[[xParameterName]], 4), + yValues = c( + data$criticalValues, data$criticalValuesMirrored, + data$futilityBounds, data$futilityBoundsMirrored + ), + categories = c( + rep(criticalValuesName, nrow(data)), rep("criticalValuesMirrored", nrow(data)), + rep(futilityBoundsName, nrow(data)), rep("futilityBoundsMirrored", nrow(data)) + ), + groups = c(rep(criticalValuesName, 2 * nrow(data)), rep(futilityBoundsName, 2 * nrow(data))) + ) + } else { + designPlan <- data + } + } else if (type == 3) { # Stage Levels + if (is.na(main)) { + main <- PlotSubTitleItems(title = "Boundaries p Values Scale") + .addPlotSubTitleItems(designPlan, designMaster, main, type) + if (!is.null(reducedParam)) { + main$add(reducedParam$title, reducedParam$value, reducedParam$subscript) + } + } + + if (survivalDesignPlanEnabled) { + xParameterName <- "eventsPerStage" + yParameterNames <- "stageLevels" + designPlan <- data.frame( + eventsPerStage = designPlan$eventsPerStage[, 1], + stageLevels = designMaster$stageLevels + ) + xParameterNameSrc <- "eventsPerStage[, 1]" + yParameterNamesSrc <- ".design$stageLevels" + } else { + xParameterName <- "informationRates" + yParameterNames <- "stageLevels" + designPlan <- TrialDesignSetR6$new(design = designMaster, singleDesign = TRUE) + xParameterNameSrc <- ".design$informationRates" + yParameterNamesSrc <- ".design$stageLevels" + } + + srcCmd <- .showPlotSourceInformation( + objectName = designPlanName, + xParameterName = xParameterNameSrc, + yParameterNames = yParameterNamesSrc, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + } else if (type == 4) { # Alpha Spending + if (is.na(main)) { + main <- PlotSubTitleItems(title = "Error Spending") + .addPlotSubTitleItems(designPlan, designMaster, main, type) + if (!is.null(reducedParam)) { + main$add(reducedParam$title, reducedParam$value, reducedParam$subscript) + } + } + if (survivalDesignPlanEnabled) { + xParameterName <- "eventsPerStage" + yParameterNames <- "alphaSpent" + designPlan <- data.frame( + eventsPerStage = designPlan$eventsPerStage[, 1], + alphaSpent = designMaster$alphaSpent + ) + xParameterNameSrc <- "eventsPerStage[, 1]" + yParameterNamesSrc <- ".design$alphaSpent" + } else { + xParameterName <- "informationRates" + yParameterNames <- "alphaSpent" + designPlan <- TrialDesignSetR6$new(design = designMaster, singleDesign = TRUE) + xParameterNameSrc <- ".design$informationRates" + yParameterNamesSrc <- ".design$alphaSpent" + } + plotPointsEnabled <- ifelse(is.na(plotPointsEnabled), FALSE, plotPointsEnabled) + + srcCmd <- .showPlotSourceInformation( + objectName = designPlanName, + xParameterName = xParameterNameSrc, + yParameterNames = yParameterNamesSrc, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + } else if (type == 5) { # Power and Stopping Probabilities + + .assertIsValidVariedParameterVectorForPlotting(designPlan, type) + + if (designPlan$.isSampleSizeObject()) { + if (is.na(main)) { + main <- PlotSubTitleItems(title = "Sample Size") + .addPlotSubTitleItems(designPlan, designMaster, main, type) + } + + yAxisScalingEnabled <- TRUE + + if (.isTrialDesignPlanMeans(designPlan)) { + xParameterName <- "alternative" + yParameterNames <- c("nFixed") + if (designMaster$kMax > 1) { + yParameterNames <- c(yParameterNames, "maxNumberOfSubjects", "expectedNumberOfSubjectsH1") + } + if (is.na(ylab)) { + ylab <- "Sample Size" + } + yAxisScalingEnabled <- FALSE + if (is.na(legendPosition)) { + legendPosition <- C_POSITION_RIGHT_TOP + } + yParameterNamesSrc <- yParameterNames + } else if (.isTrialDesignPlanRates(designPlan)) { + xParameterName <- "pi1" + yParameterNames <- c("nFixed") + if (designMaster$kMax > 1) { + yParameterNames <- c(yParameterNames, "maxNumberOfSubjects", "expectedNumberOfSubjectsH1") + } + if (is.na(ylab)) { + ylab <- "Sample Size" + } + yAxisScalingEnabled <- FALSE + if (is.na(legendPosition)) { + legendPosition <- C_POSITION_RIGHT_TOP + } + yParameterNamesSrc <- yParameterNames + } else if (survivalDesignPlanEnabled) { + designPlan <- data.frame( + hazardRatio = designPlan$hazardRatio, + eventsFixed = designPlan$eventsFixed, + maxNumberOfEvents = designPlan$eventsPerStage[designMaster$kMax, ], + expectedEventsH1 = designPlan$expectedEventsH1 + ) + xParameterName <- "hazardRatio" + yParameterNames <- c("eventsFixed") + if (designMaster$kMax > 1) { + yParameterNames <- c(yParameterNames, "maxNumberOfEvents", "expectedEventsH1") + } + if (is.na(ylab)) { + ylab <- "# Events" + } + + if (is.na(legendPosition)) { + legendPosition <- C_POSITION_RIGHT_TOP + } + yParameterNamesSrc <- c( + "eventsFixed", + paste0("eventsPerStage[", designMaster$kMax, ", ]"), "expectedEventsH1" + ) + } + + srcCmd <- .showPlotSourceInformation( + objectName = designPlanName, + xParameterName = xParameterName, + yParameterNames = yParameterNamesSrc, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + if (!is.null(srcCmd)) { + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(srcCmd)) + } + return(srcCmd) + } + + return(.plotParameterSet( + parameterSet = designPlan, designMaster = designMaster, + xParameterName = xParameterName, + yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, + palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, + legendPosition = legendPosition, variedParameters = variedParameters, + qnormAlphaLineEnabled = FALSE, yAxisScalingEnabled = FALSE, + plotSettings = plotSettings # , ... + )) + } else { + if (is.na(main)) { + main <- PlotSubTitleItems(title = "Overall Power and Early Stopping") + .addPlotSubTitleItems(designPlan, designMaster, main, type) + } + if (survivalDesignPlanEnabled) { + xParameterName <- "hazardRatio" + } else { + xParameterName <- "effect" + } + yParameterNames <- c("overallReject", "futilityStop", "earlyStop") + + if (is.na(ylab)) { + ylab <- "" + } + if (is.na(legendPosition)) { + legendPosition <- C_POSITION_LEFT_TOP + } + + srcCmd <- .showPlotSourceInformation( + objectName = designPlanName, + xParameterName = xParameterName, + yParameterNames = yParameterNames, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + if (!is.null(srcCmd)) { + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(srcCmd)) + } + return(srcCmd) + } + + if (is.null(list(...)[["ylim"]])) { + ylim <- c(0, 1) + return(.plotParameterSet( + parameterSet = designPlan, designMaster = designMaster, + xParameterName = xParameterName, + yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, + palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, + legendPosition = legendPosition, variedParameters = variedParameters, + qnormAlphaLineEnabled = FALSE, yAxisScalingEnabled = FALSE, + plotSettings = plotSettings, ylim = ylim # , ... + )) + } else { + return(.plotParameterSet( + parameterSet = designPlan, designMaster = designMaster, + xParameterName = xParameterName, + yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, + palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, + legendPosition = legendPosition, variedParameters = variedParameters, + qnormAlphaLineEnabled = FALSE, yAxisScalingEnabled = FALSE, + plotSettings = plotSettings # , ... + )) + } + } + } else if (type == 6) { # Average Sample Size / Average Event Number + .assertIsValidVariedParameterVectorForPlotting(designPlan, type) + + if (is.na(main)) { + titlePart <- ifelse(survivalDesignPlanEnabled, "Number of Events", "Sample Size") + main <- PlotSubTitleItems(title = paste0("Expected ", titlePart, " and Power / Early Stop")) + .addPlotSubTitleItems(designPlan, designMaster, main, type) + } + + if (survivalDesignPlanEnabled) { + xParameterName <- "hazardRatio" + yParameterNames <- "expectedNumberOfEvents" + expectedNumberOfEvents <- designPlan[["expectedNumberOfEvents"]] + if (is.null(expectedNumberOfEvents) || length(expectedNumberOfEvents) == 0) { + yParameterNames <- "expectedEventsH1" + } + yParameterNames <- c(yParameterNames, "overallReject", "earlyStop") # overallReject = power + if (is.na(legendPosition)) { + legendPosition <- C_POSITION_RIGHT_CENTER + } + } else { + xParameterName <- "effect" + yParameterNames <- c("expectedNumberOfSubjects", "overallReject", "earlyStop") # overallReject = power + } + srcCmd <- .showPlotSourceInformation( + objectName = designPlanName, + xParameterName = xParameterName, + yParameterNames = yParameterNames, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + } else if (type == 7) { + .assertIsValidVariedParameterVectorForPlotting(designPlan, type) + + if (is.na(main)) { + main <- PlotSubTitleItems(title = "Overall Power") + .addPlotSubTitleItems(designPlan, designMaster, main, type) + } + + if (survivalDesignPlanEnabled) { + xParameterName <- "hazardRatio" + } else { + xParameterName <- "effect" + } + yParameterNames <- "overallReject" + if (is.na(legendPosition)) { + legendPosition <- C_POSITION_RIGHT_CENTER + } + srcCmd <- .showPlotSourceInformation( + objectName = designPlanName, + xParameterName = xParameterName, + yParameterNames = yParameterNames, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + } else if (type == 8) { + .assertIsValidVariedParameterVectorForPlotting(designPlan, type) + + if (is.na(main)) { + main <- PlotSubTitleItems(title = "Overall Early Stopping") + .addPlotSubTitleItems(designPlan, designMaster, main, type) + } + + if (survivalDesignPlanEnabled) { + xParameterName <- "hazardRatio" + } else { + xParameterName <- "effect" + } + yParameterNames <- c("earlyStop", "futilityStop") + if (is.na(legendPosition)) { + legendPosition <- C_POSITION_RIGHT_CENTER + } + srcCmd <- .showPlotSourceInformation( + objectName = designPlanName, + xParameterName = xParameterName, + yParameterNames = yParameterNames, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + } else if (type == 9) { + .assertIsValidVariedParameterVectorForPlotting(designPlan, type) + + if (is.na(main)) { + if (survivalDesignPlanEnabled) { + main <- PlotSubTitleItems(title = "Expected Number of Events") + } else { + main <- PlotSubTitleItems(title = "Expected Sample Size") + } + .addPlotSubTitleItems(designPlan, designMaster, main, type) + } + + if (survivalDesignPlanEnabled) { + xParameterName <- "hazardRatio" + yParameterNames <- "expectedNumberOfEvents" + expectedNumberOfEvents <- designPlan[["expectedNumberOfEvents"]] + if (is.null(expectedNumberOfEvents) || length(expectedNumberOfEvents) == 0) { + yParameterNames <- c("expectedEventsH0", "expectedEventsH1") + if (is.na(legendPosition)) { + legendPosition <- C_POSITION_RIGHT_CENTER + } + } + } else { + xParameterName <- "effect" + yParameterNames <- "expectedNumberOfSubjects" + } + srcCmd <- .showPlotSourceInformation( + objectName = designPlanName, + xParameterName = xParameterName, + yParameterNames = yParameterNames, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + } else if (survivalDesignPlanEnabled) { + if (type == 10) { # Study Duration + .assertIsValidVariedParameterVectorForPlotting(designPlan, type) + if (is.na(main)) { + main <- PlotSubTitleItems(title = "Study Duration") + .addPlotSubTitleItems(designPlan, designMaster, main, type) + } + xParameterName <- "hazardRatio" + yParameterNames <- "studyDuration" + srcCmd <- .showPlotSourceInformation( + objectName = designPlanName, + xParameterName = xParameterName, + yParameterNames = yParameterNames, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + } else if (type == 11) { + .assertIsValidVariedParameterVectorForPlotting(designPlan, type) + if (is.na(main)) { + main <- PlotSubTitleItems(title = "Expected Number of Subjects") + .addPlotSubTitleItems(designPlan, designMaster, main, type) + } + xParameterName <- "hazardRatio" + yParameterNames <- "expectedNumberOfSubjects" + srcCmd <- .showPlotSourceInformation( + objectName = designPlanName, + xParameterName = xParameterName, + yParameterNames = yParameterNames, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + } else if (type == 12) { # Analysis Time + .assertIsValidVariedParameterVectorForPlotting(designPlan, type) + if (is.na(main)) { + main <- PlotSubTitleItems(title = "Analysis Time") + .addPlotSubTitleItems(designPlan, designMaster, main, type) + } + + xParameterName <- "hazardRatio" + yParameterNames <- "analysisTime" + yParameterNamesSrc <- c() + for (i in 1:nrow(designPlan[["analysisTime"]])) { + yParameterNamesSrc <- c(yParameterNamesSrc, paste0("analysisTime[", i, ", ]")) + } + + data <- NULL + for (k in 1:designMaster$kMax) { + part <- data.frame( + categories = rep(k, length(designPlan$hazardRatio)), + xValues = designPlan$hazardRatio, + yValues = designPlan$analysisTime[k, ] + ) + if (is.null(data)) { + data <- part + } else { + data <- rbind(data, part) + } + } + + srcCmd <- .showPlotSourceInformation( + objectName = designPlanName, + xParameterName = xParameterName, + yParameterNames = yParameterNamesSrc, + hint = showSourceHint, + type = type, showSource = showSource + ) + if (!is.null(srcCmd)) { + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(srcCmd)) + } + return(srcCmd) + } + + return(.plotDataFrame(data, + mainTitle = main, + xlab = NA_character_, ylab = NA_character_, xAxisLabel = "Hazard Ratio", + yAxisLabel1 = "Analysis Time", yAxisLabel2 = NA_character_, + plotPointsEnabled = TRUE, legendTitle = "Stage", + legendPosition = legendPosition, sided = designMaster$sided, + plotSettings = plotSettings, ... + )) + } else if (type == 13 || type == 14) { # Cumulative Distribution Function / Survival function + return(.plotSurvivalFunction(designPlan, + designMaster = designMaster, type = type, main = main, + xlab = xlab, ylab = ylab, palette = palette, + legendPosition = legendPosition, showSource = showSource, + designPlanName = designPlanName, + plotSettings = plotSettings, ... + )) + } else { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is not allowed; must be 1, 2, ..., 14") + } + } else { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is not allowed; must be 1, 2, ..., 9") + } + + if (!is.null(srcCmd)) { + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(srcCmd)) + } + return(srcCmd) + } + + p <- .plotParameterSet( + parameterSet = designPlan, designMaster = designMaster, + xParameterName = xParameterName, + yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, + palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, + legendPosition = legendPosition, variedParameters = variedParameters, + qnormAlphaLineEnabled = (type != 2), ratioEnabled = ratioEnabled, + plotSettings = plotSettings # , ... + ) + + if (type == 1 && survivalDesignPlanEnabled) { + p <- .addDecistionCriticalValuesToPlot(p = p, designMaster = designMaster, type = type, nMax = nMax) + } + return(p) +} + +.getSurvivalFunctionPlotCommand <- function(functionType = c("pwExpDist", "lambdaStep"), timeValues, lambda, + designPlan, type, piecewiseSurvivalEnabled, multiplyByHazardRatio = FALSE) { + functionType <- match.arg(functionType) + signPrefix <- ifelse(type == 13, "", "-") + if (functionType == "pwExpDist") { + functionName <- "getPiecewiseExponentialDistribution" + } else { + functionName <- "getLambdaStepFunction" + } + cmd <- paste0( + signPrefix, functionName, + "(", .reconstructSequenceCommand(timeValues), + ", piecewiseLambda = ", .arrayToString(lambda, vectorLookAndFeelEnabled = TRUE) + ) + if (piecewiseSurvivalEnabled) { + cmd <- paste0( + cmd, ", piecewiseSurvivalTime = ", + .arrayToString(designPlan$piecewiseSurvivalTime, vectorLookAndFeelEnabled = TRUE) + ) + } + if (functionType == "pwExpDist") { + cmd <- paste0(cmd, ", kappa = ", designPlan$kappa) + } + cmd <- paste0(cmd, ")") + if (multiplyByHazardRatio) { + cmd <- paste0(cmd, " * ", designPlan$hazardRatio[1]) + } + return(cmd) +} + +# Cumulative Distribution Function / Survival function +.plotSurvivalFunction <- function(designPlan, ..., designMaster, type = c(13, 14), main = NA_character_, + xlab = NA_character_, ylab = NA_character_, palette = "Set1", + legendPosition = NA_integer_, showSource = FALSE, + designPlanName = NA_character_, plotSettings = NULL) { + startTime <- Sys.time() + if (is.null(designPlan$piecewiseSurvivalTime) || + length(designPlan$piecewiseSurvivalTime) == 0) { + stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'piecewiseSurvivalTime' must be specified") + } + + type <- type[1] + if (!(type %in% c(13, 14))) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' must be 13 or 14") + } + + lambda1 <- designPlan[["lambda1"]] + lambda2 <- designPlan[["lambda2"]] + if (is.null(lambda2) || length(lambda2) == 0) { + stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'lambda2' must be specified") + } + + if (is.null(designPlan$kappa) || length(designPlan$kappa) == 0) { + stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'kappa' must be specified") + } + + if (is.null(designPlan$hazardRatio) || length(designPlan$hazardRatio) == 0) { + stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'hazardRatio' must be specified") + } + + piecewiseSurvivalEnabled <- designPlan$.piecewiseSurvivalTime$piecewiseSurvivalEnabled + + if (is.na(main)) { + if (type == 13) { + main <- PlotSubTitleItems(title = "Cumulative Distribution Function") + } else { + main <- PlotSubTitleItems(title = "Survival Function") + } + .addPlotSubTitleItems(designPlan, designMaster, main, type) + if (!piecewiseSurvivalEnabled) { + if (designPlan$.piecewiseSurvivalTime$.isLambdaBased(minNumberOfLambdas = 1)) { + main$add("lambda", round(designPlan$lambda1[1], 4), 1) + main$add("lambda", round(designPlan$lambda2, 4), 2) + } else { + main$add("pi", round(designPlan$pi1[1], 3), 1) + main$add("pi", round(designPlan$pi2, 3), 2) + } + } else if (length(designPlan$hazardRatio) == 1) { + main$add("Hazard Ratio", round(designPlan$hazardRatio[1], 3)) + } + } + + if (!piecewiseSurvivalEnabled || (length(designPlan$piecewiseSurvivalTime) == 1 && + designPlan$piecewiseSurvivalTime[1] == 0)) { + timeTo <- max(designPlan$analysisTime[designMaster$kMax, ]) + } else { + timeTo <- max(designPlan$piecewiseSurvivalTime) + } + if (is.na(timeTo) || !is.numeric(timeTo) || is.infinite(timeTo)) { + # warning("Unable to determine upper bound of time values", call. = FALSE) + timeTo <- 0 + } + + timeTo <- timeTo + 10 + by <- timeTo / 1000 + timeValues <- seq(from = 0, to = timeTo, by = by) + + data <- data.frame( + time = timeValues, + lambdaGroup1 = rep(-1, length(timeValues)), + lambdaGroup2 = rep(-1, length(timeValues)), + survival1 = rep(-1, length(timeValues)), + survival2 = rep(-1, length(timeValues)), + survivalGroup1 = rep(-1, length(timeValues)), + survivalGroup2 = rep(-1, length(timeValues)) + ) + + signPrefix <- ifelse(type == 13, "", "-") + if (piecewiseSurvivalEnabled) { + data$survival2 <- .getPiecewiseExponentialDistribution( + timeValues, + lambda2, designPlan$piecewiseSurvivalTime, designPlan$kappa + ) + + yParameterNames <- .getSurvivalFunctionPlotCommand( + "pwExpDist", + timeValues, lambda2, designPlan, type, piecewiseSurvivalEnabled + ) + + if (!is.null(lambda1) && !all(is.na(lambda1)) && + length(lambda1) == length(lambda2)) { + data$survival1 <- .getPiecewiseExponentialDistribution( + timeValues, + lambda1, designPlan$piecewiseSurvivalTime, designPlan$kappa + ) + yParameterNames <- c( + yParameterNames, + .getSurvivalFunctionPlotCommand( + "pwExpDist", + timeValues, lambda1, designPlan, type, piecewiseSurvivalEnabled + ) + ) + } else { + .warnInCaseOfUnusedValuesForPlottingSurvival(designPlan$hazardRatio) + data$survival1 <- data$survival2 * designPlan$hazardRatio[1] + yParameterNames <- c( + yParameterNames, + .getSurvivalFunctionPlotCommand("pwExpDist", timeValues, lambda2, + designPlan, type, piecewiseSurvivalEnabled, + multiplyByHazardRatio = TRUE + ) + ) + } + + yParameterNames <- c( + yParameterNames, + .getSurvivalFunctionPlotCommand( + "lambdaStep", + timeValues, lambda2, designPlan, type, piecewiseSurvivalEnabled + ) + ) + if (!is.null(lambda1) && !all(is.na(lambda1)) && + length(lambda1) == length(lambda2)) { + yParameterNames <- c( + yParameterNames, + .getSurvivalFunctionPlotCommand( + "lambdaStep", + timeValues, lambda1, designPlan, type, piecewiseSurvivalEnabled + ) + ) + } else { + yParameterNames <- c( + yParameterNames, + .getSurvivalFunctionPlotCommand("lambdaStep", timeValues, lambda2, + designPlan, type, piecewiseSurvivalEnabled, + multiplyByHazardRatio = TRUE + ) + ) + } + } else { + if (designPlan$.piecewiseSurvivalTime$.isLambdaBased(minNumberOfLambdas = 1)) { + if (length(designPlan$lambda1) > 1) { + lambda1 <- designPlan$lambda1[1] + warning("Only the first 'lambda1' (", round(lambda1, 4), + ") was used for plotting", + call. = FALSE + ) + } + } else { + .warnInCaseOfUnusedValuesForPlottingRates(designPlan$pi1) + } + + if (!is.na(designPlan$pi1[1]) && !is.na(designPlan$pi2) && !is.na(designPlan$eventTime)) { + lambda2 <- (-log(1 - designPlan$pi2))^(1 / designPlan$kappa) / designPlan$eventTime + lambda1 <- (-log(1 - designPlan$pi1[1]))^(1 / designPlan$kappa) / designPlan$eventTime + } + + data$survival2 <- .getPiecewiseExponentialDistribution( + timeValues, + lambda2, 0, designPlan$kappa + ) + data$survival1 <- .getPiecewiseExponentialDistribution( + timeValues, + lambda1, 0, designPlan$kappa + ) + + yParameterNames <- .getSurvivalFunctionPlotCommand( + "pwExpDist", + timeValues, lambda2, designPlan, type, piecewiseSurvivalEnabled + ) + yParameterNames <- c( + yParameterNames, + .getSurvivalFunctionPlotCommand( + "pwExpDist", + timeValues, lambda1, designPlan, type, piecewiseSurvivalEnabled + ) + ) + yParameterNames <- c( + yParameterNames, + .getSurvivalFunctionPlotCommand( + "lambdaStep", + timeValues, lambda2, designPlan, type, piecewiseSurvivalEnabled + ) + ) + yParameterNames <- c( + yParameterNames, + .getSurvivalFunctionPlotCommand( + "lambdaStep", timeValues, lambda1, + designPlan, type, piecewiseSurvivalEnabled + ) + ) + } + + # two groups: 1 = treatment, 2 = control + if (type == 14) { + data$survival1 <- 1 - data$survival1 + data$survival2 <- 1 - data$survival2 + } + + if (piecewiseSurvivalEnabled) { + data$lambdaGroup2 <- .getLambdaStepFunction( + timeValues, + designPlan$piecewiseSurvivalTime, lambda2 + ) + if (length(lambda1) == 1) { + if (!is.na(lambda1)) { + data$lambdaGroup1 <- rep(lambda1, length(data$lambdaGroup2)) + } else { + data$lambdaGroup1 <- data$lambdaGroup2 * designPlan$hazardRatio[1] + } + } else { + data$lambdaGroup1 <- .getLambdaStepFunction( + timeValues, + designPlan$piecewiseSurvivalTime, lambda1 + ) + } + } else { + data$lambdaGroup2 <- .getLambdaStepFunction(timeValues, 0, lambda2) + data$lambdaGroup1 <- .getLambdaStepFunction(timeValues, 0, lambda1) + } + + scalingBaseValues1 <- na.omit(c(data$survival1, data$survival2)) + scalingBaseValues2 <- na.omit(c(data$lambdaGroup1, data$lambdaGroup2)) + scalingFactor <- 1 + if (length(scalingBaseValues1) > 0 && length(scalingBaseValues2) > 0) { + scalingFactor <- max(scalingBaseValues1) / max(.getNextHigherValue(scalingBaseValues2)) + } + data2 <- data.frame( + categories = c( + rep("Treatm. piecew. exp.", nrow(data)), + rep("Control piecew. exp.", nrow(data)), + rep("Treatm. piecew. lambda", nrow(data)), + rep("Control piecew. lambda", nrow(data)) + ), + xValues = rep(data$time, 4), + yValues = c( + data$survival1, + data$survival2, + data$lambdaGroup1 * scalingFactor, + data$lambdaGroup2 * scalingFactor + ) + ) + + if (is.na(legendPosition)) { + if (type == 13) { + legendPosition <- C_POSITION_LEFT_TOP + } else { + legendPosition <- C_POSITION_RIGHT_TOP + } + } + + if (is.na(palette) || palette == "Set1") { + palette <- "Paired" + } + + if (type == 13) { + yAxisLabel1 <- "Cumulative Distribution Function" + } else { + yAxisLabel1 <- "Survival Function" + } + + srcCmd <- .showPlotSourceInformation( + objectName = designPlanName, + xParameterName = "time", + yParameterNames = yParameterNames, + showSource = showSource, + xValues = timeValues + ) + if (!is.null(srcCmd)) { + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(srcCmd)) + } + return(srcCmd) + } + + if (is.null(plotSettings)) { + plotSettings <- designPlan$.plotSettings + } + + return(.plotDataFrame(data2, + mainTitle = main, + xlab = xlab, ylab = ylab, xAxisLabel = "Time", + yAxisLabel1 = yAxisLabel1, yAxisLabel2 = "Lambda", + plotPointsEnabled = FALSE, legendTitle = NA_character_, + legendPosition = legendPosition, scalingFactor1 = 1, + scalingFactor2 = scalingFactor, palette = palette, sided = designMaster$sided, + plotSettings = plotSettings + )) +} + +.warnInCaseOfUnusedValuesForPlottingMeans <- function(alternative) { + if (length(alternative) > 1) { + warning("Only the first 'alternative' (", round(alternative[1], 3), + ") was used for plotting", + call. = FALSE + ) + return(list(title = "alternative", value = alternative[1], subscript = NA_character_)) + } + return(NULL) +} + +.warnInCaseOfUnusedValuesForPlottingRates <- function(pi1) { + if (length(pi1) > 1) { + warning("Only the first 'pi1' (", round(pi1[1], 3), + ") was used for plotting", + call. = FALSE + ) + return(list(title = "pi", value = pi1[1], subscript = "1")) + } + return(NULL) +} + +.warnInCaseOfUnusedValuesForPlottingSurvival <- function(hazardRatio) { + if (length(hazardRatio) > 1) { + warning("Only the first 'hazardRatio' (", round(hazardRatio[1], 3), + ") was used for plotting", + call. = FALSE + ) + return(list(title = "hazardRatio", value = hazardRatio[1], subscript = NA_character_)) + } + return(NULL) +} + +.warnInCaseOfUnusedValuesForPlotting <- function(designPlan) { + if (.isTrialDesignPlanMeans(designPlan) && designPlan$.isSampleSizeObject()) { + return(.warnInCaseOfUnusedValuesForPlottingMeans(designPlan$alternative)) + } + if (.isTrialDesignPlanRates(designPlan) && designPlan$.isSampleSizeObject()) { + return(.warnInCaseOfUnusedValuesForPlottingRates(designPlan$pi1)) + } + if (.isTrialDesignPlanSurvival(designPlan) && designPlan$.isSampleSizeObject()) { + return(.warnInCaseOfUnusedValuesForPlottingSurvival(designPlan$hazardRatio)) + } + return(NULL) +} + +#' +#' @title +#' Trial Design Plan Plotting +#' +#' @param x The trial design plan, obtained from \cr +#' \code{\link[=getSampleSizeMeans]{getSampleSizeMeans()}}, \cr +#' \code{\link[=getSampleSizeRates]{getSampleSizeRates()}}, \cr +#' \code{\link[=getSampleSizeSurvival]{getSampleSizeSurvival()}}, \cr +#' \code{\link[=getPowerMeans]{getPowerMeans()}}, \cr +#' \code{\link[=getPowerRates]{getPowerRates()}} or \cr +#' \code{\link[=getPowerSurvival]{getPowerSurvival()}}. +#' @param y Not available for this kind of plot (is only defined to be compatible to the generic plot function). +#' @param main The main title. +#' @param xlab The x-axis label. +#' @param ylab The y-axis label. +#' @inheritParams param_palette +#' @inheritParams param_theta +#' @inheritParams param_plotPointsEnabled +#' @inheritParams param_showSource +#' @inheritParams param_plotSettings +#' @inheritParams param_legendPosition +#' @inheritParams param_grid +#' @param type The plot type (default = \code{1}). The following plot types are available: +#' \itemize{ +#' \item \code{1}: creates a 'Boundaries' plot +#' \item \code{2}: creates a 'Boundaries Effect Scale' plot +#' \item \code{3}: creates a 'Boundaries p Values Scale' plot +#' \item \code{4}: creates a 'Error Spending' plot +#' \item \code{5}: creates a 'Sample Size' or 'Overall Power and Early Stopping' plot +#' \item \code{6}: creates a 'Number of Events' or 'Sample Size' plot +#' \item \code{7}: creates an 'Overall Power' plot +#' \item \code{8}: creates an 'Overall Early Stopping' plot +#' \item \code{9}: creates an 'Expected Number of Events' or 'Expected Sample Size' plot +#' \item \code{10}: creates a 'Study Duration' plot +#' \item \code{11}: creates an 'Expected Number of Subjects' plot +#' \item \code{12}: creates an 'Analysis Times' plot +#' \item \code{13}: creates a 'Cumulative Distribution Function' plot +#' \item \code{14}: creates a 'Survival Function' plot +#' \item \code{"all"}: creates all available plots and returns it as a grid plot or list +#' } +#' @inheritParams param_three_dots_plot +#' +#' @description +#' Plots a trial design plan. +#' +#' @details +#' Generic function to plot all kinds of trial design plans. +#' +#' @examples +#' \dontrun{ +#' if (require(ggplot2)) plot(getSampleSizeMeans()) +#' } +#' +#' @template return_object_ggplot +#' +#' @export +#' +plot.TrialDesignPlanR6 <- function(x, y, ..., main = NA_character_, + xlab = NA_character_, ylab = NA_character_, + type = ifelse(x$.design$kMax == 1, 5L, 1L), palette = "Set1", + theta = seq(-1, 1, 0.01), plotPointsEnabled = NA, + legendPosition = NA_integer_, showSource = FALSE, + grid = 1, plotSettings = NULL) { + fCall <- match.call(expand.dots = FALSE) + designPlanName <- deparse(fCall$x) + .assertGgplotIsInstalled() + .assertIsSingleInteger(grid, "grid", validateType = FALSE) + + nMax <- list(...)[["nMax"]] + if (!is.null(nMax)) { + warning( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'nMax' (", nMax, + ") will be ignored because it will be taken from design plan" + ) + } + + typeNumbers <- .getPlotTypeNumber(type, x) + if (is.null(plotSettings)) { + plotSettings <- .getGridPlotSettings(x, typeNumbers, grid) + } + p <- NULL + plotList <- list() + for (typeNumber in typeNumbers) { + p <- .plotTrialDesignPlan( + designPlan = x, + main = main, xlab = xlab, ylab = ylab, type = typeNumber, + palette = palette, theta = theta, plotPointsEnabled = plotPointsEnabled, + legendPosition = .getGridLegendPosition(legendPosition, typeNumbers, grid), + showSource = showSource, designPlanName = designPlanName, + plotSettings = plotSettings, ... + ) + .printPlotShowSourceSeparator(showSource, typeNumber, typeNumbers) + if (length(typeNumbers) > 1) { + caption <- .getPlotCaption(x, typeNumber, stopIfNotFound = TRUE) + plotList[[caption]] <- p + } + } + if (length(typeNumbers) == 1) { + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(p)) + } + + return(p) + } + + if (length(plotList) == 0) { + message("No plots available for the specified design plan for ", x$.toString()) + } + + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(plotList)) + } + + return(.createPlotResultObject(plotList, grid)) +} diff --git a/R/class_design_power_and_asn.R b/R/class_design_power_and_asn.R index 4c706d2b..9ef8775a 100644 --- a/R/class_design_power_and_asn.R +++ b/R/class_design_power_and_asn.R @@ -53,7 +53,7 @@ PowerAndAverageSampleNumberResult <- setRefClass("PowerAndAverageSampleNumberResult", contains = "ParameterSet", fields = list( - .design = "TrialDesign", + .design = "ANY", nMax = "numeric", theta = "numeric", averageSampleNumber = "numeric", diff --git a/R/class_design_r6.R b/R/class_design_r6.R new file mode 100644 index 00000000..88c899cc --- /dev/null +++ b/R/class_design_r6.R @@ -0,0 +1,1251 @@ +library("R6") +## | +## | *Trial design classes* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | rpact package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File version: $Revision: 7126 $ +## | Last changed: $Date: 2023-06-23 14:26:39 +0200 (Fr, 23 Jun 2023) $ +## | Last changed by: $Author: pahlke $ +## | + + +#' @include f_core_constants.R +#' @include f_core_plot.R +#' @include f_core_utilities.R +NULL + +#' +#' @name TrialDesign +#' +#' @title +#' Basic Trial Design +#' +#' @description +#' Basic class for trial designs. +#' +#' @template field_kMax +#' @template field_alpha +#' @template field_stages +#' @template field_informationRates +#' @template field_userAlphaSpending +#' @template field_criticalValues +#' @template field_stageLevels +#' @template field_alphaSpent +#' @template field_bindingFutility +#' @template field_tolerance +#' +#' @details +#' \code{TrialDesign} is the basic class for +#' \itemize{ +#' \item \code{\link{TrialDesignFisher}}, +#' \item \code{\link{TrialDesignGroupSequential}}, +#' \item \code{\link{TrialDesignInverseNormal}}, and +#' \item \code{\link{TrialDesignConditionalDunnett}}. +#' } +#' +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include f_core_constants.R +#' @include f_core_plot.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +TrialDesignR6 <- R6Class("TrialDesignR6", + inherit = ParameterSetR6, + public = list( + .plotSettings = NULL, + kMax = NULL, + alpha = NULL, + stages = NULL, + informationRates = NULL, + userAlphaSpending = NULL, + criticalValues = NULL, + stageLevels = NULL, + alphaSpent = NULL, + bindingFutility = NULL, + tolerance = NULL, + initialize = function(..., + kMax = NA_integer_, + alpha = NA_real_, + informationRates = NA_real_, + userAlphaSpending = NA_real_, + criticalValues = NA_real_, + stageLevels = NA_real_, + alphaSpent = NA_real_, + bindingFutility = NA, + tolerance = 1e-06 # C_ANALYSIS_TOLERANCE_DEFAULT + ) { + + self$kMax <- kMax #NEW + self$alpha <- alpha + self$informationRates <- informationRates + self$userAlphaSpending <- userAlphaSpending + self$criticalValues <- criticalValues + self$stageLevels <- stageLevels + self$alphaSpent <- alphaSpent + self$bindingFutility <- bindingFutility + self$tolerance <- tolerance + super$initialize(...) + + self$.plotSettings <- PlotSettingsR6$new() + + if (inherits(self, "TrialDesignConditionalDunnettR6")) { + self$.parameterNames <- C_PARAMETER_NAMES + } else { + self$.parameterNames <- self$.getSubListByNames(.getParameterNames(design = self), c(#TODO + "stages", + "kMax", + "alpha", + "informationRates", + "userAlphaSpending", + "criticalValues", + "stageLevels", + "alphaSpent", + "bindingFutility", + "tolerance" + )) + } + + self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS + + self$.initStages() + }, + show = function(showType = 1, digits = NA_integer_) { + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + }, + .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { + "Method for automatically printing trial design objects" + self$.resetCat() + if (showType == 3) { + .createSummary(self, digits = digits)$.show(#TODO should not work + showType = 1, + digits = digits, consoleOutputEnabled = consoleOutputEnabled + ) + } else if (showType == 2) { + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + } else { + self$.cat("Design parameters and output of ", self$.toString(), ":\n\n", + heading = 1, + consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getDerivedParameters(), "Derived from user defined parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Output", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + } + }, + .toString = function(startWithUpperCase = FALSE) { + s <- "unknown trial design" + if (.isTrialDesignGroupSequential(self)) {#TODO + s <- "group sequential design" + } else if (.isTrialDesignInverseNormal(self)) {#TODO + s <- "inverse normal combination test design" + } else if (.isTrialDesignFisher(self)) {#TODO + s <- "Fisher's combination test design" + } else if (.isTrialDesignConditionalDunnett(self)) {#TODO + s <- "conditional Dunnett test design" + } + return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) + }, + .initStages = function() { + if (length(self$kMax) == 1 && !is.na(self$kMax) && self$kMax > 0) { + self$stages <- c(1L:self$kMax) + if (self$kMax == C_KMAX_DEFAULT) { + self$.setParameterType("stages", C_PARAM_DEFAULT_VALUE) + } else { + type <- self$.getParameterType("kMax")#TODO + self$.setParameterType("stages", ifelse(type != C_PARAM_TYPE_UNKNOWN, type, C_PARAM_USER_DEFINED)) + } + } else { + self$.setParameterType("stages", C_PARAM_NOT_APPLICABLE) + } + }, + .isDelayedResponseDesign = function() { + return((inherits(self, "TrialDesignGroupSequentialR6") || inherits(self, "TrialDesignInverseNormalR6")) && + self$kMax > 1 && + !is.null(self[["delayedInformation"]]) &&#TODO + !any(is.na(self$delayedInformation)) && any(self$delayedInformation > 0)) + } + ) +) + +#' +#' @name TrialDesignCharacteristics +#' +#' @title +#' Trial Design Characteristics +#' +#' @description +#' Class for trial design characteristics. +#' +#' @template field_nFixed +#' @template field_shift +#' @template field_inflationFactor +#' @template field_stages +#' @template field_information +#' @template field_power +#' @template field_rejectionProbabilities +#' @template field_futilityProbabilities +#' @template field_averageSampleNumber1 +#' @template field_averageSampleNumber01 +#' @template field_averageSampleNumber0 +#' +#' @details +#' \code{TrialDesignCharacteristics} contains all fields required to collect the characteristics of a design. +#' This object should not be created directly; use \code{getDesignCharacteristics} +#' with suitable arguments to create it. +#' +#' @seealso \code{\link{getDesignCharacteristics}} for getting the design characteristics. +#' +#' @include class_core_parameter_set.R +#' @include f_core_constants.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +TrialDesignCharacteristicsR6 <- R6Class("TrialDesignCharacteristicsR6", + inherit = ParameterSetR6, + public = list( + .design = NULL, + .probs = NULL, + nFixed = NULL, + shift = NULL, + inflationFactor = NULL, + stages = NULL, + information = NULL, + power = NULL, + rejectionProbabilities = NULL, # efficacy probabilities + futilityProbabilities = NULL, + averageSampleNumber1 = NULL, + averageSampleNumber01 = NULL, + averageSampleNumber0 = NULL, + initialize = function(design, ...) { + + self$.design <- design + self$.parameterNames <- .getParameterNames(design = design) + self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS + self$.parameterFormatFunctions[["nFixed"]] <- ".formatProbabilities" + super$initialize(...)#TODO init vars? + self$.initStages() + }, + show = function(showType = 1, digits = NA_integer_) { + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + }, + .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { + "Method for automatically printing trial design characteristics objects" + self$.resetCat() + if (showType == 2) { + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + } else { + self$.showParametersOfOneGroup(self$.getGeneratedParameters(), + title = self$.toString(startWithUpperCase = TRUE), + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + } + }, + .initStages = function() { + if (!is.na(self$.design$kMax) && self$.design$kMax > 0) { + self$stages <- c(1L:self$.design$kMax) + if (self$.design$kMax == C_KMAX_DEFAULT) { + self$.setParameterType("stages", C_PARAM_DEFAULT_VALUE) + } else { + self$.setParameterType("stages", C_PARAM_USER_DEFINED) + } + } else { + self$.setParameterType("stages", C_PARAM_NOT_APPLICABLE) + } + }, + .toString = function(startWithUpperCase = FALSE) { + if (self$.design$.isDelayedResponseDesign()) { + prefix <- "delayed response" + if (startWithUpperCase) { + prefix <- .firstCharacterToUpperCase(prefix) + } + return(paste(prefix, self$.design$.toString(startWithUpperCase = FALSE), "characteristics")) + } + + return(paste(self$.design$.toString(startWithUpperCase = startWithUpperCase), "characteristics")) + } + ) +) + +#' +#' @title +#' Trial Design Characteristics Printing +#' +#' @param x The trial design characteristics object. +#' @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}) +#' @param showDesign Show the design print output above the design characteristics, default is \code{TRUE}. +#' @inheritParams param_three_dots_plot +#' +#' @description +#' Prints the design characteristics object. +#' +#' @details +#' Generic function to print all kinds of design characteristics. +#' +#' @export +#' +print.TrialDesignCharacteristicsR6 <- function(x, ..., markdown = FALSE, showDesign = TRUE) { + if (showDesign) { + print.ParameterSetR6(x$.design, ..., markdown = markdown) + } + print.ParameterSetR6(x, ..., markdown = markdown) +} + +#' +#' @title +#' Coerce TrialDesignCharacteristics to a Data Frame +#' +#' @description +#' Returns the \code{TrialDesignCharacteristics} as data frame. +#' +#' @param x A \code{\link{TrialDesignCharacteristics}} object. +#' @inheritParams param_niceColumnNamesEnabled +#' @inheritParams param_includeAllParameters +#' @inheritParams param_three_dots +#' +#' @details +#' Each element of the \code{\link{TrialDesignCharacteristics}} is converted to a column in the data frame. +#' +#' @template return_dataframe +#' +#' @examples +#' as.data.frame(getDesignCharacteristics(getDesignGroupSequential())) +#' +#' @export +#' +#' @keywords internal +#' +as.data.frame.TrialDesignCharacteristicsR6 <- function(x, row.names = NULL, + optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ...) { + if (x$.design$kMax > 1) { + parameterNamesToBeExcluded <- c("nFixed", "shift") + } else { + parameterNamesToBeExcluded <- c("inflationFactor") + } + return(.getAsDataFrame( + parameterSet = x, + parameterNames = parameterNamesToBeExcluded, + niceColumnNamesEnabled = niceColumnNamesEnabled, + includeAllParameters = includeAllParameters, + handleParameterNamesAsToBeExcluded = TRUE, + tableColumnNames = .getTableColumnNames(design = x$.design) + )) +} + +#' +#' @name TrialDesignFisher +#' +#' @title +#' Fisher Design +#' +#' @description +#' Trial design for Fisher's combination test. +#' +#' @template field_kMax +#' @template field_alpha +#' @template field_stages +#' @template field_informationRates +#' @template field_userAlphaSpending +#' @template field_criticalValues +#' @template field_stageLevels +#' @template field_alphaSpent +#' @template field_bindingFutility +#' @template field_tolerance +#' @template field_method +#' @template field_alpha0Vec +#' @template field_scale +#' @template field_nonStochasticCurtailment +#' @template field_sided +#' @template field_simAlpha +#' @template field_iterations +#' @template field_seed +#' +#' @details +#' This object should not be created directly; use \code{\link{getDesignFisher}} +#' with suitable arguments to create a Fisher combination test design. +#' +#' @seealso \code{\link{getDesignFisher}} for creating a Fisher combination test design. +#' +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include f_core_constants.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +TrialDesignFisherR6 <- R6Class("TrialDesignFisherR6", + inherit = TrialDesignR6, + public = list( + method = NULL, + alpha0Vec = NULL, + scale = NULL, + nonStochasticCurtailment = NULL, + sided = NULL, + simAlpha = NULL, + iterations = NULL, + seed = NULL, + initialize = function(..., + method = NA_character_, + alpha0Vec = NA_real_, + scale = NA_real_, + nonStochasticCurtailment = FALSE, + sided = as.integer(C_SIDED_DEFAULT), + simAlpha = NA_real_, + iterations = 0L, + seed = NA_real_, + tolerance = C_ANALYSIS_TOLERANCE_FISHER_DEFAULT) { + + self$method <- method + self$alpha0Vec <- alpha0Vec + self$scale <- scale + self$nonStochasticCurtailment <- nonStochasticCurtailment + self$sided <- sided + self$simAlpha <- simAlpha + self$iterations <- iterations + self$seed <- seed + self$tolerance <- tolerance + super$initialize(...) + + self$.parameterNames <- c(self$.parameterNames, self$.getSubListByNames( + .getParameterNames(design = self), c( + "method", + "alpha0Vec", + "scale", + "nonStochasticCurtailment", + "sided", + "simAlpha", + "iterations", + "seed" + ) + )) + + self$.parameterFormatFunctions$criticalValues <- ".formatCriticalValuesFisher" + + self$.initParameterTypes() + self$.setParameterType("iterations", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("seed", C_PARAM_NOT_APPLICABLE) + self$.initStages() + }, + hasChanged = function(kMax, alpha, sided, method, informationRates, alpha0Vec, userAlphaSpending, bindingFutility) { + informationRatesTemp <- informationRates + if (any(is.na(informationRatesTemp))) { + informationRatesTemp <- .getInformationRatesDefault(kMax) + } + alpha0VecTemp <- alpha0Vec[1:(kMax - 1)] + if (any(is.na(alpha0VecTemp))) { + alpha0VecTemp <- rep(C_FUTILITY_BOUNDS_DEFAULT, kMax - 1) + } + + if (!identical(kMax, self$kMax)) { + return(TRUE) + } + if (!identical(alpha, self$alpha)) { + return(TRUE) + } + if (!identical(sided, self$sided)) { + return(TRUE) + } + if (!identical(method, self$method)) { + return(TRUE) + } + if (!identical(informationRatesTemp, self$informationRates)) { + return(TRUE) + } + if (!identical(alpha0VecTemp, self$alpha0Vec)) { + return(TRUE) + } + if (!identical(userAlphaSpending, self$userAlphaSpending)) { + return(TRUE) + } + if (!identical(bindingFutility, self$bindingFutility)) { + return(TRUE) + } + return(FALSE) + }, + + # Defines the order of the parameter output + .getParametersToShow = function() { + return(c( + "method", + "kMax", + "stages", + "informationRates", + "alpha", + "alpha0Vec", + "bindingFutility", + "sided", + "tolerance", + "iterations", + "seed", + "alphaSpent", + "userAlphaSpending", + "criticalValues", + "stageLevels", + "scale", + "simAlpha", + "nonStochasticCurtailment" + )) + } + ) +) + +#' +#' @name TrialDesignInverseNormal +#' +#' @title +#' Inverse Normal Design +#' +#' @description +#' Trial design for inverse normal method. +#' +#' @template field_kMax +#' @template field_alpha +#' @template field_stages +#' @template field_informationRates +#' @template field_userAlphaSpending +#' @template field_criticalValues +#' @template field_stageLevels +#' @template field_alphaSpent +#' @template field_bindingFutility +#' @template field_tolerance +#' @template field_typeOfDesign +#' @template field_beta +#' @template field_deltaWT +#' @template field_deltaPT1 +#' @template field_deltaPT0 +#' @template field_futilityBounds +#' @template field_gammaA +#' @template field_gammaB +#' @template field_optimizationCriterion +#' @template field_sided +#' @template field_betaSpent +#' @template field_typeBetaSpending +#' @template field_userBetaSpending +#' @template field_power +#' @template field_twoSidedPower +#' @template field_constantBoundsHP +#' @template field_betaAdjustment +#' @template field_delayedInformation +#' @template field_decisionCriticalValues +#' @template field_reversalProbabilities +#' +#' @details +#' This object should not be created directly; use \code{\link[=getDesignInverseNormal]{getDesignInverseNormal()}} +#' with suitable arguments to create a inverse normal design. +#' +#' @seealso \code{\link[=getDesignInverseNormal]{getDesignInverseNormal()}} for creating a inverse normal design. +#' +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include f_core_constants.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +TrialDesignInverseNormalR6 <- R6Class("TrialDesignInverseNormalR6", + inherit = TrialDesignR6, + public = list( + typeOfDesign = NULL, + beta = NULL, + deltaWT = NULL, + deltaPT1 = NULL, + deltaPT0 = NULL, + futilityBounds = NULL, + gammaA = NULL, + gammaB = NULL, + optimizationCriterion = NULL, + sided = NULL, + betaSpent = NULL, + typeBetaSpending = NULL, + userBetaSpending = NULL, + power = NULL, + twoSidedPower = NULL, + constantBoundsHP = NULL, + betaAdjustment = NULL, + delayedInformation = NULL, + decisionCriticalValues = NULL, + reversalProbabilities = NULL, + initialize = function(..., + beta = C_BETA_DEFAULT, + betaSpent = NA_real_, + sided = C_SIDED_DEFAULT, + futilityBounds = NA_real_, + typeOfDesign = C_DEFAULT_TYPE_OF_DESIGN, + deltaWT = NA_real_, + deltaPT1 = NA_real_, + deltaPT0 = NA_real_, + optimizationCriterion = C_OPTIMIZATION_CRITERION_DEFAULT, + gammaA = NA_real_, + gammaB = NA_real_, + typeBetaSpending = C_TYPE_OF_DESIGN_BS_NONE, + userBetaSpending = NA_real_, + power = NA_real_, + twoSidedPower = C_TWO_SIDED_POWER_DEFAULT, + constantBoundsHP = NA_real_, + betaAdjustment = TRUE, # impl as constant + delayedInformation = NA_real_) { + + + self$beta <- beta + self$betaSpent <- betaSpent + self$sided <- sided + self$futilityBounds <- futilityBounds + self$typeOfDesign <- typeOfDesign + self$deltaWT <- deltaWT + self$deltaPT1 <- deltaPT1 + self$deltaPT0 <- deltaPT0 + self$optimizationCriterion <- optimizationCriterion + self$gammaA <- gammaA + self$gammaB <- gammaB + self$typeBetaSpending <- typeBetaSpending + self$userBetaSpending <- userBetaSpending + self$power <- power + self$twoSidedPower <- twoSidedPower + self$constantBoundsHP <- constantBoundsHP + self$betaAdjustment <- betaAdjustment + self$delayedInformation <- delayedInformation + super$initialize(...) + self$.initParameterNames() + self$.parameterFormatFunctions$criticalValues <- ".formatCriticalValues" + self$.initParameterTypes() + self$.initStages() + + self$.setParameterType("betaAdjustment", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("delayedInformation", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("decisionCriticalValues", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("reversalProbabilities", C_PARAM_NOT_APPLICABLE) + + }, + .initParameterNames = function() { + self$.parameterNames <- c(self$.parameterNames, self$.getSubListByNames( + .getParameterNames(design = self), c( + "beta", + "betaSpent", + "sided", + "futilityBounds", + "typeOfDesign", + "deltaWT", + "deltaPT1", + "deltaPT0", + "optimizationCriterion", + "gammaA", + "gammaB", + "typeBetaSpending", + "userBetaSpending", + "power", + "twoSidedPower", + "constantBoundsHP", + "betaAdjustment", + "delayedInformation", + "decisionCriticalValues", + "reversalProbabilities" + ) + )) + }, + .formatComparisonResult = function(x) { + if (is.null(x) || length(x) == 0 || !is.numeric(x)) { + return(x) + } + + s <- sprintf("%.9f", x) + s <- sub("\\.0+", "", s) + return(s) + }, + .pasteComparisonResult = function(name, newValue, oldValue) { + return(paste0( + name, "_new = ", .arrayToString(.formatComparisonResult(newValue)), " (", .getClassName(newValue), "), ", + name, "_old = ", .arrayToString(.formatComparisonResult(oldValue)), " (", .getClassName(oldValue), ")" + )) + }, + hasChanged = function(..., + kMax, + alpha, + beta, + sided, + typeOfDesign, + deltaWT, + deltaPT1, + deltaPT0, + informationRates, + futilityBounds, + optimizationCriterion, + typeBetaSpending, + gammaA, + gammaB, + bindingFutility, + userAlphaSpending, + userBetaSpending, + twoSidedPower, + constantBoundsHP, + betaAdjustment = TRUE, + delayedInformation = NA_real_) { + informationRatesTemp <- informationRates + if (any(is.na(informationRatesTemp))) { + informationRatesTemp <- .getInformationRatesDefault(kMax) + } + futilityBoundsTemp <- futilityBounds[1:(kMax - 1)] + if (any(is.na(futilityBoundsTemp))) { + futilityBoundsTemp <- rep(C_FUTILITY_BOUNDS_DEFAULT, kMax - 1) + } + + if (!identical(kMax, self$kMax)) { + return(self$.pasteComparisonResult("kMax", kMax, self$kMax)) + } + if (!identical(alpha, self$alpha)) { + return(self$.pasteComparisonResult("alpha", alpha, self$alpha)) + } + if (!identical(beta, self$beta)) { + return(self$.pasteComparisonResult("beta", beta, self$beta)) + } + if (!identical(sided, self$sided)) { + return(self$.pasteComparisonResult("sided", sided, self$sided)) + } + if (!identical(twoSidedPower, self$twoSidedPower)) { + return(self$.pasteComparisonResult("twoSidedPower", twoSidedPower, self$twoSidedPower)) + } + if (kMax == 1) { + return(FALSE) + } + + if (!identical(betaAdjustment, self$betaAdjustment)) { + return(self$.pasteComparisonResult("betaAdjustment", betaAdjustment, self$betaAdjustment)) + } + if (!identical(delayedInformation, self$delayedInformation)) { + return(self$.pasteComparisonResult("delayedInformation", delayedInformation, self$delayedInformation)) + } + if (!identical(typeOfDesign, self$typeOfDesign)) { + return(self$.pasteComparisonResult("typeOfDesign", typeOfDesign, self$typeOfDesign)) + } + if (typeOfDesign == C_TYPE_OF_DESIGN_WT) { + if (!identical(deltaWT, self$deltaWT)) { + return(self$.pasteComparisonResult("deltaWT", deltaWT, self$deltaWT)) + } + } + if (typeOfDesign == C_TYPE_OF_DESIGN_PT) { + if (!identical(deltaPT1, self$deltaPT1)) { + return(self$.pasteComparisonResult("deltaPT1", deltaPT1, self$deltaPT1)) + } + if (!identical(deltaPT0, self$deltaPT0)) { + return(self$.pasteComparisonResult("deltaPT0", deltaPT0, self$deltaPT0)) + } + } + if (!identical(informationRatesTemp, self$informationRates)) { + return(self$.pasteComparisonResult("informationRates", informationRatesTemp, self$informationRates)) + } + if (self$.getParameterType("futilityBounds") != C_PARAM_GENERATED && + (!grepl("^as.*", typeOfDesign) || typeBetaSpending == C_TYPE_OF_DESIGN_BS_NONE) && + !identical(futilityBoundsTemp, self$futilityBounds)) { + return(self$.pasteComparisonResult("futilityBounds", futilityBoundsTemp, self$futilityBounds)) + } + if (!identical(optimizationCriterion, self$optimizationCriterion)) { + return(self$.pasteComparisonResult("optimizationCriterion", optimizationCriterion, self$optimizationCriterion)) + } + if (!identical(typeBetaSpending, self$typeBetaSpending)) { + return(self$.pasteComparisonResult("typeBetaSpending", typeBetaSpending, self$typeBetaSpending)) + } + if (!identical(gammaA, self$gammaA)) { + return(self$.pasteComparisonResult("gammaA", gammaA, self$gammaA)) + } + if (!identical(gammaB, self$gammaB)) {#TODO + return(self$.pasteComparisonResult("gammaB", gammaB, self$gammaB)) + } + if ((typeOfDesign == C_TYPE_OF_DESIGN_PT && !identical(bindingFutility, self$bindingFutility)) || + (!identical(bindingFutility, self$bindingFutility) && + self$.getParameterType("futilityBounds") != C_PARAM_NOT_APPLICABLE && + (sided == 1 || !grepl("^as.*", typeOfDesign) || typeBetaSpending == C_TYPE_OF_DESIGN_BS_NONE) && + (any(na.omit(futilityBounds) > -6) || any(na.omit(self$futilityBounds) > -6)) + )) { + return(self$.pasteComparisonResult("bindingFutility", bindingFutility, self$bindingFutility)) + } + if (!identical(userAlphaSpending, self$userAlphaSpending)) { + return(self$.pasteComparisonResult("userAlphaSpending", userAlphaSpending, self$userAlphaSpending)) + } + if (!identical(userBetaSpending, self$userBetaSpending)) { + return(self$.pasteComparisonResult("userBetaSpending", userBetaSpending, self$userBetaSpending)) + } + if (!identical(twoSidedPower, self$twoSidedPower)) { + return(self$.pasteComparisonResult("twoSidedPower", twoSidedPower, self$twoSidedPower)) + } + if (typeOfDesign == C_TYPE_OF_DESIGN_HP) { + if (!identical(constantBoundsHP, self$constantBoundsHP)) { + return(self$.pasteComparisonResult("constantBoundsHP", constantBoundsHP, self$constantBoundsHP)) + } + } + return(FALSE) + }, + + # Defines the order of the parameter output + .getParametersToShow = function() { + return(c( + "typeOfDesign", + "kMax", + "stages", + "informationRates", + "alpha", + "beta", + "power", + "twoSidedPower", + "deltaWT", + "deltaPT1", + "deltaPT0", + "futilityBounds", + "bindingFutility", + "constantBoundsHP", + "gammaA", + "gammaB", + "optimizationCriterion", + "sided", + "betaAdjustment", + "delayedInformation", + "tolerance", + "alphaSpent", + "userAlphaSpending", + "betaSpent", + "typeBetaSpending", + "userBetaSpending", + "criticalValues", + "stageLevels", + "decisionCriticalValues", + "reversalProbabilities" + )) + } + ) +) + +#' +#' @name TrialDesignGroupSequential +#' +#' @title +#' Group Sequential Design +#' +#' @description +#' Trial design for group sequential design. +#' +#' @template field_kMax +#' @template field_alpha +#' @template field_stages +#' @template field_informationRates +#' @template field_userAlphaSpending +#' @template field_criticalValues +#' @template field_stageLevels +#' @template field_alphaSpent +#' @template field_bindingFutility +#' @template field_tolerance +#' @template field_typeOfDesign +#' @template field_beta +#' @template field_deltaWT +#' @template field_deltaPT1 +#' @template field_deltaPT0 +#' @template field_futilityBounds +#' @template field_gammaA +#' @template field_gammaB +#' @template field_optimizationCriterion +#' @template field_sided +#' @template field_betaSpent +#' @template field_typeBetaSpending +#' @template field_userBetaSpending +#' @template field_power +#' @template field_twoSidedPower +#' @template field_constantBoundsHP +#' @template field_betaAdjustment +#' @template field_delayedInformation +#' @template field_decisionCriticalValues +#' @template field_reversalProbabilities +#' +#' @details +#' This object should not be created directly; use \code{\link[=getDesignGroupSequential]{getDesignGroupSequential()}} +#' with suitable arguments to create a group sequential design. +#' +#' @seealso \code{\link[=getDesignGroupSequential]{getDesignGroupSequential()}} for creating a group sequential design. +#' +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include f_core_constants.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +TrialDesignGroupSequentialR6 <- R6Class("TrialDesignGroupSequentialR6", + inherit = TrialDesignInverseNormalR6, + public = list( + initialize = function(...) { + self$.parameterFormatFunctions$criticalValues <- ".formatCriticalValues" + super$initialize(...) + self$.initStages() + }, + show = function(showType = 1, digits = NA_integer_) { + "Method for automatically printing trial design objects" + super$show(showType = showType, digits = digits) + } + ) +) + +#' +#' @name TrialDesignConditionalDunnett +#' +#' @title +#' Conditional Dunnett Design +#' +#' @description +#' Trial design for conditional Dunnett tests. +#' +#' @template field_kMax +#' @template field_alpha +#' @template field_stages +#' @template field_informationRates +#' @template field_userAlphaSpending +#' @template field_criticalValues +#' @template field_stageLevels +#' @template field_alphaSpent +#' @template field_bindingFutility +#' @template field_tolerance +#' @template field_informationAtInterim +#' @template field_secondStageConditioning +#' @template field_sided +#' +#' @details +#' This object should not be created directly; use \code{\link{getDesignConditionalDunnett}} +#' with suitable arguments to create a conditional Dunnett test design. +#' +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include f_core_constants.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +#' @seealso \code{\link{getDesignConditionalDunnett}} for creating a conditional Dunnett test design. +#' +TrialDesignConditionalDunnettR6 <- R6Class("TrialDesignConditionalDunnettR6", + inherit = TrialDesignR6, + public = list( + informationAtInterim = NULL, + secondStageConditioning = NULL, + sided = NULL, + initialize = function(...) { + super$initialize(...)#TODO + + notApplicableParameters <- c( + "kMax", + "stages", + "informationRates", + "userAlphaSpending", + "criticalValues", + "stageLevels", + "alphaSpent", + "bindingFutility", + "tolerance" + ) + for (notApplicableParameter in notApplicableParameters) { + self$.setParameterType(notApplicableParameter, C_PARAM_NOT_APPLICABLE) + } + self$.setParameterType("alpha", ifelse( + identical(alpha, C_ALPHA_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED#TODO + )) + self$.setParameterType("informationAtInterim", ifelse( + identical(informationAtInterim, 0.5), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED#TODO + )) + self$.setParameterType("secondStageConditioning", ifelse( + identical(secondStageConditioning, TRUE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED#TODO + )) + + self$kMax <- 2L + self$sided <- 1L + + self$.initStages() + }, + show = function(showType = 1, digits = NA_integer_) { + "Method for automatically printing trial design objects" + super$show(showType = showType, digits = digits) + } + ) +) + +#' +#' @title +#' Get Design Conditional Dunnett Test +#' +#' @description +#' Defines the design to perform an analysis with the conditional Dunnett test. +#' +#' @inheritParams param_alpha +#' @param informationAtInterim The information to be expected at interim, default is \code{informationAtInterim = 0.5}. +#' @param secondStageConditioning The way the second stage p-values are calculated within the closed system of hypotheses. +#' If \code{secondStageConditioning = FALSE} is specified, the unconditional adjusted p-values are used, otherwise +#' conditional adjusted p-values are calculated, default is \code{secondStageConditioning = TRUE} +#' (for details, see Koenig et al., 2008). +#' +#' @details +#' For performing the conditional Dunnett test the design must be defined through this function. +#' You can define the information fraction and the way of how to compute the second stage +#' p-values only in the design definition, and not in the analysis call.\cr +#' See \code{\link[=getClosedConditionalDunnettTestResults]{getClosedConditionalDunnettTestResults()}} +#' for an example and Koenig et al. (2008) and +#' Wassmer & Brannath (2016), chapter 11 for details of the test procedure. +#' +#' @template return_object_trial_design +#' @template how_to_get_help_for_generics +#' +#' @family design functions +#' +#' @export +#' +getDesignConditionalDunnett <- function(alpha = 0.025, # C_ALPHA_DEFAULT + informationAtInterim = 0.5, secondStageConditioning = TRUE) { + .assertIsValidAlpha(alpha) + .assertIsSingleNumber(informationAtInterim, "informationAtInterim") + .assertIsInOpenInterval(informationAtInterim, "informationAtInterim", 0, 1) + return(TrialDesignConditionalDunnettR6$new( + alpha = alpha, + informationAtInterim = informationAtInterim, + secondStageConditioning = secondStageConditioning + )) +} + +#' +#' @title +#' Trial Design Plotting +#' +#' @description +#' Plots a trial design. +#' +#' @details +#' Generic function to plot a trial design. +#' +#' @param x The trial design, obtained from \cr +#' \code{\link[=getDesignGroupSequential]{getDesignGroupSequential()}}, \cr +#' \code{\link[=getDesignInverseNormal]{getDesignInverseNormal()}} or \cr +#' \code{\link[=getDesignFisher]{getDesignFisher()}}. +#' @param y Not available for this kind of plot (is only defined to be compatible to the generic plot function). +#' @param main The main title. +#' @param xlab The x-axis label. +#' @param ylab The y-axis label. +#' @inheritParams param_palette +#' @inheritParams param_theta +#' @inheritParams param_nMax +#' @inheritParams param_plotPointsEnabled +#' @inheritParams param_showSource +#' @inheritParams param_plotSettings +#' @inheritParams param_legendPosition +#' @inheritParams param_grid +#' @param type The plot type (default = \code{1}). The following plot types are available: +#' \itemize{ +#' \item \code{1}: creates a 'Boundaries' plot +#' \item \code{3}: creates a 'Stage Levels' plot +#' \item \code{4}: creates a 'Error Spending' plot +#' \item \code{5}: creates a 'Power and Early Stopping' plot +#' \item \code{6}: creates an 'Average Sample Size and Power / Early Stop' plot +#' \item \code{7}: creates an 'Power' plot +#' \item \code{8}: creates an 'Early Stopping' plot +#' \item \code{9}: creates an 'Average Sample Size' plot +#' \item \code{"all"}: creates all available plots and returns it as a grid plot or list +#' } +#' @inheritParams param_three_dots_plot +#' +#' @details +#' Generic function to plot a trial design. +#' +#' Note that \code{\link[=param_nMax]{nMax}} is not an argument that it passed to \code{ggplot2}. +#' Rather, the underlying calculations (e.g. power for different theta's or average sample size) are based +#' on calls to function \code{\link[=getPowerAndAverageSampleNumber]{getPowerAndAverageSampleNumber()}} +#' which has argument \code{\link[=param_nMax]{nMax}}. +#' I.e., \code{\link[=param_nMax]{nMax}} is not an argument to ggplot2 but to +#' \code{\link[=getPowerAndAverageSampleNumber]{getPowerAndAverageSampleNumber()}} +#' which is called prior to plotting. +#' +#' @seealso \code{\link[=plot.TrialDesignSet]{plot()}} to compare different designs or design parameters visual. +#' +#' @template return_object_ggplot +#' +#' @examples +#' \dontrun{ +#' design <- getDesignInverseNormal( +#' kMax = 3, alpha = 0.025, +#' typeOfDesign = "asKD", gammaA = 2, +#' informationRates = c(0.2, 0.7, 1), +#' typeBetaSpending = "bsOF" +#' ) +#' if (require(ggplot2)) { +#' plot(design) # default: type = 1 +#' } +#' } +#' +#' @export +#' +plot.TrialDesignR6 <- function(x, y, ..., main = NA_character_, + xlab = NA_character_, ylab = NA_character_, type = 1L, palette = "Set1", + theta = seq(-1, 1, 0.01), nMax = NA_integer_, plotPointsEnabled = NA, + legendPosition = NA_integer_, showSource = FALSE, + grid = 1, plotSettings = NULL) { + fCall <- match.call(expand.dots = FALSE) + designName <- deparse(fCall$x) + .assertGgplotIsInstalled() + .assertIsSingleInteger(grid, "grid", validateType = FALSE) + typeNumbers <- .getPlotTypeNumber(type, x) + if (is.null(plotSettings)) { + plotSettings <- .getGridPlotSettings(x, typeNumbers, grid) + } + p <- NULL + plotList <- list() + for (typeNumber in typeNumbers) { + p <- .plotTrialDesign( + x = x, y = y, main = main, + xlab = xlab, ylab = ylab, type = typeNumber, palette = palette, + theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, + legendPosition = .getGridLegendPosition(legendPosition, typeNumbers, grid), + showSource = showSource, designName = designName, + plotSettings = plotSettings, ... + ) + .printPlotShowSourceSeparator(showSource, typeNumber, typeNumbers) + if (length(typeNumbers) > 1) { + caption <- .getPlotCaption(x, typeNumber, stopIfNotFound = TRUE) + plotList[[caption]] <- p + } + } + if (length(typeNumbers) == 1) { + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(p)) + } + + return(p) + } + + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(plotList)) + } + + return(.createPlotResultObject(plotList, grid)) +} + +#' @rdname plot.TrialDesign +#' @export +plot.TrialDesignCharacteristicsR6 <- function(x, y, ...) { + plot(x = x$.design, y = y, ...) +} + +.plotTrialDesign <- function(..., x, y, main, + xlab, ylab, type, palette, + theta, nMax, plotPointsEnabled, + legendPosition, showSource, designName, plotSettings = NULL) {#TODO + .assertGgplotIsInstalled() + + .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) + if (any(.isTrialDesignFisher(x)) && !(type %in% c(1, 3, 4))) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'type' (", type, ") is not allowed for Fisher designs; must be 1, 3 or 4" + ) + } + + .warnInCaseOfUnknownArguments( + functionName = "plot", + ignore = c("xlim", "ylim", "companyAnnotationEnabled", "variedParameters"), ... + ) + + if ((type < 5 || type > 9) && !identical(theta, seq(-1, 1, 0.01))) { + warning("'theta' (", .reconstructSequenceCommand(theta), ") will be ignored for plot type ", type, call. = FALSE) + } + + if (!missing(y) && !is.null(y) && length(y) == 1 && inherits(y, "TrialDesign")) { + args <- list(...) + variedParameters <- args[["variedParameters"]] + if (is.null(variedParameters)) { + if (.isTrialDesignInverseNormalOrGroupSequential(x) && + .isTrialDesignInverseNormalOrGroupSequential(y) && + x$typeOfDesign != y$typeOfDesign) { + variedParameters <- "typeOfDesign" + } else { + stop( + C_EXCEPTION_TYPE_MISSING_ARGUMENT, + "'variedParameters' needs to be specified, e.g., variedParameters = \"typeOfDesign\"" + ) + } + } + designSet <- getDesignSet(designs = c(x, y), variedParameters = variedParameters) + } else { + designSet <- TrialDesignSetR6$new(design = x, singleDesign = TRUE) + if (!is.null(plotSettings)) { + designSet$.plotSettings <- plotSettings + } + } + + .plotTrialDesignSet( + x = designSet, y = y, main = main, xlab = xlab, ylab = ylab, type = type, + palette = palette, theta = theta, nMax = nMax, + plotPointsEnabled = plotPointsEnabled, legendPosition = legendPosition, + showSource = showSource, designSetName = designName, ... + ) +} + +#' +#' @title +#' Coerce TrialDesign to a Data Frame +#' +#' @description +#' Returns the \code{TrialDesign} as data frame. +#' +#' @param x A \code{\link{TrialDesign}} object. +#' @inheritParams param_niceColumnNamesEnabled +#' @inheritParams param_includeAllParameters +#' @inheritParams param_three_dots +#' +#' @details +#' Each element of the \code{\link{TrialDesign}} is converted to a column in the data frame. +#' +#' @template return_dataframe +#' +#' @examples +#' as.data.frame(getDesignGroupSequential()) +#' +#' @export +#' +#' @keywords internal +#' +as.data.frame.TrialDesignR6 <- function(x, row.names = NULL, + optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ...) { + .assertIsTrialDesign(x) + + if (includeAllParameters) { + parameterNames <- NULL + } else { + parameterNames <- x$.getParametersToShow() + } + return(.getAsDataFrame( + parameterSet = x, + parameterNames = parameterNames, + niceColumnNamesEnabled = niceColumnNamesEnabled, + includeAllParameters = includeAllParameters, + tableColumnNames = .getTableColumnNames(design = x) + )) +} diff --git a/R/class_design_set.R b/R/class_design_set.R index 4684cf78..b517d2c9 100644 --- a/R/class_design_set.R +++ b/R/class_design_set.R @@ -168,7 +168,7 @@ summary.TrialDesignSet <- function(object, ..., type = 1, digits = NA_integer_) TrialDesignSet <- setRefClass("TrialDesignSet", contains = "FieldSet", fields = list( - .plotSettings = "PlotSettings", + .plotSettings = "ANY", designs = "list", variedParameters = "character" ), @@ -177,7 +177,7 @@ TrialDesignSet <- setRefClass("TrialDesignSet", # @param ... 'designs' OR 'design' and one or more design parameters, e.g., deltaWT = c(0.1, 0.3, 0.4) # initialize = function(...) { - .plotSettings <<- PlotSettings() + .plotSettings <<- PlotSettingsR6$new() designs <<- list() variedParameters <<- character(0) if (length(list(...)) > 0) { @@ -890,35 +890,35 @@ plot.TrialDesignSet <- function(x, y, ..., type = 1L, main = NA_character_, plotPointsEnabled <- ifelse(is.na(plotPointsEnabled), FALSE, plotPointsEnabled) } else if (type == 5) { if (!is.call(main) && !isS4(main) && is.na(main)) { - main <- PlotSubTitleItems(title = "Power and Early Stopping") + main <- PlotSubTitleItemsR6$new(title = "Power and Early Stopping") main$add("N", nMax, "max") } xParameterName <- "theta" yParameterNames <- c("overallEarlyStop", "calculatedPower") } else if (type == 6) { if (!is.call(main) && !isS4(main) && is.na(main)) { - main <- PlotSubTitleItems(title = "Average Sample Size and Power / Early Stop") + main <- PlotSubTitleItemsR6$new(title = "Average Sample Size and Power / Early Stop") main$add("N", nMax, "max") } xParameterName <- "theta" yParameterNames <- c("averageSampleNumber", "overallEarlyStop", "calculatedPower") } else if (type == 7) { if (!is.call(main) && !isS4(main) && is.na(main)) { - main <- PlotSubTitleItems(title = "Power") + main <- PlotSubTitleItemsR6$new(title = "Power") main$add("N", nMax, "max") } xParameterName <- "theta" yParameterNames <- "calculatedPower" } else if (type == 8) { if (!is.call(main) && !isS4(main) && is.na(main)) { - main <- PlotSubTitleItems(title = "Early Stopping") + main <- PlotSubTitleItemsR6$new(title = "Early Stopping") main$add("N", nMax, "max") } xParameterName <- "theta" yParameterNames <- "overallEarlyStop" } else if (type == 9) { if (!is.call(main) && !isS4(main) && is.na(main)) { - main <- PlotSubTitleItems(title = "Average Sample Size") + main <- PlotSubTitleItemsR6$new(title = "Average Sample Size") main$add("N", nMax, "max") } xParameterName <- "theta" diff --git a/R/class_design_set_r6.R b/R/class_design_set_r6.R new file mode 100644 index 00000000..7d420089 --- /dev/null +++ b/R/class_design_set_r6.R @@ -0,0 +1,983 @@ +## | +## | *Trial design set classes* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | rpact package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File version: $Revision: 7126 $ +## | Last changed: $Date: 2023-06-23 14:26:39 +0200 (Fr, 23 Jun 2023) $ +## | Last changed by: $Author: pahlke $ +## | + +#' @include f_core_plot.R +#' @include f_core_utilities.R +NULL + + + +#' +#' @name TrialDesignSet +#' +#' @title +#' Class for trial design sets. +#' +#' @description +#' \code{TrialDesignSet} is a class for creating a collection of different trial designs. +#' +#' @template field_designs +#' @template field_design +#' @template field_variedParameters +#' +#' @details +#' This object cannot be created directly; better use \code{\link[=getDesignSet]{getDesignSet()}} +#' with suitable arguments to create a set of designs. +#' +#' @seealso \code{\link[=getDesignSet]{getDesignSet()}} +#' +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include f_core_plot.R +#' @include f_logger.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +TrialDesignSetR6 <- R6Class("TrialDesignSetR6", + inherit = FieldSetR6, + public = list( + .plotSettings = NULL, + designs = NULL, + variedParameters = NULL, + # + # @param ... 'designs' OR 'design' and one or more design parameters, e.g., deltaWT = c(0.1, 0.3, 0.4) + # + initialize = function(...) { + self$.plotSettings <- PlotSettingsR6$new() + self$designs <- list() + self$variedParameters <- character(0) + if (length(list(...)) > 0) { + self$add(...) + } + if (length(self$designs) > 0) { + masterDesign <- self$designs[[1]] + if (inherits(masterDesign, "ParameterSet") || inherits(masterDesign, "ParameterSetR6")) { + self$.plotSettings <- masterDesign$.plotSettings + } + } + }, + getPlotSettings = function() { + return(self$.plotSettings) + }, + show = function(showType = 1, digits = NA_integer_) { + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + }, + .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { + "Method for automatically printing trial design sets" + self$.resetCat() + self$.cat("Trial design set with ", length(self$designs), " designs\n\n", + heading = 1, + consoleOutputEnabled = consoleOutputEnabled + ) + for (design in self$designs) { + design$.show(showType = showType, consoleOutputEnabled = consoleOutputEnabled) + } + }, + isEmpty = function() { + return(length(self$designs) == 0) + }, + getSize = function() { + return(length(self$designs)) + }, + getDesignMaster = function() { + if (length(self$designs) == 0) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "no design master defined") + } + + return(self$designs[[1]]) + }, + .validateDesignsArgument = function(designsToAdd, args) { + if (!is.list(designsToAdd)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'designsToAdd' must be a list") + } + + if (length(designsToAdd) == 0) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'designsToAdd' must be not empty") + } + + designsToAddValidated <- list() + for (d in designsToAdd) { + if (.isTrialDesign(d)) { + designsToAddValidated <- c(designsToAddValidated, d) + } else { + parentDesign <- d[[".design"]] + if (is.null(parentDesign)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'designsToAdd' must be a list of trial designs (found '", .getClassName(d), "')" + ) + } + + warning("Only the parent design of ", .getClassName(d), + " was added to trial design set", + call. = FALSE + ) + designsToAddValidated <- c(designsToAddValidated, parentDesign) + } + } + + varPar <- args[["variedParameters"]] + if (!is.null(varPar) && length(varPar) > 0) { + self$variedParameters <- c(self$variedParameters, varPar) + } + + args <- args[!(names(args) %in% c("designs", "variedParameters"))] + if (length(args) > 0) { + warning("Argument", ifelse(length(args) > 1, "s", ""), " ", + .arrayToString(args, encapsulate = TRUE), " will be ignored ", + "because for 'designs' only argument 'variedParameters' will be respected", + call. = FALSE + ) + } + + self$designs <- c(self$designs, designsToAddValidated) + }, + addVariedParameters = function(varPar) { + if (is.null(varPar) || !is.character(varPar)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'varPar' must be a valid character vector") + } + + self$variedParameters <- c(self$variedParameters, varPar) + }, + .validateOptionalArguments = function(...) { + args <- list(...) + designsToAdd <- .getOptionalArgument(optionalArgumentName = "designs", ...) + if (!is.null(designsToAdd)) { + self$.validateDesignsArgument(designsToAdd = designsToAdd, args = args) + return(NULL) + } + + design <- .getOptionalArgument(optionalArgumentName = "design", ...) + optionalArgumentsDefined <- (length(args) > 0) + if (is.null(design) && !optionalArgumentsDefined) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "please specify a 'design' to add and/or a design parameter, ", + "e.g., deltaWT = c(0.1, 0.3, 0.4)" + ) + } + + if (is.null(design) && optionalArgumentsDefined && length(self$designs) == 0) { + stop( + C_EXCEPTION_TYPE_INCOMPLETE_ARGUMENTS, + "at least one design (master) must be defined in this ", + "design set to respect any design parameters" + ) + } + + if (!is.null(design)) { + self$designs <- c(self$designs, design) + } else if (length(self$designs) > 0) { + design <- self$designs[[1]] # use design master + } + + if (!.isTrialDesign(design)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'design' (", .getClassName(design), ") must be an instance of class 'TrialDesign'" + ) + } + + self$.getArgumentNames(validatedDesign = design, ...) + + invisible(design) + }, + .getArgumentNames = function(validatedDesign, ...) { + args <- list(...) + if (length(args) == 0) { + return(character(0)) + } + + argumentNames <- names(args) + if (length(argumentNames) == 0) { + warning("No argument names available for ", paste(args, collapse = ", "), call. = FALSE) + return(character(0)) + } + + argumentNames <- argumentNames[nchar(argumentNames) != 0] + argumentNames <- argumentNames[!(argumentNames %in% c("design", "designs", "singleDesign"))] + + visibleFieldNames <- validatedDesign$.getVisibleFieldNames() + for (arg in argumentNames) { + if (!(arg %in% visibleFieldNames)) { + stop(sprintf(paste0( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, + "'%s' does not contain a field with name '%s'" + ), .getClassName(validatedDesign), arg)) + } + } + + invisible(argumentNames) + }, + add = function(...) { + "Adds 'designs' OR a 'design' and/or a design parameter, e.g., deltaWT = c(0.1, 0.3, 0.4)" + design <- self$.validateOptionalArguments(...) + + args <- list(...) + singleDesign <- args[["singleDesign"]] + if (!is.null(singleDesign) && is.logical(singleDesign) && singleDesign) { + return(invisible()) + } + + if (!is.null(design)) { + d <- self$.createDesignVariants(validatedDesign = design, ...) + self$designs <- c(self$designs, d) + } + }, + assertHaveEqualSidedValues = function() { + if (length(self$designs) == 0) { + return(invisible()) + } + + sided <- self$getDesignMaster()$sided + for (design in self$designs) { + if (sided != design$sided) { + stop( + C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, + "designs have different directions of alternative (design master is ", + ifelse(sided == 1, "one", "two"), " sided)" + ) + } + } + }, + .createDesignVariants = function(validatedDesign, ...) { + .assertIsTrialDesign(validatedDesign) + argumentNames <- self$.getArgumentNames(validatedDesign = validatedDesign, ...) + + if (length(argumentNames) == 0) { + warning("Creation of design variants stopped: no valid design parameters found", call. = FALSE) + return(list()) + } + + if (length(argumentNames) > 2) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "too many arguments (", .arrayToString(argumentNames, encapsulate = TRUE), + "): up to 2 design parameters are allowed" + ) + } + + designVariants <- self$.createDesignVariantsRecursive( + designMaster = validatedDesign, + args = list(...), argumentIndex = 1, argumentNames = argumentNames + ) + + return(designVariants) + }, + .designSettingExists = function(parameterName, parameterValue, numberOfArguments = 1, + parameterNameBefore = NULL, parameterValueBefore = NULL) { + if (length(self$designs) == 0) { + return(FALSE) + } + + for (design in self$designs) { + if (!is.null(parameterNameBefore) && !is.null(parameterValueBefore)) { + if (design[[parameterNameBefore]] == parameterValueBefore && + design[[parameterName]] == parameterValue) { + return(TRUE) + } + } else if (numberOfArguments == 1) { + if (design[[parameterName]] == parameterValue) { + return(TRUE) + } + } + } + return(FALSE) + }, + .createDesignVariantsRecursive = function(designMaster, args, argumentIndex, argumentNames, + parameterNameBefore = NULL, parameterValueBefore = NULL) { + if (argumentIndex > length(argumentNames)) { + return(list()) + } + + designVariants <- list() + argumentName <- argumentNames[argumentIndex] + self$variedParameters <- unique(c(self$variedParameters, argumentName)) + argumentValues <- args[[argumentName]] + + for (argumentValue in argumentValues) { + if (self$.designSettingExists(argumentName, argumentValue, + numberOfArguments = length(argumentNames), + parameterNameBefore, parameterValueBefore + )) { + if (!is.null(parameterNameBefore) && !is.null(parameterValueBefore)) { + warning(sprintf( + "Argument ignored: there exists already a design with %s = %s (%s = %s)", + argumentName, argumentValue, parameterNameBefore, parameterValueBefore + ), call. = FALSE) + } else { + warning(sprintf( + "Argument ignored: there exists already a design with %s = %s", + argumentName, argumentValue + ), call. = FALSE) + } + } else { + designMaster2 <- self$.createDesignVariant( + designMaster = designMaster, + argumentName = argumentName, argumentValue = argumentValue + ) + if (argumentIndex == length(argumentNames)) { + if (is.null(parameterNameBefore) || is.null(parameterValueBefore)) { + .logDebug("Create design variant %s = %s", argumentName, argumentValue) + } else { + .logDebug( + "Create design variant %s = %s (%s = %s)", argumentName, argumentValue, + parameterNameBefore, parameterValueBefore + ) + } + designVariants <- c(designVariants, designMaster2) + } + designCopies2 <- self$.createDesignVariantsRecursive( + designMaster = designMaster2, + args = args, argumentIndex = argumentIndex + 1, argumentNames = argumentNames, + parameterNameBefore = argumentName, parameterValueBefore = argumentValue + ) + if (length(designCopies2) > 0) { + designVariants <- c(designVariants, designCopies2) + } + } + } + + return(designVariants) + }, + .createDesignVariant = function(designMaster, argumentName, argumentValue) { + if (.isTrialDesignGroupSequential(designMaster)) { + defaultValues <- .getDesignGroupSequentialDefaultValues() + } else if (.isTrialDesignInverseNormal(designMaster)) { + defaultValues <- .getDesignInverseNormalDefaultValues() + } else if (.isTrialDesignFisher(designMaster)) { + defaultValues <- .getDesignFisherDefaultValues() + } + + for (userDefinedParamName in designMaster$.getUserDefinedParameters()) { + defaultValues[[userDefinedParamName]] <- designMaster[[userDefinedParamName]] + } + defaultValues[[argumentName]] <- argumentValue + + if (.isTrialDesignGroupSequential(designMaster)) { + result <- getDesignGroupSequential( + kMax = defaultValues$kMax, + alpha = defaultValues$alpha, + beta = defaultValues$beta, + sided = defaultValues$sided, + informationRates = defaultValues$informationRates, + futilityBounds = defaultValues$futilityBounds, + typeOfDesign = defaultValues$typeOfDesign, + deltaWT = defaultValues$deltaWT, + optimizationCriterion = defaultValues$optimizationCriterion, + gammaA = defaultValues$gammaA, + typeBetaSpending = defaultValues$typeBetaSpending, + userAlphaSpending = defaultValues$userAlphaSpending, + userBetaSpending = defaultValues$userBetaSpending, + gammaB = defaultValues$gammaB, + tolerance = defaultValues$tolerance + ) + } else if (.isTrialDesignInverseNormal(designMaster)) { + result <- getDesignInverseNormal( + kMax = defaultValues$kMax, + alpha = defaultValues$alpha, + beta = defaultValues$beta, + sided = defaultValues$sided, + informationRates = defaultValues$informationRates, + futilityBounds = defaultValues$futilityBounds, + typeOfDesign = defaultValues$typeOfDesign, + deltaWT = defaultValues$deltaWT, + optimizationCriterion = defaultValues$optimizationCriterion, + gammaA = defaultValues$gammaA, + typeBetaSpending = defaultValues$typeBetaSpending, + userAlphaSpending = defaultValues$userAlphaSpending, + userBetaSpending = defaultValues$userBetaSpending, + gammaB = defaultValues$gammaB, + tolerance = defaultValues$tolerance + ) + } else if (.isTrialDesignFisher(designMaster)) { + result <- getDesignFisher( + kMax = defaultValues$kMax, + alpha = defaultValues$alpha, + method = defaultValues$method, + userAlphaSpending = defaultValues$userAlphaSpending, + informationRates = defaultValues$informationRates, + alpha0Vec = defaultValues$alpha0Vec, + sided = defaultValues$sided, + tolerance = defaultValues$tolerance, + iterations = defaultValues$iterations, + seed = defaultValues$seed + ) + } + result$.plotSettings <- designMaster$.plotSettings + return(result) + } + ) +) + +#' @title +#' Get Design Set +#' +#' @description +#' Creates a trial design set object and returns it. +#' +#' @param ... \code{designs} or \code{design} and one or more design parameters, e.g., \code{deltaWT = c(0.1, 0.3, 0.4)}. +#' \itemize{ +#' \item \code{design} The master design (optional, you need to specify an +#' additional parameter that shall be varied). +#' \item \code{designs} The designs to compare (optional, you need to specify the variable \code{variedParameters}). +#' } +#' +#' @details +#' Specify a master design and one or more design parameters or a list of designs. +#' +#' @return Returns a \code{\link{TrialDesignSet}} object. +#' The following generics (R generic functions) are available for this result object: +#' \itemize{ +#' \item \code{\link[=names.TrialDesignSet]{names}} to obtain the field names, +#' \item \code{\link[=length.TrialDesignSet]{length}} to obtain the number of design, +#' \item \code{\link[=print.FieldSet]{print()}} to print the object, +#' \item \code{\link[=summary.TrialDesignSet]{summary()}} to display a summary of the object, +#' \item \code{\link[=plot.TrialDesignSet]{plot()}} to plot the object, +#' \item \code{\link[=as.data.frame.TrialDesignSet]{as.data.frame()}} to coerce the object to a \code{\link[base]{data.frame}}, +#' \item \code{\link[=as.matrix.FieldSet]{as.matrix()}} to coerce the object to a \code{\link[base]{matrix}}. +#' } +#' @template how_to_get_help_for_generics +#' +#' @examples +#' # Example 1 +#' design <- getDesignGroupSequential( +#' alpha = 0.05, kMax = 6, +#' sided = 2, typeOfDesign = "WT", deltaWT = 0.1 +#' ) +#' designSet <- getDesignSet() +#' designSet$add(design = design, deltaWT = c(0.3, 0.4)) +#' \dontrun{ +#' if (require(ggplot2)) plot(designSet, type = 1) +#' } +#' +#' # Example 2 (shorter script) +#' design <- getDesignGroupSequential( +#' alpha = 0.05, kMax = 6, +#' sided = 2, typeOfDesign = "WT", deltaWT = 0.1 +#' ) +#' designSet <- getDesignSet(design = design, deltaWT = c(0.3, 0.4)) +#' \dontrun{ +#' if (require(ggplot2)) plot(designSet, type = 1) +#' } +#' +#' # Example 3 (use of designs instead of design) +#' d1 <- getDesignGroupSequential( +#' alpha = 0.05, kMax = 2, +#' sided = 1, beta = 0.2, typeOfDesign = "asHSD", +#' gammaA = 0.5, typeBetaSpending = "bsHSD", gammaB = 0.5 +#' ) +#' d2 <- getDesignGroupSequential( +#' alpha = 0.05, kMax = 4, +#' sided = 1, beta = 0.2, typeOfDesign = "asP", +#' typeBetaSpending = "bsP" +#' ) +#' designSet <- getDesignSet( +#' designs = c(d1, d2), +#' variedParameters = c("typeOfDesign", "kMax") +#' ) +#' \dontrun{ +#' if (require(ggplot2)) plot(designSet, type = 8, nMax = 20) +#' } +#' +#' @export +#' +getDesignSet <- function(...) { + return(TrialDesignSetR6$new(...)) +} + +#' +#' @title +#' Trial Design Set Summary +#' +#' @description +#' Displays a summary of \code{\link{ParameterSet}} object. +#' +#' @param object A \code{\link{ParameterSet}} object. +#' @inheritParams param_digits +#' @inheritParams param_three_dots +#' +#' @details +#' Summarizes the trial designs. +#' +#' @template details_summary +#' +#' @template return_object_summary +#' @template how_to_get_help_for_generics +#' +#' @export +#' +#' @keywords internal +#' +summary.TrialDesignSetR6 <- function(object, ..., type = 1, digits = NA_integer_) { + .warnInCaseOfUnknownArguments(functionName = "summary.TrialDesignSetR6", ...) + + .assertIsTrialDesignSet(object)#TODO + if (object$isEmpty()) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "cannot create summary because the design set is empty") + } + + summaries <- list() + for (design in object$designs) { + s <- .createSummary(design, digits = digits) + summaries <- c(summaries, s) + } + return(summaries) +} + +#' +#' @title +#' Names of a Trial Design Set Object +#' +#' @description +#' Function to get the names of a \code{\link{TrialDesignSet}} object. +#' +#' @param x A \code{\link{TrialDesignSet}} object. +#' +#' @details +#' Returns the names of a design set that can be accessed by the user. +#' +#' @template return_names +#' +#' @examples +#' designSet <- getDesignSet(design = getDesignGroupSequential(), alpha = c(0.01, 0.05)) +#' names(designSet) +#' +#' @export +#' +#' @keywords internal +#' +names.TrialDesignSetR6 <- function(x) { + return(x$.getVisibleFieldNames()) +} + +#' +#' @title +#' Length of Trial Design Set +#' +#' @description +#' Returns the number of designs in a \code{TrialDesignSet}. +#' +#' @param x A \code{\link{TrialDesignSet}} object. +#' +#' @details +#' Is helpful for iteration over all designs in a design set. +#' +#' @return Returns a non-negative \code{\link[base]{integer}} of length 1 +#' representing the number of design in the \code{TrialDesignSet}. +#' +#' @examples +#' designSet <- getDesignSet(design = getDesignGroupSequential(), alpha = c(0.01, 0.05)) +#' length(designSet) +#' +#' @export +#' +#' @keywords internal +#' +length.TrialDesignSetR6 <- function(x) { + return(length(x$designs)) +} + +#' +#' @title +#' Coerce Trial Design Set to a Data Frame +#' +#' @description +#' Returns the \code{TrialDesignSet} as data frame. +#' +#' @param x A \code{\link{TrialDesignSet}} object. +#' @inheritParams param_niceColumnNamesEnabled +#' @inheritParams param_includeAllParameters +#' @param addPowerAndAverageSampleNumber If \code{TRUE}, power and average sample size will +#' be added to data frame, default is \code{FALSE}. +#' @inheritParams param_theta +#' @inheritParams param_nMax +#' @inheritParams param_three_dots +#' +#' @details +#' Coerces the design set to a data frame. +#' +#' @template return_dataframe +#' +#' @examples +#' designSet <- getDesignSet(design = getDesignGroupSequential(), alpha = c(0.01, 0.05)) +#' as.data.frame(designSet) +#' +#' @export +#' +#' @keywords internal +#' +as.data.frame.TrialDesignSetR6 <- function(x, row.names = NULL, + optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, + addPowerAndAverageSampleNumber = FALSE, theta = seq(-1, 1, 0.02), nMax = NA_integer_, ...) { + .assertIsTrialDesignSet(x) + if (x$isEmpty()) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "cannot create data.frame because the design set is empty") + } + + fCall <- match.call(expand.dots = FALSE) + theta <- .assertIsValidThetaRange(thetaRange = theta, thetaAutoSeqEnabled = (as.character(fCall$theta)[1] != "seq")) + + if (addPowerAndAverageSampleNumber) { + .assertAssociatedArgumentsAreDefined( + addPowerAndAverageSampleNumber = addPowerAndAverageSampleNumber, + theta = theta, nMax = nMax + ) + } + + fisherDesignEnabled <- .isTrialDesignFisher(x$getDesignMaster()) + dataFrame <- NULL + for (design in x$designs) { + if (fisherDesignEnabled != .isTrialDesignFisher(design)) { + stop( + C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, "all trial designs must be from the same type ", + "('", .getClassName(x$designs[[1]]), "' != '", .getClassName(design), ")'" + ) + } + + suppressWarnings(df <- as.data.frame(design, + niceColumnNamesEnabled = niceColumnNamesEnabled, + includeAllParameters = includeAllParameters + )) + + if (.isTrialDesignWithValidFutilityBounds(design)) { + futilityBoundsName <- "futilityBounds" + if (niceColumnNamesEnabled) { + futilityBoundsName <- .getTableColumnNames(design = design)[["futilityBounds"]] + } + + kMax <- design$kMax + df[[futilityBoundsName]][kMax] <- design$criticalValues[kMax] + } + if (.isTrialDesignWithValidAlpha0Vec(design)) { + alpha0VecName <- "alpha0Vec" + if (niceColumnNamesEnabled) { + alpha0VecName <- .getTableColumnNames(design = design)[["alpha0Vec"]] + } + + kMax <- design$kMax + df[[alpha0VecName]][kMax] <- design$criticalValues[kMax] + } + + if (addPowerAndAverageSampleNumber) { + results <- PowerAndAverageSampleNumberResult(design, theta = theta, nMax = nMax) + suppressWarnings(df2 <- as.data.frame(results, + niceColumnNamesEnabled = niceColumnNamesEnabled, + includeAllParameters = includeAllParameters + )) + df <- merge(df, df2, all.y = TRUE) + } + if (is.null(dataFrame)) { + if (niceColumnNamesEnabled) { + dataFrame <- cbind("Design number" = rep(1, nrow(df)), df) + } else { + dataFrame <- cbind(designNumber = rep(1, nrow(df)), df) + } + } else { + if (niceColumnNamesEnabled) { + df <- cbind("Design number" = rep(max(dataFrame$"Design number") + 1, nrow(df)), df) + } else { + df <- cbind(designNumber = rep(max(dataFrame$designNumber) + 1, nrow(df)), df) + } + dataFrame <- rbind(dataFrame, df) + } + } + + return(dataFrame) +} + +#' +#' @title +#' Trial Design Set Plotting +#' +#' @description +#' Plots a trial design set. +#' +#' @param x The trial design set, obtained from \code{\link[=getDesignSet]{getDesignSet()}}. +#' @param y Not available for this kind of plot (is only defined to be compatible to the generic plot function). +#' @param main The main title. +#' @param xlab The x-axis label. +#' @param ylab The y-axis label. +#' @inheritParams param_palette +#' @inheritParams param_theta +#' @inheritParams param_nMax +#' @inheritParams param_plotPointsEnabled +#' @inheritParams param_showSource +#' @inheritParams param_plotSettings +#' @inheritParams param_legendPosition +#' @inheritParams param_grid +#' @param type The plot type (default = \code{1}). The following plot types are available: +#' \itemize{ +#' \item \code{1}: creates a 'Boundaries' plot +#' \item \code{3}: creates a 'Stage Levels' plot +#' \item \code{4}: creates a 'Error Spending' plot +#' \item \code{5}: creates a 'Power and Early Stopping' plot +#' \item \code{6}: creates an 'Average Sample Size and Power / Early Stop' plot +#' \item \code{7}: creates an 'Power' plot +#' \item \code{8}: creates an 'Early Stopping' plot +#' \item \code{9}: creates an 'Average Sample Size' plot +#' \item \code{"all"}: creates all available plots and returns it as a grid plot or list +#' } +#' @inheritParams param_three_dots_plot +#' +#' @details +#' Generic function to plot a trial design set. +#' Is, e.g., useful to compare different designs or design parameters visual. +#' +#' @template return_object_ggplot +#' +#' @examples +#' \dontrun{ +#' design <- getDesignInverseNormal( +#' kMax = 3, alpha = 0.025, +#' typeOfDesign = "asKD", gammaA = 2, +#' informationRates = c(0.2, 0.7, 1), typeBetaSpending = "bsOF" +#' ) +#' +#' # Create a set of designs based on the master design defined above +#' # and varied parameter 'gammaA' +#' designSet <- getDesignSet(design = design, gammaA = 4) +#' +#' if (require(ggplot2)) plot(designSet, type = 1, legendPosition = 6) +#' } +#' +#' @export +#' +plot.TrialDesignSetR6 <- function(x, y, ..., type = 1L, main = NA_character_, + xlab = NA_character_, ylab = NA_character_, palette = "Set1", + theta = seq(-1, 1, 0.02), nMax = NA_integer_, plotPointsEnabled = NA, + legendPosition = NA_integer_, showSource = FALSE, + grid = 1, plotSettings = NULL) { + fCall <- match.call(expand.dots = FALSE) + designSetName <- deparse(fCall$x) + .assertGgplotIsInstalled() + .assertIsSingleInteger(grid, "grid", validateType = FALSE) + typeNumbers <- .getPlotTypeNumber(type, x) + if (is.null(plotSettings)) { + plotSettings <- .getGridPlotSettings(x, typeNumbers, grid) + } + p <- NULL + plotList <- list() + for (typeNumber in typeNumbers) { + p <- .plotTrialDesignSet( + x = x, y = y, type = typeNumber, main = main, + xlab = xlab, ylab = ylab, palette = palette, + theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, + legendPosition = .getGridLegendPosition(legendPosition, typeNumbers, grid), + showSource = showSource, designSetName = designSetName, + plotSettings = plotSettings, ... + ) + .printPlotShowSourceSeparator(showSource, typeNumber, typeNumbers) + if (length(typeNumbers) > 1) { + caption <- .getPlotCaption(x, typeNumber, stopIfNotFound = TRUE) + plotList[[caption]] <- p + } + } + if (length(typeNumbers) == 1) { + return(p) + } + + return(.createPlotResultObject(plotList, grid)) +} + +.plotTrialDesignSet <- function(..., x, y, type = 1L, main = NA_character_, + xlab = NA_character_, ylab = NA_character_, palette = "Set1", + theta = seq(-1, 1, 0.02), nMax = NA_integer_, plotPointsEnabled = NA, + legendPosition = NA_integer_, showSource = FALSE, + designSetName = NA_character_, plotSettings = NULL) { + .assertGgplotIsInstalled() + if (!is.call(main) && !isS4(main)) { + .assertIsSingleCharacter(main, "main", naAllowed = TRUE) + } + .assertIsSingleCharacter(xlab, "xlab", naAllowed = TRUE) + .assertIsSingleCharacter(ylab, "ylab", naAllowed = TRUE) + .assertIsSingleCharacter(palette, "palette", naAllowed = TRUE) + theta <- .assertIsValidThetaRange(thetaRange = theta) + .assertIsSingleNumber(nMax, "nMax", naAllowed = TRUE) + .assertIsInClosedInterval(nMax, "nMax", lower = 1L, upper = 1e10) + .assertIsSingleLogical(plotPointsEnabled, "plotPointsEnabled", naAllowed = TRUE) + .assertIsValidLegendPosition(legendPosition) + .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) + + parameterSet <- x + designMaster <- parameterSet$getDesignMaster() + .assertIsTrialDesign(designMaster) + + if (type == 1) { + main <- if (!is.call(main) && !isS4(main) && is.na(main)) "Boundaries" else main + xParameterName <- "informationRates" + yParameterNames <- "criticalValues" + + if (designMaster$sided == 1 || (.isTrialDesignInverseNormalOrGroupSequential(designMaster) && + (designMaster$typeOfDesign == C_TYPE_OF_DESIGN_PT || grepl("^bs", designMaster$typeBetaSpending)))) { + if (.isTrialDesignWithValidFutilityBounds(designMaster)) { + yParameterNames <- c("futilityBounds", yParameterNames) + } + if (.isTrialDesignWithValidAlpha0Vec(designMaster)) { + yParameterNames <- c("alpha0Vec", yParameterNames) + } + } + } else if (type == 2) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "designs with undefined endpoint do not support plot type 2") + } else if (type == 3) { + main <- if (!is.call(main) && !isS4(main) && is.na(main)) "Stage Levels" else main + xParameterName <- "informationRates" + yParameterNames <- "stageLevels" + } else if (type == 4) { + main <- if (!is.call(main) && !isS4(main) && is.na(main)) "Error Spending" else main + xParameterName <- "informationRates" + yParameterNames <- c("alphaSpent") + if (!.isTrialDesignFisher(designMaster) && + designMaster$typeBetaSpending != C_TYPE_OF_DESIGN_BS_NONE) { + yParameterNames <- c(yParameterNames, "betaSpent") + palette <- "Paired" + } + plotPointsEnabled <- ifelse(is.na(plotPointsEnabled), FALSE, plotPointsEnabled) + } else if (type == 5) { + if (!is.call(main) && !isS4(main) && is.na(main)) { + main <- PlotSubTitleItems(title = "Power and Early Stopping") + main$add("N", nMax, "max") + } + xParameterName <- "theta" + yParameterNames <- c("overallEarlyStop", "calculatedPower") + } else if (type == 6) { + if (!is.call(main) && !isS4(main) && is.na(main)) { + main <- PlotSubTitleItems(title = "Average Sample Size and Power / Early Stop") + main$add("N", nMax, "max") + } + xParameterName <- "theta" + yParameterNames <- c("averageSampleNumber", "overallEarlyStop", "calculatedPower") + } else if (type == 7) { + if (!is.call(main) && !isS4(main) && is.na(main)) { + main <- PlotSubTitleItems(title = "Power") + main$add("N", nMax, "max") + } + xParameterName <- "theta" + yParameterNames <- "calculatedPower" + } else if (type == 8) { + if (!is.call(main) && !isS4(main) && is.na(main)) { + main <- PlotSubTitleItems(title = "Early Stopping") + main$add("N", nMax, "max") + } + xParameterName <- "theta" + yParameterNames <- "overallEarlyStop" + } else if (type == 9) { + if (!is.call(main) && !isS4(main) && is.na(main)) { + main <- PlotSubTitleItems(title = "Average Sample Size") + main$add("N", nMax, "max") + } + xParameterName <- "theta" + yParameterNames <- "averageSampleNumber" + } else { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is not allowed; must be 1, 2, ..., 9") + } + + if (type >= 5 && type <= 9) { + designSetName <- paste0( + "getPowerAndAverageSampleNumber(", designSetName, + ", theta = ", .reconstructSequenceCommand(theta), ", nMax = ", nMax, ")" + ) + } + + xValues <- NA_real_ + if (xParameterName == "theta") { + xValues <- theta + } + srcCmd <- .showPlotSourceInformation( + objectName = designSetName, + xParameterName = xParameterName, + yParameterNames = yParameterNames, + nMax = nMax, + type = type, + showSource = showSource, + xValues = xValues + ) + if (!is.null(srcCmd)) { + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(srcCmd)) + } + return(srcCmd) + } + + p <- .plotParameterSet( + parameterSet = parameterSet, designMaster = designMaster, + xParameterName = xParameterName, + yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, + palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, + legendPosition = legendPosition, plotSettings = plotSettings # , ... + ) + + p <- .addDecistionCriticalValuesToPlot(p = p, designMaster = designMaster, type = type, nMax = nMax) + + return(p) +} + +.addDecistionCriticalValuesToPlot <- function(p, designMaster, type, nMax = NA_integer_) { + if (type != 1 || !.isTrialDesignInverseNormalOrGroupSequential(designMaster)) { + return(p) + } + + data <- as.data.frame(designMaster) + xyNames <- c("delayedInformationRates", "decisionCriticalValues") + if (!all(xyNames %in% colnames(data))) { + return(p) + } + + data <- unique(na.omit(data[, xyNames])) + data$legend <- rep("Decision critical value", nrow(data)) + + if (!is.na(nMax) && nMax > 1) { + data$delayedInformationRates <- data$delayedInformationRates * nMax + tryCatch( + { + data$delayedInformationRates <- as.numeric(.formatSampleSizes(data$delayedInformationRates)) + }, + error = function(e) { + warning("Failed to format delayed information rates on x-axis: ", e$message) + } + ) + } + + plotSettings <- designMaster$.plotSettings + p <- p + ggplot2::geom_point( + data = data, + mapping = ggplot2::aes( + x = .data[["delayedInformationRates"]], + y = .data[["decisionCriticalValues"]], + colour = .data[["legend"]] + ), + size = plotSettings$scaleSize(plotSettings$pointSize, TRUE), + shape = 4, stroke = 1.25, show.legend = FALSE + ) + + for (i in 1:nrow(data)) { + label <- paste0("(", round(data[i, 1], 3), ", ", round(data[i, 2], 3), ")") + p <- p + ggplot2::annotate("text", + x = data[i, 1], y = data[i, 2], + label = label, vjust = plotSettings$scaleSize(3.0), + size = plotSettings$scaleSize(2.5) + ) + } + + try(suppressWarnings(suppressMessages(p <- p + ggplot2::scale_color_manual(values = c("#4daf4a", "#377eb8", "#e41a1c"))))) + return(p) +} diff --git a/R/class_event_probabilities.R b/R/class_event_probabilities.R index 9081aad3..2064dda8 100644 --- a/R/class_event_probabilities.R +++ b/R/class_event_probabilities.R @@ -61,7 +61,7 @@ EventProbabilities <- setRefClass("EventProbabilities", fields = list( .piecewiseSurvivalTime = "PiecewiseSurvivalTime", .accrualTime = "AccrualTime", - .plotSettings = "PlotSettings", + .plotSettings = "ANY", time = "numeric", accrualTime = "numeric", accrualIntensity = "numeric", @@ -83,7 +83,7 @@ EventProbabilities <- setRefClass("EventProbabilities", methods = list( initialize = function(...) { callSuper(...) - .plotSettings <<- PlotSettings() + .plotSettings <<- PlotSettingsR6$new() .parameterNames <<- C_PARAMETER_NAMES .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS .setParameterType("overallEventProbabilities", C_PARAM_NOT_APPLICABLE) # deprecated @@ -156,7 +156,7 @@ NumberOfSubjects <- setRefClass("NumberOfSubjects", contains = "ParameterSet", fields = list( .accrualTime = "AccrualTime", - .plotSettings = "PlotSettings", + .plotSettings = "ANY", time = "numeric", accrualTime = "numeric", accrualIntensity = "numeric", @@ -166,7 +166,7 @@ NumberOfSubjects <- setRefClass("NumberOfSubjects", methods = list( initialize = function(...) { callSuper(...) - .plotSettings <<- PlotSettings() + .plotSettings <<- PlotSettingsR6$new() .parameterNames <<- C_PARAMETER_NAMES .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS }, diff --git a/R/class_performance_score.R b/R/class_performance_score.R index be5fb4a6..140ea3d2 100644 --- a/R/class_performance_score.R +++ b/R/class_performance_score.R @@ -45,7 +45,7 @@ PerformanceScore <- setRefClass("PerformanceScore", contains = "ParameterSet", fields = list( .simulationResults = "ANY", - .plotSettings = "PlotSettings", + .plotSettings = "ANY", .alternative = "numeric", locationSampleSize = "numeric", variationSampleSize = "numeric", @@ -59,7 +59,7 @@ PerformanceScore <- setRefClass("PerformanceScore", initialize = function(simulationResults, ...) { callSuper(.simulationResults = simulationResults, ...) - .plotSettings <<- PlotSettings() + .plotSettings <<- PlotSettingsR6$new() .parameterNames <<- C_PARAMETER_NAMES .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS }, diff --git a/R/class_simulation_results.R b/R/class_simulation_results.R index 0264d2bd..e5bfd228 100644 --- a/R/class_simulation_results.R +++ b/R/class_simulation_results.R @@ -89,7 +89,7 @@ names.SimulationResults <- function(x) { SimulationResults <- setRefClass("SimulationResults", contains = "ParameterSet", fields = list( - .plotSettings = "PlotSettings", + .plotSettings = "ANY", .design = "TrialDesign", .data = "data.frame", .rawData = "data.frame", @@ -106,7 +106,7 @@ SimulationResults <- setRefClass("SimulationResults", initialize = function(design, ..., showStatistics = FALSE) { callSuper(.design = design, .showStatistics = showStatistics, ...) - .plotSettings <<- PlotSettings() + .plotSettings <<- PlotSettingsR6$new() .parameterNames <<- .getParameterNames(design = design, designPlan = .self) .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS }, diff --git a/R/class_summary_r6.R b/R/class_summary_r6.R index 5b58d9e1..054805f0 100644 --- a/R/class_summary_r6.R +++ b/R/class_summary_r6.R @@ -1070,7 +1070,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", } .createSummaryHypothesisText <- function(object, summaryFactory) { - if (!(inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) && !inherits(object, "TrialDesignPlan") && + if (!(inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) && !(inherits(object, "TrialDesignPlan") || inherits(object, "TrialDesignPlanR6")) && !inherits(object, "SimulationResults")) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, @@ -1245,7 +1245,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", .addAllocationRatioToHeader <- function(parameterSet, header, sep = ", ") { if (!.isTrialDesignPlanSurvival(parameterSet) && !grepl("Simulation", .getClassName(parameterSet))) { numberOfGroups <- 1 - if (inherits(parameterSet, "TrialDesignPlan")) { + if (inherits(parameterSet, "TrialDesignPlan") || inherits(parameterSet, "TrialDesignPlanR6")) { numberOfGroups <- parameterSet$groups } else if (inherits(parameterSet, "AnalysisResults") || inherits(parameterSet, "AnalysisResultsR6")) { numberOfGroups <- parameterSet$.dataInput$getNumberOfGroups() @@ -2883,7 +2883,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", if (.isTrialDesignPlan(object) || inherits(object, "SimulationResults")) { design <- object$.design designPlan <- object - } else if (inherits(object, "TrialDesignCharacteristics")) { + } else if (inherits(object, "TrialDesignCharacteristics") || inherits(object, "TrialDesignCharacteristicsR6")) { design <- object$.design # designPlan <- object } else if (.isTrialDesign(object)) { @@ -3191,7 +3191,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", if (design$kMax > 1) { summaryFactory$addParameter(designPlan, - parameterName = ifelse(inherits(designPlan, "TrialDesignPlan") && designPlan$.isSampleSizeObject(), + parameterName = ifelse((inherits(designPlan, "TrialDesignPlan") || inherits(designPlan, "TrialDesignPlanR6")) && designPlan$.isSampleSizeObject(), "expectedNumberOfSubjectsH1", "expectedNumberOfSubjects" ), parameterCaption = "Expected number of subjects", @@ -3209,7 +3209,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", } if (survivalEnabled) { - if (design$kMax > 1 && !(inherits(designPlan, "TrialDesignPlanSurvival") && designPlan$.isSampleSizeObject())) { + if (design$kMax > 1 && !((inherits(designPlan, "TrialDesignPlanSurvival") || inherits(designPlan, "TrialDesignPlanSurvivalR6")) && designPlan$.isSampleSizeObject())) { summaryFactory$addParameter(designPlan, parameterName = "expectedNumberOfEvents", parameterCaption = "Expected number of events", diff --git a/R/class_time.R b/R/class_time.R index 1904e06a..e6fb0ebc 100644 --- a/R/class_time.R +++ b/R/class_time.R @@ -213,7 +213,7 @@ getPiecewiseSurvivalTime <- function(piecewiseSurvivalTime = NA_real_, ignore = c(".pi1Default", ".lambdaBased", ".silent"), exceptionEnabled = TRUE ) - if (inherits(piecewiseSurvivalTime, "TrialDesignPlanSurvival")) { + if (inherits(piecewiseSurvivalTime, "TrialDesignPlanSurvival") || inherits(piecewiseSurvivalTime, "TrialDesignPlanSurvivalR6")) { piecewiseSurvivalTime <- piecewiseSurvivalTime$.piecewiseSurvivalTime } @@ -307,7 +307,7 @@ getAccrualTime <- function(accrualTime = NA_real_, ) if (inherits(accrualTime, "AccrualTime") || - inherits(accrualTime, "TrialDesignPlanSurvival")) { + inherits(accrualTime, "TrialDesignPlanSurvival") || inherits(accrualTime, "TrialDesignPlanSurvivalR6")) { if (!identical(accrualIntensity, C_ACCRUAL_INTENSITY_DEFAULT)) { .warnInCaseOfUnusedArgument(accrualIntensity, "accrualIntensity", NA_real_, "getAccrualTime") } @@ -318,7 +318,7 @@ getAccrualTime <- function(accrualTime = NA_real_, return(accrualTime) } - if (inherits(accrualTime, "TrialDesignPlanSurvival")) { + if (inherits(accrualTime, "TrialDesignPlanSurvival") || inherits(accrualTime, "TrialDesignPlanSurvivalR6")) { return(accrualTime$.accrualTime) } diff --git a/R/f_core_assertions.R b/R/f_core_assertions.R index ce975e98..5d1cfaa7 100644 --- a/R/f_core_assertions.R +++ b/R/f_core_assertions.R @@ -61,23 +61,23 @@ NULL } .isTrialDesignSet <- function(x) { - return(.getClassName(x) == "TrialDesignSet") + return(.getClassName(x) == "TrialDesignSet" || .getClassName(x) == "TrialDesignSetR6") } .isTrialDesignGroupSequential <- function(design) { - return(.getClassName(design) == C_CLASS_NAME_TRIAL_DESIGN_GROUP_SEQUENTIAL) + return(.getClassName(design) == C_CLASS_NAME_TRIAL_DESIGN_GROUP_SEQUENTIAL || .getClassName(design) == "TrialDesignGroupSequentialR6") } .isTrialDesignInverseNormal <- function(design) { - return(.getClassName(design) == C_CLASS_NAME_TRIAL_DESIGN_INVERSE_NORMAL) + return(.getClassName(design) == C_CLASS_NAME_TRIAL_DESIGN_INVERSE_NORMAL || .getClassName(design) == "TrialDesignInverseNormalR6") } .isTrialDesignFisher <- function(design) { - return(.getClassName(design) == C_CLASS_NAME_TRIAL_DESIGN_FISHER) + return(.getClassName(design) == C_CLASS_NAME_TRIAL_DESIGN_FISHER || .getClassName(design) == "TrialDesignFisherR6") } .isTrialDesignConditionalDunnett <- function(design) { - return(.getClassName(design) == C_CLASS_NAME_TRIAL_DESIGN_CONDITIONAL_DUNNETT) + return(.getClassName(design) == C_CLASS_NAME_TRIAL_DESIGN_CONDITIONAL_DUNNETT || .getClassName(design) == "TrialDesignConditionalDunnettR6") } .isTrialDesignInverseNormalOrGroupSequential <- function(design) { @@ -94,15 +94,15 @@ NULL } .isTrialDesignPlanMeans <- function(designPlan) { - return(.getClassName(designPlan) == "TrialDesignPlanMeans") + return(.getClassName(designPlan) == "TrialDesignPlanMeans" || .getClassName(designPlan) == "TrialDesignPlanMeansR6") } .isTrialDesignPlanRates <- function(designPlan) { - return(.getClassName(designPlan) == "TrialDesignPlanRates") + return(.getClassName(designPlan) == "TrialDesignPlanRates" || .getClassName(designPlan) == "TrialDesignPlanRatesR6") } .isTrialDesignPlanSurvival <- function(designPlan) { - return(.getClassName(designPlan) == "TrialDesignPlanSurvival") + return(.getClassName(designPlan) == "TrialDesignPlanSurvival" || .getClassName(designPlan) == "TrialDesignPlanSurvivalR6") } .isTrialDesignPlan <- function(designPlan) { diff --git a/R/f_core_constants.R b/R/f_core_constants.R index 3ea310b8..be29bb3f 100644 --- a/R/f_core_constants.R +++ b/R/f_core_constants.R @@ -1025,7 +1025,7 @@ C_TABLE_COLUMN_NAMES <- list( parameterNames$futilityBounds <- captionList[[parameterNameFutilityBounds]] } - if (!is.null(designPlan) && inherits(designPlan, "TrialDesignPlanSurvival") && + if (!is.null(designPlan) && (inherits(designPlan, "TrialDesignPlanSurvival") || inherits(designPlan, "TrialDesignPlanSurvivalR6")) && !is.null(designPlan$.piecewiseSurvivalTime) && designPlan$.piecewiseSurvivalTime$piecewiseSurvivalEnabled) { parameterNames$lambda2 <- "Piecewise survival lambda (2)" @@ -1033,12 +1033,12 @@ C_TABLE_COLUMN_NAMES <- list( } if (!is.null(designPlan) && - inherits(designPlan, "TrialDesignPlanSurvival") && + (inherits(designPlan, "TrialDesignPlanSurvival") || inherits(designPlan, "TrialDesignPlanSurvivalR6")) && identical(designPlan$.design$kMax, 1L)) { parameterNames$maxNumberOfEvents <- "Number of events" } - if (!is.null(designPlan) && inherits(designPlan, "TrialDesignPlan") && + if (!is.null(designPlan) && (inherits(designPlan, "TrialDesignPlan") || inherits(designPlan, "TrialDesignPlanR6")) && identical(designPlan$.design$kMax, 1L)) { parameterNames$studyDuration <- "Study duration" } @@ -1059,7 +1059,7 @@ C_TABLE_COLUMN_NAMES <- list( } if (!is.null(designPlan) && - (inherits(designPlan, "TrialDesignPlanMeans") || + ((inherits(designPlan, "TrialDesignPlanMeans") || inherits(designPlan, "TrialDesignPlanMeansR6")) || inherits(designPlan, "SimulationResultsMeans")) && isTRUE(designPlan$meanRatio)) { parameterNames$stDev <- "Coefficient of variation" diff --git a/R/f_core_plot.R b/R/f_core_plot.R index 1c063df1..9dec7e8d 100644 --- a/R/f_core_plot.R +++ b/R/f_core_plot.R @@ -36,7 +36,7 @@ NULL .assertIsSingleInteger(type, "type", validateType = FALSE) - if (inherits(obj, "TrialDesignPlan")) { + if (inherits(obj, "TrialDesignPlan") || inherits(obj, "TrialDesignPlanR6")) { if (type == 1) { if (.isTrialDesignPlanSurvival(obj)) { return(.addNumberToPlotCaption("Boundaries Z Scale", type, numberInCaptionEnabled)) @@ -80,7 +80,7 @@ NULL return(.addNumberToPlotCaption("Reject per Stage", type, numberInCaptionEnabled)) } - if (inherits(obj, "TrialDesignPlan") || inherits(obj, "SimulationResults")) { + if (inherits(obj, "TrialDesignPlan") || inherits(obj, "TrialDesignPlanR6") || inherits(obj, "SimulationResults")) { if (type == 5) { if (obj$.isSampleSizeObject()) { return(.addNumberToPlotCaption("Sample Size", type, numberInCaptionEnabled)) @@ -117,7 +117,7 @@ NULL } else if (type == 14) { return(.addNumberToPlotCaption("Survival Function", type, numberInCaptionEnabled)) } - } else if (inherits(obj, "TrialDesign") || inherits(obj, "TrialDesignSet")) { + } else if (inherits(obj, "TrialDesign") || inherits(obj, "TrialDesignSet") || inherits(obj, "TrialDesignR6") || inherits(obj, "TrialDesignSetR6")) { if (type == 1) { return(.addNumberToPlotCaption("Boundaries", type, numberInCaptionEnabled)) } else if (type == 3) { @@ -399,7 +399,7 @@ getAvailablePlotTypes <- function(obj, output = c("numeric", "caption", "numcap" } types <- integer(0) - if (inherits(obj, "TrialDesignPlan")) { + if (inherits(obj, "TrialDesignPlan") || inherits(obj, "TrialDesignPlanR6")) { if (obj$.design$kMax > 1) { types <- c(types, 1:4) } @@ -454,9 +454,9 @@ getAvailablePlotTypes <- function(obj, output = c("numeric", "caption", "numcap" plotTypesToCheck <- c(1:14) } types <- .removeInvalidPlotTypes(obj, types, plotTypesToCheck) - } else if (inherits(obj, "TrialDesign") || inherits(obj, "TrialDesignSet")) { + } else if (inherits(obj, "TrialDesign") || inherits(obj, "TrialDesignR6") || inherits(obj, "TrialDesignSet") || inherits(obj, "TrialDesignSetR6")) { design <- obj - if (inherits(obj, "TrialDesignSet")) { + if (inherits(obj, "TrialDesignSet") || inherits(obj, "TrialDesignSetR6")) { design <- obj$getDesignMaster() } if (design$kMax > 1) { @@ -710,7 +710,7 @@ getAvailablePlotTypes <- function(obj, output = c("numeric", "caption", "numcap" ) } - if (inherits(parameterSet, "TrialDesignSet")) { + if (inherits(parameterSet, "TrialDesignSet") || inherits(parameterSet, "TrialDesignSetR6")) { suppressWarnings(data <- as.data.frame(parameterSet, niceColumnNamesEnabled = FALSE, includeAllParameters = TRUE, @@ -827,8 +827,8 @@ getAvailablePlotTypes <- function(obj, output = c("numeric", "caption", "numcap" "overallEarlyStop", "calculatedPower" ))] fieldNames <- c( - names(parameterSet$getRefClass()$fields()), - names(designMaster$getRefClass()$fields()) + names(parameterSet),#TODO + names(designMaster)#TODO ) if (simulationEnrichmentEnmabled) { fieldNames <- c(fieldNames, gsub("s$", "", names(parameterSet$effectList)), "situation") @@ -842,12 +842,12 @@ getAvailablePlotTypes <- function(obj, output = c("numeric", "caption", "numcap" ) } } - if (is.null(plotSettings) || !inherits(plotSettings, "PlotSettings")) { + if (is.null(plotSettings) || !inherits(plotSettings, "PlotSettingsR6")) { plotSettings <- parameterSet$getPlotSettings() } } else { - if (is.null(plotSettings) || !inherits(plotSettings, "PlotSettings")) { - plotSettings <- PlotSettings() + if (is.null(plotSettings) || !inherits(plotSettings, "PlotSettingsR6")) { + plotSettings <- PlotSettingsR6$new() } } @@ -1235,7 +1235,7 @@ getAvailablePlotTypes <- function(obj, output = c("numeric", "caption", "numcap" } if (is.null(plotSettings)) { - plotSettings <- PlotSettings() + plotSettings <- PlotSettingsR6$new() } nRow <- nrow(data) @@ -1592,7 +1592,7 @@ saveLastPlot <- function(filename, outputPath = .getRelativeFigureOutputPath()) plotSettings <- x$.plotSettings if (is.null(plotSettings)) { - plotSettings <- PlotSettings() + plotSettings <- PlotSettingsR6$new() } else { plotSettings <- plotSettings$clone() } diff --git a/R/f_core_utilities.R b/R/f_core_utilities.R index 0ccdb178..82c3936e 100644 --- a/R/f_core_utilities.R +++ b/R/f_core_utilities.R @@ -1043,10 +1043,10 @@ getParameterCaption <- function(obj, parameterName) { design <- NULL designPlan <- NULL - if (inherits(obj, "TrialDesignPlan")) { + if (inherits(obj, "TrialDesignPlan") || inherits(obj, "TrialDesignPlanR6")) { designPlan <- obj design <- obj$.design - } else if (inherits(obj, "TrialDesign")) { + } else if (inherits(obj, "TrialDesign") || inherits(obj, "TrialDesignR6")) { design <- obj } else { design <- obj[[".design"]] @@ -1092,10 +1092,10 @@ getParameterName <- function(obj, parameterCaption) { design <- NULL designPlan <- NULL - if (inherits(obj, "TrialDesignPlan")) { + if (inherits(obj, "TrialDesignPlan") || inherits(obj, "TrialDesignPlanR6")) { designPlan <- obj design <- obj$.design - } else if (inherits(obj, "TrialDesign")) { + } else if (inherits(obj, "TrialDesign") || inherits(obj, "TrialDesignR6")) { design <- obj } else { design <- obj[[".design"]] diff --git a/R/f_design_fisher_combination_test.R b/R/f_design_fisher_combination_test.R index 2e6a4ac2..1121b165 100644 --- a/R/f_design_fisher_combination_test.R +++ b/R/f_design_fisher_combination_test.R @@ -145,7 +145,7 @@ getDesignFisher <- function(..., warning("'bindingFutility' (", bindingFutility, ") will be ignored", call. = FALSE) } - design <- TrialDesignFisher( + design <- TrialDesignFisherR6$new( kMax = kMax, alpha = alpha, method = method, diff --git a/R/f_design_group_sequential.R b/R/f_design_group_sequential.R index 863409b8..3f46591f 100644 --- a/R/f_design_group_sequential.R +++ b/R/f_design_group_sequential.R @@ -242,14 +242,13 @@ getGroupSequentialProbabilities <- function(decisionMatrix, informationRates) { } .validateBaseParameters <- function(design, twoSidedWarningForDefaultValues = TRUE) { - if (.isDefinedArgument(design$kMax)) { + if (.isDefinedArgument(design$kMax)) { .assertDesignParameterExists(design, "kMax", C_KMAX_DEFAULT) .assertIsValidKMax(design$kMax) if (.isDefinedArgument(design$informationRates)) { .assertAreValidInformationRates(design$informationRates, design$kMax) } - if (.isDefinedArgument(design$futilityBounds)) { .assertAreValidFutilityBounds(design$futilityBounds, design$kMax) } @@ -325,12 +324,12 @@ getGroupSequentialProbabilities <- function(decisionMatrix, informationRates) { .assertIsInClosedInterval(delayedInformation, "delayedInformation", lower = 0, upper = NULL, naAllowed = TRUE) if (designClass == C_CLASS_NAME_TRIAL_DESIGN_INVERSE_NORMAL) { - design <- TrialDesignInverseNormal( + design <- TrialDesignInverseNormalR6$new( kMax = kMax, bindingFutility = bindingFutility, delayedInformation = delayedInformation ) } else if (designClass == C_CLASS_NAME_TRIAL_DESIGN_GROUP_SEQUENTIAL) { - design <- TrialDesignGroupSequential( + design <- TrialDesignGroupSequentialR6$new( kMax = kMax, bindingFutility = bindingFutility, delayedInformation = delayedInformation ) @@ -1769,7 +1768,7 @@ getDesignCharacteristics <- function(design = NULL, ...) { writeToDesign = FALSE, twoSidedWarningForDefaultValues = FALSE ) - designCharacteristics <- TrialDesignCharacteristics(design = design) + designCharacteristics <- TrialDesignCharacteristicsR6$new(design = design) designCharacteristics$rejectionProbabilities <- rep(NA_real_, design$kMax) designCharacteristics$.setParameterType("rejectionProbabilities", C_PARAM_NOT_APPLICABLE) diff --git a/R/f_design_sample_size_calculator.R b/R/f_design_sample_size_calculator.R index 9fb98610..cf229530 100644 --- a/R/f_design_sample_size_calculator.R +++ b/R/f_design_sample_size_calculator.R @@ -1256,6 +1256,7 @@ getSampleSizeSurvival <- function(design = NULL, ..., dropoutTime = dropoutTime, hazardRatio = hazardRatio ) + return(.getSampleSize(designPlan)) } @@ -1365,8 +1366,7 @@ getSampleSizeSurvival <- function(design = NULL, ..., } .assertIsValidAllocationRatioPlannedSampleSize(allocationRatioPlanned, maxNumberOfSubjects) - - designPlan <- TrialDesignPlanSurvival( + designPlan <- TrialDesignPlanSurvivalR6$new( design = design, typeOfComputation = typeOfComputation, thetaH0 = thetaH0, @@ -3255,7 +3255,6 @@ getNumberOfSubjects <- function(time, ..., .getEventsFixed <- function(..., typeOfComputation = c("Schoenfeld", "Freedman", "HsiehFreedman"), twoSidedPower, alpha, beta, sided, hazardRatio, thetaH0, allocationRatioPlanned) { typeOfComputation <- match.arg(typeOfComputation) - if (typeOfComputation == "Schoenfeld") { eventsFixed <- (.getOneMinusQNorm(alpha / sided) + .getOneMinusQNorm(beta))^2 / (log(hazardRatio) - log(thetaH0))^2 * @@ -3934,7 +3933,7 @@ getNumberOfSubjects <- function(time, ..., } } - designPlan <- TrialDesignPlanMeans(design = design, meanRatio = meanRatio) + designPlan <- TrialDesignPlanMeansR6$new(design = design, meanRatio = meanRatio) designPlan$.setSampleSizeObject(objectType) designPlan$criticalValuesPValueScale <- matrix(design$stageLevels, ncol = 1) @@ -4125,7 +4124,7 @@ getNumberOfSubjects <- function(time, ..., } } - designPlan <- TrialDesignPlanRates(design = design) + designPlan <- TrialDesignPlanRatesR6$new(design = design) designPlan$.setSampleSizeObject(objectType) designPlan$criticalValuesPValueScale <- matrix(design$stageLevels, ncol = 1) diff --git a/R/f_design_utilities.R b/R/f_design_utilities.R index f689fcf0..f5769e41 100644 --- a/R/f_design_utilities.R +++ b/R/f_design_utilities.R @@ -1020,12 +1020,12 @@ getMedianByPi <- function(piValue, designParametersToShow <- c(designParametersToShow, ".design$stageLevels") } if (design$sided == 2 && !grepl("Analysis|Simulation", .getClassName(parameterSet)) && - (!inherits(parameterSet, "TrialDesignPlan") || parameterSet$.isSampleSizeObject())) { + (!(inherits(parameterSet, "TrialDesignPlan") || inherits(parameterSet, "TrialDesignPlanR6")) || parameterSet$.isSampleSizeObject())) { designParametersToShow <- c(designParametersToShow, ".design$twoSidedPower") } designParametersToShow <- c(designParametersToShow, ".design$alpha") if (!grepl("Analysis|Simulation", .getClassName(parameterSet)) && - (!inherits(parameterSet, "TrialDesignPlan") || parameterSet$.isSampleSizeObject())) { + (!(inherits(parameterSet, "TrialDesignPlan") || inherits(parameterSet, "TrialDesignPlanR6")) || parameterSet$.isSampleSizeObject())) { designParametersToShow <- c(designParametersToShow, ".design$beta") } diff --git a/R/f_object_r_code.R b/R/f_object_r_code.R index 4bb35506..2aed3b35 100644 --- a/R/f_object_r_code.R +++ b/R/f_object_r_code.R @@ -125,7 +125,7 @@ NULL } .getGeneratorFunctionName <- function(obj) { - if ("TrialDesignPlanMeans" == .getClassName(obj)) { + if ("TrialDesignPlanMeans" == .getClassName(obj) || "TrialDesignPlanMeansR6" == .getClassName(obj)) { if (obj$.isSampleSizeObject()) { return("getSampleSizeMeans") } @@ -133,7 +133,7 @@ NULL return("getPowerMeans") } - if ("TrialDesignPlanRates" == .getClassName(obj)) { + if ("TrialDesignPlanRates" == .getClassName(obj) || "TrialDesignPlanRatesR6" == .getClassName(obj)) { if (obj$.isSampleSizeObject()) { return("getSampleSizeRates") } @@ -141,7 +141,7 @@ NULL return("getPowerRates") } - if ("TrialDesignPlanSurvival" == .getClassName(obj)) { + if ("TrialDesignPlanSurvival" == .getClassName(obj) || "TrialDesignPlanSurvivalR6" == .getClassName(obj)) { if (obj$.isSampleSizeObject()) { return("getSampleSizeSurvival") } @@ -149,10 +149,10 @@ NULL return("getPowerSurvival") } - if (inherits(obj, "TrialDesign")) { - return(paste0("get", sub("^Trial", "", .getClassName(obj)))) + if (inherits(obj, "TrialDesign") || inherits(obj, "TrialDesignR6")) { + return(paste0("get", sub("^Trial", "", sub("R6","",.getClassName(obj))))) } - + if (inherits(obj, "Dataset")) { return("getDataset") } @@ -161,11 +161,11 @@ NULL return("getAnalysisResults") } - if ("TrialDesignSet" == .getClassName(obj)) { + if ("TrialDesignSet" == .getClassName(obj) || "TrialDesignSetR6" == .getClassName(obj)) { return("getDesignSet") } - if ("TrialDesignCharacteristics" == .getClassName(obj)) { + if ("TrialDesignCharacteristics" == .getClassName(obj) || "TrialDesignCharacteristicsR6" == .getClassName(obj)) { return("getDesignCharacteristics") } @@ -237,7 +237,7 @@ NULL return("gePerformanceScore") } - if (inherits(obj, "SummaryFactory") || "SummaryFactory" == .getClassName(obj)) { + if (inherits(obj, "SummaryFactory") || "SummaryFactory" == .getClassName(obj) || inherits(obj, "SummaryFactoryR6") || "SummaryFactoryR6" == .getClassName(obj)) { return(.getGeneratorFunctionName(obj$object)) } @@ -728,7 +728,7 @@ getObjectRCode <- function(obj, ..., } } - if (inherits(obj, "TrialDesignPlanSurvival")) { + if (inherits(obj, "TrialDesignPlanSurvival") || inherits(obj, "TrialDesignPlanSurvivalR6")) { if (!("accrualTime" %in% objNames) && obj$.getParameterType("accrualTime") == "g" && !all(is.na(obj$accrualTime))) { # case 2: follow-up time and absolute intensity given diff --git a/load_source_files.R b/load_source_files.R new file mode 100644 index 00000000..6d12ae82 --- /dev/null +++ b/load_source_files.R @@ -0,0 +1,183 @@ +###################################################################################### +# # +# -- Load source files -- # +# # +# This file is part of the R package RPACT - R Package for Adaptive Clinical Trials. # +# # +# Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD # +# Licensed under "GNU Lesser General Public License" version 3 # +# License text can be found here: https://www.r-project.org/Licenses/LGPL-3 # +# # +# RPACT company website: https://www.rpact.com # +# RPACT package website: https://www.rpact.org # +# # +# Contact us for information about our services: info@rpact.com # +# # +# File version: $Revision: 4443 $ # +# Last changed: $Date: 2021-02-22 09:13:17 +0100 (Mon, 22 Feb 2021) $ # +# Last changed by: $Author: pahlke $ # +###################################################################################### + +#setwd("C:\\Users\\Till\\CLionProjects\\rpactsvn") +#setwd("/home/massive/eclipse-workspace/rpact.ext") + +library(Rcpp) +library(tictoc) +library(testthat) +library(parallel) +library(rbenchmark) +library(doParallel) +library(foreach) +library(R6) +library(profvis) +library(rpact.as251) + +tic() + +Sys.setenv("RPACT_COMPILE_CPP_FILES" = FALSE) +Sys.setenv("RPACT_DEVELOPMENT_MODE" = TRUE) + +#print("The following packages are not up to date:") +#pacman::p_update(FALSE) + +#sessionInfo() + +# eliminate package startup messages +#suppressPackageStartupMessages() + +if (exists(".onUnload")) { + .onUnload("") +} + +# cleanup (remove all variables and functions) +rm(list=ls(all=TRUE), envir = .GlobalEnv) +# help 'environment': https://stat.ethz.ch/R-manual/R-devel/library/base/html/environment.html + +#makeActiveBinding("refresh", function() { system(paste0(R.home(),"/bin/x64/R")); q("no") }, .GlobalEnv) +#paste0(R.home(),"/bin/x64/R --no-save") + +### rpact.dev::detachPackage("rpact", characterOnly = TRUE) + +# debug warnings: +#options(warn=2) # normal: options(warn=1) +# traceback() + +gc() + +baseDir <- file.path(sub("/R$", "", getwd())) +sourceFileDir <- file.path(baseDir, 'R') + +fileNames <- c( + "class_core_parameter_set_r6", + "class_analysis_stage_results_r6", + "class_analysis_results_r6", + "class_summary_r6", + "class_design_r6", + "class_core_plot_settings_r6", + "class_design_set_r6", + "f_core_constants", + "class_design_plan_r6", + "f_design_utilities", + "f_analysis_utilities", + "class_core_parameter_set", + #"class_core_plot_settings", + "f_core_assertions", + "f_core_utilities", + #"class_design", + #"class_design_set", + "class_design_power_and_asn", + "class_time", + "class_summary", + "f_logger", + #"class_design_plan", + "class_analysis_dataset", + #"class_analysis_stage_results", + #"class_analysis_results", + "class_simulation_results", + "class_event_probabilities", + "f_core_output_formats", + "f_core_plot", + "f_design_group_sequential", + "f_design_fisher_combination_test", + "f_design_sample_size_calculator", + "f_analysis_base_means", + "f_analysis_base_rates", + "f_analysis_base_survival", + "f_analysis_base", + "f_analysis_enrichment", + "f_analysis_enrichment_means", + "f_analysis_enrichment_rates", + "f_analysis_enrichment_survival", + "f_analysis_multiarm_means", + "f_analysis_multiarm_rates", + "f_analysis_multiarm_survival", + "f_analysis_multiarm", + "f_simulation_base_means", + "f_simulation_base_rates", + "f_simulation_base_survival", + "f_simulation_multiarm", + "f_simulation_multiarm_means", + "f_simulation_multiarm_rates", + "f_simulation_multiarm_survival", + "f_simulation_utilities", + "f_parameter_set_utilities" +) + +# https://stackoverflow.com/questions/17635531/calling-cuda-compiled-dll-from-r + +if (as.logical(Sys.getenv("RPACT_COMPILE_CPP_FILES"))) { + # Important: .Call methods will be only added to lookup table if used in the R folder + Rcpp::compileAttributes(verbose = TRUE) +} + +# Create init file. The file must be deleted before Rcpp::compileAttributes execution! +#tools::package_native_routine_registration_skeleton(".", file.path(baseDir, "src", "rpact_init.c"), character_only = FALSE) + +#pkgbuild::clean_dll() +dllFile <- file.path(baseDir, "src", "rpact.dll") +if (!file.exists(dllFile)) { + if (is.loaded(dllFile) || !is.null(getLoadedDLLs()[["rpact"]])) { + dyn.unload(dllFile) + } + # Warning: does not create all required dll's! Use rpact.dev::buildPackage instead respectively first time! + pkgbuild::compile_dll(force = TRUE, compile_attributes = FALSE, register_routines = FALSE) + #pkgbuild::compile_dll(force = TRUE, compile_attributes = TRUE, register_routines = FALSE) + #pkgbuild::compile_dll(force = TRUE, compile_attributes = TRUE, register_routines = TRUE) +} +### print(paste0("Execute dyn.load('", dllFile, "')...")) +### print(dyn.load(dllFile)) + +### print(getDLLRegisteredRoutines("rpact")) +# .Call .Call.numParameters +# 1 _rpact_getRandomSurvivalDistribution 2 +# 2 _rpact_getRandomPiecewiseExponentialDistribution 3 +# 3 _rpact_getSimulationSurvivalCpp 31 +# 4 R_getDensityValues 6 + +for (fileName in fileNames) { + sourceFile <- file.path(sourceFileDir, paste0(fileName, ".R")) + print(paste0("Update source file '", sourceFile, "'...")) + source(sourceFile) +} + +rHome <- Sys.getenv("R_HOME") +if (grepl("Program Files", rHome)) { + stop("R must be installed in a directory without spaces; current directory: ", rHome) +} + +if (as.logical(Sys.getenv("RPACT_COMPILE_CPP_FILES")) || !exists("getSimulationSurvivalCpp")) { + cppSourceFiles <- list.files(file.path(baseDir, "src"), pattern = "\\.cpp$") + cppSourceFiles <- cppSourceFiles[!(cppSourceFiles %in% c("RcppExports.cpp"))] + cppSourceFiles <- sort(cppSourceFiles, decreasing = TRUE) + for (cppSourceFile in cppSourceFiles) { + if(cppSourceFile != "f_as251.cpp") { + file <- file.path(baseDir, "src", cppSourceFile) + print(paste0("Perform sourceCpp(", file, ")...")) + Rcpp::sourceCpp(file) + } + } +} + +print("Initialization completed.") + +toc() diff --git a/tests/testthat/helper-f_core_assertions.R b/tests/testthat/helper-f_core_assertions.R index cdf41daa..5cb587b3 100644 --- a/tests/testthat/helper-f_core_assertions.R +++ b/tests/testthat/helper-f_core_assertions.R @@ -21,7 +21,7 @@ getAssertionTestDesign <- function(..., kMax = NA_integer_, informationRates = NA_real_, futilityBounds = NA_real_, designClass = "TrialDesignInverseNormal") { if (designClass == "TrialDesignFisher") { - return(TrialDesignFisher( + return(TrialDesignFisherR6$new( kMax = kMax, alpha = 0.025, method = "equalAlpha", diff --git a/tests/testthat/test-class_core_plot_settings.R b/tests/testthat/test-class_core_plot_settings.R index 483bd1a9..115bada6 100644 --- a/tests/testthat/test-class_core_plot_settings.R +++ b/tests/testthat/test-class_core_plot_settings.R @@ -24,10 +24,18 @@ test_plan_section("Testing the Class 'PlotSettings'") test_that("Test plot settings", { expect_error(PlotSubTitleItem()) - + expect_type(PlotSubTitleItems(), "S4") expect_type(getPlotSettings(), "S4") expect_type(PlotSettings(), "S4") + + expect_error(PlotSubTitleItemR6$new()) + + expect_type(PlotSubTitleItemsR6$new(), "R6") + + expect_type(getPlotSettingsR6$new(), "R6") + + expect_type(PlotSettingsR6$new(), "R6") }) From cd4ef07448a1eb63b3d7af45c588c0e4d1c3d207 Mon Sep 17 00:00:00 2001 From: Till Luca Jensen Date: Tue, 13 Feb 2024 13:51:17 +0100 Subject: [PATCH 08/28] added classes --- DESCRIPTION | 21 +- R/class_analysis_dataset.R | 1529 ------ R/class_analysis_dataset_r6.R | 4226 +++++++++++++++++ R/class_core_parameter_set.R | 6 +- R/class_core_parameter_set_r6.R | 13 +- R/class_design_plan.R | 1228 +---- R/class_design_power_and_asn_r6.R | 329 ++ R/class_design_set.R | 263 +- R/class_design_set_r6.R | 2 +- R/class_event_probabilities.R | 6 +- R/class_event_probabilities_r6.R | 533 +++ R/class_performance_score_r6.R | 81 + R/class_simulation_results.R | 6 +- R/class_simulation_results_r6.R | 2842 +++++++++++ R/class_summary.R | 2821 +---------- R/class_summary_r6.R | 61 +- R/class_time.R | 200 - R/class_time_r6.R | 2297 +++++++++ R/f_analysis_base.R | 8 +- R/f_core_assertions.R | 16 +- R/f_core_constants.R | 2 +- R/f_core_plot.R | 14 +- R/f_design_group_sequential.R | 2 +- R/f_design_sample_size_calculator.R | 4 +- R/f_object_r_code.R | 49 +- R/f_simulation_base_means.R | 2 +- R/f_simulation_base_rates.R | 2 +- R/f_simulation_base_survival.R | 2 +- R/f_simulation_calc_subjects_function.R | 10 +- R/f_simulation_enrichment.R | 6 +- R/f_simulation_multiarm.R | 6 +- R/f_simulation_performance_score.R | 12 +- R/f_simulation_utilities.R | 2 +- load_source_files.R | 26 +- .../testthat/test-class_core_plot_settings.R | 8 +- 35 files changed, 10466 insertions(+), 6169 deletions(-) create mode 100644 R/class_analysis_dataset_r6.R create mode 100644 R/class_design_power_and_asn_r6.R create mode 100644 R/class_event_probabilities_r6.R create mode 100644 R/class_performance_score_r6.R create mode 100644 R/class_simulation_results_r6.R create mode 100644 R/class_time_r6.R diff --git a/DESCRIPTION b/DESCRIPTION index 66fcb367..eca4e39c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -71,11 +71,25 @@ Config/testthat/parallel: true Config/testthat/start-first: *analysis* Collate: 'RcppExports.R' - 'f_logger.R' + 'class_core_parameter_set_r6.R' + 'class_core_plot_settings_r6.R' + 'class_analysis_results_r6.R' + 'class_analysis_stage_results_r6.R' + 'class_summary_r6.R' + 'class_design_r6.R' + 'class_design_set_r6.R' + 'class_event_probabilities_r6.R' + 'class_time_r6.R' + 'class_design_power_and_asn_r6.R' + 'class_performance_score_r6.R' 'f_core_constants.R' + 'class_design_plan_r6.R' + 'class_simulation_results_r6.R' + 'f_logger.R' 'f_core_utilities.R' 'f_core_assertions.R' 'f_analysis_utilities.R' + 'class_analysis_dataset_r6.R' 'f_parameter_set_utilities.R' 'class_core_parameter_set.R' 'class_core_plot_settings.R' @@ -86,15 +100,10 @@ Collate: 'class_analysis_dataset.R' 'class_analysis_stage_results.R' 'class_analysis_results.R' - 'class_analysis_results_r6.R' - 'class_analysis_stage_results_r6.R' - 'class_core_parameter_set_r6.R' - 'class_time.R' 'class_design_set.R' 'f_design_utilities.R' 'class_design_plan.R' 'class_design_power_and_asn.R' - 'class_event_probabilities.R' 'f_simulation_utilities.R' 'f_simulation_base_survival.R' 'class_simulation_results.R' diff --git a/R/class_analysis_dataset.R b/R/class_analysis_dataset.R index ff706983..6988a03a 100644 --- a/R/class_analysis_dataset.R +++ b/R/class_analysis_dataset.R @@ -85,1248 +85,6 @@ C_KEY_WORDS <- c( C_KEY_WORDS_OVERALL_LOG_RANKS ) -#' @title -#' Read Dataset -#' -#' @description -#' Reads a data file and returns it as dataset object. -#' -#' @param file A CSV file (see \code{\link[utils]{read.table}}). -#' @param header A logical value indicating whether the file contains the names of -#' the variables as its first line. -#' @param sep The field separator character. Values on each line of the file are separated -#' by this character. If sep = "," (the default for \code{readDataset}) the separator is a comma. -#' @param quote The set of quoting characters. To disable quoting altogether, use -#' quote = "". See scan for the behavior on quotes embedded in quotes. Quoting is only -#' considered for columns read as character, which is all of them unless \code{colClasses} is specified. -#' @param dec The character used in the file for decimal points. -#' @param fill logical. If \code{TRUE} then in case the rows have unequal length, blank fields -#' are implicitly added. -#' @param comment.char character: a character vector of length one containing a single character -#' or an empty string. Use "" to turn off the interpretation of comments altogether. -#' @param fileEncoding character string: if non-empty declares the encoding used on a file -#' (not a connection) so the character data can be re-encoded. -#' See the 'Encoding' section of the help for file, the 'R Data Import/Export Manual' and 'Note'. -#' @param ... Further arguments to be passed to code{\link[utils]{read.table}}. -#' -#' @details -#' \code{readDataset} is a wrapper function that uses \code{\link[utils]{read.table}} to read the -#' CSV file into a data frame, transfers it from long to wide format with \code{\link[stats]{reshape}} -#' and puts the data to \code{\link[=getDataset]{getDataset()}}. -#' -#' @template return_object_dataset -#' -#' @seealso -#' \itemize{ -#' \item \code{\link[=readDatasets]{readDatasets()}} for reading multiple datasets, -#' \item \code{\link[=writeDataset]{writeDataset()}} for writing a single dataset, -#' \item \code{\link[=writeDatasets]{writeDatasets()}} for writing multiple datasets. -#' } -#' -#' @examples -#' \dontrun{ -#' dataFileRates <- system.file("extdata", -#' "dataset_rates.csv", -#' package = "rpact" -#' ) -#' if (dataFileRates != "") { -#' datasetRates <- readDataset(dataFileRates) -#' datasetRates -#' } -#' -#' dataFileMeansMultiArm <- system.file("extdata", -#' "dataset_means_multi-arm.csv", -#' package = "rpact" -#' ) -#' if (dataFileMeansMultiArm != "") { -#' datasetMeansMultiArm <- readDataset(dataFileMeansMultiArm) -#' datasetMeansMultiArm -#' } -#' -#' dataFileRatesMultiArm <- system.file("extdata", -#' "dataset_rates_multi-arm.csv", -#' package = "rpact" -#' ) -#' if (dataFileRatesMultiArm != "") { -#' datasetRatesMultiArm <- readDataset(dataFileRatesMultiArm) -#' datasetRatesMultiArm -#' } -#' -#' dataFileSurvivalMultiArm <- system.file("extdata", -#' "dataset_survival_multi-arm.csv", -#' package = "rpact" -#' ) -#' if (dataFileSurvivalMultiArm != "") { -#' datasetSurvivalMultiArm <- readDataset(dataFileSurvivalMultiArm) -#' datasetSurvivalMultiArm -#' } -#' } -#' -#' @export -#' -readDataset <- function(file, ..., header = TRUE, sep = ",", quote = "\"", - dec = ".", fill = TRUE, comment.char = "", fileEncoding = "UTF-8") { - if (!file.exists(file)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the file '", file, "' does not exist") - } - - data <- utils::read.table( - file = file, header = header, sep = sep, - quote = quote, dec = dec, fill = fill, fileEncoding = fileEncoding, ... - ) - dataWide <- stats::reshape(data = data, direction = "wide", idvar = "stages", timevar = "groups") - colnames(dataWide) <- gsub("\\.", "", colnames(dataWide)) - return(getDataset(dataWide)) -} - -#' @title -#' Write Dataset -#' -#' @description -#' Writes a dataset to a CSV file. -#' -#' @param dataset A dataset. -#' @param file The target CSV file. -#' @param append Logical. Only relevant if file is a character string. -#' If \code{TRUE}, the output is appended to the file. If \code{FALSE}, any existing file of the name is destroyed. -#' @param sep The field separator character. Values on each line of the file are separated -#' by this character. If sep = "," (the default for \code{writeDataset}) the separator is a comma. -#' @param quote The set of quoting characters. To disable quoting altogether, use -#' quote = "". See scan for the behavior on quotes embedded in quotes. Quoting is only -#' considered for columns read as character, which is all of them unless \code{colClasses} is specified. -#' @param dec The character used in the file for decimal points. -#' @param eol The character(s) to print at the end of each line (row). -#' @param na The string to use for missing values in the data. -#' @param row.names Either a logical value indicating whether the row names of \code{dataset} are -#' to be written along with \code{dataset}, or a character vector of row names to be written. -#' @param col.names Either a logical value indicating whether the column names of \code{dataset} are -#' to be written along with \code{dataset}, or a character vector of column names to be written. -#' See the section on 'CSV files' for the meaning of \code{col.names = NA}. -#' @param qmethod A character string specifying how to deal with embedded double quote characters -#' when quoting strings. Must be one of "double" (default in \code{writeDataset}) or "escape". -#' @param fileEncoding Character string: if non-empty declares the encoding used on a file -#' (not a connection) so the character data can be re-encoded. -#' See the 'Encoding' section of the help for file, the 'R Data Import/Export Manual' and 'Note'. -#' @param ... Further arguments to be passed to \code{\link[utils]{write.table}}. -#' -#' @details -#' \code{\link[=writeDataset]{writeDataset()}} is a wrapper function that coerces the dataset to a data frame and uses \cr -#' \code{\link[utils]{write.table}} to write it to a CSV file. -#' -#' @seealso -#' \itemize{ -#' \item \code{\link[=writeDatasets]{writeDatasets()}} for writing multiple datasets, -#' \item \code{\link[=readDataset]{readDataset()}} for reading a single dataset, -#' \item \code{\link[=readDatasets]{readDatasets()}} for reading multiple datasets. -#' } -#' -#' @examples -#' \dontrun{ -#' datasetOfRates <- getDataset( -#' n1 = c(11, 13, 12, 13), -#' n2 = c(8, 10, 9, 11), -#' events1 = c(10, 10, 12, 12), -#' events2 = c(3, 5, 5, 6) -#' ) -#' writeDataset(datasetOfRates, "dataset_rates.csv") -#' } -#' -#' @export -#' -writeDataset <- function(dataset, file, ..., append = FALSE, quote = TRUE, sep = ",", - eol = "\n", na = "NA", dec = ".", row.names = TRUE, - col.names = NA, qmethod = "double", - fileEncoding = "UTF-8") { - .assertIsDataset(dataset) - - x <- as.data.frame(dataset, niceColumnNamesEnabled = FALSE) - - utils::write.table( - x = x, file = file, append = append, quote = quote, sep = sep, - eol = eol, na = na, dec = dec, row.names = FALSE, - col.names = TRUE, qmethod = qmethod, - fileEncoding = fileEncoding - ) -} - -#' @title -#' Read Multiple Datasets -#' -#' @description -#' Reads a data file and returns it as a list of dataset objects. -#' -#' @param file A CSV file (see \code{\link[utils]{read.table}}). -#' @param header A logical value indicating whether the file contains the names of -#' the variables as its first line. -#' @param sep The field separator character. Values on each line of the file are separated -#' by this character. If sep = "," (the default for \code{readDatasets}) the separator is a comma. -#' @param quote The set of quoting characters. To disable quoting altogether, use -#' quote = "". See scan for the behavior on quotes embedded in quotes. Quoting is only -#' considered for columns read as character, which is all of them unless \code{colClasses} is specified. -#' @param dec The character used in the file for decimal points. -#' @param fill logical. If \code{TRUE} then in case the rows have unequal length, blank fields -#' are implicitly added. -#' @param comment.char character: a character vector of length one containing a single character -#' or an empty string. Use "" to turn off the interpretation of comments altogether. -#' @param fileEncoding character string: if non-empty declares the encoding used on a file -#' (not a connection) so the character data can be re-encoded. -#' See the 'Encoding' section of the help for file, the 'R Data Import/Export Manual' and 'Note'. -#' @param ... Further arguments to be passed to \code{\link[utils]{read.table}}. -#' -#' @details -#' Reads a file that was written by \code{\link[=writeDatasets]{writeDatasets()}} before. -#' -#' @return Returns a \code{\link[base]{list}} of \code{\link{Dataset}} objects. -#' -#' @seealso -#' \itemize{ -#' \item \code{\link[=readDataset]{readDataset()}} for reading a single dataset, -#' \item \code{\link[=writeDatasets]{writeDatasets()}} for writing multiple datasets, -#' \item \code{\link[=writeDataset]{writeDataset()}} for writing a single dataset. -#' } -#' -#' @examples -#' dataFile <- system.file("extdata", "datasets_rates.csv", package = "rpact") -#' if (dataFile != "") { -#' datasets <- readDatasets(dataFile) -#' datasets -#' } -#' @export -#' -readDatasets <- function(file, ..., header = TRUE, sep = ",", quote = "\"", - dec = ".", fill = TRUE, comment.char = "", fileEncoding = "UTF-8") { - if (!file.exists(file)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the file '", file, "' does not exist") - } - - data <- utils::read.table( - file = file, header = header, sep = sep, - quote = quote, dec = dec, fill = fill, fileEncoding = fileEncoding, ... - ) - - if (is.null(data[["datasetId"]])) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "data file must contain the column 'datasetId'") - } - - datasets <- list() - for (datasetId in unique(data$datasetId)) { - subData <- data[data$datasetId == datasetId, ] - dataFrame <- subset(subData, select = -datasetId) - description <- NA_character_ - if (!is.null(dataFrame[["description"]])) { - description <- as.character(dataFrame$description[1]) - dataFrame <- subset(dataFrame, select = -description) - } - if (length(unique(subData$groups)) == 2) { - dataWide <- stats::reshape(dataFrame, direction = "wide", idvar = "stages", timevar = "groups") - colnames(dataWide) <- gsub("\\.", "", colnames(dataWide)) - dataset <- getDataset(dataWide) - } else { - dataset <- getDataset(dataFrame) - } - dataset$setDescription(description) - datasets <- c(datasets, dataset) - } - return(datasets) -} - -#' @title -#' Write Multiple Datasets -#' -#' @description -#' Writes a list of datasets to a CSV file. -#' -#' @param datasets A list of datasets. -#' @param file The target CSV file. -#' @param append Logical. Only relevant if file is a character string. -#' If \code{TRUE}, the output is appended to the file. If FALSE, any existing file of the name is destroyed. -#' @param sep The field separator character. Values on each line of the file are separated -#' by this character. If sep = "," (the default for \code{writeDatasets}) the separator is a comma. -#' @param quote The set of quoting characters. To disable quoting altogether, use -#' quote = "". See scan for the behavior on quotes embedded in quotes. Quoting is only -#' considered for columns read as character, which is all of them unless \code{colClasses} is specified. -#' @param dec The character used in the file for decimal points. -#' @param eol The character(s) to print at the end of each line (row). -#' @param na The string to use for missing values in the data. -#' @param row.names Either a logical value indicating whether the row names of \code{dataset} are -#' to be written along with \code{dataset}, or a character vector of row names to be written. -#' @param col.names Either a logical value indicating whether the column names of \code{dataset} are -#' to be written along with \code{dataset}, or a character vector of column names to be written. -#' See the section on 'CSV files' for the meaning of \code{col.names = NA}. -#' @param qmethod A character string specifying how to deal with embedded double quote characters -#' when quoting strings. Must be one of "double" (default in \code{writeDatasets}) or "escape". -#' @param fileEncoding Character string: if non-empty declares the encoding used on a file -#' (not a connection) so the character data can be re-encoded. -#' See the 'Encoding' section of the help for file, the 'R Data Import/Export Manual' and 'Note'. -#' @param ... Further arguments to be passed to \code{\link[utils]{write.table}}. -#' -#' @details -#' The format of the CSV file is optimized for usage of \code{\link[=readDatasets]{readDatasets()}}. -#' -#' @seealso -#' \itemize{ -#' \item \code{\link[=writeDataset]{writeDataset()}} for writing a single dataset, -#' \item \code{\link[=readDatasets]{readDatasets()}} for reading multiple datasets, -#' \item \code{\link[=readDataset]{readDataset()}} for reading a single dataset. -#' } -#' -#' @examples -#' \dontrun{ -#' d1 <- getDataset( -#' n1 = c(11, 13, 12, 13), -#' n2 = c(8, 10, 9, 11), -#' events1 = c(10, 10, 12, 12), -#' events2 = c(3, 5, 5, 6) -#' ) -#' d2 <- getDataset( -#' n1 = c(9, 13, 12, 13), -#' n2 = c(6, 10, 9, 11), -#' events1 = c(10, 10, 12, 12), -#' events2 = c(4, 5, 5, 6) -#' ) -#' datasets <- list(d1, d2) -#' writeDatasets(datasets, "datasets_rates.csv") -#' } -#' -#' @export -#' -writeDatasets <- function(datasets, file, ..., append = FALSE, quote = TRUE, sep = ",", - eol = "\n", na = "NA", dec = ".", row.names = TRUE, - col.names = NA, qmethod = "double", - fileEncoding = "UTF-8") { - if (!is.list(datasets)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'datasets' must be a list of datasets") - } - - if (length(datasets) == 0) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'datasets' is empty") - } - - datasetType <- NA_character_ - dataFrames <- NULL - for (i in 1:length(datasets)) { - dataset <- datasets[[i]] - .assertIsDataset(dataset) - if (is.na(datasetType)) { - datasetType <- .getClassName(dataset) - } else if (.getClassName(dataset) != datasetType) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all datasets must have the same type") - } - - data <- as.data.frame(dataset, niceColumnNamesEnabled = FALSE) - datasetId <- ifelse(!is.null(dataset$getId()) && !is.na(dataset$getId()), dataset$getId(), i) - data <- cbind(rep(datasetId, nrow(data)), data) - colnames(data)[1] <- "datasetId" - - if (!is.null(dataset$getDescription()) && !is.na(dataset$getDescription())) { - data <- cbind(data, rep(dataset$getDescription(), nrow(data))) - colnames(data)[ncol(data)] <- "description" - } - - if (is.null(dataFrames)) { - dataFrames <- data - } else { - dataFrames <- rbind(dataFrames, data) - } - } - - if (is.null(dataFrames)) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to bind datasets") - } - - utils::write.table( - x = dataFrames, file = file, append = append, quote = quote, sep = sep, - eol = eol, na = na, dec = dec, row.names = FALSE, - col.names = TRUE, qmethod = qmethod, - fileEncoding = fileEncoding - ) -} - -.getDataset <- function(..., floatingPointNumbersEnabled = FALSE) { - args <- list(...) - if (length(args) == 0) { - stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "data.frame, data vectors, or datasets expected") - } - - if (.optionalArgsContainsDatasets(...)) { - if (length(args) == 1) { - return(args[[1]]) - } - - design <- .getDesignFromArgs(...) - if (length(args) == 2 && !is.null(design)) { - dataset <- .getDatasetFromArgs(...) - if (!is.null(dataset)) { - dataset <- dataset$copy(shallow = FALSE) - dataset$.design <- design - return(dataset) - } - } - - return(.getEnrichmentDatasetFromArgs(...)) - } - - exampleType <- args[["example"]] - if (!is.null(exampleType) && exampleType %in% c("means", "rates", "survival")) { - return(.getDatasetExample(exampleType = exampleType)) - } - - if (length(args) == 1 && !is.null(args[[1]]) && is.list(args[[1]]) && !is.data.frame(args[[1]])) { - return(.getDatasetMeansFromModelsByStage(emmeansResults = args[[1]])) - } - - emmeansResults <- .getDatasetMeansModelObjectsList(args) - if (!is.null(emmeansResults) && length(emmeansResults) > 0) { - return(.getDatasetMeansFromModelsByStage(emmeansResults = emmeansResults)) - } - - dataFrame <- .getDataFrameFromArgs(...) - - design <- .getDesignFromArgs(...) - - if (is.null(dataFrame)) { - args <- .removeDesignFromArgs(args) - - paramNames <- names(args) - paramNames <- paramNames[paramNames != ""] - - numberOfParameters <- length(args) - if (numberOfParameters > 0 && names(args)[1] == "" && .isTrialDesign(args[[1]])) { - numberOfParameters <- numberOfParameters - 1 - } - - if (length(paramNames) != numberOfParameters) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all parameters must be named") - } - - if (length(paramNames) != length(unique(paramNames))) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the parameter names must be unique") - } - - dataFrame <- .createDataFrame(...) - } - - enrichmentEnabled <- .isDataObjectEnrichment(...) - - if (.isDataObjectMeans(...)) { - return(DatasetMeans( - dataFrame = dataFrame, - floatingPointNumbersEnabled = floatingPointNumbersEnabled, - enrichmentEnabled = enrichmentEnabled, - .design = design - )) - } - - if (.isDataObjectRates(...)) { - return(DatasetRates( - dataFrame = dataFrame, - floatingPointNumbersEnabled = floatingPointNumbersEnabled, - enrichmentEnabled = enrichmentEnabled, - .design = design - )) - } - - if (.isDataObjectNonStratifiedEnrichmentSurvival(...)) { - return(DatasetEnrichmentSurvival( - dataFrame = dataFrame, - floatingPointNumbersEnabled = floatingPointNumbersEnabled, - enrichmentEnabled = enrichmentEnabled, - .design = design - )) - } - - if (.isDataObjectSurvival(...)) { - return(DatasetSurvival( - dataFrame = dataFrame, - floatingPointNumbersEnabled = floatingPointNumbersEnabled, - enrichmentEnabled = enrichmentEnabled, - .design = design - )) - } - - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "failed to identify dataset type") -} - -#' @title -#' Get Dataset -#' -#' @description -#' Creates a dataset object and returns it. -#' -#' @param ... A \code{data.frame} or some data vectors defining the dataset. -#' @param floatingPointNumbersEnabled If \code{TRUE}, -#' sample sizes and event numbers can be specified as floating-point numbers -#' (this make sense, e.g., for theoretical comparisons); \cr -#' by default \code{floatingPointNumbersEnabled = FALSE}, i.e., -#' samples sizes and event numbers defined as floating-point numbers will be truncated. -#' -#' @details -#' The different dataset types \code{DatasetMeans}, of \code{DatasetRates}, or -#' \code{DatasetSurvival} can be created as follows: -#' \itemize{ -#' \item An element of \code{\link{DatasetMeans}} for one sample is created by \cr -#' \code{getDataset(sampleSizes =, means =, stDevs =)} where \cr -#' \code{sampleSizes}, \code{means}, \code{stDevs} are vectors with stage-wise sample sizes, -#' means and standard deviations of length given by the number of available stages. -#' \item An element of \code{\link{DatasetMeans}} for two samples is created by \cr -#' \code{getDataset(sampleSizes1 =, sampleSizes2 =, means1 =, means2 =, } \cr -#' \code{stDevs1 =, stDevs2 =)} where -#' \code{sampleSizes1}, \code{sampleSizes2}, \code{means1}, \code{means2}, -#' \code{stDevs1}, \code{stDevs2} are vectors with -#' stage-wise sample sizes, means and standard deviations for the two treatment groups -#' of length given by the number of available stages. -#' \item An element of \code{\link{DatasetRates}} for one sample is created by \cr -#' \code{getDataset(sampleSizes =, events =)} where \code{sampleSizes}, \code{events} are vectors -#' with stage-wise sample sizes and events of length given by the number of available stages. -#' \item An element of \code{\link{DatasetRates}} for two samples is created by \cr -#' \code{getDataset(sampleSizes1 =, sampleSizes2 =, events1 =, events2 =)} where -#' \code{sampleSizes1}, \code{sampleSizes2}, \code{events1}, \code{events2} -#' are vectors with stage-wise sample sizes -#' and events for the two treatment groups of length given by the number of available stages. -#' \item An element of \code{\link{DatasetSurvival}} is created by \cr -#' \code{getDataset(events =, logRanks =, allocationRatios =)} where -#' \code{events}, \code{logRanks}, and \code{allocation ratios} are the stage-wise events, -#' (one-sided) logrank statistics, and allocation ratios. -#' \item An element of \code{\link{DatasetMeans}}, \code{\link{DatasetRates}}, and \code{\link{DatasetSurvival}} -#' for more than one comparison is created by adding subsequent digits to the variable names. -#' The system can analyze these data in a multi-arm many-to-one comparison setting where the -#' group with the highest index represents the control group. -#' } -#' Prefix \code{overall[Capital case of first letter of variable name]...} for the variable -#' names enables entering the overall (cumulative) results and calculates stage-wise statistics. -#' Since rpact version 3.2, the prefix \code{cumulative[Capital case of first letter of variable name]...} or -#' \code{cum[Capital case of first letter of variable name]...} can alternatively be used for this. -#' -#' \code{n} can be used in place of \code{samplesizes}. -#' -#' Note that in survival design usually the overall (cumulative) events and logrank test statistics are provided -#' in the output, so \cr -#' \code{getDataset(cumulativeEvents=, cumulativeLogRanks =, cumulativeAllocationRatios =)} \cr -#' is the usual command for entering survival data. Note also that for \code{cumulativeLogranks} also the -#' z scores from a Cox regression can be used. -#' -#' For multi-arm designs, the index refers to the considered comparison. For example,\cr -#' \code{ -#' getDataset(events1=c(13, 33), logRanks1 = c(1.23, 1.55), events2 = c(16, NA), logRanks2 = c(1.55, NA)) -#' } \cr -#' refers to the case where one active arm (1) is considered at both stages whereas active arm 2 -#' was dropped at interim. Number of events and logrank statistics are entered for the corresponding -#' comparison to control (see Examples). -#' -#' For enrichment designs, the comparison of two samples is provided for an unstratified -#' (sub-population wise) or stratified data input.\cr -#' For unstratified (sub-population wise) data input the data sets are defined for the sub-populations -#' S1, S2, ..., F, where F refers to the full populations. Use of \code{getDataset(S1 = , S2, ..., F = )} -#' defines the data set to be used in \code{\link[=getAnalysisResults]{getAnalysisResults()}} (see examples)\cr -#' For stratified data input the data sets are defined for the strata S1, S12, S2, ..., R, where R -#' refers to the remainder of the strata such that the union of all sets is the full population. -#' Use of \code{getDataset(S1 = , S12 = , S2, ..., R = )} defines the data set to be used in -#' \code{\link[=getAnalysisResults]{getAnalysisResults()}} (see examples)\cr -#' For survival data, for enrichment designs the log-rank statistics should be entered as stratified -#' log-rank statistics in order to provide strong control of Type I error rate. For stratified data input, -#' the variables to be specified in \code{getDataset()} are \code{events}, \code{expectedEvents}, -#' \code{varianceEvents}, and \code{allocationRatios} or \code{overallEvents}, \code{overallExpectedEvents}, -#' \code{overallVarianceEvents}, and \code{overallAllocationRatios}. From this, (stratified) log-rank tests are -#' calculated. -#' -#' @template return_object_dataset -#' -#' @template examples_get_dataset -#' -#' @include f_analysis_base.R -#' @include f_analysis_utilities.R -#' -#' @export -#' -getDataset <- function(..., floatingPointNumbersEnabled = FALSE) { - dataset <- .getDataset(floatingPointNumbersEnabled = floatingPointNumbersEnabled, ...) - if (dataset$.enrichmentEnabled && dataset$getNumberOfGroups() != 2) { - warning("Only population enrichment data with 2 groups can be analyzed but ", - dataset$getNumberOfGroups(), " group", - ifelse(dataset$getNumberOfGroups() == 1, " is", "s are"), " defined", - call. = FALSE - ) - } - return(dataset) -} - -#' @rdname getDataset -#' @export -getDataSet <- function(..., floatingPointNumbersEnabled = FALSE) { - return(getDataset(floatingPointNumbersEnabled = floatingPointNumbersEnabled, ...)) -} - -.getDatasetMeansModelObjectsList <- function(args) { - if (is.null(args) || length(args) == 0 || !is.list(args)) { - return(NULL) - } - - emmeansResults <- list() - for (arg in args) { - if (inherits(arg, "emmGrid")) { - emmeansResults[[length(emmeansResults) + 1]] <- arg - } - } - if (length(emmeansResults) == 0) { - return(NULL) - } - - argNames <- names(args) - for (i in 1:length(args)) { - arg <- args[[i]] - if (!inherits(arg, "emmGrid")) { - argName <- argNames[i] - argInfo <- "" - if (length(argName) == 1 && argName != "") { - argInfo <- paste0(sQuote(argName), " ") - } - argInfo <- paste0(argInfo, "(", .arrayToString(arg), ")") - warning("Argument ", argInfo, " will be ignored because only 'emmGrid' objects will be respected") - } - } - - return(emmeansResults) -} - -.getStandardDeviationFromStandardError <- function(sampleSize, standardError, ..., - dfValue = NA_real_, alpha = 0.05, lmEnabled = TRUE, stDevCalcMode = "auto") { - qtCalcEnablbled <- length(stDevCalcMode) == 1 && !is.na(stDevCalcMode) && stDevCalcMode == "t" - if ((qtCalcEnablbled || !lmEnabled) && !is.na(dfValue) && !is.infinite(dfValue) && dfValue > 0) { - qValue <- stats::qt(1 - alpha / 2, df = dfValue) - stDev <- standardError * 2 / qValue * sqrt(sampleSize) - } else { - stDev <- standardError * sqrt(sampleSize) - } - - return(stDev) -} - -.getDatasetMeansFromModelsByStage <- function(emmeansResults, correctGroupOrder = TRUE) { - if (is.null(emmeansResults)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(emmeansResults), " must be a non-empty list") - } - if (!is.list(emmeansResults)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(emmeansResults), " must be a list") - } - if (length(emmeansResults) == 0) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(emmeansResults), " must be not empty") - } - - for (stage in 1:length(emmeansResults)) { - if (!inherits(emmeansResults[[stage]], "emmGrid")) { - stop(sprintf( - paste0( - "%s%s must contain %s objects created by emmeans(x), ", - "where x is a linear model result (one object per stage; class is %s at stage %s)" - ), - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("emmeansResults"), sQuote("emmGrid"), - .getClassName(emmeansResults[[stage]]), stage - )) - } - } - - stages <- integer(0) - groups <- integer(0) - means <- numeric(0) - stDevs <- numeric(0) - sampleSizes <- numeric(0) - - lmEnabled <- TRUE - tryCatch( - { - modelCall <- emmeansResults[[1]]@model.info$call - modelFunction <- as.character(modelCall)[1] - lmEnabled <- modelFunction == "lm" - if (!grepl(paste0("::", modelFunction), modelFunction)) { - packageName <- .getPackageName(modelFunction) - if (!is.na(packageName)) { - modelFunction <- paste0(packageName, "::", modelFunction) - } - } - - if (lmEnabled) { - warning("When using ", modelFunction, "() ", - "the estimated marginal means and standard deviations can be inaccurate ", - "and analysis results based on this values may be imprecise", - call. = FALSE - ) - } else { - warning("Using ", modelFunction, " emmeans result objects as ", - "arguments of getDataset() is experminental in this rpact version and not fully validated", - call. = FALSE - ) - } - }, - error = function(e) { - warning("Using emmeans result objects as ", - "arguments of getDataset() is experminental in this rpact version and not fully validated", - call. = FALSE - ) - } - ) - - stDevCalcMode <- getOption("rpact.dataset.stdev.calc.mode", "auto") # auto, sigma, norm, t - for (stage in 1:length(emmeansResults)) { - emmeansResult <- emmeansResults[[stage]] - emmeansResultsSummary <- summary(emmeansResult) - emmeansResultsList <- as.list(emmeansResult) - - if (is.null(emmeansResultsSummary[["emmean"]])) { - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, - "the objects in summary(emmeansResults) must contain the field 'emmean'" - ) - } - for (expectedField in c("sigma", "extras")) { - if (is.null(emmeansResultsList[[expectedField]])) { - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, - "the objects in as.list(emmeansResults) must contain the field ", sQuote(expectedField) - ) - } - } - - numberOfGroups <- length(emmeansResultsSummary$emmean) - rpactGroupNumbers <- 1:numberOfGroups - if (correctGroupOrder) { - rpactGroupNumbers <- 1 - if (numberOfGroups > 1) { - rpactGroupNumbers <- c(2:numberOfGroups, rpactGroupNumbers) - } - } - for (group in 1:length(emmeansResultsSummary$emmean)) { - stages <- c(stages, stage) - groups <- c(groups, group) - rpactGroupNumber <- rpactGroupNumbers[group] - - standardError <- emmeansResultsSummary$SE[rpactGroupNumber] - - sampleSize <- emmeansResultsList$extras[rpactGroupNumber, ] - meanValue <- emmeansResultsSummary$emmean[rpactGroupNumber] - dfValue <- emmeansResultsSummary$df[rpactGroupNumber] - if (length(stDevCalcMode) == 1 && !is.na(stDevCalcMode) && stDevCalcMode == "sigma") { - # pooled standard deviation from emmeans - stDev <- emmeansResultsList$sigma - } else { - stDev <- .getStandardDeviationFromStandardError(sampleSize, standardError, - dfValue = dfValue, lmEnabled = lmEnabled, stDevCalcMode = stDevCalcMode - ) - } - - means <- c(means, meanValue) - stDevs <- c(stDevs, stDev) - sampleSizes <- c(sampleSizes, sampleSize) - } - } - - data <- data.frame( - stages = stages, - groups = groups, - means = means, - stDevs = stDevs, - sampleSizes = sampleSizes - ) - data <- data[order(data$stages, data$groups), ] - dataWide <- stats::reshape(data = data, direction = "wide", idvar = "stages", timevar = "groups") - colnames(dataWide) <- gsub("\\.", "", colnames(dataWide)) - return(getDataset(dataWide)) -} - -.optionalArgsContainsDatasets <- function(...) { - args <- list(...) - if (length(args) == 0) { - return(FALSE) - } - - for (arg in args) { - if (inherits(arg, "Dataset")) { - return(TRUE) - } - } - return(FALSE) -} - -.getSubsetsFromArgs <- function(...) { - args <- list(...) - if (length(args) == 0) { - stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "one or more subset datasets expected") - } - - subsetNames <- names(args) - if (is.null(subsetNames)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all subsets must be named") - } - - if (!("R" %in% subsetNames) && !("F" %in% subsetNames)) { - stop( - C_EXCEPTION_TYPE_MISSING_ARGUMENT, - '"R" (stratified analysis)" or "F" (non-stratified analysis) must be defined as subset' - ) - } - - subsetNumbers <- gsub("\\D", "", subsetNames) - subsetNumbers <- subsetNumbers[subsetNumbers != ""] # & nchar(subsetNumbers) == 1 - if (length(subsetNumbers) == 0) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all subset names (", - .arrayToString(subsetNames), ") must be \"S[n]\", \"R\", or \"F\", ", - "where [n] is a number with increasing digits (starting with 1)" - ) - } - - stratifiedInput <- "R" %in% subsetNames - - subsetNumbers <- paste0(subsetNumbers, collapse = "") - subsetNumbers <- strsplit(subsetNumbers, "")[[1]] - subsetNumbers <- as.integer(subsetNumbers) - gMax <- max(subsetNumbers) + 1 - validSubsetNames <- .createSubsetsByGMax(gMax, stratifiedInput = stratifiedInput, all = FALSE) - for (subsetName in subsetNames) { - if (subsetName == "") { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all subsets must be named") - } - - if (!(subsetName %in% validSubsetNames)) { - suffix <- ifelse(stratifiedInput, " (stratified analysis)", " (non-stratified analysis)") - if (length(validSubsetNames) < 10) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "invalid subset name (", subsetName, "); ", - "valid names are ", .arrayToString(validSubsetNames), suffix - ) - } else { - restFull <- ifelse(stratifiedInput, '"R"', '"F"') - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "invalid subset name (", subsetName, "): ", - "all subset names must be \"S[n]\" or ", restFull, ", ", - "where [n] is a number with increasing digits", suffix - ) - } - } - } - - subsets <- NULL - subsetType <- NA_character_ - emptySubsetNames <- validSubsetNames[!(validSubsetNames %in% subsetNames)] - for (subsetName in subsetNames) { - subset <- args[[subsetName]] - if (is.null(subset) || (!isS4(subset) && is.na(subset))) { - emptySubsetNames <- c(emptySubsetNames, subsetName) - } else { - if (!.isDataset(subset)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "subset ", subsetName, " is not a dataset (is ", .getClassName(subset), ")" - ) - } - if (!is.na(subsetType) && subsetType != .getClassName(subset)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "all subsets must have the same type (found ", subsetType, " and ", .getClassName(subset), ")" - ) - } - subsetType <- .getClassName(subset) - if (is.null(subset[[".data"]])) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "subset ", subsetName, " does not contain field '.data'" - ) - } - subset <- subset$.data - subset$subset <- rep(subsetName, nrow(subset)) - if (is.null(subsets)) { - subsets <- subset - } else { - subsets <- rbind(subsets, subset) - } - } - } - - if (length(emptySubsetNames) > 0) { - emptySubsetNames <- unique(emptySubsetNames) - template <- subsets[subsets$subset == ifelse(stratifiedInput, "R", "F"), ] - colNames <- colnames(template) - colNames <- colNames[!(colNames %in% c("stage", "group", "subset"))] - for (colName in colNames) { - template[[colName]] <- rep(NA_real_, nrow(template)) - } - - for (subsetName in emptySubsetNames) { - template$subset <- rep(subsetName, nrow(template)) - subsets <- rbind(subsets, template) - } - - if (length(emptySubsetNames) == 1) { - warning("The undefined subset ", emptySubsetNames, - " was defined as empty subset", - call. = FALSE - ) - } else { - warning(gettextf( - "The %s undefined subsets %s were defined as empty subsets", - length(emptySubsetNames), .arrayToString(emptySubsetNames) - ), call. = FALSE) - } - } - - return(subsets) -} - -.validateEnrichmentDataFrameAtFirstStage <- function(dataFrame, params) { - dataFrameStage1 <- dataFrame[dataFrame$stage == 1, ] - for (param in params) { - paramValue <- dataFrameStage1[[param]] - if (any(is.null(paramValue) || any(is.infinite(paramValue)))) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - gettextf( - "all %s values (%s) at first stage must be valid", - sQuote(param), .arrayToString(paramValue, maxLength = 10) - ) - ) - } - if (any(is.na(paramValue))) { - subsets <- unique(dataFrame$subset) - for (s in subsets) { - subData <- dataFrame[dataFrame$subset == s, ] - subsetParamValues <- subData[[param]] - if (!all(is.na(subsetParamValues)) && any(is.na(subsetParamValues[subData$stage == 1]))) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - gettextf( - "all %s values (%s) at first stage must be valid (NA is not allowed)", - sQuote(param), .arrayToString(paramValue, maxLength = 10) - ) - ) - } - } - } - } -} - -.getEndpointSpecificDataFrameParameterNames <- function(dataFrame) { - paramNames <- colnames(dataFrame) - paramNames <- paramNames[!(paramNames %in% c("stage", "group", "subset"))] - return(paramNames) -} - -.validateEnrichmentDataFrameDeselection <- function(dataFrame) { - paramNames <- .getEndpointSpecificDataFrameParameterNames(dataFrame) - for (i in 1:nrow(dataFrame)) { - row <- dataFrame[i, paramNames] - if (any(is.na(row)) && !all(is.na(row))) { - stop( - C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, - gettextf( - paste0( - "inconsistent deselection in group %s at stage %s (", - "%s: all or none must be NA)" - ), - dataFrame$group[i], dataFrame$stage[i], .arrayToString(paramNames, maxCharacters = 40) - ) - ) - } - } - - subsets <- unique(dataFrame$subset) - for (s in subsets) { - deselectedStage <- 0 - for (stage in unique(dataFrame$stage)) { - subData <- dataFrame[dataFrame$subset == s & dataFrame$stage == stage, paramNames] - - if (deselectedStage > 0 && !all(is.na(subData))) { - stop( - C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, - gettextf(paste0( - "%s was deselected at stage %s ", - "and therefore must be also deselected in the following stages, ", - "but is no longer deselected in stage %s" - ), s, deselectedStage, stage) - ) - } - - if (any(is.na(subData))) { - deselectedStage <- stage - } - } - } -} - -.validateEnrichmentDataFrameMeans <- function(dataFrame) { - if (any(na.omit(dataFrame$stDev) <= 0) || any(na.omit(dataFrame$overallStDev) <= 0)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all standard deviations must be > 0") - } - if (any(na.omit(dataFrame$sampleSize) <= 0) || any(na.omit(dataFrame$overallSampleSize) <= 0)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all sample sizes must be > 0") - } - - .validateEnrichmentDataFrameAtFirstStage(dataFrame, - params = c("sampleSize", "overallSampleSize", "mean", "overallMean", "stDev", "overallStDev") - ) - - .validateEnrichmentDataFrameDeselection(dataFrame) - - subsets <- unique(dataFrame$subset) - if ("F" %in% subsets) { - subsets <- subsets[subsets != "F"] - fullData <- dataFrame[dataFrame$subset == "F", ] - for (s in subsets) { - for (stage in unique(dataFrame$stage)) { - for (group in unique(dataFrame$group)) { - subData <- dataFrame[dataFrame$subset == s & dataFrame$stage == stage & dataFrame$group == group, ] - - stDevFull <- na.omit(fullData$stDev[fullData$stage == stage & fullData$group == group]) - stDevSubset <- na.omit(subData$stDev) - if (length(stDevFull) > 0 && length(stDevSubset) > 0 && any(stDevFull <= stDevSubset)) { - stop( - C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, - gettextf( - "'stDev' F (%s) must be > 'stDev' %s (%s) in group %s at stage %s", - .arrayToString(stDevFull), s, - .arrayToString(stDevSubset), group, stage - ) - ) - } - - sampleSizeFull <- na.omit(fullData$sampleSize[fullData$stage == stage & fullData$group == group]) - sampleSizeSubset <- na.omit(subData$sampleSize) - if (length(sampleSizeFull) > 0 && length(sampleSizeSubset) > 0 && any(sampleSizeFull < sampleSizeSubset)) { - stop( - C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, - gettextf( - "'sampleSize' F (%s) must be >= 'sampleSize' %s (%s) in group %s at stage %s", - .arrayToString(sampleSizeFull), s, - .arrayToString(sampleSizeSubset), group, stage - ) - ) - } - } - } - } - } -} - -.validateEnrichmentDataFrameSurvival <- function(dataFrame) { - if (any(na.omit(dataFrame$event) < 0) || any(na.omit(dataFrame$overallEvent) < 0)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all events must be >= 0") - } - - .validateEnrichmentDataFrameAtFirstStage(dataFrame, - params = c("event", "overallEvent") - ) - - .validateEnrichmentDataFrameDeselection(dataFrame) - - subsets <- unique(dataFrame$subset) - if ("F" %in% subsets) { - subsets <- subsets[subsets != "F"] - fullData <- dataFrame[dataFrame$subset == "F", ] - for (s in subsets) { - for (stage in unique(dataFrame$stage)) { - for (group in unique(dataFrame$group)) { - subData <- dataFrame[dataFrame$subset == s & dataFrame$stage == stage & dataFrame$group == group, ] - - eventFull <- na.omit(fullData$event[fullData$stage == stage & fullData$group == group]) - eventSubset <- na.omit(subData$event) - if (length(eventFull) > 0 && length(eventSubset) > 0 && any(eventFull < eventSubset)) { - stop( - C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, - gettextf( - "'event' F (%s) must be >= 'event' %s (%s) in group %s at stage %s", - .arrayToString(eventFull), s, - .arrayToString(eventSubset), group, stage - ) - ) - } - } - } - } - } -} - -.validateEnrichmentDataFrameRates <- function(dataFrame) { - if (any(na.omit(dataFrame$sampleSize) <= 0) || any(na.omit(dataFrame$overallSampleSize) <= 0)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all sample sizes must be > 0") - } - - .validateEnrichmentDataFrameAtFirstStage(dataFrame, - params = c("sampleSize", "overallSampleSize") - ) - - .validateEnrichmentDataFrameDeselection(dataFrame) - - subsets <- unique(dataFrame$subset) - if ("F" %in% subsets) { - subsets <- subsets[subsets != "F"] - fullData <- dataFrame[dataFrame$subset == "F", ] - for (s in subsets) { - for (stage in unique(dataFrame$stage)) { - for (group in unique(dataFrame$group)) { - subData <- dataFrame[dataFrame$subset == s & dataFrame$stage == stage & dataFrame$group == group, ] - - sampleSizeFull <- na.omit(fullData$sampleSize[fullData$stage == stage & fullData$group == group]) - sampleSizeSubset <- na.omit(subData$sampleSize) - if (length(sampleSizeFull) > 0 && length(sampleSizeSubset) > 0 && any(sampleSizeFull < sampleSizeSubset)) { - stop( - C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, - gettextf( - "'sampleSize' F (%s) must be >= 'sampleSize' %s (%s) in group %s at stage %s", - .arrayToString(sampleSizeFull), s, - .arrayToString(sampleSizeSubset), group, stage - ) - ) - } - } - } - } - } - - .validateEnrichmentDataFrameSurvival(dataFrame) -} - -.validateEnrichmentDataFrameHasConsistentNumberOfStages <- function(dataFrame) { - subsets <- unique(dataFrame$subset) - kMaxList <- list() - for (s in subsets) { - subsetStages <- as.integer(sort(unique(na.omit(as.character(dataFrame$stage[dataFrame$subset == s]))))) - kMax <- max(subsetStages) - if (!identical(1:kMax, subsetStages)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - gettextf("subset %s has incomplete stages (%s)", s, .arrayToString(subsetStages)) - ) - } - - kMaxList[[s]] <- kMax - } - - kMax <- unique(unlist(kMaxList)) - if (length(kMax) > 1) { - stop( - C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, - "all subsets must have the identical number of stages defined (kMax: ", .listToString(kMaxList), ")" - ) - } -} - -.validateEnrichmentDataFrame <- function(dataFrame) { - paramNames <- colnames(dataFrame) - if (any(grepl("(S|s)tDev", paramNames))) { - .validateEnrichmentDataFrameMeans(dataFrame) - } else if (any(grepl("(S|s)ampleSize", paramNames)) && any(grepl("(E|e)vent", paramNames))) { - .validateEnrichmentDataFrameRates(dataFrame) - } else if (any(grepl("(L|l)ogRank", paramNames)) || any(grepl("(E|e)xpectedEvent", paramNames))) { - .validateEnrichmentDataFrameSurvival(dataFrame) - } else { - print(paramNames) - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "could not identify the endpoint of the specified dataset") - } - - subsets <- unique(dataFrame$subset) - if ("R" %in% subsets) { - paramNames <- .getEndpointSpecificDataFrameParameterNames(dataFrame) - paramName <- paramNames[1] - subsets <- subsets[subsets != "R"] - subsets <- subsets[grepl("^S\\d$", subsets)] - if (length(subsets) > 0) { - restData <- dataFrame[dataFrame$subset == "R", ] - for (s in subsets) { - stages <- unique(dataFrame$stage) - stages <- stages[stages != 1] - if (length(stages) > 0) { - for (stage in stages) { - for (group in unique(dataFrame$group)) { - subData <- dataFrame[dataFrame$subset == s & dataFrame$stage == stage & dataFrame$group == group, ] - - paramValueRest <- restData[[paramName]][restData$stage == stage & restData$group == group] - paramValueSubset <- subData[[paramName]] - if (length(paramValueRest) > 0 && length(paramValueSubset) > 0 && - any(is.na(paramValueSubset)) && !all(is.na(paramValueRest))) { - stop( - C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, - gettextf( - paste0( - "if %s is deselected (NA) then R also must be deselected (NA) but, e.g., ", - "%s R is %s in group %s at stage %s" - ), - s, sQuote(paramName), .arrayToString(paramValueRest, vectorLookAndFeelEnabled = TRUE), - group, stage - ) - ) - } - } - } - } - } - } - } - - .validateEnrichmentDataFrameHasConsistentNumberOfStages(dataFrame) -} - -.getEnrichmentDataFrameFromArgs <- function(...) { - dataFrame <- .getSubsetsFromArgs(...) - - validColumns <- c() - for (j in 1:ncol(dataFrame)) { - if (!all(is.na(dataFrame[, j]))) { - validColumns <- c(validColumns, j) - } - } - if (length(validColumns) > 0) { - dataFrame <- dataFrame[, validColumns] - } - - return(dataFrame) -} - -.getEnrichmentDatasetFromArgs <- function(...) { - dataFrame <- .getEnrichmentDataFrameFromArgs(...) - .validateEnrichmentDataFrame(dataFrame) - dataFrame <- .getWideFormat(dataFrame) - return(.getDataset(dataFrame = dataFrame)) -} - -.getDatasetExample <- function(exampleType) { - if (exampleType == "means") { - return(getDataset( - n1 = c(13, 25), - n2 = c(15, NA), - n3 = c(14, 27), - n4 = c(12, 29), - means1 = c(24.2, 22.2), - means2 = c(18.8, NA), - means3 = c(26.7, 27.7), - means4 = c(9.2, 12.2), - stDevs1 = c(24.4, 22.1), - stDevs2 = c(21.2, NA), - stDevs3 = c(25.6, 23.2), - stDevs4 = c(21.5, 22.7) - )) - } else if (exampleType == "rates") { - return(getDataset( - n1 = c(23, 25), - n2 = c(25, NA), - n3 = c(24, 27), - n4 = c(22, 29), - events1 = c(15, 12), - events2 = c(19, NA), - events3 = c(18, 22), - events4 = c(12, 13) - )) - } else if (exampleType == "survival") { - return(getDataset( - events1 = c(25, 32), - events2 = c(18, NA), - events3 = c(22, 36), - logRanks1 = c(2.2, 1.8), - logRanks2 = c(1.99, NA), - logRanks3 = c(2.32, 2.11) - )) - } - - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'exampleType' (", exampleType, ") is not allowed") -} - #' #' @name Dataset #' @@ -2248,234 +1006,6 @@ DatasetMeans <- setRefClass("DatasetMeans", ) ) -#' @examples -#' -#' datasetExample <- getDataset( -#' means1 = c(112.3, 105.1, 121.3), -#' means2 = c(98.1, 99.3, 100.1), -#' means3 = c(98.1, 99.3, 100.1), -#' stDevs1 = c(44.4, 42.9, 41.4), -#' stDevs2 = c(46.7, 41.1, 39.5), -#' stDevs3 = c(46.7, 41.1, 39.5), -#' n1 = c(84, 81, 82), -#' n2 = c(87, 83, 81), -#' n3 = c(87, 82, 84) -#' ) -#' .getRandomDataMeans(datasetExample, -#' randomDataParamName = "outcome", numberOfVisits = 3, -#' fixedCovariates = list(gender = c("f", "m"), bmi = c(17, 40)) -#' ) -#' -#' @noRd -#' -.getRandomDataMeans <- function(dataset, ..., - treatmentName = "Treatment group", - controlName = "Control group", - randomDataParamName = "randomData", - numberOfVisits = 1L, - fixedCovariates = NULL, - covariateEffects = NULL, - seed = NA_real_) { - if (!is.null(fixedCovariates)) { - if (!is.list(fixedCovariates)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("fixedCovariates"), " must be a named list") - } - } - if (!is.null(covariateEffects)) { - if (!is.list(covariateEffects)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("covariateEffects"), " must be a named list") - } - } - - .assertIsSingleCharacter(treatmentName, "treatmentName") - .assertIsSingleCharacter(controlName, "controlName") - .assertIsSingleCharacter(randomDataParamName, "randomDataParamName") - .assertIsSinglePositiveInteger(numberOfVisits, "numberOfVisits", validateType = FALSE) - .assertIsSingleNumber(seed, "seed", naAllowed = TRUE) - - seed <- .setSeed(seed) - - numberOfGroups <- dataset$getNumberOfGroups() - - sampleSize <- 0 - for (stage in 1:dataset$getNumberOfStages()) { - for (group in 1:numberOfGroups) { - if (dataset$.enrichmentEnabled) { - for (subset in levels(dataset$.data$subset)) { - n <- dataset$getSampleSize(stage = stage, group = group, subset = subset) - if (n > sampleSize) { - sampleSize <- n - } - } - } else { - n <- dataset$getSampleSize(stage = stage, group = group) - n <- round(n / numberOfVisits) - if (n > sampleSize) { - sampleSize <- n - } - } - } - } - - idFactor <- 10^nchar(as.character(sampleSize)) - - data <- NULL - for (stage in 1:dataset$getNumberOfStages()) { - for (group in 1:numberOfGroups) { - for (visit in 1:numberOfVisits) { - if (dataset$.enrichmentEnabled) { - for (subset in levels(dataset$.data$subset)) { - n <- dataset$getSampleSize(stage = stage, group = group, subset = subset) - randomData <- stats::rnorm( - n = n, - mean = dataset$getMean(stage = stage, group = group, subset = subset), - sd = dataset$getStDev(stage = stage, group = group, subset = subset) - ) - row <- data.frame( - subject = idFactor * group + c(1:n), - stage = rep(stage, n), - group = rep(group, n), - subset = rep(subset, n), - randomData = randomData - ) - if (is.null(data)) { - data <- row - } else { - data <- rbind(data, row) - } - } - } else { - n <- dataset$getSampleSize(stage = stage, group = group) - n <- floor(n / numberOfVisits) - randomData <- stats::rnorm( - n = sampleSize, - mean = dataset$getMean(stage = stage, group = group), - sd = dataset$getStDev(stage = stage, group = group) - ) - - subjectIds <- (idFactor * 10 * stage) + (idFactor * group) + c(1:sampleSize) - indices <- 1:sampleSize - randomDataBefore <- NULL - numberOfDropOutsBefore <- 0 - if (visit > 1 && !is.null(data)) { - randomDataBefore <- data$randomData[data$stage == visit - 1 & data$subject %in% subjectIds] - numberOfDropOutsBefore <- sum(is.na(randomDataBefore)) - indices <- which(!is.na(randomDataBefore)) - } - sampleSizeBefore <- sampleSize - numberOfDropOutsBefore - if (n < sampleSizeBefore) { - numberOfDropOuts <- sampleSizeBefore - n - dropOuts <- sample(c(rep(1, n - numberOfDropOuts), rep(0, numberOfDropOuts))) - randomData[indices[dropOuts == 0]] <- NA_real_ - if (!is.null(randomDataBefore)) { - randomData[is.na(randomDataBefore)] <- NA_real_ - } - } - - row <- data.frame( - subject = subjectIds, - stage = rep(stage, sampleSize), - group = rep(group, sampleSize), - visit = rep(visit - 1, sampleSize), - randomData = randomData - ) - - if (is.null(data)) { - data <- row - } else { - data <- rbind(data, row) - } - } - } - } - } - data$stage <- factor(data$stage) - groupLevels <- paste(treatmentName, c(1:numberOfGroups)) - if (numberOfGroups > 1) { - if (numberOfGroups == 2) { - groupLevels[1] <- treatmentName - } - groupLevels[numberOfGroups] <- controlName - } - - data$group <- factor(data$group, labels = groupLevels) - if (dataset$.enrichmentEnabled) { - data$subset <- factor(data$subset) - } - - if (!is.null(randomDataParamName) && length(randomDataParamName) == 1 && !is.na(randomDataParamName)) { - colNames <- colnames(data) - colNames[colNames == "randomData"] <- randomDataParamName - colnames(data) <- colNames - } - - if (!is.null(fixedCovariates)) { - fixedCovariateNames <- names(fixedCovariates) - if (is.null(fixedCovariateNames) || any(nchar(trimws(fixedCovariateNames)) == 0)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("fixedCovariates"), " must be a named list") - } - - subjects <- sort(unique(data$subject)) - for (fixedCovariateName in fixedCovariateNames) { - data[[fixedCovariateName]] <- rep(NA, nrow(data)) - values <- fixedCovariates[[fixedCovariateName]] - if (is.null(values) || length(values) < 2 || any(is.na(values))) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(paste0("fixedCovariates$", fixedCovariateName)), - " (", .arrayToString(values), ") must be a valid numeric or character vector with a minimum of 2 values" - ) - } - - if (is.character(values)) { - if (length(unique(values)) < length(values)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(paste0("fixedCovariates$", fixedCovariateName)), - " (", .arrayToString(values, maxLength = 20), ") must be a unique vector" - ) - } - - fixedCovariateSample <- sample(values, length(subjects), replace = TRUE) - for (i in 1:length(subjects)) { - data[[fixedCovariateName]][data$subject == subjects[i]] <- fixedCovariateSample[i] - } - } else if (is.numeric(values)) { - if (length(values) == 2) { - minValue <- min(values) - maxValue <- max(values) - covMean <- runif(1, minValue, maxValue) - covSD <- covMean * 0.1 - showMessage <- TRUE - for (i in 1:length(subjects)) { - groupName <- as.character(data$group[data$subject == subjects[i]])[1] - covEffect <- 1 - if (groupName == controlName && !is.null(covariateEffects)) { - covEffect <- covariateEffects[[fixedCovariateName]] - if (is.null(covEffect)) { - covEffect <- 1 - } else { - .assertIsNumericVector(covEffect, paste0("covariateEffects$", fixedCovariateName)) - if (showMessage) { - message( - "Add effect ", covEffect, " to ", - sQuote(fixedCovariateName), " of ", sQuote(groupName) - ) - showMessage <- FALSE - } - } - } - continuesExample <- rnorm(sum(data$subject == subjects[i]), covMean * covEffect, covSD) - data[[fixedCovariateName]][data$subject == subjects[i]] <- continuesExample - } - } - } - } - } - - data$seed <- rep(seed, nrow(data)) - - return(data) -} - #' #' @title #' Dataset Plotting @@ -3882,37 +2412,6 @@ DatasetEnrichmentSurvival <- setRefClass("DatasetEnrichmentSurvival", ) ) -.isFloatingPointSampleSize <- function(object, param) { - values <- object[[param]] - if (is.null(values)) { - return(FALSE) - } - - values <- na.omit(values) - if (length(values) == 0) { - return(FALSE) - } - - if (any(floor(values) != values)) { - return(TRUE) - } - - return(FALSE) -} - -.getMaxDigits <- function(values) { - values <- na.omit(values) - if (length(values) == 0) { - return(0) - } - - values <- trimws(format(values, scientific = FALSE, digits = 15)) - values <- gsub("^\\d*\\.", "", values) - values <- gsub("\\D", "", values) - max(nchar(values)) -} - - #' #' @title #' Dataset Summary @@ -4141,34 +2640,6 @@ summary.Dataset <- function(object, ..., type = 1, digits = NA_integer_) { return(summaryFactory) } -.getDatasetArgumentsRCodeLines <- function(x, complete = FALSE, digits = 4) { - m <- getWideFormat(x) - lines <- character(0) - paramNames <- colnames(m) - if (!complete) { - if (x$.inputType == "stagewise") { - paramNames <- paramNames[!grepl("^overall", paramNames)] - } else { - paramNames <- paramNames[grepl("^(stage|group|subset|overall)", paramNames)] - } - } - - for (paramName in paramNames) { - encapsulate <- grepl("^subset", paramName) - if (!encapsulate || isTRUE(x$.enrichmentEnabled)) { - values <- m[[paramName]] - if (!encapsulate && is.numeric(values) && !is.null(digits) && length(digits) == 1 && !is.na(digits)) { - values <- round(values, digits = digits) - } - lines <- c(lines, paste0(paramName, " = ", .arrayToString(values, - vectorLookAndFeelEnabled = TRUE, encapsulate = encapsulate, digits = NA_integer_ - ))) - } - } - - return(lines) -} - #' #' @title #' Print Dataset Values diff --git a/R/class_analysis_dataset_r6.R b/R/class_analysis_dataset_r6.R new file mode 100644 index 00000000..580c6e35 --- /dev/null +++ b/R/class_analysis_dataset_r6.R @@ -0,0 +1,4226 @@ +## | +## | *Dataset classes* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | rpact package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File version: $Revision: 7139 $ +## | Last changed: $Date: 2023-06-28 08:15:31 +0200 (Mi, 28 Jun 2023) $ +## | Last changed by: $Author: pahlke $ +## | + +#' @include f_analysis_utilities.R +#' @include f_core_utilities.R +#' @include f_object_r_code.R +NULL + +C_KEY_WORDS_GROUPS <- c("group", "groups") + +C_KEY_WORDS_STAGES <- c("stage", "stages") + +C_KEY_WORDS_SUBSETS <- c("subset", "subsets") + +C_KEY_WORDS_SAMPLE_SIZES <- .getAllParameterNameVariants(c("n", "N", "sampleSizes", "sampleSize")) + +C_KEY_WORDS_MEANS <- c("means", "mean") + +C_KEY_WORDS_ST_DEVS <- .getAllParameterNameVariants(c("stDevs", "stDev", "stds", "sd")) + +C_KEY_WORDS_EVENTS <- c("event", "events") + +C_KEY_WORDS_OVERALL_EVENTS <- .getAllParameterNameVariants(c("overallEvents", "overallEvent")) + +C_KEY_WORDS_EXPECTED_EVENTS <- .getAllParameterNameVariants(c("expectedEvents", "expectedEvent")) + +C_KEY_WORDS_VARIANCE_EVENTS <- .getAllParameterNameVariants(c("varianceEvents", "varianceEvent")) + +C_KEY_WORDS_OVERALL_EXPECTED_EVENTS <- .getAllParameterNameVariants(c("overallExpectedEvents", "overallExpectedEvent")) + +C_KEY_WORDS_OVERALL_VARIANCE_EVENTS <- .getAllParameterNameVariants(c("overallVarianceEvents", "overallVarianceEvent")) + +C_KEY_WORDS_OVERALL_SAMPLE_SIZES <- .getAllParameterNameVariants(c( + "overallN", "overallSampleSizes", "overallSampleSize" +)) + +C_KEY_WORDS_OVERALL_MEANS <- .getAllParameterNameVariants(c("overallMeans", "overallMean")) + +C_KEY_WORDS_OVERALL_ST_DEVS <- .getAllParameterNameVariants(c( + "overallStDevs", "overallStDev", "overall.sd", "overall_sd" +)) + +C_KEY_WORDS_ALLOCATION_RATIOS <- .getAllParameterNameVariants(c("ar", "allocationRatios", "allocationRatio")) + +C_KEY_WORDS_LOG_RANKS <- .getAllParameterNameVariants(c("logRanks", "logRank", "lr")) + +C_KEY_WORDS_OVERALL_ALLOCATION_RATIOS <- .getAllParameterNameVariants(c( + "oar", "car", "overallAllocationRatios", "overallAllocationRatio" +)) + +C_KEY_WORDS_OVERALL_LOG_RANKS <- .getAllParameterNameVariants(c("olr", "clr", "overallLogRanks", "overallLogRank")) + +C_KEY_WORDS <- c( + C_KEY_WORDS_GROUPS, + C_KEY_WORDS_STAGES, + C_KEY_WORDS_SUBSETS, + C_KEY_WORDS_SAMPLE_SIZES, + C_KEY_WORDS_MEANS, + C_KEY_WORDS_ST_DEVS, + C_KEY_WORDS_EVENTS, + C_KEY_WORDS_OVERALL_EVENTS, + C_KEY_WORDS_OVERALL_SAMPLE_SIZES, + C_KEY_WORDS_OVERALL_MEANS, + C_KEY_WORDS_OVERALL_ST_DEVS, + C_KEY_WORDS_ALLOCATION_RATIOS, + C_KEY_WORDS_LOG_RANKS, + C_KEY_WORDS_OVERALL_ALLOCATION_RATIOS, + C_KEY_WORDS_OVERALL_LOG_RANKS +) + +#' @title +#' Read Dataset +#' +#' @description +#' Reads a data file and returns it as dataset object. +#' +#' @param file A CSV file (see \code{\link[utils]{read.table}}). +#' @param header A logical value indicating whether the file contains the names of +#' the variables as its first line. +#' @param sep The field separator character. Values on each line of the file are separated +#' by this character. If sep = "," (the default for \code{readDataset}) the separator is a comma. +#' @param quote The set of quoting characters. To disable quoting altogether, use +#' quote = "". See scan for the behavior on quotes embedded in quotes. Quoting is only +#' considered for columns read as character, which is all of them unless \code{colClasses} is specified. +#' @param dec The character used in the file for decimal points. +#' @param fill logical. If \code{TRUE} then in case the rows have unequal length, blank fields +#' are implicitly added. +#' @param comment.char character: a character vector of length one containing a single character +#' or an empty string. Use "" to turn off the interpretation of comments altogether. +#' @param fileEncoding character string: if non-empty declares the encoding used on a file +#' (not a connection) so the character data can be re-encoded. +#' See the 'Encoding' section of the help for file, the 'R Data Import/Export Manual' and 'Note'. +#' @param ... Further arguments to be passed to code{\link[utils]{read.table}}. +#' +#' @details +#' \code{readDataset} is a wrapper function that uses \code{\link[utils]{read.table}} to read the +#' CSV file into a data frame, transfers it from long to wide format with \code{\link[stats]{reshape}} +#' and puts the data to \code{\link[=getDataset]{getDataset()}}. +#' +#' @template return_object_dataset +#' +#' @seealso +#' \itemize{ +#' \item \code{\link[=readDatasets]{readDatasets()}} for reading multiple datasets, +#' \item \code{\link[=writeDataset]{writeDataset()}} for writing a single dataset, +#' \item \code{\link[=writeDatasets]{writeDatasets()}} for writing multiple datasets. +#' } +#' +#' @examples +#' \dontrun{ +#' dataFileRates <- system.file("extdata", +#' "dataset_rates.csv", +#' package = "rpact" +#' ) +#' if (dataFileRates != "") { +#' datasetRates <- readDataset(dataFileRates) +#' datasetRates +#' } +#' +#' dataFileMeansMultiArm <- system.file("extdata", +#' "dataset_means_multi-arm.csv", +#' package = "rpact" +#' ) +#' if (dataFileMeansMultiArm != "") { +#' datasetMeansMultiArm <- readDataset(dataFileMeansMultiArm) +#' datasetMeansMultiArm +#' } +#' +#' dataFileRatesMultiArm <- system.file("extdata", +#' "dataset_rates_multi-arm.csv", +#' package = "rpact" +#' ) +#' if (dataFileRatesMultiArm != "") { +#' datasetRatesMultiArm <- readDataset(dataFileRatesMultiArm) +#' datasetRatesMultiArm +#' } +#' +#' dataFileSurvivalMultiArm <- system.file("extdata", +#' "dataset_survival_multi-arm.csv", +#' package = "rpact" +#' ) +#' if (dataFileSurvivalMultiArm != "") { +#' datasetSurvivalMultiArm <- readDataset(dataFileSurvivalMultiArm) +#' datasetSurvivalMultiArm +#' } +#' } +#' +#' @export +#' +readDataset <- function(file, ..., header = TRUE, sep = ",", quote = "\"", + dec = ".", fill = TRUE, comment.char = "", fileEncoding = "UTF-8") { + if (!file.exists(file)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the file '", file, "' does not exist") + } + + data <- utils::read.table( + file = file, header = header, sep = sep, + quote = quote, dec = dec, fill = fill, fileEncoding = fileEncoding, ... + ) + dataWide <- stats::reshape(data = data, direction = "wide", idvar = "stages", timevar = "groups") + colnames(dataWide) <- gsub("\\.", "", colnames(dataWide)) + return(getDataset(dataWide)) +} + +#' @title +#' Write Dataset +#' +#' @description +#' Writes a dataset to a CSV file. +#' +#' @param dataset A dataset. +#' @param file The target CSV file. +#' @param append Logical. Only relevant if file is a character string. +#' If \code{TRUE}, the output is appended to the file. If \code{FALSE}, any existing file of the name is destroyed. +#' @param sep The field separator character. Values on each line of the file are separated +#' by this character. If sep = "," (the default for \code{writeDataset}) the separator is a comma. +#' @param quote The set of quoting characters. To disable quoting altogether, use +#' quote = "". See scan for the behavior on quotes embedded in quotes. Quoting is only +#' considered for columns read as character, which is all of them unless \code{colClasses} is specified. +#' @param dec The character used in the file for decimal points. +#' @param eol The character(s) to print at the end of each line (row). +#' @param na The string to use for missing values in the data. +#' @param row.names Either a logical value indicating whether the row names of \code{dataset} are +#' to be written along with \code{dataset}, or a character vector of row names to be written. +#' @param col.names Either a logical value indicating whether the column names of \code{dataset} are +#' to be written along with \code{dataset}, or a character vector of column names to be written. +#' See the section on 'CSV files' for the meaning of \code{col.names = NA}. +#' @param qmethod A character string specifying how to deal with embedded double quote characters +#' when quoting strings. Must be one of "double" (default in \code{writeDataset}) or "escape". +#' @param fileEncoding Character string: if non-empty declares the encoding used on a file +#' (not a connection) so the character data can be re-encoded. +#' See the 'Encoding' section of the help for file, the 'R Data Import/Export Manual' and 'Note'. +#' @param ... Further arguments to be passed to \code{\link[utils]{write.table}}. +#' +#' @details +#' \code{\link[=writeDataset]{writeDataset()}} is a wrapper function that coerces the dataset to a data frame and uses \cr +#' \code{\link[utils]{write.table}} to write it to a CSV file. +#' +#' @seealso +#' \itemize{ +#' \item \code{\link[=writeDatasets]{writeDatasets()}} for writing multiple datasets, +#' \item \code{\link[=readDataset]{readDataset()}} for reading a single dataset, +#' \item \code{\link[=readDatasets]{readDatasets()}} for reading multiple datasets. +#' } +#' +#' @examples +#' \dontrun{ +#' datasetOfRates <- getDataset( +#' n1 = c(11, 13, 12, 13), +#' n2 = c(8, 10, 9, 11), +#' events1 = c(10, 10, 12, 12), +#' events2 = c(3, 5, 5, 6) +#' ) +#' writeDataset(datasetOfRates, "dataset_rates.csv") +#' } +#' +#' @export +#' +writeDataset <- function(dataset, file, ..., append = FALSE, quote = TRUE, sep = ",", + eol = "\n", na = "NA", dec = ".", row.names = TRUE, + col.names = NA, qmethod = "double", + fileEncoding = "UTF-8") { + .assertIsDataset(dataset) + + x <- as.data.frame(dataset, niceColumnNamesEnabled = FALSE) + + utils::write.table( + x = x, file = file, append = append, quote = quote, sep = sep, + eol = eol, na = na, dec = dec, row.names = FALSE, + col.names = TRUE, qmethod = qmethod, + fileEncoding = fileEncoding + ) +} + +#' @title +#' Read Multiple Datasets +#' +#' @description +#' Reads a data file and returns it as a list of dataset objects. +#' +#' @param file A CSV file (see \code{\link[utils]{read.table}}). +#' @param header A logical value indicating whether the file contains the names of +#' the variables as its first line. +#' @param sep The field separator character. Values on each line of the file are separated +#' by this character. If sep = "," (the default for \code{readDatasets}) the separator is a comma. +#' @param quote The set of quoting characters. To disable quoting altogether, use +#' quote = "". See scan for the behavior on quotes embedded in quotes. Quoting is only +#' considered for columns read as character, which is all of them unless \code{colClasses} is specified. +#' @param dec The character used in the file for decimal points. +#' @param fill logical. If \code{TRUE} then in case the rows have unequal length, blank fields +#' are implicitly added. +#' @param comment.char character: a character vector of length one containing a single character +#' or an empty string. Use "" to turn off the interpretation of comments altogether. +#' @param fileEncoding character string: if non-empty declares the encoding used on a file +#' (not a connection) so the character data can be re-encoded. +#' See the 'Encoding' section of the help for file, the 'R Data Import/Export Manual' and 'Note'. +#' @param ... Further arguments to be passed to \code{\link[utils]{read.table}}. +#' +#' @details +#' Reads a file that was written by \code{\link[=writeDatasets]{writeDatasets()}} before. +#' +#' @return Returns a \code{\link[base]{list}} of \code{\link{Dataset}} objects. +#' +#' @seealso +#' \itemize{ +#' \item \code{\link[=readDataset]{readDataset()}} for reading a single dataset, +#' \item \code{\link[=writeDatasets]{writeDatasets()}} for writing multiple datasets, +#' \item \code{\link[=writeDataset]{writeDataset()}} for writing a single dataset. +#' } +#' +#' @examples +#' dataFile <- system.file("extdata", "datasets_rates.csv", package = "rpact") +#' if (dataFile != "") { +#' datasets <- readDatasets(dataFile) +#' datasets +#' } +#' @export +#' +readDatasets <- function(file, ..., header = TRUE, sep = ",", quote = "\"", + dec = ".", fill = TRUE, comment.char = "", fileEncoding = "UTF-8") { + if (!file.exists(file)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the file '", file, "' does not exist") + } + + data <- utils::read.table( + file = file, header = header, sep = sep, + quote = quote, dec = dec, fill = fill, fileEncoding = fileEncoding, ... + ) + + if (is.null(data[["datasetId"]])) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "data file must contain the column 'datasetId'") + } + + datasets <- list() + for (datasetId in unique(data$datasetId)) { + subData <- data[data$datasetId == datasetId, ] + dataFrame <- subset(subData, select = -datasetId) + description <- NA_character_ + if (!is.null(dataFrame[["description"]])) { + description <- as.character(dataFrame$description[1]) + dataFrame <- subset(dataFrame, select = -description) + } + if (length(unique(subData$groups)) == 2) { + dataWide <- stats::reshape(dataFrame, direction = "wide", idvar = "stages", timevar = "groups") + colnames(dataWide) <- gsub("\\.", "", colnames(dataWide)) + dataset <- getDataset(dataWide) + } else { + dataset <- getDataset(dataFrame) + } + dataset$setDescription(description) + datasets <- c(datasets, dataset) + } + return(datasets) +} + +#' @title +#' Write Multiple Datasets +#' +#' @description +#' Writes a list of datasets to a CSV file. +#' +#' @param datasets A list of datasets. +#' @param file The target CSV file. +#' @param append Logical. Only relevant if file is a character string. +#' If \code{TRUE}, the output is appended to the file. If FALSE, any existing file of the name is destroyed. +#' @param sep The field separator character. Values on each line of the file are separated +#' by this character. If sep = "," (the default for \code{writeDatasets}) the separator is a comma. +#' @param quote The set of quoting characters. To disable quoting altogether, use +#' quote = "". See scan for the behavior on quotes embedded in quotes. Quoting is only +#' considered for columns read as character, which is all of them unless \code{colClasses} is specified. +#' @param dec The character used in the file for decimal points. +#' @param eol The character(s) to print at the end of each line (row). +#' @param na The string to use for missing values in the data. +#' @param row.names Either a logical value indicating whether the row names of \code{dataset} are +#' to be written along with \code{dataset}, or a character vector of row names to be written. +#' @param col.names Either a logical value indicating whether the column names of \code{dataset} are +#' to be written along with \code{dataset}, or a character vector of column names to be written. +#' See the section on 'CSV files' for the meaning of \code{col.names = NA}. +#' @param qmethod A character string specifying how to deal with embedded double quote characters +#' when quoting strings. Must be one of "double" (default in \code{writeDatasets}) or "escape". +#' @param fileEncoding Character string: if non-empty declares the encoding used on a file +#' (not a connection) so the character data can be re-encoded. +#' See the 'Encoding' section of the help for file, the 'R Data Import/Export Manual' and 'Note'. +#' @param ... Further arguments to be passed to \code{\link[utils]{write.table}}. +#' +#' @details +#' The format of the CSV file is optimized for usage of \code{\link[=readDatasets]{readDatasets()}}. +#' +#' @seealso +#' \itemize{ +#' \item \code{\link[=writeDataset]{writeDataset()}} for writing a single dataset, +#' \item \code{\link[=readDatasets]{readDatasets()}} for reading multiple datasets, +#' \item \code{\link[=readDataset]{readDataset()}} for reading a single dataset. +#' } +#' +#' @examples +#' \dontrun{ +#' d1 <- getDataset( +#' n1 = c(11, 13, 12, 13), +#' n2 = c(8, 10, 9, 11), +#' events1 = c(10, 10, 12, 12), +#' events2 = c(3, 5, 5, 6) +#' ) +#' d2 <- getDataset( +#' n1 = c(9, 13, 12, 13), +#' n2 = c(6, 10, 9, 11), +#' events1 = c(10, 10, 12, 12), +#' events2 = c(4, 5, 5, 6) +#' ) +#' datasets <- list(d1, d2) +#' writeDatasets(datasets, "datasets_rates.csv") +#' } +#' +#' @export +#' +writeDatasets <- function(datasets, file, ..., append = FALSE, quote = TRUE, sep = ",", + eol = "\n", na = "NA", dec = ".", row.names = TRUE, + col.names = NA, qmethod = "double", + fileEncoding = "UTF-8") { + if (!is.list(datasets)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'datasets' must be a list of datasets") + } + + if (length(datasets) == 0) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'datasets' is empty") + } + + datasetType <- NA_character_ + dataFrames <- NULL + for (i in 1:length(datasets)) { + dataset <- datasets[[i]] + .assertIsDataset(dataset) + if (is.na(datasetType)) { + datasetType <- .getClassName(dataset) + } else if (.getClassName(dataset) != datasetType) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all datasets must have the same type") + } + + data <- as.data.frame(dataset, niceColumnNamesEnabled = FALSE) + datasetId <- ifelse(!is.null(dataset$getId()) && !is.na(dataset$getId()), dataset$getId(), i) + data <- cbind(rep(datasetId, nrow(data)), data) + colnames(data)[1] <- "datasetId" + + if (!is.null(dataset$getDescription()) && !is.na(dataset$getDescription())) { + data <- cbind(data, rep(dataset$getDescription(), nrow(data))) + colnames(data)[ncol(data)] <- "description" + } + + if (is.null(dataFrames)) { + dataFrames <- data + } else { + dataFrames <- rbind(dataFrames, data) + } + } + + if (is.null(dataFrames)) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to bind datasets") + } + + utils::write.table( + x = dataFrames, file = file, append = append, quote = quote, sep = sep, + eol = eol, na = na, dec = dec, row.names = FALSE, + col.names = TRUE, qmethod = qmethod, + fileEncoding = fileEncoding + ) +} + +.getDataset <- function(..., floatingPointNumbersEnabled = FALSE) { + args <- list(...) + if (length(args) == 0) { + stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "data.frame, data vectors, or datasets expected") + } + + if (.optionalArgsContainsDatasets(...)) { + if (length(args) == 1) { + return(args[[1]]) + } + + design <- .getDesignFromArgs(...) + if (length(args) == 2 && !is.null(design)) { + dataset <- .getDatasetFromArgs(...) + if (!is.null(dataset)) { + dataset <- dataset$clone(deep = TRUE) #TODO was $copy shallow + dataset$.design <- design + return(dataset) + } + } + + return(.getEnrichmentDatasetFromArgs(...)) + } + + exampleType <- args[["example"]] + if (!is.null(exampleType) && exampleType %in% c("means", "rates", "survival")) { + return(.getDatasetExample(exampleType = exampleType)) + } + + if (length(args) == 1 && !is.null(args[[1]]) && is.list(args[[1]]) && !is.data.frame(args[[1]])) { + return(.getDatasetMeansFromModelsByStage(emmeansResults = args[[1]])) + } + + emmeansResults <- .getDatasetMeansModelObjectsList(args) + if (!is.null(emmeansResults) && length(emmeansResults) > 0) { + return(.getDatasetMeansFromModelsByStage(emmeansResults = emmeansResults)) + } + + dataFrame <- .getDataFrameFromArgs(...) + + design <- .getDesignFromArgs(...) + + if (is.null(dataFrame)) { + args <- .removeDesignFromArgs(args) + + paramNames <- names(args) + paramNames <- paramNames[paramNames != ""] + + numberOfParameters <- length(args) + if (numberOfParameters > 0 && names(args)[1] == "" && .isTrialDesign(args[[1]])) { + numberOfParameters <- numberOfParameters - 1 + } + + if (length(paramNames) != numberOfParameters) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all parameters must be named") + } + + if (length(paramNames) != length(unique(paramNames))) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the parameter names must be unique") + } + + dataFrame <- .createDataFrame(...) + } + + enrichmentEnabled <- .isDataObjectEnrichment(...) + + if (.isDataObjectMeans(...)) { + return(DatasetMeansR6$new( + dataFrame = dataFrame, + floatingPointNumbersEnabled = floatingPointNumbersEnabled, + enrichmentEnabled = enrichmentEnabled, + .design = design + )) + } + + if (.isDataObjectRates(...)) { + return(DatasetRatesR6$new( + dataFrame = dataFrame, + floatingPointNumbersEnabled = floatingPointNumbersEnabled, + enrichmentEnabled = enrichmentEnabled, + .design = design + )) + } + + if (.isDataObjectNonStratifiedEnrichmentSurvival(...)) { + return(DatasetEnrichmentSurvivalR6$new( + dataFrame = dataFrame, + floatingPointNumbersEnabled = floatingPointNumbersEnabled, + enrichmentEnabled = enrichmentEnabled, + .design = design + )) + } + + if (.isDataObjectSurvival(...)) { + return(DatasetSurvivalR6$new( + dataFrame = dataFrame, + floatingPointNumbersEnabled = floatingPointNumbersEnabled, + enrichmentEnabled = enrichmentEnabled, + .design = design + )) + } + + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "failed to identify dataset type") +} + +#' @title +#' Get Dataset +#' +#' @description +#' Creates a dataset object and returns it. +#' +#' @param ... A \code{data.frame} or some data vectors defining the dataset. +#' @param floatingPointNumbersEnabled If \code{TRUE}, +#' sample sizes and event numbers can be specified as floating-point numbers +#' (this make sense, e.g., for theoretical comparisons); \cr +#' by default \code{floatingPointNumbersEnabled = FALSE}, i.e., +#' samples sizes and event numbers defined as floating-point numbers will be truncated. +#' +#' @details +#' The different dataset types \code{DatasetMeans}, of \code{DatasetRates}, or +#' \code{DatasetSurvival} can be created as follows: +#' \itemize{ +#' \item An element of \code{\link{DatasetMeans}} for one sample is created by \cr +#' \code{getDataset(sampleSizes =, means =, stDevs =)} where \cr +#' \code{sampleSizes}, \code{means}, \code{stDevs} are vectors with stage-wise sample sizes, +#' means and standard deviations of length given by the number of available stages. +#' \item An element of \code{\link{DatasetMeans}} for two samples is created by \cr +#' \code{getDataset(sampleSizes1 =, sampleSizes2 =, means1 =, means2 =, } \cr +#' \code{stDevs1 =, stDevs2 =)} where +#' \code{sampleSizes1}, \code{sampleSizes2}, \code{means1}, \code{means2}, +#' \code{stDevs1}, \code{stDevs2} are vectors with +#' stage-wise sample sizes, means and standard deviations for the two treatment groups +#' of length given by the number of available stages. +#' \item An element of \code{\link{DatasetRates}} for one sample is created by \cr +#' \code{getDataset(sampleSizes =, events =)} where \code{sampleSizes}, \code{events} are vectors +#' with stage-wise sample sizes and events of length given by the number of available stages. +#' \item An element of \code{\link{DatasetRates}} for two samples is created by \cr +#' \code{getDataset(sampleSizes1 =, sampleSizes2 =, events1 =, events2 =)} where +#' \code{sampleSizes1}, \code{sampleSizes2}, \code{events1}, \code{events2} +#' are vectors with stage-wise sample sizes +#' and events for the two treatment groups of length given by the number of available stages. +#' \item An element of \code{\link{DatasetSurvival}} is created by \cr +#' \code{getDataset(events =, logRanks =, allocationRatios =)} where +#' \code{events}, \code{logRanks}, and \code{allocation ratios} are the stage-wise events, +#' (one-sided) logrank statistics, and allocation ratios. +#' \item An element of \code{\link{DatasetMeans}}, \code{\link{DatasetRates}}, and \code{\link{DatasetSurvival}} +#' for more than one comparison is created by adding subsequent digits to the variable names. +#' The system can analyze these data in a multi-arm many-to-one comparison setting where the +#' group with the highest index represents the control group. +#' } +#' Prefix \code{overall[Capital case of first letter of variable name]...} for the variable +#' names enables entering the overall (cumulative) results and calculates stage-wise statistics. +#' Since rpact version 3.2, the prefix \code{cumulative[Capital case of first letter of variable name]...} or +#' \code{cum[Capital case of first letter of variable name]...} can alternatively be used for this. +#' +#' \code{n} can be used in place of \code{samplesizes}. +#' +#' Note that in survival design usually the overall (cumulative) events and logrank test statistics are provided +#' in the output, so \cr +#' \code{getDataset(cumulativeEvents=, cumulativeLogRanks =, cumulativeAllocationRatios =)} \cr +#' is the usual command for entering survival data. Note also that for \code{cumulativeLogranks} also the +#' z scores from a Cox regression can be used. +#' +#' For multi-arm designs, the index refers to the considered comparison. For example,\cr +#' \code{ +#' getDataset(events1=c(13, 33), logRanks1 = c(1.23, 1.55), events2 = c(16, NA), logRanks2 = c(1.55, NA)) +#' } \cr +#' refers to the case where one active arm (1) is considered at both stages whereas active arm 2 +#' was dropped at interim. Number of events and logrank statistics are entered for the corresponding +#' comparison to control (see Examples). +#' +#' For enrichment designs, the comparison of two samples is provided for an unstratified +#' (sub-population wise) or stratified data input.\cr +#' For unstratified (sub-population wise) data input the data sets are defined for the sub-populations +#' S1, S2, ..., F, where F refers to the full populations. Use of \code{getDataset(S1 = , S2, ..., F = )} +#' defines the data set to be used in \code{\link[=getAnalysisResults]{getAnalysisResults()}} (see examples)\cr +#' For stratified data input the data sets are defined for the strata S1, S12, S2, ..., R, where R +#' refers to the remainder of the strata such that the union of all sets is the full population. +#' Use of \code{getDataset(S1 = , S12 = , S2, ..., R = )} defines the data set to be used in +#' \code{\link[=getAnalysisResults]{getAnalysisResults()}} (see examples)\cr +#' For survival data, for enrichment designs the log-rank statistics should be entered as stratified +#' log-rank statistics in order to provide strong control of Type I error rate. For stratified data input, +#' the variables to be specified in \code{getDataset()} are \code{events}, \code{expectedEvents}, +#' \code{varianceEvents}, and \code{allocationRatios} or \code{overallEvents}, \code{overallExpectedEvents}, +#' \code{overallVarianceEvents}, and \code{overallAllocationRatios}. From this, (stratified) log-rank tests are +#' calculated. +#' +#' @template return_object_dataset +#' +#' @template examples_get_dataset +#' +#' @include f_analysis_base.R +#' @include f_analysis_utilities.R +#' +#' @export +#' +getDataset <- function(..., floatingPointNumbersEnabled = FALSE) { + dataset <- .getDataset(floatingPointNumbersEnabled = floatingPointNumbersEnabled, ...) + if (dataset$.enrichmentEnabled && dataset$getNumberOfGroups() != 2) { + warning("Only population enrichment data with 2 groups can be analyzed but ", + dataset$getNumberOfGroups(), " group", + ifelse(dataset$getNumberOfGroups() == 1, " is", "s are"), " defined", + call. = FALSE + ) + } + return(dataset) +} + +#' @rdname getDataset +#' @export +getDataSet <- function(..., floatingPointNumbersEnabled = FALSE) { + return(getDataset(floatingPointNumbersEnabled = floatingPointNumbersEnabled, ...)) +} + +.getDatasetMeansModelObjectsList <- function(args) { + if (is.null(args) || length(args) == 0 || !is.list(args)) { + return(NULL) + } + + emmeansResults <- list() + for (arg in args) { + if (inherits(arg, "emmGrid")) { + emmeansResults[[length(emmeansResults) + 1]] <- arg + } + } + if (length(emmeansResults) == 0) { + return(NULL) + } + + argNames <- names(args) + for (i in 1:length(args)) { + arg <- args[[i]] + if (!inherits(arg, "emmGrid")) { + argName <- argNames[i] + argInfo <- "" + if (length(argName) == 1 && argName != "") { + argInfo <- paste0(sQuote(argName), " ") + } + argInfo <- paste0(argInfo, "(", .arrayToString(arg), ")") + warning("Argument ", argInfo, " will be ignored because only 'emmGrid' objects will be respected") + } + } + + return(emmeansResults) +} + +.getStandardDeviationFromStandardError <- function(sampleSize, standardError, ..., + dfValue = NA_real_, alpha = 0.05, lmEnabled = TRUE, stDevCalcMode = "auto") { + qtCalcEnablbled <- length(stDevCalcMode) == 1 && !is.na(stDevCalcMode) && stDevCalcMode == "t" + if ((qtCalcEnablbled || !lmEnabled) && !is.na(dfValue) && !is.infinite(dfValue) && dfValue > 0) { + qValue <- stats::qt(1 - alpha / 2, df = dfValue) + stDev <- standardError * 2 / qValue * sqrt(sampleSize) + } else { + stDev <- standardError * sqrt(sampleSize) + } + + return(stDev) +} + +.getDatasetMeansFromModelsByStage <- function(emmeansResults, correctGroupOrder = TRUE) { + if (is.null(emmeansResults)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(emmeansResults), " must be a non-empty list") + } + if (!is.list(emmeansResults)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(emmeansResults), " must be a list") + } + if (length(emmeansResults) == 0) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(emmeansResults), " must be not empty") + } + + for (stage in 1:length(emmeansResults)) { + if (!inherits(emmeansResults[[stage]], "emmGrid")) { + stop(sprintf( + paste0( + "%s%s must contain %s objects created by emmeans(x), ", + "where x is a linear model result (one object per stage; class is %s at stage %s)" + ), + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("emmeansResults"), sQuote("emmGrid"), + .getClassName(emmeansResults[[stage]]), stage + )) + } + } + + stages <- integer(0) + groups <- integer(0) + means <- numeric(0) + stDevs <- numeric(0) + sampleSizes <- numeric(0) + + lmEnabled <- TRUE + tryCatch( + { + modelCall <- emmeansResults[[1]]@model.info$call + modelFunction <- as.character(modelCall)[1] + lmEnabled <- modelFunction == "lm" + if (!grepl(paste0("::", modelFunction), modelFunction)) { + packageName <- .getPackageName(modelFunction) + if (!is.na(packageName)) { + modelFunction <- paste0(packageName, "::", modelFunction) + } + } + + if (lmEnabled) { + warning("When using ", modelFunction, "() ", + "the estimated marginal means and standard deviations can be inaccurate ", + "and analysis results based on this values may be imprecise", + call. = FALSE + ) + } else { + warning("Using ", modelFunction, " emmeans result objects as ", + "arguments of getDataset() is experminental in this rpact version and not fully validated", + call. = FALSE + ) + } + }, + error = function(e) { + warning("Using emmeans result objects as ", + "arguments of getDataset() is experminental in this rpact version and not fully validated", + call. = FALSE + ) + } + ) + + stDevCalcMode <- getOption("rpact.dataset.stdev.calc.mode", "auto") # auto, sigma, norm, t + for (stage in 1:length(emmeansResults)) { + emmeansResult <- emmeansResults[[stage]] + emmeansResultsSummary <- summary(emmeansResult) + emmeansResultsList <- as.list(emmeansResult) + + if (is.null(emmeansResultsSummary[["emmean"]])) { + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, + "the objects in summary(emmeansResults) must contain the field 'emmean'" + ) + } + for (expectedField in c("sigma", "extras")) { + if (is.null(emmeansResultsList[[expectedField]])) { + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, + "the objects in as.list(emmeansResults) must contain the field ", sQuote(expectedField) + ) + } + } + + numberOfGroups <- length(emmeansResultsSummary$emmean) + rpactGroupNumbers <- 1:numberOfGroups + if (correctGroupOrder) { + rpactGroupNumbers <- 1 + if (numberOfGroups > 1) { + rpactGroupNumbers <- c(2:numberOfGroups, rpactGroupNumbers) + } + } + for (group in 1:length(emmeansResultsSummary$emmean)) { + stages <- c(stages, stage) + groups <- c(groups, group) + rpactGroupNumber <- rpactGroupNumbers[group] + + standardError <- emmeansResultsSummary$SE[rpactGroupNumber] + + sampleSize <- emmeansResultsList$extras[rpactGroupNumber, ] + meanValue <- emmeansResultsSummary$emmean[rpactGroupNumber] + dfValue <- emmeansResultsSummary$df[rpactGroupNumber] + if (length(stDevCalcMode) == 1 && !is.na(stDevCalcMode) && stDevCalcMode == "sigma") { + # pooled standard deviation from emmeans + stDev <- emmeansResultsList$sigma + } else { + stDev <- .getStandardDeviationFromStandardError(sampleSize, standardError, + dfValue = dfValue, lmEnabled = lmEnabled, stDevCalcMode = stDevCalcMode + ) + } + + means <- c(means, meanValue) + stDevs <- c(stDevs, stDev) + sampleSizes <- c(sampleSizes, sampleSize) + } + } + + data <- data.frame( + stages = stages, + groups = groups, + means = means, + stDevs = stDevs, + sampleSizes = sampleSizes + ) + data <- data[order(data$stages, data$groups), ] + dataWide <- stats::reshape(data = data, direction = "wide", idvar = "stages", timevar = "groups") + colnames(dataWide) <- gsub("\\.", "", colnames(dataWide)) + return(getDataset(dataWide)) +} + +.optionalArgsContainsDatasets <- function(...) { + args <- list(...) + if (length(args) == 0) { + return(FALSE) + } + + for (arg in args) { + if (inherits(arg, "Dataset") || inherits(arg, "DatasetR6")) { + return(TRUE) + } + } + return(FALSE) +} + +.getSubsetsFromArgs <- function(...) { + args <- list(...) + if (length(args) == 0) { + stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "one or more subset datasets expected") + } + + subsetNames <- names(args) + if (is.null(subsetNames)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all subsets must be named") + } + + if (!("R" %in% subsetNames) && !("F" %in% subsetNames)) { + stop( + C_EXCEPTION_TYPE_MISSING_ARGUMENT, + '"R" (stratified analysis)" or "F" (non-stratified analysis) must be defined as subset' + ) + } + + subsetNumbers <- gsub("\\D", "", subsetNames) + subsetNumbers <- subsetNumbers[subsetNumbers != ""] # & nchar(subsetNumbers) == 1 + if (length(subsetNumbers) == 0) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all subset names (", + .arrayToString(subsetNames), ") must be \"S[n]\", \"R\", or \"F\", ", + "where [n] is a number with increasing digits (starting with 1)" + ) + } + + stratifiedInput <- "R" %in% subsetNames + + subsetNumbers <- paste0(subsetNumbers, collapse = "") + subsetNumbers <- strsplit(subsetNumbers, "")[[1]] + subsetNumbers <- as.integer(subsetNumbers) + gMax <- max(subsetNumbers) + 1 + validSubsetNames <- .createSubsetsByGMax(gMax, stratifiedInput = stratifiedInput, all = FALSE) + for (subsetName in subsetNames) { + if (subsetName == "") { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all subsets must be named") + } + + if (!(subsetName %in% validSubsetNames)) { + suffix <- ifelse(stratifiedInput, " (stratified analysis)", " (non-stratified analysis)") + if (length(validSubsetNames) < 10) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "invalid subset name (", subsetName, "); ", + "valid names are ", .arrayToString(validSubsetNames), suffix + ) + } else { + restFull <- ifelse(stratifiedInput, '"R"', '"F"') + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "invalid subset name (", subsetName, "): ", + "all subset names must be \"S[n]\" or ", restFull, ", ", + "where [n] is a number with increasing digits", suffix + ) + } + } + } + + subsets <- NULL + subsetType <- NA_character_ + emptySubsetNames <- validSubsetNames[!(validSubsetNames %in% subsetNames)] + for (subsetName in subsetNames) { + subset <- args[[subsetName]] + if (is.null(subset) || (!(isS4(subset) || is.R6(subset)) && is.na(subset))) { + emptySubsetNames <- c(emptySubsetNames, subsetName) + } else { + if (!.isDataset(subset)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "subset ", subsetName, " is not a dataset (is ", .getClassName(subset), ")" + ) + } + if (!is.na(subsetType) && subsetType != .getClassName(subset)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "all subsets must have the same type (found ", subsetType, " and ", .getClassName(subset), ")" + ) + } + subsetType <- .getClassName(subset) + if (is.null(subset[[".data"]])) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "subset ", subsetName, " does not contain field '.data'" + ) + } + subset <- subset$.data + subset$subset <- rep(subsetName, nrow(subset)) + if (is.null(subsets)) { + subsets <- subset + } else { + subsets <- rbind(subsets, subset) + } + } + } + + if (length(emptySubsetNames) > 0) { + emptySubsetNames <- unique(emptySubsetNames) + template <- subsets[subsets$subset == ifelse(stratifiedInput, "R", "F"), ] + colNames <- colnames(template) + colNames <- colNames[!(colNames %in% c("stage", "group", "subset"))] + for (colName in colNames) { + template[[colName]] <- rep(NA_real_, nrow(template)) + } + + for (subsetName in emptySubsetNames) { + template$subset <- rep(subsetName, nrow(template)) + subsets <- rbind(subsets, template) + } + + if (length(emptySubsetNames) == 1) { + warning("The undefined subset ", emptySubsetNames, + " was defined as empty subset", + call. = FALSE + ) + } else { + warning(gettextf( + "The %s undefined subsets %s were defined as empty subsets", + length(emptySubsetNames), .arrayToString(emptySubsetNames) + ), call. = FALSE) + } + } + + return(subsets) +} + +.validateEnrichmentDataFrameAtFirstStage <- function(dataFrame, params) { + dataFrameStage1 <- dataFrame[dataFrame$stage == 1, ] + for (param in params) { + paramValue <- dataFrameStage1[[param]] + if (any(is.null(paramValue) || any(is.infinite(paramValue)))) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + gettextf( + "all %s values (%s) at first stage must be valid", + sQuote(param), .arrayToString(paramValue, maxLength = 10) + ) + ) + } + if (any(is.na(paramValue))) { + subsets <- unique(dataFrame$subset) + for (s in subsets) { + subData <- dataFrame[dataFrame$subset == s, ] + subsetParamValues <- subData[[param]] + if (!all(is.na(subsetParamValues)) && any(is.na(subsetParamValues[subData$stage == 1]))) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + gettextf( + "all %s values (%s) at first stage must be valid (NA is not allowed)", + sQuote(param), .arrayToString(paramValue, maxLength = 10) + ) + ) + } + } + } + } +} + +.getEndpointSpecificDataFrameParameterNames <- function(dataFrame) { + paramNames <- colnames(dataFrame) + paramNames <- paramNames[!(paramNames %in% c("stage", "group", "subset"))] + return(paramNames) +} + +.validateEnrichmentDataFrameDeselection <- function(dataFrame) { + paramNames <- .getEndpointSpecificDataFrameParameterNames(dataFrame) + for (i in 1:nrow(dataFrame)) { + row <- dataFrame[i, paramNames] + if (any(is.na(row)) && !all(is.na(row))) { + stop( + C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, + gettextf( + paste0( + "inconsistent deselection in group %s at stage %s (", + "%s: all or none must be NA)" + ), + dataFrame$group[i], dataFrame$stage[i], .arrayToString(paramNames, maxCharacters = 40) + ) + ) + } + } + + subsets <- unique(dataFrame$subset) + for (s in subsets) { + deselectedStage <- 0 + for (stage in unique(dataFrame$stage)) { + subData <- dataFrame[dataFrame$subset == s & dataFrame$stage == stage, paramNames] + + if (deselectedStage > 0 && !all(is.na(subData))) { + stop( + C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, + gettextf(paste0( + "%s was deselected at stage %s ", + "and therefore must be also deselected in the following stages, ", + "but is no longer deselected in stage %s" + ), s, deselectedStage, stage) + ) + } + + if (any(is.na(subData))) { + deselectedStage <- stage + } + } + } +} + +.validateEnrichmentDataFrameMeans <- function(dataFrame) { + if (any(na.omit(dataFrame$stDev) <= 0) || any(na.omit(dataFrame$overallStDev) <= 0)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all standard deviations must be > 0") + } + if (any(na.omit(dataFrame$sampleSize) <= 0) || any(na.omit(dataFrame$overallSampleSize) <= 0)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all sample sizes must be > 0") + } + + .validateEnrichmentDataFrameAtFirstStage(dataFrame, + params = c("sampleSize", "overallSampleSize", "mean", "overallMean", "stDev", "overallStDev") + ) + + .validateEnrichmentDataFrameDeselection(dataFrame) + + subsets <- unique(dataFrame$subset) + if ("F" %in% subsets) { + subsets <- subsets[subsets != "F"] + fullData <- dataFrame[dataFrame$subset == "F", ] + for (s in subsets) { + for (stage in unique(dataFrame$stage)) { + for (group in unique(dataFrame$group)) { + subData <- dataFrame[dataFrame$subset == s & dataFrame$stage == stage & dataFrame$group == group, ] + + stDevFull <- na.omit(fullData$stDev[fullData$stage == stage & fullData$group == group]) + stDevSubset <- na.omit(subData$stDev) + if (length(stDevFull) > 0 && length(stDevSubset) > 0 && any(stDevFull <= stDevSubset)) { + stop( + C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, + gettextf( + "'stDev' F (%s) must be > 'stDev' %s (%s) in group %s at stage %s", + .arrayToString(stDevFull), s, + .arrayToString(stDevSubset), group, stage + ) + ) + } + + sampleSizeFull <- na.omit(fullData$sampleSize[fullData$stage == stage & fullData$group == group]) + sampleSizeSubset <- na.omit(subData$sampleSize) + if (length(sampleSizeFull) > 0 && length(sampleSizeSubset) > 0 && any(sampleSizeFull < sampleSizeSubset)) { + stop( + C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, + gettextf( + "'sampleSize' F (%s) must be >= 'sampleSize' %s (%s) in group %s at stage %s", + .arrayToString(sampleSizeFull), s, + .arrayToString(sampleSizeSubset), group, stage + ) + ) + } + } + } + } + } +} + +.validateEnrichmentDataFrameSurvival <- function(dataFrame) { + if (any(na.omit(dataFrame$event) < 0) || any(na.omit(dataFrame$overallEvent) < 0)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all events must be >= 0") + } + + .validateEnrichmentDataFrameAtFirstStage(dataFrame, + params = c("event", "overallEvent") + ) + + .validateEnrichmentDataFrameDeselection(dataFrame) + + subsets <- unique(dataFrame$subset) + if ("F" %in% subsets) { + subsets <- subsets[subsets != "F"] + fullData <- dataFrame[dataFrame$subset == "F", ] + for (s in subsets) { + for (stage in unique(dataFrame$stage)) { + for (group in unique(dataFrame$group)) { + subData <- dataFrame[dataFrame$subset == s & dataFrame$stage == stage & dataFrame$group == group, ] + + eventFull <- na.omit(fullData$event[fullData$stage == stage & fullData$group == group]) + eventSubset <- na.omit(subData$event) + if (length(eventFull) > 0 && length(eventSubset) > 0 && any(eventFull < eventSubset)) { + stop( + C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, + gettextf( + "'event' F (%s) must be >= 'event' %s (%s) in group %s at stage %s", + .arrayToString(eventFull), s, + .arrayToString(eventSubset), group, stage + ) + ) + } + } + } + } + } +} + +.validateEnrichmentDataFrameRates <- function(dataFrame) { + if (any(na.omit(dataFrame$sampleSize) <= 0) || any(na.omit(dataFrame$overallSampleSize) <= 0)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all sample sizes must be > 0") + } + + .validateEnrichmentDataFrameAtFirstStage(dataFrame, + params = c("sampleSize", "overallSampleSize") + ) + + .validateEnrichmentDataFrameDeselection(dataFrame) + + subsets <- unique(dataFrame$subset) + if ("F" %in% subsets) { + subsets <- subsets[subsets != "F"] + fullData <- dataFrame[dataFrame$subset == "F", ] + for (s in subsets) { + for (stage in unique(dataFrame$stage)) { + for (group in unique(dataFrame$group)) { + subData <- dataFrame[dataFrame$subset == s & dataFrame$stage == stage & dataFrame$group == group, ] + + sampleSizeFull <- na.omit(fullData$sampleSize[fullData$stage == stage & fullData$group == group]) + sampleSizeSubset <- na.omit(subData$sampleSize) + if (length(sampleSizeFull) > 0 && length(sampleSizeSubset) > 0 && any(sampleSizeFull < sampleSizeSubset)) { + stop( + C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, + gettextf( + "'sampleSize' F (%s) must be >= 'sampleSize' %s (%s) in group %s at stage %s", + .arrayToString(sampleSizeFull), s, + .arrayToString(sampleSizeSubset), group, stage + ) + ) + } + } + } + } + } + + .validateEnrichmentDataFrameSurvival(dataFrame) +} + +.validateEnrichmentDataFrameHasConsistentNumberOfStages <- function(dataFrame) { + subsets <- unique(dataFrame$subset) + kMaxList <- list() + for (s in subsets) { + subsetStages <- as.integer(sort(unique(na.omit(as.character(dataFrame$stage[dataFrame$subset == s]))))) + kMax <- max(subsetStages) + if (!identical(1:kMax, subsetStages)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + gettextf("subset %s has incomplete stages (%s)", s, .arrayToString(subsetStages)) + ) + } + + kMaxList[[s]] <- kMax + } + + kMax <- unique(unlist(kMaxList)) + if (length(kMax) > 1) { + stop( + C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, + "all subsets must have the identical number of stages defined (kMax: ", .listToString(kMaxList), ")" + ) + } +} + +.validateEnrichmentDataFrame <- function(dataFrame) { + paramNames <- colnames(dataFrame) + if (any(grepl("(S|s)tDev", paramNames))) { + .validateEnrichmentDataFrameMeans(dataFrame) + } else if (any(grepl("(S|s)ampleSize", paramNames)) && any(grepl("(E|e)vent", paramNames))) { + .validateEnrichmentDataFrameRates(dataFrame) + } else if (any(grepl("(L|l)ogRank", paramNames)) || any(grepl("(E|e)xpectedEvent", paramNames))) { + .validateEnrichmentDataFrameSurvival(dataFrame) + } else { + print(paramNames) + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "could not identify the endpoint of the specified dataset") + } + + subsets <- unique(dataFrame$subset) + if ("R" %in% subsets) { + paramNames <- .getEndpointSpecificDataFrameParameterNames(dataFrame) + paramName <- paramNames[1] + subsets <- subsets[subsets != "R"] + subsets <- subsets[grepl("^S\\d$", subsets)] + if (length(subsets) > 0) { + restData <- dataFrame[dataFrame$subset == "R", ] + for (s in subsets) { + stages <- unique(dataFrame$stage) + stages <- stages[stages != 1] + if (length(stages) > 0) { + for (stage in stages) { + for (group in unique(dataFrame$group)) { + subData <- dataFrame[dataFrame$subset == s & dataFrame$stage == stage & dataFrame$group == group, ] + + paramValueRest <- restData[[paramName]][restData$stage == stage & restData$group == group] + paramValueSubset <- subData[[paramName]] + if (length(paramValueRest) > 0 && length(paramValueSubset) > 0 && + any(is.na(paramValueSubset)) && !all(is.na(paramValueRest))) { + stop( + C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, + gettextf( + paste0( + "if %s is deselected (NA) then R also must be deselected (NA) but, e.g., ", + "%s R is %s in group %s at stage %s" + ), + s, sQuote(paramName), .arrayToString(paramValueRest, vectorLookAndFeelEnabled = TRUE), + group, stage + ) + ) + } + } + } + } + } + } + } + + .validateEnrichmentDataFrameHasConsistentNumberOfStages(dataFrame) +} + +.getEnrichmentDataFrameFromArgs <- function(...) { + dataFrame <- .getSubsetsFromArgs(...) + + validColumns <- c() + for (j in 1:ncol(dataFrame)) { + if (!all(is.na(dataFrame[, j]))) { + validColumns <- c(validColumns, j) + } + } + if (length(validColumns) > 0) { + dataFrame <- dataFrame[, validColumns] + } + + return(dataFrame) +} + +.getEnrichmentDatasetFromArgs <- function(...) { + dataFrame <- .getEnrichmentDataFrameFromArgs(...) + .validateEnrichmentDataFrame(dataFrame) + dataFrame <- .getWideFormat(dataFrame) + return(.getDataset(dataFrame = dataFrame)) +} + +.getDatasetExample <- function(exampleType) { + if (exampleType == "means") { + return(getDataset( + n1 = c(13, 25), + n2 = c(15, NA), + n3 = c(14, 27), + n4 = c(12, 29), + means1 = c(24.2, 22.2), + means2 = c(18.8, NA), + means3 = c(26.7, 27.7), + means4 = c(9.2, 12.2), + stDevs1 = c(24.4, 22.1), + stDevs2 = c(21.2, NA), + stDevs3 = c(25.6, 23.2), + stDevs4 = c(21.5, 22.7) + )) + } else if (exampleType == "rates") { + return(getDataset( + n1 = c(23, 25), + n2 = c(25, NA), + n3 = c(24, 27), + n4 = c(22, 29), + events1 = c(15, 12), + events2 = c(19, NA), + events3 = c(18, 22), + events4 = c(12, 13) + )) + } else if (exampleType == "survival") { + return(getDataset( + events1 = c(25, 32), + events2 = c(18, NA), + events3 = c(22, 36), + logRanks1 = c(2.2, 1.8), + logRanks2 = c(1.99, NA), + logRanks3 = c(2.32, 2.11) + )) + } + + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'exampleType' (", exampleType, ") is not allowed") +} + +#' +#' @name Dataset +#' +#' @title +#' Dataset +#' +#' @description +#' Basic class for datasets. +#' +#' @template field_stages +#' @template field_groups +#' +#' @details +#' \code{Dataset} is the basic class for +#' \itemize{ +#' \item \code{\link{DatasetMeans}}, +#' \item \code{\link{DatasetRates}}, +#' \item \code{\link{DatasetSurvival}}, and +#' \item \code{\link{DatasetEnrichmentSurvival}}. +#' } +#' This basic class contains the fields \code{stages} and \code{groups} and several commonly used +#' functions. +#' +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include class_design.R +#' @include f_core_constants.R +#' @include f_core_assertions.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +DatasetR6 <- R6Class("DatasetR6", + inherit = ParameterSetR6, + public = list( + .data = NULL, + .plotSettings = NULL, + .id = NULL, + .description = NULL, + .floatingPointNumbersEnabled = NULL, + .kMax = NULL, + .enrichmentEnabled = NULL, + .inputType = NULL, + .design = NULL, + stages = NULL, + groups = NULL, + subsets = NULL, + initialize = function(dataFrame, ..., floatingPointNumbersEnabled = FALSE, enrichmentEnabled = FALSE) { + super$initialize() + + self$.floatingPointNumbersEnabled <- floatingPointNumbersEnabled + self$.enrichmentEnabled <- enrichmentEnabled + + self$.plotSettings <- PlotSettingsR6$new() + self$.parameterNames <- .getParameterNames(dataset = self) + self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS + + self$.id <- NA_integer_ + self$.description <- NA_character_ + self$.inputType <- NA_character_ + + if (!missing(dataFrame)) { + self$.initByDataFrame(dataFrame) + self$.kMax <- self$getNumberOfStages() + if (!self$.enrichmentEnabled) { + self$.validateDataset() + } + } + }, + getPlotSettings = function() { + return(self$.plotSettings) + }, + show = function(showType = 1, digits = NA_integer_) { + "Method for automatically printing dataset objects" + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + }, + .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { + self$.resetCat() + + if (!is.null(showType) && length(showType) == 1 && !is.na(showType) && + is.character(showType) && showType == "rcmd") { + s <- strsplit(getObjectRCode(self, stringWrapParagraphWidth = NULL), "), *")[[1]] + s[2:length(s)] <- paste0("\t", s[2:length(s)]) + s <- paste0(s, collapse = "),\n") + cat(s, "\n") + } else if (showType == 2) { + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + } else { + self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), + title = self$.toString(startWithUpperCase = TRUE), orderByParameterName = FALSE, + consoleOutputEnabled = consoleOutputEnabled + ) + + self$.showParametersOfOneGroup(self$.getGeneratedParameters(), + title = "Calculated data", orderByParameterName = FALSE, + consoleOutputEnabled = consoleOutputEnabled + ) + + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + + if (!is.na(self$.description) && nchar(self$.description) > 0) { + self$.cat("Description: ", self$.description, "\n\n", + consoleOutputEnabled = consoleOutputEnabled + ) + } + } + }, + .initByDataFrame = function(dataFrame) { + if (!is.data.frame(dataFrame)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'dataFrame' must be a data.frame (is an instance of class ", .getClassName(dataFrame), ")" + ) + } + + if (!self$.paramExists(dataFrame, "stage") && !self$.paramExists(dataFrame, "stages")) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'dataFrame' must contain parameter 'stages' or 'stage'" + ) + } + + self$stages <- as.integer(self$.getValuesByParameterName(dataFrame, c("stages", "stage"))) + if (!self$.enrichmentEnabled && length(unique(self$stages)) < length(self$stages)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'stages' (", .arrayToString(self$stages), + ") must be a unique vector of stage numbers" + ) + } + self$groups <- rep(1L, length(self$stages)) + + self$.setParameterType("groups", C_PARAM_USER_DEFINED) + self$.setParameterType("stages", C_PARAM_USER_DEFINED) + + if (any(grepl("^subsets?\\d*$", colnames(dataFrame)))) { + numberOfTreatmentGroups <- self$.getNumberOfGroups(dataFrame, c(C_KEY_WORDS_SAMPLE_SIZES, C_KEY_WORDS_LOG_RANKS)) + self$subsets <- character(0) + for (group in 1:numberOfTreatmentGroups) { + suffix <- ifelse(any(grepl("^subsets?\\d+$", colnames(dataFrame))), group, "") + self$subsets <- c(self$subsets, self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_SUBSETS, suffix = suffix)) + } + self$.setParameterType("subsets", C_PARAM_USER_DEFINED) + } else { + self$subsets <- rep(NA_character_, length(self$stages)) + } + }, + .validateDataset = function() { + .assertIsValidKMax(kMax = self$getNumberOfStages()) + + for (var in names(self)) { + values <- self[[var]] + if (any(is.nan(values)) || any(is.infinite(values))) { + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'", var, "' (", .arrayToString(values), + ") contains illegal values, i.e., something went wrong" + ) + } + } + }, + .validateValues = function(values, name) { + if (self$.enrichmentEnabled) { + return(invisible()) + } + + l1 <- length(unique(self$stages)) + l2 <- length(values) + if (l1 != l2) { + stop( + C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, + "there ", ifelse(l1 == 1, paste("is", l1, "stage"), + paste("are", l1, "stages") + ), " defined", + " (", .arrayToString(unique(self$stages)), ") and '", name, "' has length ", l2 + ) + } + }, + .recreateDataFrame = function() { + self$.data <- data.frame( + stage = factor(self$stages), + group = factor(self$groups), + subset = factor(self$subsets) + ) + }, + .setDataToVariables = function() { + self$stages <- as.integer(self$.data$stage) + self$groups <- as.integer(self$.data$group) + self$subsets <- as.character(self$.data$subset) + }, + .fillWithNAs = function(kMax) { + numberOfStages <- self$getNumberOfStages() + self$.kMax <- numberOfStages + if (numberOfStages >= kMax) { + return(invisible()) + } + + numberOfGroups <- self$getNumberOfGroups(survivalCorrectionEnabled = FALSE) + if (self$.enrichmentEnabled) { + for (stage in (numberOfStages + 1):kMax) { + for (group in 1:numberOfGroups) { + for (subset in levels(self$.data$subset)) { + self$stages <- c(self$stages, stage) + self$groups <- c(self$groups, group) + self$subsets <- c(self$subsets, subset) + } + } + } + } else { + for (stage in (numberOfStages + 1):kMax) { + for (group in 1:numberOfGroups) { + self$stages <- c(self$stages, stage) + self$groups <- c(self$groups, group) + self$subsets <- c(self$subsets, NA_character_) + } + } + } + }, + .trim = function(kMax) { + if (is.na(kMax)) { + kMax <- self$.kMax + } + numberOfStages <- self$getNumberOfStages(FALSE) + if (numberOfStages <= kMax) { + return(invisible(numeric(0))) + } + + indices <- which(self$stages <= kMax) + + self$stages <- self$stages[indices] + self$groups <- self$groups[indices] + self$subsets <- self$subsets[indices] + + return(indices) + }, + .orderDataByStageAndGroup = function() { + if (self$.enrichmentEnabled) { + dat <- self$.data + dat$char <- gsub("\\d", "", as.character(self$.data$subset)) + dat$char[dat$char == "R"] <- "Z" + dat$char[dat$char == "F"] <- "Z" + dat$num <- as.integer(gsub("\\D", "", as.character(self$.data$subset))) + + self$.data <- self$.data[order(self$.data$stage, self$.data$group, dat$char, dat$num), ] + } else { + self$.data <- self$.data[order(self$.data$stage, self$.data$group), ] + } + }, + .getNumberOfNAsToAdd = function(kMax) { + n <- kMax - self$getNumberOfStages() + if (n <= 0) { + return(0) + } + + n <- n * self$getNumberOfGroups(survivalCorrectionEnabled = FALSE) + if (self$.enrichmentEnabled) { + n <- n * self$getNumberOfSubsets() + } + return(n) + }, + .paramExists = function(dataFrame, parameterName) { + for (p in parameterName) { + value <- dataFrame[[p]] + if (!is.null(value)) { + return(TRUE) + } + } + return(FALSE) + }, + .getValuesByParameterName = function(dataFrame, parameterNameVariants, ..., + defaultValues = NULL, suffix = "") { + for (parameterName in parameterNameVariants) { + key <- paste0(parameterName, suffix) + if (self$.paramExists(dataFrame, key)) { + return(dataFrame[[key]]) + } + } + + if (!is.null(defaultValues)) { + return(defaultValues) + } + + stop( + C_EXCEPTION_TYPE_MISSING_ARGUMENT, "parameter '", + paste0(parameterNameVariants[1], suffix), "' is missing or not correctly specified" + ) + }, + .getValueLevels = function(values) { + if (is.factor(values)) { + return(levels(values)) + } + + return(sort(unique(na.omit(values)))) + }, + .getValues = function(paramName, paramValues) { + values <- self$.data[[paramName]] + valueLevels <- self$.getValueLevels(values) + if (!all(paramValues %in% valueLevels)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", paramName, "' (", .arrayToString(paramValues), + ") out of range [", .arrayToString(valueLevels), "]" + ) + } + return(values) + }, + .getIndexValues = function(paramName, paramValues, subset = NA_character_) { + values <- self$.getValues(paramName, paramValues) + if (all(is.na(subset))) { + return(which(values %in% paramValues)) + } + + self$.assertIsValidSubset(subset) + return(which(values %in% paramValues & self$.data$subset %in% subset)) + }, + .assertIsValidSubset = function(subset) { + for (s in subset) { + if (!(s %in% levels(self$.data$subset))) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'subset' (", s, + ") is not a defined value [", .arrayToString(levels(self$.data$subset)), "]" + ) + } + } + }, + .getIndices = function(..., stage, group, subset = NA_character_) { + if (is.null(self$.data)) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'.data' must be defined") + } + + if (!is.null(stage) && !any(is.na(stage)) && all(stage < 0)) { + index <- 1:self$getNumberOfStages() + stage <- index[!(index %in% abs(stage))] + } + + if (!is.null(group) && !any(is.na(group)) && all(group < 0)) { + index <- 1:self$getNumberOfGroups(survivalCorrectionEnabled = FALSE) + group <- index[!(index %in% abs(group))] + } + + # stage only and optional subset + if (!is.null(group) && length(group) == 1 && is.na(group)) { + return(self$.getIndexValues("stage", stage, subset)) + } + + # group only and optional subset + if (!is.null(stage) && length(stage) == 1 && is.na(stage)) { + return(self$.getIndexValues("group", group, subset)) + } + + # stage and group and optional subset + stageValues <- self$.getValues("stage", stage) + groupValues <- self$.getValues("group", group) + if (all(is.na(subset))) { + return(which(stageValues %in% stage & groupValues %in% group)) + } + + self$.assertIsValidSubset(subset) + return(which(stageValues %in% stage & groupValues %in% group & self$.data$subset %in% subset)) + }, + .getValidatedFloatingPointNumbers = function(x, parameterName = "Sample sizes") { + if (self$.floatingPointNumbersEnabled) { + return(x) + } + + nToCheck <- stats::na.omit(x) + if (any(nToCheck != as.integer(nToCheck))) { + warning(parameterName, " specified as floating-point numbers were truncated", call. = FALSE) + } + + x[!is.na(x)] <- as.integer(x[!is.na(x)]) + return(x) + }, + .keyWordExists = function(dataFrame, keyWords, suffix = "") { + for (key in keyWords) { + if (self$.paramExists(dataFrame, paste0(key, suffix))) { + return(TRUE) + } + } + return(FALSE) + }, + .getNumberOfGroups = function(dataFrame, keyWords) { + for (group in 2:1000) { + if (!self$.keyWordExists(dataFrame, keyWords, group)) { + return(group - 1) + } + } + return(1) + }, + .getValidatedStage = function(stage = NA_integer_) { + if (all(is.na(stage))) { + stage <- c(1:self$getNumberOfStages()) + } + return(stage) + }, + getNumberOfGroups = function(survivalCorrectionEnabled = TRUE) { + data <- stats::na.omit(self$.data) + if (!survivalCorrectionEnabled) { + return(length(levels(data$group))) + } + return(length(levels(data$group)) + ifelse(inherits(self, "DatasetSurvival") || inherits(self, "DatasetSurvivalR6"), 1, 0)) + }, + getNumberOfStages = function(naOmitEnabled = TRUE) { + if (naOmitEnabled) { + colNames <- colnames(self$.data) + validColNames <- character(0) + for (colName in colNames) { + colValues <- self$.data[, colName] + if (length(colValues) > 0 && !all(is.na(colValues))) { + validColNames <- c(validColNames, colName) + } + } + subData <- stats::na.omit(self$.data[, validColNames]) + numberOfStages <- length(unique(as.character(subData$stage))) + if (numberOfStages == 0) { + print(self$.data[, validColNames]) + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, + ".data seems to contain an invalid column" + ) + } + return(numberOfStages) + } + return(length(levels(self$.data$stage))) + }, + getNumberOfSubsets = function() { + return(length(levels(self$.data$subset))) + }, + isDatasetMeans = function() { + return(inherits(self, "DatasetMeansR6")) + }, + isDatasetRates = function() { + return(inherits(self, "DatasetRatesR6")) + }, + isDatasetSurvival = function() { + return(inherits(self, "DatasetSurvivalR6")) + }, + isStratified = function() { + return(self$.enrichmentEnabled && "R" %in% levels(self$.data$subset)) + }, + setId = function(id) { + self$.id <- as.integer(id) + }, + getId = function() { + return(self$.id) + }, + setDescription = function(description) { + self$.description <- description + }, + getDescription = function() { + return(self$.description) + }, + .toString = function(startWithUpperCase = FALSE) { + s <- "dataset of " + if (self$.enrichmentEnabled) { + s <- paste0(s, "enrichment ") + } else if (self$getNumberOfGroups() > 2) { + s <- paste0(s, "multi-arm ") + } + + if (self$isDatasetMeans()) { + s <- paste0(s, "means") + } else if (self$isDatasetRates()) { + s <- paste0(s, "rates") + } else if (self$isDatasetSurvival()) { + s <- paste0(s, "survival data") + } else { + s <- paste0(s, "unknown endpoint") + } + return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) + } + ) +) + +#' +#' @name DatasetMeans +#' +#' @title +#' Dataset of Means +#' +#' @description +#' Class for a dataset of means. +#' +#' @template field_groups +#' @template field_stages +#' @template field_sampleSizes +#' @template field_means +#' @template field_stDevs +#' @template field_overallSampleSizes +#' @template field_overallMeans +#' @template field_overallStDevs +#' +#' @details +#' This object cannot be created directly; better use \code{\link{getDataset}} +#' with suitable arguments to create a dataset of means. +#' +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include f_core_constants.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +DatasetMeansR6 <- R6Class("DatasetMeansR6", + inherit = DatasetR6, + public = list( + sampleSizes = NULL, + means = NULL, + stDevs = NULL, + overallSampleSizes = NULL, + overallMeans = NULL, + overallStDevs = NULL, + getSampleSize = function(stage, group = 1, subset = NA_character_) { + return(self$.data$sampleSize[self$.getIndices(stage = stage, group = group, subset = subset)]) + }, + getMean = function(stage, group = 1, subset = NA_character_) { + return(self$.data$mean[self$.getIndices(stage = stage, group = group, subset = subset)]) + }, + getStDev = function(stage, group = 1, subset = NA_character_) { + return(self$.data$stDev[self$.getIndices(stage = stage, group = group, subset = subset)]) + }, + getSampleSizes = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { + return(self$.data$sampleSize[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) + }, + getMeans = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { + return(self$.data$mean[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) + }, + getStDevs = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { + return(self$.data$stDev[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) + }, + getSampleSizesUpTo = function(to, group = 1, subset = NA_character_) { + return(self$.data$sampleSize[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) + }, + getMeansUpTo = function(to, group = 1, subset = NA_character_) { + return(self$.data$mean[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) + }, + getStDevsUpTo = function(to, group = 1, subset = NA_character_) { + return(self$.data$stDev[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) + }, + getOverallSampleSize = function(stage, group = 1, subset = NA_character_) { + return(self$.data$overallSampleSize[self$.getIndices(stage = stage, group = group, subset = subset)]) + }, + getOverallMean = function(stage, group = 1, subset = NA_character_) { + return(self$.data$overallMean[self$.getIndices(stage = stage, group = group, subset = subset)]) + }, + getOverallStDev = function(stage, group = 1, subset = NA_character_) { + return(self$.data$overallStDev[self$.getIndices(stage = stage, group = group, subset = subset)]) + }, + getOverallSampleSizes = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { + return(self$.data$overallSampleSize[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) + }, + getOverallMeans = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { + return(self$.data$overallMean[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) + }, + getOverallStDevs = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { + return(self$.data$overallStDev[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) + }, + getOverallSampleSizesUpTo = function(to, group = 1, subset = NA_character_) { + return(self$.data$overallSampleSize[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) + }, + getOverallMeansUpTo = function(to, group = 1, subset = NA_character_) { + return(self$.data$overallMean[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) + }, + getOverallStDevsUpTo = function(to, group = 1, subset = NA_character_) { + return(self$.data$overallStDev[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) + }, + .initByDataFrame = function(dataFrame) { + super$.initByDataFrame(dataFrame) + + # case: one mean - stage wise + if (self$.paramExists(dataFrame, C_KEY_WORDS_SAMPLE_SIZES)) { + self$.inputType <- "stagewise" + self$sampleSizes <- self$.getValidatedFloatingPointNumbers(self$.getValuesByParameterName( + dataFrame, + C_KEY_WORDS_SAMPLE_SIZES + ), parameterName = "Sample sizes") + self$.validateValues(self$sampleSizes, "n") + if (any(stats::na.omit(self$sampleSizes) <= 0)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "all sample sizes must be > 0, but 'n' = ", + .arrayToString(self$sampleSizes, vectorLookAndFeelEnabled = TRUE) + ) + } + + self$means <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_MEANS) + self$.validateValues(self$means, "means") + + self$stDevs <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_ST_DEVS) + self$.validateValues(self$stDevs, "stDevs") + } + + # case: one mean - overall + else if (self$.paramExists(dataFrame, C_KEY_WORDS_OVERALL_SAMPLE_SIZES)) { + self$.inputType <- "overall" + self$overallSampleSizes <- self$.getValidatedFloatingPointNumbers(self$.getValuesByParameterName( + dataFrame, + C_KEY_WORDS_OVERALL_SAMPLE_SIZES + ), parameterName = "Cumulative sample sizes ") + self$.validateValues(self$overallSampleSizes, "overallSampleSizes") + + self$overallMeans <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_MEANS) + self$.validateValues(self$overallMeans, "overallMeans") + + self$overallStDevs <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_ST_DEVS) + self$.validateValues(self$overallStDevs, "overallStDevs") + } + + # case: two or more means - stage wise + else if (self$.paramExists(dataFrame, paste0(C_KEY_WORDS_SAMPLE_SIZES, 1)) && + self$.paramExists(dataFrame, paste0(C_KEY_WORDS_SAMPLE_SIZES, 2))) { + self$.inputType <- "stagewise" + numberOfTreatmentGroups <- self$.getNumberOfGroups(dataFrame, C_KEY_WORDS_SAMPLE_SIZES) + self$stages <- rep(self$stages, numberOfTreatmentGroups) + self$groups <- integer(0) + self$sampleSizes <- numeric(0) + self$means <- numeric(0) + self$stDevs <- numeric(0) + for (group in 1:numberOfTreatmentGroups) { + sampleSizesTemp <- self$.getValidatedFloatingPointNumbers(self$.getValuesByParameterName( + dataFrame, C_KEY_WORDS_SAMPLE_SIZES, + suffix = group + ), parameterName = "Sample sizes") + self$.validateValues(sampleSizesTemp, paste0("n", group)) + if (any(stats::na.omit(sampleSizesTemp) <= 0)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "all sample sizes must be > 0, but 'n", group, "' = ", + .arrayToString(sampleSizesTemp, vectorLookAndFeelEnabled = TRUE) + ) + } + self$sampleSizes <- c(self$sampleSizes, sampleSizesTemp) + + meansTemp <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_MEANS, suffix = group) + self$.validateValues(meansTemp, paste0("means", group)) + self$means <- c(self$means, meansTemp) + + stDevsTemp <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_ST_DEVS, suffix = group) + self$.validateValues(stDevsTemp, paste0("stDevs", group)) + self$stDevs <- c(self$stDevs, stDevsTemp) + + self$groups <- c(self$groups, rep(as.integer(group), length(sampleSizesTemp))) + } + } + + # case: two or more means - overall + else if (self$.paramExists(dataFrame, paste0(C_KEY_WORDS_OVERALL_SAMPLE_SIZES, 1)) && + self$.paramExists(dataFrame, paste0(C_KEY_WORDS_OVERALL_SAMPLE_SIZES, 2))) { + self$.inputType <- "overall" + numberOfTreatmentGroups <- self$.getNumberOfGroups(dataFrame, C_KEY_WORDS_OVERALL_SAMPLE_SIZES) + self$stages <- rep(self$stages, numberOfTreatmentGroups) + self$groups <- integer(0) + self$sampleSizes <- numeric(0) + self$means <- numeric(0) + self$stDevs <- numeric(0) + self$overallSampleSizes <- numeric(0) + self$overallMeans <- numeric(0) + self$overallStDevs <- numeric(0) + for (group in 1:numberOfTreatmentGroups) { + overallSampleSizesTemp <- self$.getValidatedFloatingPointNumbers(self$.getValuesByParameterName( + dataFrame, C_KEY_WORDS_OVERALL_SAMPLE_SIZES, + suffix = group + ), parameterName = "Cumulative sample sizes") + self$.validateValues(overallSampleSizesTemp, paste0("overallSampleSizes", group)) + self$overallSampleSizes <- c(self$overallSampleSizes, overallSampleSizesTemp) + + overallMeansTemp <- self$.getValuesByParameterName(dataFrame, + C_KEY_WORDS_OVERALL_MEANS, + suffix = group + ) + self$.validateValues(overallMeansTemp, paste0("overallMeans", group)) + self$overallMeans <- c(self$overallMeans, overallMeansTemp) + + overallStDevsTemp <- self$.getValuesByParameterName(dataFrame, + C_KEY_WORDS_OVERALL_ST_DEVS, + suffix = group + ) + self$.validateValues(overallStDevsTemp, paste0("overallStDevs", group)) + self$overallStDevs <- c(self$overallStDevs, overallStDevsTemp) + + self$groups <- c(self$groups, rep(as.integer(group), length(overallSampleSizesTemp))) + } + } else { + stop( + C_EXCEPTION_TYPE_MISSING_ARGUMENT, + "sample sizes are missing or not correctly specified" + ) + } + + if (self$.inputType == "stagewise") { + n <- length(self$sampleSizes) + self$overallSampleSizes <- rep(NA_real_, n) + self$overallMeans <- rep(NA_real_, n) + self$overallStDevs <- rep(NA_real_, n) + + self$.setParameterType("sampleSizes", C_PARAM_USER_DEFINED) + self$.setParameterType("means", C_PARAM_USER_DEFINED) + self$.setParameterType("stDevs", C_PARAM_USER_DEFINED) + + self$.setParameterType("overallSampleSizes", C_PARAM_GENERATED) + self$.setParameterType("overallMeans", C_PARAM_GENERATED) + self$.setParameterType("overallStDevs", C_PARAM_GENERATED) + + self$.recreateDataFrame() + self$.createOverallData() + } else { + n <- length(self$overallSampleSizes) + self$sampleSizes <- rep(NA_real_, n) + self$means <- rep(NA_real_, n) + self$stDevs <- rep(NA_real_, n) + + self$.setParameterType("sampleSizes", C_PARAM_GENERATED) + self$.setParameterType("means", C_PARAM_GENERATED) + self$.setParameterType("stDevs", C_PARAM_GENERATED) + + self$.setParameterType("overallSampleSizes", C_PARAM_USER_DEFINED) + self$.setParameterType("overallMeans", C_PARAM_USER_DEFINED) + self$.setParameterType("overallStDevs", C_PARAM_USER_DEFINED) + + self$.recreateDataFrame() + self$.createStageWiseData() + } + + if (sum(stats::na.omit(self$sampleSizes) < 0) > 0) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all sample sizes must be >= 0") + } + if (sum(stats::na.omit(self$stDevs) < 0) > 0) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all standard deviations must be >= 0") + } + }, + .recreateDataFrame = function() { + super$.recreateDataFrame() + self$.data <- cbind(self$.data, data.frame( + sampleSize = self$sampleSizes, + mean = self$means, + stDev = self$stDevs, + overallSampleSize = self$overallSampleSizes, + overallMean = self$overallMeans, + overallStDev = self$overallStDevs + )) + self$.orderDataByStageAndGroup() + self$.setDataToVariables() + }, + .setDataToVariables = function() { + super$.setDataToVariables() + self$sampleSizes <- self$.data$sampleSize + self$means <- self$.data$mean + self$stDevs <- self$.data$stDev + self$overallSampleSizes <- self$.data$overallSampleSize + self$overallMeans <- self$.data$overallMean + self$overallStDevs <- self$.data$overallStDev + }, + .fillWithNAs = function(kMax) { + super$.fillWithNAs(kMax) + n <- self$.getNumberOfNAsToAdd(kMax) + + naRealsToAdd <- rep(NA_real_, n) + + self$sampleSizes <- c(self$sampleSizes, naRealsToAdd) + self$means <- c(self$means, naRealsToAdd) + self$stDevs <- c(self$stDevs, naRealsToAdd) + + self$overallSampleSizes <- c(self$overallSampleSizes, naRealsToAdd) + self$overallMeans <- c(self$overallMeans, naRealsToAdd) + self$overallStDevs <- c(self$overallStDevs, naRealsToAdd) + + self$.recreateDataFrame() + }, + .trim = function(kMax = NA_integer_) { + indices <- super$.trim(kMax) + if (length(indices) == 0) { + return(invisible(FALSE)) + } + + self$sampleSizes <- self$sampleSizes[indices] + self$means <- self$means[indices] + self$stDevs <- self$stDevs[indices] + + self$overallSampleSizes <- self$overallSampleSizes[indices] + self$overallMeans <- self$overallMeans[indices] + self$overallStDevs <- self$overallStDevs[indices] + + self$.recreateDataFrame() + return(invisible(TRUE)) + }, + .getOverallMeans = function(sampleSizes, means) { + return(cumsum(sampleSizes * means) / cumsum(sampleSizes)) + }, + .getOverallStDevs = function(sampleSizes, means, stDevs, overallMeans) { + kMax <- length(sampleSizes) + overallStDev <- rep(NA_real_, kMax) + for (k in 1:kMax) { + overallStDev[k] <- sqrt((sum((sampleSizes[1:k] - 1) * stDevs[1:k]^2) + + sum(sampleSizes[1:k] * (means[1:k] - overallMeans[k])^2)) / + (sum(sampleSizes[1:k]) - 1)) + } + return(overallStDev) + }, + .createOverallData = function() { + self$.data$overallSampleSize <- rep(NA_real_, nrow(self$.data)) + self$.data$overallMean <- rep(NA_real_, nrow(self$.data)) + self$.data$overallStDev <- rep(NA_real_, nrow(self$.data)) + subsetLevels <- NA_character_ + if (self$.enrichmentEnabled) { + subsetLevels <- levels(self$.data$subset) + } + for (s in subsetLevels) { + for (g in levels(self$.data$group)) { + if (!is.na(s)) { + indices <- which(self$.data$subset == s & self$.data$group == g) + } else { + indices <- which(self$.data$group == g) + } + self$.data$overallSampleSize[indices] <- cumsum(self$.data$sampleSize[indices]) + self$.data$overallMean[indices] <- self$.getOverallMeans( + self$.data$sampleSize[indices], self$.data$mean[indices] + ) + self$.data$overallStDev[indices] <- self$.getOverallStDevs( + self$.data$sampleSize[indices], + self$.data$mean[indices], self$.data$stDev[indices], self$.data$overallMean[indices] + ) + } + } + self$.setDataToVariables() + }, + .getStageWiseSampleSizes = function(overallSampleSizes) { + result <- overallSampleSizes + if (length(overallSampleSizes) == 1) { + return(result) + } + + kMax <- length(overallSampleSizes) + result[2:kMax] <- overallSampleSizes[2:kMax] - overallSampleSizes[1:(kMax - 1)] + return(result) + }, + .getStageWiseMeans = function(sampleSizes, overallSampleSizes, overallMeans) { + result <- overallMeans + if (length(overallMeans) == 1) { + return(result) + } + + for (k in 2:length(overallMeans)) { + result[k] <- (overallSampleSizes[k] * overallMeans[k] - + overallSampleSizes[k - 1] * overallMeans[k - 1]) / sampleSizes[k] + } + return(result) + }, + .getStageWiseStDev = function(overallStDevs, sampleSizes, overallSampleSizes, means, overallMeans, k) { + numBeforeK <- (overallSampleSizes[k - 1] - 1) * overallStDevs[k - 1]^2 + numK <- (overallSampleSizes[k] - 1) * overallStDevs[k]^2 + numSumBeforeK <- sum(sampleSizes[1:(k - 1)] * (means[1:(k - 1)] - overallMeans[k - 1])^2) + numSumK <- sum(sampleSizes[1:k] * (means[1:k] - overallMeans[k])^2) + denom <- (sampleSizes[k] - 1) + value <- (numK - numBeforeK + numSumBeforeK - numSumK) / denom + if (is.null(value) || length(value) != 1 || is.na(value) || value < 0) { + warning("No calculation of stage-wise standard deviation from ", + "overall standard deviations possible at stage ", k, + call. = FALSE + ) + return(NA_real_) + } + + return(sqrt(value)) + }, + .getStageWiseStDevs = function(overallStDevs, sampleSizes, overallSampleSizes, means, overallMeans) { + result <- overallStDevs + if (length(overallStDevs) == 1) { + return(result) + } + + for (k in 2:length(overallStDevs)) { + result[k] <- self$.getStageWiseStDev(overallStDevs, sampleSizes, overallSampleSizes, means, overallMeans, k) + } + return(result) + }, + .createStageWiseData = function() { + "Calculates stage-wise means and standard deviation if cunulative data is available" + + self$.data$sampleSize <- rep(NA_real_, nrow(self$.data)) + self$.data$mean <- rep(NA_real_, nrow(self$.data)) + self$.data$stDev <- rep(NA_real_, nrow(self$.data)) + + subsetLevels <- NA_character_ + if (self$.enrichmentEnabled) { + subsetLevels <- levels(self$.data$subset) + } + + for (s in subsetLevels) { + for (g in levels(self$.data$group)) { + if (!is.na(s)) { + indices <- which(self$.data$subset == s & self$.data$group == g) + } else { + indices <- which(self$.data$group == g) + } + + .assertValuesAreStrictlyIncreasing(self$.data$overallSampleSize[indices], + paste0("overallSampleSizes", g), + endingNasAllowed = TRUE + ) + + self$.data$sampleSize[indices] <- self$.getStageWiseSampleSizes(self$.data$overallSampleSize[indices]) + self$.data$mean[indices] <- self$.getStageWiseMeans( + self$.data$sampleSize[indices], + self$.data$overallSampleSize[indices], self$.data$overallMean[indices] + ) + self$.data$stDev[indices] <- self$.getStageWiseStDevs( + self$.data$overallStDev[indices], self$.data$sampleSize[indices], + self$.data$overallSampleSize[indices], self$.data$mean[indices], self$.data$overallMean[indices] + ) + } + } + self$.setDataToVariables() + }, + getRandomData = function() { + return(self$.getRandomDataMeans(self)) + } + ) +) + +#' @examples +#' +#' datasetExample <- getDataset( +#' means1 = c(112.3, 105.1, 121.3), +#' means2 = c(98.1, 99.3, 100.1), +#' means3 = c(98.1, 99.3, 100.1), +#' stDevs1 = c(44.4, 42.9, 41.4), +#' stDevs2 = c(46.7, 41.1, 39.5), +#' stDevs3 = c(46.7, 41.1, 39.5), +#' n1 = c(84, 81, 82), +#' n2 = c(87, 83, 81), +#' n3 = c(87, 82, 84) +#' ) +#' .getRandomDataMeans(datasetExample, +#' randomDataParamName = "outcome", numberOfVisits = 3, +#' fixedCovariates = list(gender = c("f", "m"), bmi = c(17, 40)) +#' ) +#' +#' @noRd +#' +.getRandomDataMeans <- function(dataset, ..., + treatmentName = "Treatment group", + controlName = "Control group", + randomDataParamName = "randomData", + numberOfVisits = 1L, + fixedCovariates = NULL, + covariateEffects = NULL, + seed = NA_real_) { + if (!is.null(fixedCovariates)) { + if (!is.list(fixedCovariates)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("fixedCovariates"), " must be a named list") + } + } + if (!is.null(covariateEffects)) { + if (!is.list(covariateEffects)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("covariateEffects"), " must be a named list") + } + } + + .assertIsSingleCharacter(treatmentName, "treatmentName") + .assertIsSingleCharacter(controlName, "controlName") + .assertIsSingleCharacter(randomDataParamName, "randomDataParamName") + .assertIsSinglePositiveInteger(numberOfVisits, "numberOfVisits", validateType = FALSE) + .assertIsSingleNumber(seed, "seed", naAllowed = TRUE) + + seed <- .setSeed(seed) + + numberOfGroups <- dataset$getNumberOfGroups() + + sampleSize <- 0 + for (stage in 1:dataset$getNumberOfStages()) { + for (group in 1:numberOfGroups) { + if (dataset$.enrichmentEnabled) { + for (subset in levels(dataset$.data$subset)) { + n <- dataset$getSampleSize(stage = stage, group = group, subset = subset) + if (n > sampleSize) { + sampleSize <- n + } + } + } else { + n <- dataset$getSampleSize(stage = stage, group = group) + n <- round(n / numberOfVisits) + if (n > sampleSize) { + sampleSize <- n + } + } + } + } + + idFactor <- 10^nchar(as.character(sampleSize)) + + data <- NULL + for (stage in 1:dataset$getNumberOfStages()) { + for (group in 1:numberOfGroups) { + for (visit in 1:numberOfVisits) { + if (dataset$.enrichmentEnabled) { + for (subset in levels(dataset$.data$subset)) { + n <- dataset$getSampleSize(stage = stage, group = group, subset = subset) + randomData <- stats::rnorm( + n = n, + mean = dataset$getMean(stage = stage, group = group, subset = subset), + sd = dataset$getStDev(stage = stage, group = group, subset = subset) + ) + row <- data.frame( + subject = idFactor * group + c(1:n), + stage = rep(stage, n), + group = rep(group, n), + subset = rep(subset, n), + randomData = randomData + ) + if (is.null(data)) { + data <- row + } else { + data <- rbind(data, row) + } + } + } else { + n <- dataset$getSampleSize(stage = stage, group = group) + n <- floor(n / numberOfVisits) + randomData <- stats::rnorm( + n = sampleSize, + mean = dataset$getMean(stage = stage, group = group), + sd = dataset$getStDev(stage = stage, group = group) + ) + + subjectIds <- (idFactor * 10 * stage) + (idFactor * group) + c(1:sampleSize) + indices <- 1:sampleSize + randomDataBefore <- NULL + numberOfDropOutsBefore <- 0 + if (visit > 1 && !is.null(data)) { + randomDataBefore <- data$randomData[data$stage == visit - 1 & data$subject %in% subjectIds] + numberOfDropOutsBefore <- sum(is.na(randomDataBefore)) + indices <- which(!is.na(randomDataBefore)) + } + sampleSizeBefore <- sampleSize - numberOfDropOutsBefore + if (n < sampleSizeBefore) { + numberOfDropOuts <- sampleSizeBefore - n + dropOuts <- sample(c(rep(1, n - numberOfDropOuts), rep(0, numberOfDropOuts))) + randomData[indices[dropOuts == 0]] <- NA_real_ + if (!is.null(randomDataBefore)) { + randomData[is.na(randomDataBefore)] <- NA_real_ + } + } + + row <- data.frame( + subject = subjectIds, + stage = rep(stage, sampleSize), + group = rep(group, sampleSize), + visit = rep(visit - 1, sampleSize), + randomData = randomData + ) + + if (is.null(data)) { + data <- row + } else { + data <- rbind(data, row) + } + } + } + } + } + data$stage <- factor(data$stage) + groupLevels <- paste(treatmentName, c(1:numberOfGroups)) + if (numberOfGroups > 1) { + if (numberOfGroups == 2) { + groupLevels[1] <- treatmentName + } + groupLevels[numberOfGroups] <- controlName + } + + data$group <- factor(data$group, labels = groupLevels) + if (dataset$.enrichmentEnabled) { + data$subset <- factor(data$subset) + } + + if (!is.null(randomDataParamName) && length(randomDataParamName) == 1 && !is.na(randomDataParamName)) { + colNames <- colnames(data) + colNames[colNames == "randomData"] <- randomDataParamName + colnames(data) <- colNames + } + + if (!is.null(fixedCovariates)) { + fixedCovariateNames <- names(fixedCovariates) + if (is.null(fixedCovariateNames) || any(nchar(trimws(fixedCovariateNames)) == 0)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("fixedCovariates"), " must be a named list") + } + + subjects <- sort(unique(data$subject)) + for (fixedCovariateName in fixedCovariateNames) { + data[[fixedCovariateName]] <- rep(NA, nrow(data)) + values <- fixedCovariates[[fixedCovariateName]] + if (is.null(values) || length(values) < 2 || any(is.na(values))) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(paste0("fixedCovariates$", fixedCovariateName)), + " (", .arrayToString(values), ") must be a valid numeric or character vector with a minimum of 2 values" + ) + } + + if (is.character(values)) { + if (length(unique(values)) < length(values)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(paste0("fixedCovariates$", fixedCovariateName)), + " (", .arrayToString(values, maxLength = 20), ") must be a unique vector" + ) + } + + fixedCovariateSample <- sample(values, length(subjects), replace = TRUE) + for (i in 1:length(subjects)) { + data[[fixedCovariateName]][data$subject == subjects[i]] <- fixedCovariateSample[i] + } + } else if (is.numeric(values)) { + if (length(values) == 2) { + minValue <- min(values) + maxValue <- max(values) + covMean <- runif(1, minValue, maxValue) + covSD <- covMean * 0.1 + showMessage <- TRUE + for (i in 1:length(subjects)) { + groupName <- as.character(data$group[data$subject == subjects[i]])[1] + covEffect <- 1 + if (groupName == controlName && !is.null(covariateEffects)) { + covEffect <- covariateEffects[[fixedCovariateName]] + if (is.null(covEffect)) { + covEffect <- 1 + } else { + .assertIsNumericVector(covEffect, paste0("covariateEffects$", fixedCovariateName)) + if (showMessage) { + message( + "Add effect ", covEffect, " to ", + sQuote(fixedCovariateName), " of ", sQuote(groupName) + ) + showMessage <- FALSE + } + } + } + continuesExample <- rnorm(sum(data$subject == subjects[i]), covMean * covEffect, covSD) + data[[fixedCovariateName]][data$subject == subjects[i]] <- continuesExample + } + } + } + } + } + + data$seed <- rep(seed, nrow(data)) + + return(data) +} + +#' +#' @title +#' Dataset Plotting +#' +#' @description +#' Plots a dataset. +#' +#' @param x The \code{\link{Dataset}} object to plot. +#' @param y Not available for this kind of plot (is only defined to be compatible +#' to the generic plot function). +#' @param main The main title, default is \code{"Dataset"}. +#' @param xlab The x-axis label, default is \code{"Stage"}. +#' @param ylab The y-axis label. +#' @param legendTitle The legend title, default is \code{"Group"}. +#' @inheritParams param_palette +#' @inheritParams param_showSource +#' @inheritParams param_plotSettings +#' @inheritParams param_three_dots_plot +#' +#' @details +#' Generic function to plot all kinds of datasets. +#' +#' @template return_object_ggplot +#' +#' @examples +#' # Plot a dataset of means +#' dataExample <- getDataset( +#' n1 = c(22, 11, 22, 11), +#' n2 = c(22, 13, 22, 13), +#' means1 = c(1, 1.1, 1, 1), +#' means2 = c(1.4, 1.5, 3, 2.5), +#' stDevs1 = c(1, 2, 2, 1.3), +#' stDevs2 = c(1, 2, 2, 1.3) +#' ) +#' \dontrun{ +#' if (require(ggplot2)) plot(dataExample, main = "Comparison of Means") +#' } +#' +#' # Plot a dataset of rates +#' dataExample <- getDataset( +#' n1 = c(8, 10, 9, 11), +#' n2 = c(11, 13, 12, 13), +#' events1 = c(3, 5, 5, 6), +#' events2 = c(8, 10, 12, 12) +#' ) +#' \dontrun{ +#' if (require(ggplot2)) plot(dataExample, main = "Comparison of Rates") +#' } +#' +#' @export +#' +plot.DatasetR6 <- function(x, y, ..., main = "Dataset", xlab = "Stage", ylab = NA_character_, + legendTitle = "Group", palette = "Set1", showSource = FALSE, plotSettings = NULL) { + if (x$.enrichmentEnabled) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "plot of enrichment data is not implemented yet") + } + + .assertGgplotIsInstalled() + + if (x$isDatasetMeans()) { + data <- x$getRandomData() + if (is.na(ylab)) { + ylab <- "Random data" + } + } else if (x$isDatasetRates()) { + data <- x$.data + if (is.na(ylab)) { + ylab <- "Frequency (Events and Sample Size)" + } + } else if (x$isDatasetSurvival()) { + # Open work: implement dataset plot of survival data + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "plot of survival data is not implemented yet") + } + + if (!is.logical(showSource) || isTRUE(showSource)) { + warning("'showSource' != FALSE is not implemented yet for class ", .getClassName(x)) + } + + if (is.null(plotSettings)) { + plotSettings <- x$getPlotSettings() + } + + if (x$getNumberOfGroups() == 1) { + if (x$isDatasetMeans()) { + p <- ggplot2::ggplot( + data = data, + ggplot2::aes(y = .data[["randomData"]], x = factor(.data[["stage"]])) + ) + p <- p + ggplot2::geom_boxplot(ggplot2::aes(fill = .data[["stage"]])) + p <- p + ggplot2::geom_point( + colour = "#0e414e", shape = 20, + position = ggplot2::position_jitter(width = .1), + size = plotSettings$pointSize + ) + p <- p + ggplot2::stat_summary( + fun = "mean", geom = "point", + shape = 21, position = ggplot2::position_dodge(.75), size = 4, fill = "white", + colour = "black", show.legend = FALSE + ) + } else if (x$isDatasetRates()) { + p <- ggplot2::ggplot(show.legend = FALSE) + + # plot sample size + p <- p + ggplot2::geom_bar( + data = data, + ggplot2::aes( + y = .data[["sampleSize"]], + x = factor(.data[["stage"]]), fill = factor(.data[["stage"]]) + ), + position = "dodge", stat = "identity", alpha = 0.4 + ) + + # plot events + p <- p + ggplot2::geom_bar( + data = data, + ggplot2::aes( + y = .data[["event"]], x = factor(.data[["stage"]]), + fill = factor(.data[["stage"]]) + ), + position = "dodge", stat = "identity" + ) + } else if (x$isDatasetSurvival()) { + # implement survival plot here + } + } else { + data$stageGroup <- interaction(data$stage, data$group) + + if (x$isDatasetMeans()) { + p <- ggplot2::ggplot(ggplot2::aes( + y = .data[["randomData"]], x = factor(.data[["stage"]]), + fill = factor(.data[["group"]]) + ), data = data) + p <- p + ggplot2::geom_point(ggplot2::aes(colour = .data[["group"]]), + shape = 20, + position = ggplot2::position_dodge(.75), + size = plotSettings$pointSize + ) + p <- p + ggplot2::geom_boxplot() + p <- p + ggplot2::stat_summary(ggplot2::aes(colour = .data[["group"]]), + fun = "mean", geom = "point", + shape = 21, position = ggplot2::position_dodge(.75), size = 4, fill = "white", + show.legend = FALSE + ) + } else if (x$isDatasetRates()) { + p <- ggplot2::ggplot(show.legend = FALSE) + + # plot sample size + p <- p + ggplot2::geom_bar( + ggplot2::aes( + y = .data[["sampleSize"]], + x = factor(.data[["stage"]]), fill = factor(.data[["group"]]) + ), + data = data, position = "dodge", stat = "identity", alpha = 0.4 + ) + + # plot events + p <- p + ggplot2::geom_bar( + data = data, + ggplot2::aes( + y = .data[["event"]], x = factor(.data[["stage"]]), + fill = factor(.data[["group"]]) + ), + position = "dodge", stat = "identity" + ) + } else if (x$isDatasetSurvival()) { + # implement survival plot here + } + } + + # hide second legend + if (x$getNumberOfGroups() == 1) { + p <- p + ggplot2::guides(fill = FALSE, colour = FALSE) + } else { + p <- p + ggplot2::guides(colour = FALSE) + } + + # set theme + p <- plotSettings$setTheme(p) + # p <- designSet$getPlotSettings()$hideGridLines(p) + + # set main title + p <- plotSettings$setMainTitle(p, main) + + # set axes labels + p <- plotSettings$setAxesLabels(p, xlab = xlab, ylab = ylab) + + # set legend + if (x$getNumberOfGroups() > 1) { + p <- plotSettings$setLegendPosition(p, legendPosition = C_POSITION_OUTSIDE_PLOT) + p <- plotSettings$setLegendBorder(p) + p <- plotSettings$setLegendTitle(p, legendTitle, mode = "fill") + p <- plotSettings$setLegendLabelSize(p) + } + + p <- plotSettings$setAxesAppearance(p) + p <- plotSettings$setColorPalette(p, palette, mode = "all") + p <- plotSettings$enlargeAxisTicks(p) + + companyAnnotationEnabled <- .getOptionalArgument("companyAnnotationEnabled", ...) + if (is.null(companyAnnotationEnabled) || !is.logical(companyAnnotationEnabled)) { + companyAnnotationEnabled <- FALSE + } + p <- plotSettings$addCompanyAnnotation(p, enabled = companyAnnotationEnabled) + + p +} + +#' +#' @name DatasetRates +#' +#' @title +#' Dataset of Rates +#' +#' @description +#' Class for a dataset of rates. +#' +#' @template field_groups +#' @template field_stages +#' @template field_sampleSizes +#' @template field_overallSampleSizes +#' @template field_events +#' @template field_overallEvents +#' +#' @details +#' This object cannot be created directly; better use \code{\link{getDataset}} +#' with suitable arguments to create a dataset of rates. +#' +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include f_core_constants.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +DatasetRatesR6 <- R6Class("DatasetRatesR6", + inherit = DatasetR6, + public = list( + sampleSizes = NULL, + events = NULL, + overallSampleSizes = NULL, + overallEvents = NULL, + getSampleSize = function(stage, group = 1, subset = NA_character_) { + return(self$.data$sampleSize[self$.getIndices(stage = stage, group = group, subset = subset)]) + }, + getSampleSizes = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { + return(self$.data$sampleSize[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) + }, + getSampleSizesUpTo = function(to, group = 1, subset = NA_character_) { + return(self$.data$sampleSize[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) + }, + getEvent = function(stage, group = 1, subset = NA_character_) { + return(self$.data$event[self$.getIndices(stage = stage, group = group, subset = subset)]) + }, + getEvents = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { + return(self$.data$event[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) + }, + getEventsUpTo = function(to, group = 1, subset = NA_character_) { + return(self$.data$event[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) + }, + getOverallSampleSize = function(stage, group = 1, subset = NA_character_) { + return(self$.data$overallSampleSize[self$.getIndices(stage = stage, group = group, subset = subset)]) + }, + getOverallSampleSizes = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { + return(self$.data$overallSampleSize[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) + }, + getOverallSampleSizesUpTo = function(to, group = 1, subset = NA_character_) { + return(self$.data$overallSampleSize[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) + }, + getOverallEvent = function(stage, group = 1, subset = NA_character_) { + return(self$.data$overallEvent[self$.getIndices(stage = stage, group = group, subset = subset)]) + }, + getOverallEvents = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { + return(self$.data$overallEvent[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) + }, + getOverallEventsUpTo = function(to, group = 1, subset = NA_character_) { + return(self$.data$overallEvent[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) + }, + .initByDataFrame = function(dataFrame) { + super$.initByDataFrame(dataFrame) + + # case: one rate - stage wise + if (self$.paramExists(dataFrame, C_KEY_WORDS_SAMPLE_SIZES)) { + self$.inputType <- "stagewise" + + self$sampleSizes <- self$.getValidatedFloatingPointNumbers( + self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_SAMPLE_SIZES), + parameterName = "Sample sizes" + ) + self$.validateValues(self$sampleSizes, "n") + if (any(stats::na.omit(self$sampleSizes) <= 0)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "all sample sizes must be > 0, but 'n' = ", + self$.arrayToString(self$sampleSizes, vectorLookAndFeelEnabled = TRUE) + ) + } + + self$events <- self$.getValidatedFloatingPointNumbers( + self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_EVENTS), + parameterName = "Events" + ) + self$.validateValues(self$events, "events") + if (any(stats::na.omit(self$events) < 0)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all events must be >= 0, but 'events' = ", + self$.arrayToString(self$events, vectorLookAndFeelEnabled = TRUE) + ) + } + + kMax <- length(self$sampleSizes) + stageNumber <- length(stats::na.omit(self$sampleSizes)) + dataInput <- data.frame( + sampleSizes = self$sampleSizes, + events = self$events + ) + dataInput <- self$.getOverallData(dataInput, kMax, stage = stageNumber) + self$overallSampleSizes <- dataInput$overallSampleSizes + self$overallEvents <- dataInput$overallEvents + + self$.setParameterType("sampleSizes", C_PARAM_USER_DEFINED) + self$.setParameterType("events", C_PARAM_USER_DEFINED) + + self$.setParameterType("overallSampleSizes", C_PARAM_GENERATED) + self$.setParameterType("overallEvents", C_PARAM_GENERATED) + } + + # case: one rate - overall + else if (self$.paramExists(dataFrame, C_KEY_WORDS_OVERALL_SAMPLE_SIZES)) { + self$.inputType <- "overall" + self$overallSampleSizes <- self$.getValidatedFloatingPointNumbers( + self$.getValuesByParameterName( + dataFrame, + C_KEY_WORDS_OVERALL_SAMPLE_SIZES + ), + parameterName = "Cumulative sample sizes" + ) + self$.validateValues(self$overallSampleSizes, "overallSampleSizes") + .assertValuesAreStrictlyIncreasing(self$overallSampleSizes, "overallSampleSizes", endingNasAllowed = TRUE) + + self$overallEvents <- self$.getValidatedFloatingPointNumbers( + self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_EVENTS), + parameterName = "Cumulative events" + ) + self$.validateValues(self$overallEvents, "overallEvents") + .assertValuesAreMonotoneIncreasing(self$overallEvents, "overallEvents", endingNasAllowed = TRUE) + + kMax <- length(self$overallSampleSizes) + stageNumber <- length(stats::na.omit(self$overallSampleSizes)) + stageWiseData <- self$.getStageWiseData(data.frame( + overallSampleSizes = self$overallSampleSizes, + overallEvents = self$overallEvents + ), kMax, stage = stageNumber) + self$sampleSizes <- stageWiseData$sampleSizes + self$events <- stageWiseData$events + + self$.setParameterType("sampleSizes", C_PARAM_GENERATED) + self$.setParameterType("events", C_PARAM_GENERATED) + + self$.setParameterType("overallSampleSizes", C_PARAM_USER_DEFINED) + self$.setParameterType("overallEvents", C_PARAM_USER_DEFINED) + } + + # case: two or more rates - stage wise + else if (self$.paramExists(dataFrame, paste0(C_KEY_WORDS_SAMPLE_SIZES, 1)) && + self$.paramExists(dataFrame, paste0(C_KEY_WORDS_SAMPLE_SIZES, 2))) { + self$.inputType <- "stagewise" + + numberOfTreatmentGroups <- self$.getNumberOfGroups(dataFrame, C_KEY_WORDS_SAMPLE_SIZES) + + self$stages <- rep(self$stages, numberOfTreatmentGroups) + + self$groups <- integer(0) + self$sampleSizes <- numeric(0) + self$events <- numeric(0) + self$overallSampleSizes <- numeric(0) + self$overallEvents <- numeric(0) + for (group in 1:numberOfTreatmentGroups) { + sampleSizesTemp <- self$.getValidatedFloatingPointNumbers( + self$.getValuesByParameterName( + dataFrame, C_KEY_WORDS_SAMPLE_SIZES, + suffix = group + ), + parameterName = "Sample sizes" + ) + self$.validateValues(sampleSizesTemp, paste0("n", group)) + if (any(stats::na.omit(sampleSizesTemp) <= 0)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "all sample sizes must be > 0, but 'n", group, "' = ", + self$.arrayToString(sampleSizesTemp, vectorLookAndFeelEnabled = TRUE) + ) + } + self$sampleSizes <- c(self$sampleSizes, sampleSizesTemp) + + eventsTemp <- self$.getValidatedFloatingPointNumbers( + self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_EVENTS, suffix = group), + parameterName = "Events" + ) + self$.validateValues(eventsTemp, paste0("events", group)) + if (any(stats::na.omit(eventsTemp) < 0)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all events must be >= 0, but 'events", group, "' = ", + self$.arrayToString(eventsTemp, vectorLookAndFeelEnabled = TRUE) + ) + } + self$events <- c(self$events, eventsTemp) + + self$groups <- c(self$groups, rep(as.integer(group), length(sampleSizesTemp))) + + kMax <- length(sampleSizesTemp) + numberOfValidStages <- length(stats::na.omit(sampleSizesTemp)) + overallData <- self$.getOverallData(data.frame( + sampleSizes = sampleSizesTemp, + events = eventsTemp + ), kMax, stage = numberOfValidStages) + + self$overallSampleSizes <- c(self$overallSampleSizes, overallData$overallSampleSizes) + self$overallEvents <- c(self$overallEvents, overallData$overallEvents) + } + if (sum(stats::na.omit(self$sampleSizes) < 0) > 0) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all sample sizes must be >= 0") + } + + self$.setParameterType("sampleSizes", C_PARAM_USER_DEFINED) + self$.setParameterType("events", C_PARAM_USER_DEFINED) + + self$.setParameterType("overallSampleSizes", C_PARAM_GENERATED) + self$.setParameterType("overallEvents", C_PARAM_GENERATED) + } + + # case: two or more rates - overall + else if (self$.paramExists(dataFrame, paste0(C_KEY_WORDS_OVERALL_SAMPLE_SIZES, 1)) && + self$.paramExists(dataFrame, paste0(C_KEY_WORDS_OVERALL_SAMPLE_SIZES, 2))) { + self$.inputType <- "overall" + + numberOfTreatmentGroups <- self$.getNumberOfGroups(dataFrame, C_KEY_WORDS_OVERALL_SAMPLE_SIZES) + + self$stages <- rep(self$stages, numberOfTreatmentGroups) + + self$groups <- integer(0) + self$sampleSizes <- numeric(0) + self$events <- numeric(0) + self$overallSampleSizes <- numeric(0) + self$overallEvents <- numeric(0) + for (group in 1:numberOfTreatmentGroups) { + overallSampleSizesTemp <- self$.getValidatedFloatingPointNumbers( + self$.getValuesByParameterName( + dataFrame, C_KEY_WORDS_OVERALL_SAMPLE_SIZES, + suffix = group + ), + parameterName = "Cumulative sample sizes" + ) + self$.validateValues(overallSampleSizesTemp, paste0("overallSampleSizes", group)) + .assertValuesAreStrictlyIncreasing(overallSampleSizesTemp, + paste0("overallSampleSizes", group), + endingNasAllowed = TRUE + ) + self$overallSampleSizes <- c(self$overallSampleSizes, overallSampleSizesTemp) + + overallEventsTemp <- self$.getValidatedFloatingPointNumbers( + self$.getValuesByParameterName(dataFrame, + C_KEY_WORDS_OVERALL_EVENTS, + suffix = group + ), + parameterName = "Cumulative events" + ) + self$.validateValues(overallEventsTemp, paste0("overallEvents", group)) + .assertValuesAreMonotoneIncreasing(overallEventsTemp, + paste0("overallEvents", group), + endingNasAllowed = TRUE + ) + self$overallEvents <- c(self$overallEvents, overallEventsTemp) + + self$groups <- c(self$groups, rep(as.integer(group), length(overallSampleSizesTemp))) + + kMax <- length(overallSampleSizesTemp) + numberOfValidStages <- length(stats::na.omit(overallSampleSizesTemp)) + stageWiseData <- self$.getStageWiseData(data.frame( + overallSampleSizes = overallSampleSizesTemp, + overallEvents = overallEventsTemp + ), kMax, stage = numberOfValidStages) + + validatedSampleSizes <- stageWiseData$sampleSizes + self$.validateValues(validatedSampleSizes, paste0("n", group)) + self$sampleSizes <- c(self$sampleSizes, validatedSampleSizes) + self$events <- c(self$events, stageWiseData$events) + + if (sum(stats::na.omit(self$sampleSizes) < 0) > 0) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all sample sizes must be >= 0") + } + } + + self$.setParameterType("sampleSizes", C_PARAM_GENERATED) + self$.setParameterType("events", C_PARAM_GENERATED) + + self$.setParameterType("overallSampleSizes", C_PARAM_USER_DEFINED) + self$.setParameterType("overallEvents", C_PARAM_USER_DEFINED) + } else { + stop( + C_EXCEPTION_TYPE_MISSING_ARGUMENT, + "sample sizes are missing or not correctly specified" + ) + } + + if (sum(stats::na.omit(self$events) < 0) > 0) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all events must be >= 0") + } + + self$.recreateDataFrame() + if (self$.enrichmentEnabled) { + self$.createOverallDataEnrichment() + } + }, + .recreateDataFrame = function() { + super$.recreateDataFrame() + self$.data <- cbind(self$.data, data.frame( + sampleSize = self$sampleSizes, + event = self$events, + overallSampleSize = self$overallSampleSizes, + overallEvent = self$overallEvents + )) + self$.orderDataByStageAndGroup() + self$.setDataToVariables() + }, + .setDataToVariables = function() { + super$.setDataToVariables() + self$sampleSizes <- self$.data$sampleSize + self$events <- self$.data$event + self$overallSampleSizes <- self$.data$overallSampleSize + self$overallEvents <- self$.data$overallEvent + }, + .fillWithNAs = function(kMax) { + super$.fillWithNAs(kMax) + n <- self$.getNumberOfNAsToAdd(kMax) + + self$sampleSizes <- c(self$sampleSizes, rep(NA_real_, n)) + self$events <- c(self$events, rep(NA_real_, n)) + + self$overallSampleSizes <- c(self$overallSampleSizes, rep(NA_real_, n)) + self$overallEvents <- c(self$overallEvents, rep(NA_real_, n)) + + self$.recreateDataFrame() + }, + .trim = function(kMax = NA_integer_) { + indices <- super$.trim(kMax) + if (length(indices) == 0) { + return(invisible(FALSE)) + } + + self$sampleSizes <- self$sampleSizes[indices] + self$events <- self$events[indices] + + self$overallSampleSizes <- self$overallSampleSizes[indices] + self$overallEvents <- self$overallEvents[indices] + + self$.recreateDataFrame() + + return(invisible(TRUE)) + }, + getRandomData = function() { + data <- NULL + for (stage in 1:self$getNumberOfStages()) { + for (group in 1:self$getNumberOfGroups()) { + if (self$.enrichmentEnabled) { + for (subset in levels(self$.data$subset)) { + n <- self$getSampleSize(stage = stage, group = group, subset = subset) + numberOfEvents <- self$getEvent(stage = stage, group = group, subset = subset) + randomIndices <- sample(x = c(1:n), size = numberOfEvents, replace = FALSE) + randomData <- rep(0, n) + randomData[randomIndices] <- 1#TODO indices -> indizes + + row <- data.frame( + stage = stage, + group = group, + subset = subset, + randomData = randomData + ) + if (is.null(data)) { + data <- row + } else { + data <- rbind(data, row) + } + } + } else { + n <- self$getSampleSize(stage = stage, group = group) + numberOfEvents <- self$getEvent(stage = stage, group = group) + randomIndices <- sample(x = c(1:n), size = numberOfEvents, replace = FALSE) + randomData <- rep(0, n) + randomData[randomIndices] <- 1 + + row <- data.frame( + stage = stage, + group = group, + randomData = randomData + ) + if (is.null(data)) { + data <- row + } else { + data <- rbind(data, row) + } + } + } + } + data$stage <- factor(data$stage) + data$group <- factor(data$group, label = paste("Group", c(1:self$getNumberOfGroups()))) + return(data) + }, + .createOverallDataEnrichment = function() { + if (!self$.enrichmentEnabled) { + return(invisible()) + } + + self$.data$overallSampleSize <- rep(NA_real_, nrow(self$.data)) + self$.data$overallEvent <- rep(NA_real_, nrow(self$.data)) + for (s in levels(self$.data$subset)) { + for (g in levels(self$.data$group)) { + indices <- which(self$.data$subset == s & self$.data$group == g) + self$.data$overallSampleSize[indices] <- cumsum(self$.data$sampleSize[indices]) + self$.data$overallEvent[indices] <- cumsum(self$.data$event[indices]) + } + } + + self$.setDataToVariables() + }, + .getOverallData = function(dataInput, kMax, stage) { + "Calculates cumulative values if stage-wise data is available" + if (is.null(dataInput[["sampleSizes"]])) { + stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "data input must contain variable 'sampleSizes'") + } + if (is.null(dataInput[["events"]])) { + stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "data input must contain variable 'events'") + } + + dataInput$overallSampleSizes <- c( + cumsum(dataInput$sampleSizes[1:stage]), + rep(NA_real_, kMax - stage) + ) + + dataInput$overallEvents <- c( + cumsum(dataInput$events[1:stage]), + rep(NA_real_, kMax - stage) + ) + + return(dataInput) + }, + .getStageWiseData = function(dataInput, kMax, stage) { + "Calculates stage-wise values if cumulative data is available" + if (is.null(dataInput[["overallSampleSizes"]])) { + stop( + C_EXCEPTION_TYPE_MISSING_ARGUMENT, + "data input must contain variable 'overallSampleSizes'" + ) + } + if (is.null(dataInput[["overallEvents"]])) { + stop( + C_EXCEPTION_TYPE_MISSING_ARGUMENT, + "data input must contain variable 'overallEvents'" + ) + } + + dataInput$sampleSizes <- c(dataInput$overallSampleSizes[1:stage], rep(NA_real_, kMax - stage)) + if (stage > 1) { + dataInput$sampleSizes[2:stage] <- dataInput$overallSampleSizes[2:stage] - + dataInput$overallSampleSizes[1:(stage - 1)] + } + + dataInput$events <- c(dataInput$overallEvents[1:stage], rep(NA_real_, kMax - stage)) + if (stage > 1) { + dataInput$events[2:stage] <- dataInput$overallEvents[2:stage] - + dataInput$overallEvents[1:(stage - 1)] + } + + return(dataInput) + } + ) +) + +#' +#' @name DatasetSurvival +#' +#' @title +#' Dataset of Survival Data +#' +#' @description +#' Class for a dataset of survival data. +#' +#' @template field_groups +#' @template field_stages +#' @template field_events +#' @template field_overallEvents +#' @template field_allocationRatios +#' @template field_overallAllocationRatios +#' @template field_logRanks +#' @template field_overallLogRanks +#' +#' +#' @details +#' This object cannot be created directly; better use \code{\link{getDataset}} +#' with suitable arguments to create a dataset of survival data. +#' +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include f_core_constants.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +DatasetSurvivalR6 <- R6Class("DatasetSurvivalR6", + inherit = DatasetR6, + public = list( + overallEvents = NULL, + overallAllocationRatios = NULL, + overallLogRanks = NULL, + events = NULL, + allocationRatios = NULL, + logRanks = NULL, + getEvent = function(stage, group = 1, subset = NA_character_) { + return(self$.data$event[self$.getIndices(stage = stage, group = group, subset = subset)]) + }, + getEvents = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { + return(self$.data$event[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) + }, + getEventsUpTo = function(to, group = 1, subset = NA_character_) { + return(self$.data$event[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) + }, + getAllocationRatio = function(stage, group = 1, subset = NA_character_) { + return(self$.data$allocationRatio[self$.getIndices(stage = stage, group = group, subset = subset)]) + }, + getAllocationRatios = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { + return(self$.data$allocationRatio[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) + }, + getAllocationRatiosUpTo = function(to, group = 1, subset = NA_character_) { + return(self$.data$allocationRatio[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) + }, + getLogRank = function(stage, group = 1, subset = NA_character_) { + return(self$.data$logRank[self$.getIndices(stage = stage, group = group, subset = subset)]) + }, + getLogRanks = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { + return(self$.data$logRank[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) + }, + getLogRanksUpTo = function(to, group = 1, subset = NA_character_) { + return(self$.data$logRank[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) + }, + getOverallEvent = function(stage, group = 1, subset = NA_character_) { + return(self$.data$overallEvent[self$.getIndices(stage = stage, group = group, subset = subset)]) + }, + getOverallEvents = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { + return(self$.data$overallEvent[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) + }, + getOverallEventsUpTo = function(to, group = 1, subset = NA_character_) { + return(self$.data$overallEvent[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) + }, + getOverallAllocationRatio = function(stage, group = 1, subset = NA_character_) { + return(self$.data$overallAllocationRatio[self$.getIndices(stage = stage, group = group, subset = subset)]) + }, + getOverallAllocationRatios = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { + return(self$.data$overallAllocationRatio[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) + }, + getOverallAllocationRatiosUpTo = function(to, group = 1, subset = NA_character_) { + return(self$.data$overallAllocationRatio[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) + }, + getOverallLogRank = function(stage, group = 1, subset = NA_character_) { + return(self$.data$overallLogRank[self$.getIndices(stage = stage, group = group, subset = subset)]) + }, + getOverallLogRanks = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { + return(self$.data$overallLogRank[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) + }, + getOverallLogRanksUpTo = function(to, group = 1, subset = NA_character_) { + return(self$.data$overallLogRank[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) + }, + .getAllocationRatioDefaultValues = function(stages, events, logRanks) { + allocationRatioDefaultValues <- rep(C_ALLOCATION_RATIO_DEFAULT, length(stages)) + indices <- which(is.na(events) | is.na(logRanks)) + allocationRatioDefaultValues[indices] <- NA_real_ + return(allocationRatioDefaultValues) + }, + .initByDataFrame = function(dataFrame) { + super$.initByDataFrame(dataFrame) + + if (inherits(self, "DatasetEnrichmentSurvivalR6")) { + if (self$.paramExists(dataFrame, C_KEY_WORDS_EXPECTED_EVENTS) || + self$.paramExists(dataFrame, C_KEY_WORDS_VARIANCE_EVENTS)) { + self$.inputType <- "stagewise" + + self$events <- self$.getValidatedFloatingPointNumbers( + self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_EVENTS), + parameterName = "Events" + ) + self$.validateValues(self$events, "events") + + self$allocationRatios <- self$.getValuesByParameterName( + dataFrame, C_KEY_WORDS_ALLOCATION_RATIOS, + defaultValues = .getAllocationRatioDefaultValues(self$stages, self$events, self$expectedEvents) + ) + self$.validateValues(self$allocationRatios, "allocationRatios") + } else if (self$.paramExists(dataFrame, C_KEY_WORDS_OVERALL_EXPECTED_EVENTS) || + self$.paramExists(dataFrame, C_KEY_WORDS_OVERALL_VARIANCE_EVENTS)) { + self$.inputType <- "overall" + + self$overallEvents <- self$.getValidatedFloatingPointNumbers( + self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_EVENTS), + parameterName = "Cumulative events" + ) + self$.validateValues(self$overallEvents, "overallEvents") + + self$overallAllocationRatios <- self$.getValuesByParameterName( + dataFrame, + parameterNameVariants = C_KEY_WORDS_OVERALL_ALLOCATION_RATIOS, + defaultValues = self$.getAllocationRatioDefaultValues(self$stages, self$overallEvents, self$overallExpectedEvents) + ) + self$.validateValues(self$overallAllocationRatios, "overallAllocationRatios") + } + + # stratified enrichment: do nothing more here + } + + # case: survival, two groups - overall + else if (self$.paramExists(dataFrame, C_KEY_WORDS_OVERALL_LOG_RANKS)) { + self$.inputType <- "overall" + self$overallEvents <- self$.getValidatedFloatingPointNumbers( + self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_EVENTS), + parameterName = "Cumulative events" + ) + self$.validateValues(self$overallEvents, "overallEvents") + if (!self$.enrichmentEnabled) { + .assertValuesAreStrictlyIncreasing(self$overallEvents, "overallEvents", endingNasAllowed = TRUE) + } + + self$overallLogRanks <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_LOG_RANKS) + self$.validateValues(self$overallLogRanks, "overallLogRanks") + + self$overallAllocationRatios <- self$.getValuesByParameterName( + dataFrame, + parameterNameVariants = C_KEY_WORDS_OVERALL_ALLOCATION_RATIOS, + defaultValues = self$.getAllocationRatioDefaultValues(self$stages, self$overallEvents, self$overallLogRanks) + ) + self$.validateValues(self$overallAllocationRatios, "overallAllocationRatios") + + self$.setParameterType("groups", C_PARAM_NOT_APPLICABLE) + } + + # case: survival, two groups - stage wise + else if (self$.paramExists(dataFrame, C_KEY_WORDS_LOG_RANKS)) { + self$.inputType <- "stagewise" + self$events <- self$.getValidatedFloatingPointNumbers(self$.getValuesByParameterName( + dataFrame, C_KEY_WORDS_EVENTS + ), parameterName = "Events") + self$.validateValues(self$events, "events") + if (any(stats::na.omit(self$events) < 0)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all events must be >= 0") + } + + self$logRanks <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_LOG_RANKS) + self$.validateValues(self$logRanks, "logRanks") + + self$allocationRatios <- self$.getValuesByParameterName( + dataFrame, C_KEY_WORDS_ALLOCATION_RATIOS, + defaultValues = self$.getAllocationRatioDefaultValues(self$stages, self$events, self$logRanks) + ) + self$.validateValues(self$allocationRatios, "allocationRatios") + + self$.setParameterType("groups", C_PARAM_NOT_APPLICABLE) + } + + # case: survival, three ore more groups - overall + else if (self$.paramExists(dataFrame, paste0(C_KEY_WORDS_OVERALL_LOG_RANKS, 1)) && + self$.paramExists(dataFrame, paste0(C_KEY_WORDS_OVERALL_LOG_RANKS, 2))) { + self$.inputType <- "overall" + + numberOfTreatmentGroups <- self$.getNumberOfGroups(dataFrame, C_KEY_WORDS_OVERALL_LOG_RANKS) + + self$stages <- rep(self$stages, numberOfTreatmentGroups) + + self$groups <- integer(0) + self$overallEvents <- numeric(0) + self$overallAllocationRatios <- numeric(0) + self$overallLogRanks <- numeric(0) + for (group in 1:numberOfTreatmentGroups) { + overallEventsTemp <- self$.getValuesByParameterName(dataFrame, + C_KEY_WORDS_OVERALL_EVENTS, + suffix = group + ) + self$.validateValues(overallEventsTemp, paste0("overallEvents", group)) + if (is.null(dataFrame[["subset"]]) || length(unique(dataFrame[["subset"]])) <= 1) { + .assertValuesAreStrictlyIncreasing(overallEventsTemp, + paste0("overallEvents", group), + endingNasAllowed = TRUE + ) + } + self$overallEvents <- c(self$overallEvents, overallEventsTemp) + + overallLogRanksTemp <- self$.getValuesByParameterName( + dataFrame, C_KEY_WORDS_OVERALL_LOG_RANKS, + suffix = group + ) + self$.validateValues(overallLogRanksTemp, paste0("overallLogRanks", group)) + self$overallLogRanks <- c(self$overallLogRanks, overallLogRanksTemp) + + overallAllocationRatiosTemp <- self$.getValuesByParameterName( + dataFrame, C_KEY_WORDS_OVERALL_ALLOCATION_RATIOS, + suffix = group, + defaultValues = self$.getAllocationRatioDefaultValues( + overallEventsTemp, + overallEventsTemp, overallLogRanksTemp + ) + ) + self$.validateValues(overallAllocationRatiosTemp, paste0("overallAllocationRatios", group)) + self$overallAllocationRatios <- c(self$overallAllocationRatios, overallAllocationRatiosTemp) + + self$groups <- c(self$groups, rep(as.integer(group), length(overallLogRanksTemp))) + } + } + + # case: survival, three ore more groups - stage wise + else if (self$.paramExists(dataFrame, paste0(C_KEY_WORDS_LOG_RANKS, 1)) && + self$.paramExists(dataFrame, paste0(C_KEY_WORDS_LOG_RANKS, 2))) { + self$.inputType <- "stagewise" + numberOfTreatmentGroups <- self$.getNumberOfGroups(dataFrame, C_KEY_WORDS_LOG_RANKS) + + self$stages <- rep(self$stages, numberOfTreatmentGroups) + + self$groups <- integer(0) + self$events <- numeric(0) + self$allocationRatios <- numeric(0) + self$logRanks <- numeric(0) + for (group in 1:numberOfTreatmentGroups) { + eventsTemp <- self$.getValidatedFloatingPointNumbers(self$.getValuesByParameterName( + dataFrame, C_KEY_WORDS_EVENTS, + suffix = group + ), parameterName = "Events") + if (any(stats::na.omit(eventsTemp) < 0)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all events must be >= 0, but 'events", group, "' = ", + self$.arrayToString(eventsTemp, vectorLookAndFeelEnabled = TRUE) + ) + } + self$events <- c(self$events, eventsTemp) + + logRanksTemp <- self$.getValuesByParameterName( + dataFrame, C_KEY_WORDS_LOG_RANKS, + suffix = group + ) + self$.validateValues(logRanksTemp, paste0("n", group)) + self$logRanks <- c(self$logRanks, logRanksTemp) + + allocationRatiosTemp <- self$.getValuesByParameterName( + dataFrame, C_KEY_WORDS_ALLOCATION_RATIOS, + suffix = group, + defaultValues = self$.getAllocationRatioDefaultValues( + eventsTemp, + eventsTemp, logRanksTemp + ) + ) + self$.validateValues(allocationRatiosTemp, paste0("allocationRatios", group)) + self$allocationRatios <- c(self$allocationRatios, allocationRatiosTemp) + + self$groups <- c(self$groups, rep(as.integer(group), length(eventsTemp))) + } + } else { + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, "unable to identify case for ", .getClassName(self), " and columns ", + self$.arrayToString(colnames(dataFrame)) + ) + } + + if (self$.inputType == "stagewise") { + n <- length(self$events) + self$overallEvents <- rep(NA_real_, n) + self$overallAllocationRatios <- rep(NA_real_, n) + self$overallLogRanks <- rep(NA_real_, n) + + self$.setParameterType("events", C_PARAM_USER_DEFINED) + self$.setParameterType("allocationRatios", C_PARAM_USER_DEFINED) + if (!inherits(self, "DatasetEnrichmentSurvivalR6")) { + self$.setParameterType("logRanks", C_PARAM_USER_DEFINED) + } + + self$.setParameterType("overallEvents", C_PARAM_GENERATED) + self$.setParameterType("overallAllocationRatios", C_PARAM_GENERATED) + if (!inherits(self, "DatasetEnrichmentSurvivalR6")) { + self$.setParameterType("overallLogRanks", C_PARAM_GENERATED) + } + + if (!inherits(self, "DatasetEnrichmentSurvivalR6")) { + self$.recreateDataFrame() + self$.createOverallData() + } + } else { + n <- length(self$overallEvents) + self$events <- rep(NA_real_, n) + self$allocationRatios <- rep(NA_real_, n) + self$logRanks <- rep(NA_real_, n) + + self$.setParameterType("events", C_PARAM_GENERATED) + self$.setParameterType("allocationRatios", C_PARAM_GENERATED) + if (!inherits(self, "DatasetEnrichmentSurvivalR6")) { + self$.setParameterType("logRanks", C_PARAM_GENERATED) + } + + self$.setParameterType("overallEvents", C_PARAM_USER_DEFINED) + self$.setParameterType("overallAllocationRatios", C_PARAM_USER_DEFINED) + if (!inherits(self, "DatasetEnrichmentSurvivalR6")) { + self$.setParameterType("overallLogRanks", C_PARAM_USER_DEFINED) + } + + if (!inherits(self, "DatasetEnrichmentSurvivalR6")) { + self$.recreateDataFrame() + self$.createStageWiseData() + } + } + }, + .recreateDataFrame = function() { + super$.recreateDataFrame() + + if (inherits(self, "DatasetEnrichmentSurvivalR6")) { + self$.data <- cbind(self$.data, data.frame( + overallEvent = self$overallEvents, + overallExpectedEvent = self$overallExpectedEvents, + overallVarianceEvent = self$overallVarianceEvents, + overallAllocationRatio = self$overallAllocationRatios, + event = self$events, + expectedEvent = self$expectedEvents, + # varianceEvent = varianceEvents, # maybe implemented later + allocationRatio = self$allocationRatios + )) + } else { + self$.data <- cbind(self$.data, data.frame( + overallEvent = self$overallEvents, + overallAllocationRatio = self$overallAllocationRatios, + overallLogRank = self$overallLogRanks, + event = self$events, + allocationRatio = self$allocationRatios, + logRank = self$logRanks + )) + } + self$.orderDataByStageAndGroup() + self$.setDataToVariables() + }, + .setDataToVariables = function() { + super$.setDataToVariables() + self$overallEvents <- self$.data$overallEvent + self$overallAllocationRatios <- self$.data$overallAllocationRatio + self$events <- self$.data$event + self$allocationRatios <- self$.data$allocationRatio + if (!inherits(self, "DatasetEnrichmentSurvivalR6")) { + self$overallLogRanks <- self$.data$overallLogRank + self$logRanks <- self$.data$logRank + } + }, + .fillWithNAs = function(kMax) { + super$.fillWithNAs(kMax) + n <- self$.getNumberOfNAsToAdd(kMax) + + self$overallEvents <- c(self$overallEvents, rep(NA_real_, n)) + self$overallAllocationRatios <- c(self$overallAllocationRatios, rep(NA_real_, n)) + self$overallLogRanks <- c(self$overallLogRanks, rep(NA_real_, n)) + + self$events <- c(self$events, rep(NA_real_, n)) + self$allocationRatios <- c(self$allocationRatios, rep(NA_real_, n)) + self$logRanks <- c(self$logRanks, rep(NA_real_, n)) + + self$.recreateDataFrame() + }, + .trim = function(kMax = NA_integer_) { + indices <- super$.trim(kMax) + if (length(indices) == 0) { + return(invisible(FALSE)) + } + + self$events <- self$events[indices] + self$allocationRatios <- self$allocationRatios[indices] + self$logRanks <- self$logRanks[indices] + + self$overallEvents <- self$overallEvents[indices] + self$overallAllocationRatios <- self$overallAllocationRatios[indices] + self$overallLogRanks <- self$overallLogRanks[indices] + + self$.recreateDataFrame() + + return(invisible(TRUE)) + }, + getRandomData = function() { + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, + "the function 'DatasetSurvival.getRandomData()' is not implemented yet" + ) + }, + .getOverallLogRanks = function(logRanks, events, overallEvents, + kMax = length(logRanks), stage = length(logRanks)) { + result <- c(logRanks[1:stage], rep(NA_real_, kMax - stage)) + if (stage == 1) { + return(result) + } + for (k in 2:stage) { + result[k] <- + (sqrt(events[k]) * logRanks[k] + + sqrt(overallEvents[k - 1]) * + result[k - 1]) / sqrt(overallEvents[k]) + } + return(result) + }, + .getOverallAllocationRatios = function(allocationRatios, events, overallEvents, + kMax = length(allocationRatios), stage = length(allocationRatios)) { + result <- c( + allocationRatios[1:stage], + rep(NA_real_, kMax - stage) + ) + if (stage == 1) { + return(result) + } + for (k in 2:stage) { + result[k] <- (events[k] * + allocationRatios[k] + overallEvents[k - 1] * + result[k - 1]) / overallEvents[k] + } + return(result) + }, + .createOverallData = function() { + self$.data$overallEvent <- rep(NA_real_, nrow(self$.data)) + if (inherits(self, "DatasetEnrichmentSurvivalR6")) { + self$.data$overallExpectedEvent <- rep(NA_real_, nrow(self$.data)) + self$.data$overallVarianceEvent <- rep(NA_real_, nrow(self$.data)) + } else { + self$.data$overallLogRank <- rep(NA_real_, nrow(self$.data)) + } + self$.data$overallAllocationRatio <- rep(NA_real_, nrow(self$.data)) + subsetLevels <- NA_character_ + if (self$.enrichmentEnabled) { + subsetLevels <- levels(self$.data$subset) + } + for (s in subsetLevels) { + for (g in levels(self$.data$group)) { + if (!is.na(s)) { + indices <- which(self$.data$subset == s & self$.data$group == g) + } else { + indices <- which(self$.data$group == g) + } + self$.data$overallEvent[indices] <- cumsum(self$.data$event[indices]) + self$.data$overallExpectedEvent[indices] <- cumsum(self$.data$expectedEvent[indices]) + # .data$overallVarianceEvent[indices] <<- # maybe implemented later + self$.data$overallLogRank[indices] <- self$.getOverallLogRanks( + self$.data$logRank[indices], self$.data$event[indices], self$.data$overallEvent[indices] + ) + self$.data$overallAllocationRatio[indices] <- self$.getOverallAllocationRatios( + self$.data$allocationRatio[indices], self$.data$event[indices], self$.data$overallEvent[indices] + ) + } + } + self$.setDataToVariables() + }, + .getStageWiseEvents = function(overallEvents) { + result <- overallEvents + if (length(result) == 1) { + return(result) + } + + kMax <- length(result) + result[2:kMax] <- overallEvents[2:kMax] - overallEvents[1:(kMax - 1)] + return(result) + }, + .getStageWiseLogRanks = function(overallLogRanks, overallEvents) { + result <- overallLogRanks + if (length(result) == 1) { + return(result) + } + + kMax <- length(result) + result[2:kMax] <- (sqrt(overallEvents[2:kMax]) * + overallLogRanks[2:kMax] - + sqrt(overallEvents[1:(kMax - 1)]) * + overallLogRanks[1:(kMax - 1)]) / + sqrt(overallEvents[2:kMax] - overallEvents[1:(kMax - 1)]) + return(result) + }, + .getStageWiseAllocationRatios = function(overallAllocationRatios, events, overallEvents) { + result <- overallAllocationRatios + if (length(result) == 1) { + return(result) + } + + kMax <- length(result) + result[2:kMax] <- ( + overallAllocationRatios[2:kMax] - + overallAllocationRatios[1:(kMax - 1)] * + overallEvents[1:(kMax - 1)] / overallEvents[2:kMax] + ) / (events[2:kMax] / overallEvents[2:kMax]) + if (any(stats::na.omit(result) <= 0)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "overall allocation ratios not correctly specified: ", + "one or more calculated stage-wise allocation ratios <= 0" + ) + } + return(result) + }, + .createStageWiseData = function() { + "Calculates stage-wise logrank statistics, events, and allocation ratios if cumulative data is available" + + self$.data$event <- rep(NA_real_, nrow(self$.data)) + if (inherits(self, "DatasetEnrichmentSurvivalR6")) { + self$.data$expectedEvent <- rep(NA_real_, nrow(self$.data)) + self$.data$varianceEvent <- rep(NA_real_, nrow(self$.data)) + } else { + self$.data$logRank <- rep(NA_real_, nrow(self$.data)) + } + self$.data$allocationRatio <- rep(NA_real_, nrow(self$.data)) + + subsetLevels <- NA_character_ + if (self$.enrichmentEnabled) { + subsetLevels <- levels(self$.data$subset) + } + + for (s in subsetLevels) { + for (g in levels(self$.data$group)) { + if (!is.na(s)) { + indices <- which(self$.data$subset == s & self$.data$group == g) + } else { + indices <- which(self$.data$group == g) + } + + groupNumber <- ifelse(levels(self$.data$group) > 1, g, "") + if (self$.enrichmentEnabled) { + .assertValuesAreStrictlyIncreasing(self$.data$overallEvent[indices], + paste0("overallEvents", groupNumber, "[subset == \"", s, "\"]"), + endingNasAllowed = TRUE + ) + } else { + .assertValuesAreStrictlyIncreasing(self$.data$overallEvent[indices], + paste0("overallEvents", groupNumber), + endingNasAllowed = TRUE + ) + } + + self$.data$event[indices] <- self$.getStageWiseEvents(self$.data$overallEvent[indices]) + if (inherits(self, "DatasetEnrichmentSurvivalR6")) { + self$.data$expectedEvent[indices] <- self$.getStageWiseEvents(self$.data$overallExpectedEvent[indices]) + # .data$varianceEvent[indices] <<- # maybe implemented later + } else { + self$.data$logRank[indices] <- self$.getStageWiseLogRanks( + self$.data$overallLogRank[indices], self$.data$overallEvent[indices] + ) + } + self$.data$allocationRatio[indices] <- self$.getStageWiseAllocationRatios( + self$.data$overallAllocationRatio[indices], + self$.data$event[indices], self$.data$overallEvent[indices] + ) + } + } + self$.setDataToVariables() + } + ) +) + +#' +#' @rdname DatasetSurvival +#' +#' @keywords internal +#' +DatasetEnrichmentSurvivalR6 <- R6Class("DatasetEnrichmentSurvivalR6", + inherit = DatasetSurvivalR6, + public = list( + expectedEvents = NULL, + varianceEvents = NULL, + overallExpectedEvents = NULL, + overallVarianceEvents = NULL, + .initByDataFrame = function(dataFrame) { + super$.initByDataFrame(dataFrame) + + if (self$.paramExists(dataFrame, C_KEY_WORDS_OVERALL_EXPECTED_EVENTS) || + self$.paramExists(dataFrame, C_KEY_WORDS_OVERALL_VARIANCE_EVENTS)) { + if (!self$.paramExists(dataFrame, C_KEY_WORDS_OVERALL_EXPECTED_EVENTS)) { + stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'overallExpectedEvents' is missing") + } + if (!self$.paramExists(dataFrame, C_KEY_WORDS_OVERALL_VARIANCE_EVENTS)) { + stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'overallVarianceEvents' is missing") + } + + self$.inputType <- "overall" + + self$overallEvents <- self$.getValidatedFloatingPointNumbers( + self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_EVENTS), + parameterName = "Cumulative events" + ) + self$.validateValues(self$overallEvents, "overallEvents") + + self$overallExpectedEvents <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_EXPECTED_EVENTS) + self$.validateValues(self$overallExpectedEvents, "overallExpectedEvents") + + self$overallVarianceEvents <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_VARIANCE_EVENTS) + self$.validateValues(self$overallVarianceEvents, "overallVarianceEvents") + + self$overallAllocationRatios <- self$.getValuesByParameterName( + dataFrame, + parameterNameVariants = C_KEY_WORDS_OVERALL_ALLOCATION_RATIOS, + defaultValues = self$.getAllocationRatioDefaultValues(self$stages, self$overallEvents, self$overallExpectedEvents) + ) + self$.validateValues(self$overallAllocationRatios, "overallAllocationRatios") + } else if (self$.paramExists(dataFrame, C_KEY_WORDS_EXPECTED_EVENTS) || + self$.paramExists(dataFrame, C_KEY_WORDS_VARIANCE_EVENTS)) { + if (!self$.paramExists(dataFrame, C_KEY_WORDS_EXPECTED_EVENTS)) { + stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'expectedEvents' is missing") + } + if (!self$.paramExists(dataFrame, C_KEY_WORDS_VARIANCE_EVENTS)) { + stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'varianceEvents' is missing") + } + + self$.inputType <- "stagewise" + + self$events <- self$.getValidatedFloatingPointNumbers( + self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_EVENTS), + parameterName = "Events" + ) + self$.validateValues(self$events, "events") + + self$expectedEvents <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_EXPECTED_EVENTS) + self$.validateValues(self$expectedEvents, "expectedEvents") + + self$varianceEvents <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_VARIANCE_EVENTS) + self$.validateValues(varianceEvents, "varianceEvents") + + self$allocationRatios <- self$.getValuesByParameterName( + dataFrame, + parameterNameVariants = C_KEY_WORDS_ALLOCATION_RATIOS, + defaultValues = self$.getAllocationRatioDefaultValues(self$stages, self$events, self$expectedEvents) + ) + self$.validateValues(self$allocationRatios, "allocationRatios") + } + + self$.setParameterType("groups", C_PARAM_NOT_APPLICABLE) + + if (self$.inputType == "stagewise") { + n <- length(self$events) + self$overallExpectedEvents <- rep(NA_real_, n) + self$overallVarianceEvents <- rep(NA_real_, n) + + self$.setParameterType("events", C_PARAM_USER_DEFINED) + self$.setParameterType("allocationRatios", C_PARAM_USER_DEFINED) + self$.setParameterType("expectedEvents", C_PARAM_USER_DEFINED) + self$.setParameterType("varianceEvents", C_PARAM_USER_DEFINED) + + self$.setParameterType("overallEvents", C_PARAM_GENERATED) + self$.setParameterType("overallAllocationRatios", C_PARAM_GENERATED) + self$.setParameterType("overallExpectedEvents", C_PARAM_GENERATED) + self$.setParameterType("overallVarianceEvents", C_PARAM_GENERATED) + + self$.recreateDataFrame() + self$.createOverallData() + } else { + n <- length(self$overallEvents) + self$expectedEvents <- rep(NA_real_, n) + self$varianceEvents <- rep(NA_real_, n) + + self$.setParameterType("events", C_PARAM_GENERATED) + self$.setParameterType("allocationRatios", C_PARAM_GENERATED) + self$.setParameterType("expectedEvents", C_PARAM_GENERATED) + self$.setParameterType("varianceEvents", C_PARAM_GENERATED) + + self$.setParameterType("overallEvents", C_PARAM_USER_DEFINED) + self$.setParameterType("overallAllocationRatios", C_PARAM_USER_DEFINED) + self$.setParameterType("overallExpectedEvents", C_PARAM_USER_DEFINED) + self$.setParameterType("overallVarianceEvents", C_PARAM_USER_DEFINED) + + self$.recreateDataFrame() + self$.createStageWiseData() + } + }, + .getVisibleFieldNames = function() { + visibleFieldNames <- super$.getVisibleFieldNames() + visibleFieldNames <- visibleFieldNames[!(visibleFieldNames %in% c("logRanks", "overallLogRanks"))] + return(visibleFieldNames) + }, + .setDataToVariables = function() { + super$.setDataToVariables() + self$overallExpectedEvents <- self$.data$overallExpectedEvent + self$overallVarianceEvents <- self$.data$overallVarianceEvent + self$expectedEvents <- self$.data$expectedEvent + }, + getOverallExpectedEvent = function(stage, group = 1, subset = NA_character_) { + return(self$.data$overallExpectedEvent[self$.getIndices(stage = stage, group = group, subset = subset)]) + }, + getOverallExpectedEvents = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { + return(self$.data$overallExpectedEvent[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) + }, + getOverallExpectedEventsUpTo = function(to, group = 1, subset = NA_character_) { + return(self$.data$overallExpectedEvent[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) + }, + getOverallVarianceEvent = function(stage, group = 1, subset = NA_character_) { + return(self$.data$overallVarianceEvent[self$.getIndices(stage = stage, group = group, subset = subset)]) + }, + getOverallVarianceEvents = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { + return(self$.data$overallVarianceEvent[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) + }, + getOverallVarianceEventsUpTo = function(to, group = 1, subset = NA_character_) { + return(self$.data$overallVarianceEvent[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) + } + ) +) + +.isFloatingPointSampleSize <- function(object, param) { + values <- object[[param]] + if (is.null(values)) { + return(FALSE) + } + + values <- na.omit(values) + if (length(values) == 0) { + return(FALSE) + } + + if (any(floor(values) != values)) { + return(TRUE) + } + + return(FALSE) +} + +.getMaxDigits <- function(values) { + values <- na.omit(values) + if (length(values) == 0) { + return(0) + } + + values <- trimws(format(values, scientific = FALSE, digits = 15)) + values <- gsub("^\\d*\\.", "", values) + values <- gsub("\\D", "", values) + max(nchar(values)) +} + + +#' +#' @title +#' Dataset Summary +#' +#' @description +#' Displays a summary of \code{\link{Dataset}} object. +#' +#' @param object A \code{\link{Dataset}} object. +#' @inheritParams param_digits +#' @inheritParams param_three_dots +#' +#' @details +#' Summarizes the parameters and results of a dataset. +#' +#' @template details_summary +#' +#' @template return_object_summary +#' @template how_to_get_help_for_generics +#' +#' @export +#' +#' @keywords internal +#' +summary.DatasetR6 <- function(object, ..., type = 1, digits = NA_integer_) { + .warnInCaseOfUnknownArguments(functionName = "summary", ...) + + if (type == 1 && inherits(object, "SummaryFactoryR6")) { + return(object) + } + + if (type != 1) { + return(summary.ParameterSet(object, type = type, digits = digits, ...)) + } + + intervalFormat <- getOption("rpact.summary.intervalFormat", "[%s; %s]") + .assertIsValidSummaryIntervalFormat(intervalFormat) + + summaryFactory <- SummaryFactoryR6$new(object = object, intervalFormat = intervalFormat) + + s <- object$.toString() + + kMax <- object$getNumberOfStages() + summaryFactory$title <- .firstCharacterToUpperCase(s) + + numberOfGroups <- object$getNumberOfGroups() + + if (numberOfGroups == 1) { + groups <- "one sample" + } else if (numberOfGroups == 2) { + groups <- c("one treatment", "one control group") + if (object$isDatasetSurvival()) { + groups <- paste0(groups, c(" (1)", " (2)")) + } + } else { + groups <- c(paste0( + .integerToWrittenNumber(numberOfGroups - 1), + " treatment groups" + ), "one control group") + if (object$isDatasetSurvival()) { + groups <- paste0(groups, c( + paste0(" (", .arrayToString(1:(numberOfGroups - 1)), ")"), + paste0(" (", numberOfGroups, ")") + )) + } + } + + prefix <- "" + if (object$isDatasetMeans()) { + prefix <- "the sample sizes, means, and standard deviations of " + } else if (object$isDatasetRates()) { + prefix <- "the sample sizes and events of " + } else if (object$isDatasetSurvival()) { + prefix <- "the events and log rank statistics of the comparison of " + } + if (numberOfGroups > 1) { + prefix <- paste0(prefix, "\n") + } + header <- paste0( + "The dataset contains ", prefix, + paste0(groups, collapse = ifelse(object$isDatasetSurvival(), " with ", " and ")) + ) + if (object$.enrichmentEnabled) { + header <- paste0(header, ". The data will be analyzed ", ifelse(object$isStratified(), "", "non-"), "stratified") + } + if (kMax > 1) { + header <- paste0( + header, ".\nThe total number of looks is ", .integerToWrittenNumber(kMax), + "; stage-wise and cumulative data are included" + ) + } + header <- paste0(header, ".") + summaryFactory$header <- header + + digitSettings <- .getSummaryDigits(digits) + digits <- digitSettings$digits + digitsSampleSize <- 0 + digitsGeneral <- digitSettings$digitsGeneral + digitsProbabilities <- digitSettings$digitsProbabilities + + paramsToCheck <- character(0) + if (object$isDatasetMeans() || object$isDatasetRates()) { + paramsToCheck <- c(paramsToCheck, "sampleSizes") + if (kMax > 1) { + paramsToCheck <- c(paramsToCheck, "overallSampleSizes") + } + } else if (object$isDatasetRates() || object$isDatasetSurvival()) { + paramsToCheck <- c(paramsToCheck, "events") + if (kMax > 1) { + paramsToCheck <- c(paramsToCheck, "overallEvents") + } + } + if (length(paramsToCheck) > 0) { + for (param in paramsToCheck) { + if (.isFloatingPointSampleSize(object, param)) { + digitsSampleSize <- max(digitsSampleSize, .getMaxDigits(object[[param]])) + } + } + digitsSampleSize <- min(digitsSampleSize, digits) + } + + summaryFactory$addItem("Stage", object$stages) + + if (numberOfGroups > 1) { + groupNumbers <- object$groups + if (object$isDatasetSurvival()) { + groupNumbers <- paste0(object$groups, " vs ", numberOfGroups) + summaryFactory$addItem("Comparison", groupNumbers) + } else { + summaryFactory$addItem("Group", groupNumbers) + } + } + + if (object$.enrichmentEnabled) { + summaryFactory$addItem("Subset", object$subsets) + } + + parameterCaptionPrefix <- ifelse(kMax == 1, "", "Stage-wise ") + + if (object$isDatasetMeans() || object$isDatasetRates()) { + summaryFactory$addParameter(object, + parameterName = "sampleSizes", + parameterCaption = .firstCharacterToUpperCase(parameterCaptionPrefix, "sample size"), + roundDigits = digitsSampleSize + ) + if (kMax > 1) { + summaryFactory$addParameter(object, + parameterName = "overallSampleSizes", + parameterCaption = "Cumulative sample size", roundDigits = digitsSampleSize + ) + } + } + + if (object$isDatasetMeans()) { + summaryFactory$addParameter(object, + parameterName = "means", + parameterCaption = .firstCharacterToUpperCase(parameterCaptionPrefix, "mean"), + roundDigits = digitsGeneral + ) + if (kMax > 1) { + summaryFactory$addParameter(object, + parameterName = "overallMeans", + parameterCaption = "Cumulative mean", roundDigits = digitsGeneral + ) + } + summaryFactory$addParameter(object, + parameterName = "stDevs", + parameterCaption = .firstCharacterToUpperCase(parameterCaptionPrefix, "standard deviation"), + roundDigits = digitsGeneral + ) + if (kMax > 1) { + summaryFactory$addParameter(object, + parameterName = "overallStDevs", + parameterCaption = "Cumulative standard deviation", roundDigits = digitsGeneral + ) + } + } else if (object$isDatasetRates()) { + summaryFactory$addParameter(object, + parameterName = "events", + parameterCaption = .firstCharacterToUpperCase(parameterCaptionPrefix, "number of events"), + roundDigits = digitsSampleSize + ) + if (kMax > 1) { + summaryFactory$addParameter(object, + parameterName = "overallEvents", + parameterCaption = "Cumulative number of events", roundDigits = digitsSampleSize + ) + } + } else if (object$isDatasetSurvival()) { + summaryFactory$addParameter(object, + parameterName = "events", + parameterCaption = .firstCharacterToUpperCase(parameterCaptionPrefix, "number of events"), + roundDigits = digitsSampleSize + ) + if (kMax > 1) { + summaryFactory$addParameter(object, + parameterName = "overallEvents", + parameterCaption = "Cumulative number of events", roundDigits = digitsSampleSize + ) + } + summaryFactory$addParameter(object, + parameterName = "logRanks", + parameterCaption = .firstCharacterToUpperCase(parameterCaptionPrefix, "log rank statistic"), + roundDigits = digitsGeneral + ) + if (kMax > 1) { + summaryFactory$addParameter(object, + parameterName = "overallLogRanks", + parameterCaption = "Cumulative log rank statistic", roundDigits = digitsGeneral + ) + } + if (!any(is.na(object$allocationRatios)) && any(object$allocationRatios != 1)) { + summaryFactory$addParameter(object, + parameterName = "allocationRatios", + parameterCaption = .firstCharacterToUpperCase(parameterCaptionPrefix, "allocation ratio"), + roundDigits = digitsGeneral + ) + if (kMax > 1) { + summaryFactory$addParameter(object, + parameterName = "overallAllocationRatios", + parameterCaption = "Cumulative allocation ratio", roundDigits = digitsGeneral + ) + } + } + } + + return(summaryFactory) +} + +.getDatasetArgumentsRCodeLines <- function(x, complete = FALSE, digits = 4) { + m <- getWideFormat(x) + lines <- character(0) + paramNames <- colnames(m) + if (!complete) { + if (x$.inputType == "stagewise") { + paramNames <- paramNames[!grepl("^overall", paramNames)] + } else { + paramNames <- paramNames[grepl("^(stage|group|subset|overall)", paramNames)] + } + } + + for (paramName in paramNames) { + encapsulate <- grepl("^subset", paramName) + if (!encapsulate || isTRUE(x$.enrichmentEnabled)) { + values <- m[[paramName]] + if (!encapsulate && is.numeric(values) && !is.null(digits) && length(digits) == 1 && !is.na(digits)) { + values <- round(values, digits = digits) + } + lines <- c(lines, paste0(paramName, " = ", .arrayToString(values, + vectorLookAndFeelEnabled = TRUE, encapsulate = encapsulate, digits = NA_integer_ + ))) + } + } + + return(lines) +} + +#' +#' @title +#' Print Dataset Values +#' +#' @description +#' \code{print} prints its \code{\link{Dataset}} argument and returns it invisibly (via \code{invisible(x)}). +#' +#' @param x A \code{\link{Dataset}} object. +#' @param markdown If \code{TRUE}, the output will be created in Markdown. +#' @param output A character defining the output type, default is "list". +#' @inheritParams param_three_dots +#' +#' @details +#' Prints the dataset. +#' +#' @export +#' +#' @keywords internal +#' +print.DatasetR6 <- function(x, ..., markdown = FALSE, output = c("list", "long", "wide", "r", "rComplete")) { + fCall <- match.call(expand.dots = FALSE) + datasetName <- deparse(fCall$x) + + output <- match.arg(output) + + if (markdown) { + if (output != "list") { + warning("'output' (\"", output, "\") will be ignored ", + "because only \"list\" is supported yet if markdown is enabled", + call. = FALSE + ) + } + + x$.catMarkdownText() + return(invisible(x)) + } + + if (output == "long") { + m <- getLongFormat(x) + m <- prmatrix(m, rowlab = rep("", nrow(m))) + print(m, quote = FALSE, right = FALSE) + return(invisible(x)) + } else if (output == "wide") { + m <- getWideFormat(x) + m <- prmatrix(m, rowlab = rep("", nrow(m))) + print(m, quote = FALSE, right = FALSE) + return(invisible(x)) + } else if (output %in% c("r", "rComplete")) { + lines <- .getDatasetArgumentsRCodeLines(x, complete = (output == "rComplete")) + lines <- paste0("\t", lines) + + if (is.null(datasetName) || length(datasetName) != 1 || is.na(datasetName)) { + datasetName <- "dataInput" + } + + cat(datasetName, " <- getDataset(\n", sep = "") + cat(paste0(lines, collapse = ",\n"), "\n") + cat(")\n") + return(invisible(x)) + } + + x$show() + return(invisible(x)) +} diff --git a/R/class_core_parameter_set.R b/R/class_core_parameter_set.R index a83aa8db..6f211768 100644 --- a/R/class_core_parameter_set.R +++ b/R/class_core_parameter_set.R @@ -611,7 +611,7 @@ ParameterSet <- setRefClass("ParameterSet", } if (!is.null(category) && !is.na(category)) { if (.isMultiArmSimulationResults(.self) && paramName == "singleNumberOfEventsPerStage") { - if (!inherits(.self, "SimulationResultsEnrichmentSurvival") && + if (!(inherits(.self, "SimulationResultsEnrichmentSurvival") || inherits(.self, "SimulationResultsEnrichmentSurvivalR6")) && !is.na(numberOfCategories) && numberOfCategories == category) { category <- "control" } @@ -668,7 +668,7 @@ ParameterSet <- setRefClass("ParameterSet", } } } else if (.isMultiArmAnalysisResults(.self) || grepl("StageResultsMultiArm", .getClassName(.self)) || - (inherits(.self, "SimulationResults") && paramName == "effectMatrix") || + ((inherits(.self, "SimulationResults") || inherits(.self, "SimulationResultsR6")) && paramName == "effectMatrix") || (inherits(.self, "ClosedCombinationTestResults") && paramName %in% c("rejected", "separatePValues"))) { paramCaption <- paste0(paramCaption, " (", matrixRow, ")") @@ -1038,7 +1038,7 @@ as.matrix.FieldSet <- function(x, ..., enforceRowNames = TRUE, niceColumnNamesEn return(result) } - if (inherits(x, "PowerAndAverageSampleNumberResult")) { + if (inherits(x, "PowerAndAverageSampleNumberResult") || inherits(x, "PowerAndAverageSampleNumberResultR6")) { dimnames(result)[[1]] <- rep("", nrow(result)) return(result) } diff --git a/R/class_core_parameter_set_r6.R b/R/class_core_parameter_set_r6.R index 89f7ab18..48691d31 100644 --- a/R/class_core_parameter_set_r6.R +++ b/R/class_core_parameter_set_r6.R @@ -307,6 +307,7 @@ ParameterSetR6 <- R6Class("ParameterSetR6", .getParametersOfOneGroup = function(parameterType) { if (length(parameterType) == 1) { parameterNames <- names(self$.parameterTypes[self$.parameterTypes == parameterType]) + } else { parameterNames <- names(self$.parameterTypes[which(self$.parameterTypes %in% parameterType)]) } @@ -580,7 +581,7 @@ ParameterSetR6 <- R6Class("ParameterSetR6", } if (!is.null(category) && !is.na(category)) { if (.isMultiArmSimulationResults(self) && paramName == "singleNumberOfEventsPerStage") { - if (!inherits(self, "SimulationResultsEnrichmentSurvival") && + if (!(inherits(self, "SimulationResultsEnrichmentSurvival") || inherits(self, "SimulationResultsEnrichmentSurvivalR6")) && !is.na(numberOfCategories) && numberOfCategories == category) { category <- "control" } @@ -637,7 +638,7 @@ ParameterSetR6 <- R6Class("ParameterSetR6", } } } else if (.isMultiArmAnalysisResults(self) || grepl("StageResultsMultiArm", .getClassName(self)) || - (inherits(self, "SimulationResults") && paramName == "effectMatrix") || + ((inherits(self, "SimulationResults") || inherits(self, "SimulationResultsR6")) && paramName == "effectMatrix") || (inherits(self, "ClosedCombinationTestResults") && paramName %in% c("rejected", "separatePValues"))) { paramCaption <- paste0(paramCaption, " (", matrixRow, ")") @@ -1292,7 +1293,7 @@ ParameterSetR6 <- R6Class("ParameterSetR6", parametersToIgnore <- c(parametersToIgnore, "hazardRatio") } - if (!inherits(parameterSet, "AccrualTime")) { + if (!(inherits(parameterSet, "AccrualTime") || !inherits(parameterSet, "AccrualTimeR6"))) { accrualTime <- parameterSet[["accrualTime"]] if (!is.null(accrualTime) && length(accrualTime) > 1) { parametersToIgnore <- c(parametersToIgnore, c("accrualTime", "accrualIntensity")) @@ -1542,7 +1543,7 @@ as.matrix.FieldSetR6 <- function(x, ..., enforceRowNames = TRUE, niceColumnNames return(result) } - if (inherits(x, "PowerAndAverageSampleNumberResult")) { + if (inherits(x, "PowerAndAverageSampleNumberResult") || inherits(x, "PowerAndAverageSampleNumberResultR6")) { dimnames(result)[[1]] <- rep("", nrow(result)) return(result) } @@ -1621,9 +1622,9 @@ summary.ParameterSetR6 <- function(object, ..., type = 1, digits = NA_integer_, } if (type == 1 && (inherits(object, "TrialDesign") || inherits(object, "TrialDesignR6") || inherits(object, "TrialDesignPlan") || inherits(object, "TrialDesignPlanR6") || - inherits(object, "SimulationResults") || (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) || + inherits(object, "SimulationResults") || inherits(object, "SimulationResultsR6") || (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) || inherits(object, "TrialDesignCharacteristics") || inherits(object, "TrialDesignCharacteristicsR6") || - inherits(object, "PerformanceScore"))) { + inherits(object, "PerformanceScore") || inherits(object, "PerformanceScoreR6"))) { output <- match.arg(output) return(.createSummary(object, digits = digits, output = output)) } diff --git a/R/class_design_plan.R b/R/class_design_plan.R index 068222cb..331505c7 100644 --- a/R/class_design_plan.R +++ b/R/class_design_plan.R @@ -726,8 +726,8 @@ TrialDesignPlanRates <- setRefClass("TrialDesignPlanRates", TrialDesignPlanSurvival <- setRefClass("TrialDesignPlanSurvival", contains = "TrialDesignPlan", fields = list( - .piecewiseSurvivalTime = "PiecewiseSurvivalTime", - .accrualTime = "AccrualTime", + .piecewiseSurvivalTime = "ANY", + .accrualTime = "ANY", .calculateFollowUpTime = "logical", thetaH0 = "numeric", typeOfComputation = "character", @@ -926,1230 +926,6 @@ TrialDesignPlanSurvival <- setRefClass("TrialDesignPlanSurvival", ) ) -.addPlotSubTitleItems <- function(designPlan, designMaster, items, type) { - if (type %in% c(1, 3, 4)) { - return(invisible()) - } - - if (.isTrialDesignPlanMeans(designPlan)) { - nMax <- designPlan$maxNumberOfSubjects[1] # use first value for plotting - - if (!(type %in% c(5))) { - items$add("N", round(nMax, 1), "max") - } - - if ((type %in% c(5)) && !(items$title == "Sample Size")) { - items$add("N", round(nMax, 1), "max") - } - - if (designPlan$meanRatio) { - items$add("coefficient of variation", designPlan$stDev) - } else { - items$add("standard deviation", designPlan$stDev) - } - - if (designPlan$groups == 1) { - if (type %in% c(2, (5:9))) { - items$add("H0: mu", designPlan$thetaH0) - items$add("allocation ratio", round(designPlan$allocationRatioPlanned, 2)) - } - } else { - if (type %in% c(2, (5:9))) { - if (designPlan$meanRatio) { - items$add("H0: mean ratio", designPlan$thetaH0) - } else { - items$add("H0: mean difference", designPlan$thetaH0) - } - items$add("allocation ratio", round(designPlan$allocationRatioPlanned, 2)) - } - } - } else if (.isTrialDesignPlanRates(designPlan)) { - nMax <- designPlan$maxNumberOfSubjects[1] # use first value for plotting - - if (!(type %in% c(5))) { - items$add("N", round(nMax, 1), "max") - } - - if ((type %in% c(5)) && !(items$title == "Sample Size")) { - items$add("N", round(nMax, 1), "max") - } - - if (designPlan$groups == 2 && !(type %in% c(3, 4)) && - length(designPlan$pi2) == 1 && !is.na(designPlan$pi2)) { - items$add("pi", designPlan$pi2, 2) - } - - if (designPlan$groups == 1) { - if (type %in% c(2, (5:9))) { - items$add("H0: pi", designPlan$thetaH0) - } - } else { - if (type %in% c(2, (5:9))) { - if (designPlan$riskRatio) { - items$add("H0: risk ratio", designPlan$thetaH0) - } else { - items$add("H0: risk difference", designPlan$thetaH0) - } - items$add("allocation ratio", round(designPlan$allocationRatioPlanned, 2)) - } - } - } else if (.isTrialDesignPlanSurvival(designPlan)) { - if (designPlan$.isPowerObject() && !(type %in% (13:14))) { - items$add("maximum number of events", designPlan$maxNumberOfEvents[1]) - } - if (type %in% (10:12)) { - items$add("maximum number of subjects", designPlan$maxNumberOfSubjects[1]) - } - if (type %in% c(2, (5:12))) { - items$add("H0: hazard ratio", designPlan$thetaH0) - items$add("allocation ratio", round(designPlan$allocationRatioPlanned, 2)) - } - } -} - -.assertIsValidVariedParameterVectorForPlotting <- function(designPlan, plotType) { - if (.isTrialDesignPlanMeans(designPlan)) { - if (is.null(designPlan$alternative) || any(is.na(designPlan$alternative)) || - length(designPlan$alternative) <= 1) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "plot type ", plotType, - " is only available if 'alternative' with length > 1 is defined" - ) - } - } else if (.isTrialDesignPlanRates(designPlan)) { - if (is.null(designPlan$pi1) || any(is.na(designPlan$pi1)) || - length(designPlan$pi1) <= 1) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "plot type ", plotType, - " is only available if 'pi1' with length > 1 is defined" - ) - } - } else if (.isTrialDesignPlanSurvival(designPlan)) { - if (is.null(designPlan$hazardRatio) || any(is.na(designPlan$hazardRatio)) || - length(designPlan$hazardRatio) <= 1) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "plot type ", plotType, - " is only available if 'hazardRatio' with length > 1 is defined" - ) - } - } -} - -.plotTrialDesignPlan <- function(designPlan, type = 1L, main = NA_character_, - xlab = NA_character_, ylab = NA_character_, palette = "Set1", - theta = seq(-1, 1, 0.02), plotPointsEnabled = NA, - legendPosition = NA_integer_, showSource = FALSE, - designPlanName = NA_character_, plotSettings = NULL, ...) { - .assertGgplotIsInstalled() - .assertIsTrialDesignPlan(designPlan) - .assertIsValidLegendPosition(legendPosition) - .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) - theta <- .assertIsValidThetaRange(thetaRange = theta) - - survivalDesignPlanEnabled <- .isTrialDesignPlanSurvival(designPlan) - - nMax <- ifelse(survivalDesignPlanEnabled, designPlan$maxNumberOfEvents[1], - designPlan$maxNumberOfSubjects[1] - ) # use first value for plotting - - if (is.null(plotSettings)) { - plotSettings <- designPlan$.plotSettings - } - - designMaster <- designPlan$.design - - if (designMaster$kMax == 1 && (type %in% c(1:4))) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, - ") is not available for 'kMax' = 1" - ) - } - - if (designPlan$.isSampleSizeObject()) { - if (survivalDesignPlanEnabled) { - if (!(type %in% c(1:5, 13, 14))) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, - ") is not allowed; must be 1, 2, 3, 4, 5, 13 or 14" - ) - } - } else { - if (!(type %in% c(1:5))) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, - ") is not allowed; must be 1, 2, 3, 4, 5" - ) - } - } - } - - if (is.na(plotPointsEnabled)) { - plotPointsEnabled <- type < 4 - } - - ratioEnabled <- (survivalDesignPlanEnabled || - (.isTrialDesignPlanMeans(designPlan) && designPlan$meanRatio) || - (.isTrialDesignPlanRates(designPlan) && designPlan$riskRatio)) - - variedParameters <- logical(0) - - showSourceHint <- "" - if (type %in% c(5:12)) { - if (.isTrialDesignPlanMeans(designPlan) && length(designPlan$alternative) == 2 && - designPlan$.getParameterType("alternative") == C_PARAM_USER_DEFINED) { - if (!is.logical(showSource) || isTRUE(showSource)) { - showSourceHint <- .getVariedParameterHint(designPlan$alternative, "alternative") - } - designPlan <- designPlan$clone( - alternative = - .getVariedParameterVector(designPlan$alternative, "alternative") - ) - } else if ((.isTrialDesignPlanRates(designPlan) || survivalDesignPlanEnabled) && - length(designPlan$pi1) == 2 && - designPlan$.getParameterType("pi1") == C_PARAM_USER_DEFINED) { - if (!is.logical(showSource) || isTRUE(showSource)) { - showSourceHint <- .getVariedParameterHint(designPlan$pi1, "pi1") - } - designPlan <- designPlan$clone( - pi1 = - .getVariedParameterVector(designPlan$pi1, "pi1") - ) - } else if (survivalDesignPlanEnabled && length(designPlan$hazardRatio) == 2 && - designPlan$.getParameterType("hazardRatio") == C_PARAM_USER_DEFINED) { - if (!is.logical(showSource) || isTRUE(showSource)) { - showSourceHint <- .getVariedParameterHint(designPlan$hazardRatio, "hazardRatio") - } - designPlan <- designPlan$clone( - hazardRatio = - .getVariedParameterVector(designPlan$hazardRatio, "hazardRatio") - ) - } - } - - srcCmd <- NULL - - reducedParam <- NULL - if (type %in% c(1:4)) { - reducedParam <- .warnInCaseOfUnusedValuesForPlotting(designPlan) - } - - if (type == 1) { # Boundary plot - if (survivalDesignPlanEnabled) { - if (is.na(main)) { - main <- PlotSubTitleItems(title = "Boundaries Z Scale") - .addPlotSubTitleItems(designPlan, designMaster, main, type) - if (!is.null(reducedParam)) { - main$add(reducedParam$title, reducedParam$value, reducedParam$subscript) - } - } - - if (designMaster$sided == 1) { - designPlan <- data.frame( - eventsPerStage = designPlan$eventsPerStage[, 1], - criticalValues = designMaster$criticalValues, - futilityBounds = c(designMaster$futilityBounds, designMaster$criticalValues[designMaster$kMax]) - ) - } else { - designPlan <- data.frame( - eventsPerStage = designPlan$eventsPerStage[, 1], - criticalValues = designMaster$criticalValues, - criticalValuesMirrored = -designMaster$criticalValues - ) - } - - xParameterName <- "eventsPerStage" - if (designMaster$sided == 1) { - if (any(designMaster$futilityBounds > C_FUTILITY_BOUNDS_DEFAULT)) { - yParameterNames <- c("futilityBounds", "criticalValues") - } else { - yParameterNames <- "criticalValues" - } - yParameterNamesSrc <- yParameterNames - } else { - yParameterNames <- c("criticalValues", "criticalValuesMirrored") - yParameterNamesSrc <- c("criticalValues", paste0("-", designPlanName, "$.design$criticalValues")) - } - - if (is.na(legendPosition)) { - legendPosition <- C_POSITION_RIGHT_TOP - } - - srcCmd <- .showPlotSourceInformation( - objectName = paste0(designPlanName, "$.design"), - xParameterName = paste0(designPlanName, "$", xParameterName, "[, 1]"), - yParameterNames = yParameterNamesSrc, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - } else { - if (is.na(main)) { - main <- PlotSubTitleItems(title = "Boundaries") - .addPlotSubTitleItems(designPlan, designMaster, main, type) - if (!is.null(reducedParam)) { - main$add(reducedParam$title, reducedParam$value, reducedParam$subscript) - } - } - - designSet <- TrialDesignSetR6$new(design = designMaster, singleDesign = TRUE) - designSet$.plotSettings <- designPlan$.plotSettings - designPlanName <- paste0(designPlanName, "$.design") - return(.plotTrialDesignSet( - x = designSet, y = NULL, main = main, - xlab = xlab, ylab = ylab, type = type, - palette = palette, theta = theta, nMax = nMax, - plotPointsEnabled = plotPointsEnabled, legendPosition = legendPosition, - designSetName = designPlanName, showSource = showSource, - plotSettings = plotSettings # , ... - )) - } - } else if (type == 2) { # Effect Scale Boundary plot - if (is.na(main)) { - main <- PlotSubTitleItems(title = "Boundaries Effect Scale") - .addPlotSubTitleItems(designPlan, designMaster, main, type) - if (!is.null(reducedParam)) { - main$add(reducedParam$title, reducedParam$value, reducedParam$subscript) - } - } - - if (is.na(ylab)) { - if (.isTrialDesignPlanMeans(designPlan)) { - if (designPlan$groups == 1) { - ylab <- "Mean" - } else if (!designPlan$meanRatio) { - ylab <- "Mean Difference" - } else { - ylab <- "Mean Ratio" - } - } else if (.isTrialDesignPlanRates(designPlan)) { - if (designPlan$groups == 1) { - ylab <- "Rate" - } else if (!designPlan$riskRatio) { - ylab <- "Rate Difference" - } else { - ylab <- "Risk Ratio" - } - } else if (survivalDesignPlanEnabled) { - ylab <- "Hazard Ratio" - } - } - - groupedPlotEnabled <- FALSE - yParameterNamesSrc <- c() - if (designMaster$sided == 1) { - if (any(designMaster$futilityBounds > C_FUTILITY_BOUNDS_DEFAULT)) { - data <- data.frame( - criticalValuesEffectScale = designPlan$criticalValuesEffectScale[, 1], - futilityBoundsEffectScale = c( - designPlan$futilityBoundsEffectScale[, 1], - designPlan$criticalValuesEffectScale[designMaster$kMax, 1] - ) - ) - yParameterNamesSrc <- c(yParameterNamesSrc, "criticalValuesEffectScale[, 1]") - yParameterNamesSrc <- c(yParameterNamesSrc, paste0( - "c(", designPlanName, "$futilityBoundsEffectScale[, 1], ", - designPlanName, "$criticalValuesEffectScale[nrow(", designPlanName, "$criticalValuesEffectScale), 1])" - )) - } else { - data <- data.frame( - criticalValuesEffectScale = designPlan$criticalValuesEffectScale[, 1] - ) - yParameterNamesSrc <- c(yParameterNamesSrc, "criticalValuesEffectScale[, 1]") - } - } else if (designMaster$typeOfDesign == C_TYPE_OF_DESIGN_PT) { - data <- data.frame( - criticalValues = designPlan$criticalValuesEffectScaleUpper[, 1], - criticalValuesMirrored = designPlan$criticalValuesEffectScaleLower[, 1], - futilityBounds = c( - designPlan$futilityBoundsEffectScaleUpper[, 1], - designPlan$criticalValuesEffectScaleUpper[designMaster$kMax, 1] - ), - futilityBoundsMirrored = c( - designPlan$futilityBoundsEffectScaleLower[, 1], - designPlan$criticalValuesEffectScaleLower[designMaster$kMax, 1] - ) - ) - yParameterNamesSrc <- c(yParameterNamesSrc, "criticalValuesEffectScaleUpper[, 1]") - yParameterNamesSrc <- c(yParameterNamesSrc, "criticalValuesEffectScaleLower[, 1]") - yParameterNamesSrc <- c(yParameterNamesSrc, paste0( - "c(", designPlanName, "$futilityBoundsEffectScaleUpper[, 1], ", - designPlanName, "$criticalValuesEffectScaleUpper[nrow(", designPlanName, "$criticalValuesEffectScaleUpper), 1])" - )) - yParameterNamesSrc <- c(yParameterNamesSrc, paste0( - "c(", designPlanName, "$futilityBoundsEffectScaleLower[, 1], ", - designPlanName, "$criticalValuesEffectScaleLower[nrow(", designPlanName, "$criticalValuesEffectScaleLower), 1])" - )) - groupedPlotEnabled <- TRUE - } else { - data <- data.frame( - criticalValuesEffectScale = designPlan$criticalValuesEffectScaleUpper[, 1], - criticalValuesEffectScaleMirrored = designPlan$criticalValuesEffectScaleLower[, 1] - ) - yParameterNamesSrc <- c(yParameterNamesSrc, "criticalValuesEffectScaleUpper[, 1]") - yParameterNamesSrc <- c(yParameterNamesSrc, "criticalValuesEffectScaleLower[, 1]") - } - - if (survivalDesignPlanEnabled) { - xParameterName <- "eventsPerStage" - xParameterNameSrc <- paste0(designPlanName, "$", xParameterName, "[, 1]") - data <- cbind(data.frame(eventsPerStage = designPlan$eventsPerStage[, 1]), data) - } else { - xParameterName <- "informationRates" - xParameterNameSrc <- paste0(designPlanName, "$.design$", xParameterName) - data <- cbind(data.frame(informationRates = designMaster$informationRates), data) - } - if (designMaster$sided == 1 || designMaster$typeOfDesign == C_TYPE_OF_DESIGN_PT) { - if (any(designMaster$futilityBounds > C_FUTILITY_BOUNDS_DEFAULT)) { - yParameterNames <- c("futilityBoundsEffectScale", "criticalValuesEffectScale") - } else { - yParameterNames <- "criticalValuesEffectScale" - } - } else { - yParameterNames <- c("criticalValuesEffectScale", "criticalValuesEffectScaleMirrored") - } - - if (is.na(legendPosition)) { - legendPosition <- C_POSITION_RIGHT_TOP - } - - if (is.na(legendPosition)) { - legendPosition <- C_POSITION_RIGHT_TOP - } - - srcCmd <- .showPlotSourceInformation( - objectName = designPlanName, - xParameterName = xParameterNameSrc, - yParameterNames = yParameterNamesSrc, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - - if (groupedPlotEnabled) { - tableColumnNames <- C_TABLE_COLUMN_NAMES - criticalValuesName <- designPlan$.getDataFrameColumnCaption("criticalValuesEffectScale", tableColumnNames, TRUE) - futilityBoundsName <- designPlan$.getDataFrameColumnCaption("futilityBoundsEffectScale", tableColumnNames, TRUE) - - designPlan <- data.frame( - xValues = rep(data[[xParameterName]], 4), - yValues = c( - data$criticalValues, data$criticalValuesMirrored, - data$futilityBounds, data$futilityBoundsMirrored - ), - categories = c( - rep(criticalValuesName, nrow(data)), rep("criticalValuesMirrored", nrow(data)), - rep(futilityBoundsName, nrow(data)), rep("futilityBoundsMirrored", nrow(data)) - ), - groups = c(rep(criticalValuesName, 2 * nrow(data)), rep(futilityBoundsName, 2 * nrow(data))) - ) - } else { - designPlan <- data - } - } else if (type == 3) { # Stage Levels - if (is.na(main)) { - main <- PlotSubTitleItems(title = "Boundaries p Values Scale") - .addPlotSubTitleItems(designPlan, designMaster, main, type) - if (!is.null(reducedParam)) { - main$add(reducedParam$title, reducedParam$value, reducedParam$subscript) - } - } - - if (survivalDesignPlanEnabled) { - xParameterName <- "eventsPerStage" - yParameterNames <- "stageLevels" - designPlan <- data.frame( - eventsPerStage = designPlan$eventsPerStage[, 1], - stageLevels = designMaster$stageLevels - ) - xParameterNameSrc <- "eventsPerStage[, 1]" - yParameterNamesSrc <- ".design$stageLevels" - } else { - xParameterName <- "informationRates" - yParameterNames <- "stageLevels" - designPlan <- TrialDesignSetR6$new(design = designMaster, singleDesign = TRUE) - xParameterNameSrc <- ".design$informationRates" - yParameterNamesSrc <- ".design$stageLevels" - } - - srcCmd <- .showPlotSourceInformation( - objectName = designPlanName, - xParameterName = xParameterNameSrc, - yParameterNames = yParameterNamesSrc, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - } else if (type == 4) { # Alpha Spending - if (is.na(main)) { - main <- PlotSubTitleItems(title = "Error Spending") - .addPlotSubTitleItems(designPlan, designMaster, main, type) - if (!is.null(reducedParam)) { - main$add(reducedParam$title, reducedParam$value, reducedParam$subscript) - } - } - if (survivalDesignPlanEnabled) { - xParameterName <- "eventsPerStage" - yParameterNames <- "alphaSpent" - designPlan <- data.frame( - eventsPerStage = designPlan$eventsPerStage[, 1], - alphaSpent = designMaster$alphaSpent - ) - xParameterNameSrc <- "eventsPerStage[, 1]" - yParameterNamesSrc <- ".design$alphaSpent" - } else { - xParameterName <- "informationRates" - yParameterNames <- "alphaSpent" - designPlan <- TrialDesignSetR6$new(design = designMaster, singleDesign = TRUE) - xParameterNameSrc <- ".design$informationRates" - yParameterNamesSrc <- ".design$alphaSpent" - } - plotPointsEnabled <- ifelse(is.na(plotPointsEnabled), FALSE, plotPointsEnabled) - - srcCmd <- .showPlotSourceInformation( - objectName = designPlanName, - xParameterName = xParameterNameSrc, - yParameterNames = yParameterNamesSrc, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - } else if (type == 5) { # Power and Stopping Probabilities - - .assertIsValidVariedParameterVectorForPlotting(designPlan, type) - - if (designPlan$.isSampleSizeObject()) { - if (is.na(main)) { - main <- PlotSubTitleItems(title = "Sample Size") - .addPlotSubTitleItems(designPlan, designMaster, main, type) - } - - yAxisScalingEnabled <- TRUE - - if (.isTrialDesignPlanMeans(designPlan)) { - xParameterName <- "alternative" - yParameterNames <- c("nFixed") - if (designMaster$kMax > 1) { - yParameterNames <- c(yParameterNames, "maxNumberOfSubjects", "expectedNumberOfSubjectsH1") - } - if (is.na(ylab)) { - ylab <- "Sample Size" - } - yAxisScalingEnabled <- FALSE - if (is.na(legendPosition)) { - legendPosition <- C_POSITION_RIGHT_TOP - } - yParameterNamesSrc <- yParameterNames - } else if (.isTrialDesignPlanRates(designPlan)) { - xParameterName <- "pi1" - yParameterNames <- c("nFixed") - if (designMaster$kMax > 1) { - yParameterNames <- c(yParameterNames, "maxNumberOfSubjects", "expectedNumberOfSubjectsH1") - } - if (is.na(ylab)) { - ylab <- "Sample Size" - } - yAxisScalingEnabled <- FALSE - if (is.na(legendPosition)) { - legendPosition <- C_POSITION_RIGHT_TOP - } - yParameterNamesSrc <- yParameterNames - } else if (survivalDesignPlanEnabled) { - designPlan <- data.frame( - hazardRatio = designPlan$hazardRatio, - eventsFixed = designPlan$eventsFixed, - maxNumberOfEvents = designPlan$eventsPerStage[designMaster$kMax, ], - expectedEventsH1 = designPlan$expectedEventsH1 - ) - xParameterName <- "hazardRatio" - yParameterNames <- c("eventsFixed") - if (designMaster$kMax > 1) { - yParameterNames <- c(yParameterNames, "maxNumberOfEvents", "expectedEventsH1") - } - if (is.na(ylab)) { - ylab <- "# Events" - } - - if (is.na(legendPosition)) { - legendPosition <- C_POSITION_RIGHT_TOP - } - yParameterNamesSrc <- c( - "eventsFixed", - paste0("eventsPerStage[", designMaster$kMax, ", ]"), "expectedEventsH1" - ) - } - - srcCmd <- .showPlotSourceInformation( - objectName = designPlanName, - xParameterName = xParameterName, - yParameterNames = yParameterNamesSrc, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - if (!is.null(srcCmd)) { - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(srcCmd)) - } - return(srcCmd) - } - - return(.plotParameterSet( - parameterSet = designPlan, designMaster = designMaster, - xParameterName = xParameterName, - yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, - palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, - legendPosition = legendPosition, variedParameters = variedParameters, - qnormAlphaLineEnabled = FALSE, yAxisScalingEnabled = FALSE, - plotSettings = plotSettings # , ... - )) - } else { - if (is.na(main)) { - main <- PlotSubTitleItems(title = "Overall Power and Early Stopping") - .addPlotSubTitleItems(designPlan, designMaster, main, type) - } - if (survivalDesignPlanEnabled) { - xParameterName <- "hazardRatio" - } else { - xParameterName <- "effect" - } - yParameterNames <- c("overallReject", "futilityStop", "earlyStop") - - if (is.na(ylab)) { - ylab <- "" - } - if (is.na(legendPosition)) { - legendPosition <- C_POSITION_LEFT_TOP - } - - srcCmd <- .showPlotSourceInformation( - objectName = designPlanName, - xParameterName = xParameterName, - yParameterNames = yParameterNames, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - if (!is.null(srcCmd)) { - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(srcCmd)) - } - return(srcCmd) - } - - if (is.null(list(...)[["ylim"]])) { - ylim <- c(0, 1) - return(.plotParameterSet( - parameterSet = designPlan, designMaster = designMaster, - xParameterName = xParameterName, - yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, - palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, - legendPosition = legendPosition, variedParameters = variedParameters, - qnormAlphaLineEnabled = FALSE, yAxisScalingEnabled = FALSE, - plotSettings = plotSettings, ylim = ylim # , ... - )) - } else { - return(.plotParameterSet( - parameterSet = designPlan, designMaster = designMaster, - xParameterName = xParameterName, - yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, - palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, - legendPosition = legendPosition, variedParameters = variedParameters, - qnormAlphaLineEnabled = FALSE, yAxisScalingEnabled = FALSE, - plotSettings = plotSettings # , ... - )) - } - } - } else if (type == 6) { # Average Sample Size / Average Event Number - .assertIsValidVariedParameterVectorForPlotting(designPlan, type) - - if (is.na(main)) { - titlePart <- ifelse(survivalDesignPlanEnabled, "Number of Events", "Sample Size") - main <- PlotSubTitleItems(title = paste0("Expected ", titlePart, " and Power / Early Stop")) - .addPlotSubTitleItems(designPlan, designMaster, main, type) - } - - if (survivalDesignPlanEnabled) { - xParameterName <- "hazardRatio" - yParameterNames <- "expectedNumberOfEvents" - expectedNumberOfEvents <- designPlan[["expectedNumberOfEvents"]] - if (is.null(expectedNumberOfEvents) || length(expectedNumberOfEvents) == 0) { - yParameterNames <- "expectedEventsH1" - } - yParameterNames <- c(yParameterNames, "overallReject", "earlyStop") # overallReject = power - if (is.na(legendPosition)) { - legendPosition <- C_POSITION_RIGHT_CENTER - } - } else { - xParameterName <- "effect" - yParameterNames <- c("expectedNumberOfSubjects", "overallReject", "earlyStop") # overallReject = power - } - srcCmd <- .showPlotSourceInformation( - objectName = designPlanName, - xParameterName = xParameterName, - yParameterNames = yParameterNames, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - } else if (type == 7) { - .assertIsValidVariedParameterVectorForPlotting(designPlan, type) - - if (is.na(main)) { - main <- PlotSubTitleItems(title = "Overall Power") - .addPlotSubTitleItems(designPlan, designMaster, main, type) - } - - if (survivalDesignPlanEnabled) { - xParameterName <- "hazardRatio" - } else { - xParameterName <- "effect" - } - yParameterNames <- "overallReject" - if (is.na(legendPosition)) { - legendPosition <- C_POSITION_RIGHT_CENTER - } - srcCmd <- .showPlotSourceInformation( - objectName = designPlanName, - xParameterName = xParameterName, - yParameterNames = yParameterNames, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - } else if (type == 8) { - .assertIsValidVariedParameterVectorForPlotting(designPlan, type) - - if (is.na(main)) { - main <- PlotSubTitleItems(title = "Overall Early Stopping") - .addPlotSubTitleItems(designPlan, designMaster, main, type) - } - - if (survivalDesignPlanEnabled) { - xParameterName <- "hazardRatio" - } else { - xParameterName <- "effect" - } - yParameterNames <- c("earlyStop", "futilityStop") - if (is.na(legendPosition)) { - legendPosition <- C_POSITION_RIGHT_CENTER - } - srcCmd <- .showPlotSourceInformation( - objectName = designPlanName, - xParameterName = xParameterName, - yParameterNames = yParameterNames, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - } else if (type == 9) { - .assertIsValidVariedParameterVectorForPlotting(designPlan, type) - - if (is.na(main)) { - if (survivalDesignPlanEnabled) { - main <- PlotSubTitleItems(title = "Expected Number of Events") - } else { - main <- PlotSubTitleItems(title = "Expected Sample Size") - } - .addPlotSubTitleItems(designPlan, designMaster, main, type) - } - - if (survivalDesignPlanEnabled) { - xParameterName <- "hazardRatio" - yParameterNames <- "expectedNumberOfEvents" - expectedNumberOfEvents <- designPlan[["expectedNumberOfEvents"]] - if (is.null(expectedNumberOfEvents) || length(expectedNumberOfEvents) == 0) { - yParameterNames <- c("expectedEventsH0", "expectedEventsH1") - if (is.na(legendPosition)) { - legendPosition <- C_POSITION_RIGHT_CENTER - } - } - } else { - xParameterName <- "effect" - yParameterNames <- "expectedNumberOfSubjects" - } - srcCmd <- .showPlotSourceInformation( - objectName = designPlanName, - xParameterName = xParameterName, - yParameterNames = yParameterNames, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - } else if (survivalDesignPlanEnabled) { - if (type == 10) { # Study Duration - .assertIsValidVariedParameterVectorForPlotting(designPlan, type) - if (is.na(main)) { - main <- PlotSubTitleItems(title = "Study Duration") - .addPlotSubTitleItems(designPlan, designMaster, main, type) - } - xParameterName <- "hazardRatio" - yParameterNames <- "studyDuration" - srcCmd <- .showPlotSourceInformation( - objectName = designPlanName, - xParameterName = xParameterName, - yParameterNames = yParameterNames, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - } else if (type == 11) { - .assertIsValidVariedParameterVectorForPlotting(designPlan, type) - if (is.na(main)) { - main <- PlotSubTitleItems(title = "Expected Number of Subjects") - .addPlotSubTitleItems(designPlan, designMaster, main, type) - } - xParameterName <- "hazardRatio" - yParameterNames <- "expectedNumberOfSubjects" - srcCmd <- .showPlotSourceInformation( - objectName = designPlanName, - xParameterName = xParameterName, - yParameterNames = yParameterNames, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - } else if (type == 12) { # Analysis Time - .assertIsValidVariedParameterVectorForPlotting(designPlan, type) - if (is.na(main)) { - main <- PlotSubTitleItems(title = "Analysis Time") - .addPlotSubTitleItems(designPlan, designMaster, main, type) - } - - xParameterName <- "hazardRatio" - yParameterNames <- "analysisTime" - yParameterNamesSrc <- c() - for (i in 1:nrow(designPlan[["analysisTime"]])) { - yParameterNamesSrc <- c(yParameterNamesSrc, paste0("analysisTime[", i, ", ]")) - } - - data <- NULL - for (k in 1:designMaster$kMax) { - part <- data.frame( - categories = rep(k, length(designPlan$hazardRatio)), - xValues = designPlan$hazardRatio, - yValues = designPlan$analysisTime[k, ] - ) - if (is.null(data)) { - data <- part - } else { - data <- rbind(data, part) - } - } - - srcCmd <- .showPlotSourceInformation( - objectName = designPlanName, - xParameterName = xParameterName, - yParameterNames = yParameterNamesSrc, - hint = showSourceHint, - type = type, showSource = showSource - ) - if (!is.null(srcCmd)) { - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(srcCmd)) - } - return(srcCmd) - } - - return(.plotDataFrame(data, - mainTitle = main, - xlab = NA_character_, ylab = NA_character_, xAxisLabel = "Hazard Ratio", - yAxisLabel1 = "Analysis Time", yAxisLabel2 = NA_character_, - plotPointsEnabled = TRUE, legendTitle = "Stage", - legendPosition = legendPosition, sided = designMaster$sided, - plotSettings = plotSettings, ... - )) - } else if (type == 13 || type == 14) { # Cumulative Distribution Function / Survival function - return(.plotSurvivalFunction(designPlan, - designMaster = designMaster, type = type, main = main, - xlab = xlab, ylab = ylab, palette = palette, - legendPosition = legendPosition, showSource = showSource, - designPlanName = designPlanName, - plotSettings = plotSettings, ... - )) - } else { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is not allowed; must be 1, 2, ..., 14") - } - } else { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is not allowed; must be 1, 2, ..., 9") - } - - if (!is.null(srcCmd)) { - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(srcCmd)) - } - return(srcCmd) - } - - p <- .plotParameterSet( - parameterSet = designPlan, designMaster = designMaster, - xParameterName = xParameterName, - yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, - palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, - legendPosition = legendPosition, variedParameters = variedParameters, - qnormAlphaLineEnabled = (type != 2), ratioEnabled = ratioEnabled, - plotSettings = plotSettings # , ... - ) - - if (type == 1 && survivalDesignPlanEnabled) { - p <- .addDecistionCriticalValuesToPlot(p = p, designMaster = designMaster, type = type, nMax = nMax) - } - return(p) -} - -.getSurvivalFunctionPlotCommand <- function(functionType = c("pwExpDist", "lambdaStep"), timeValues, lambda, - designPlan, type, piecewiseSurvivalEnabled, multiplyByHazardRatio = FALSE) { - functionType <- match.arg(functionType) - signPrefix <- ifelse(type == 13, "", "-") - if (functionType == "pwExpDist") { - functionName <- "getPiecewiseExponentialDistribution" - } else { - functionName <- "getLambdaStepFunction" - } - cmd <- paste0( - signPrefix, functionName, - "(", .reconstructSequenceCommand(timeValues), - ", piecewiseLambda = ", .arrayToString(lambda, vectorLookAndFeelEnabled = TRUE) - ) - if (piecewiseSurvivalEnabled) { - cmd <- paste0( - cmd, ", piecewiseSurvivalTime = ", - .arrayToString(designPlan$piecewiseSurvivalTime, vectorLookAndFeelEnabled = TRUE) - ) - } - if (functionType == "pwExpDist") { - cmd <- paste0(cmd, ", kappa = ", designPlan$kappa) - } - cmd <- paste0(cmd, ")") - if (multiplyByHazardRatio) { - cmd <- paste0(cmd, " * ", designPlan$hazardRatio[1]) - } - return(cmd) -} - -# Cumulative Distribution Function / Survival function -.plotSurvivalFunction <- function(designPlan, ..., designMaster, type = c(13, 14), main = NA_character_, - xlab = NA_character_, ylab = NA_character_, palette = "Set1", - legendPosition = NA_integer_, showSource = FALSE, - designPlanName = NA_character_, plotSettings = NULL) { - startTime <- Sys.time() - if (is.null(designPlan$piecewiseSurvivalTime) || - length(designPlan$piecewiseSurvivalTime) == 0) { - stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'piecewiseSurvivalTime' must be specified") - } - - type <- type[1] - if (!(type %in% c(13, 14))) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' must be 13 or 14") - } - - lambda1 <- designPlan[["lambda1"]] - lambda2 <- designPlan[["lambda2"]] - if (is.null(lambda2) || length(lambda2) == 0) { - stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'lambda2' must be specified") - } - - if (is.null(designPlan$kappa) || length(designPlan$kappa) == 0) { - stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'kappa' must be specified") - } - - if (is.null(designPlan$hazardRatio) || length(designPlan$hazardRatio) == 0) { - stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'hazardRatio' must be specified") - } - - piecewiseSurvivalEnabled <- designPlan$.piecewiseSurvivalTime$piecewiseSurvivalEnabled - - if (is.na(main)) { - if (type == 13) { - main <- PlotSubTitleItems(title = "Cumulative Distribution Function") - } else { - main <- PlotSubTitleItems(title = "Survival Function") - } - .addPlotSubTitleItems(designPlan, designMaster, main, type) - if (!piecewiseSurvivalEnabled) { - if (designPlan$.piecewiseSurvivalTime$.isLambdaBased(minNumberOfLambdas = 1)) { - main$add("lambda", round(designPlan$lambda1[1], 4), 1) - main$add("lambda", round(designPlan$lambda2, 4), 2) - } else { - main$add("pi", round(designPlan$pi1[1], 3), 1) - main$add("pi", round(designPlan$pi2, 3), 2) - } - } else if (length(designPlan$hazardRatio) == 1) { - main$add("Hazard Ratio", round(designPlan$hazardRatio[1], 3)) - } - } - - if (!piecewiseSurvivalEnabled || (length(designPlan$piecewiseSurvivalTime) == 1 && - designPlan$piecewiseSurvivalTime[1] == 0)) { - timeTo <- max(designPlan$analysisTime[designMaster$kMax, ]) - } else { - timeTo <- max(designPlan$piecewiseSurvivalTime) - } - if (is.na(timeTo) || !is.numeric(timeTo) || is.infinite(timeTo)) { - # warning("Unable to determine upper bound of time values", call. = FALSE) - timeTo <- 0 - } - - timeTo <- timeTo + 10 - by <- timeTo / 1000 - timeValues <- seq(from = 0, to = timeTo, by = by) - - data <- data.frame( - time = timeValues, - lambdaGroup1 = rep(-1, length(timeValues)), - lambdaGroup2 = rep(-1, length(timeValues)), - survival1 = rep(-1, length(timeValues)), - survival2 = rep(-1, length(timeValues)), - survivalGroup1 = rep(-1, length(timeValues)), - survivalGroup2 = rep(-1, length(timeValues)) - ) - - signPrefix <- ifelse(type == 13, "", "-") - if (piecewiseSurvivalEnabled) { - data$survival2 <- .getPiecewiseExponentialDistribution( - timeValues, - lambda2, designPlan$piecewiseSurvivalTime, designPlan$kappa - ) - - yParameterNames <- .getSurvivalFunctionPlotCommand( - "pwExpDist", - timeValues, lambda2, designPlan, type, piecewiseSurvivalEnabled - ) - - if (!is.null(lambda1) && !all(is.na(lambda1)) && - length(lambda1) == length(lambda2)) { - data$survival1 <- .getPiecewiseExponentialDistribution( - timeValues, - lambda1, designPlan$piecewiseSurvivalTime, designPlan$kappa - ) - yParameterNames <- c( - yParameterNames, - .getSurvivalFunctionPlotCommand( - "pwExpDist", - timeValues, lambda1, designPlan, type, piecewiseSurvivalEnabled - ) - ) - } else { - .warnInCaseOfUnusedValuesForPlottingSurvival(designPlan$hazardRatio) - data$survival1 <- data$survival2 * designPlan$hazardRatio[1] - yParameterNames <- c( - yParameterNames, - .getSurvivalFunctionPlotCommand("pwExpDist", timeValues, lambda2, - designPlan, type, piecewiseSurvivalEnabled, - multiplyByHazardRatio = TRUE - ) - ) - } - - yParameterNames <- c( - yParameterNames, - .getSurvivalFunctionPlotCommand( - "lambdaStep", - timeValues, lambda2, designPlan, type, piecewiseSurvivalEnabled - ) - ) - if (!is.null(lambda1) && !all(is.na(lambda1)) && - length(lambda1) == length(lambda2)) { - yParameterNames <- c( - yParameterNames, - .getSurvivalFunctionPlotCommand( - "lambdaStep", - timeValues, lambda1, designPlan, type, piecewiseSurvivalEnabled - ) - ) - } else { - yParameterNames <- c( - yParameterNames, - .getSurvivalFunctionPlotCommand("lambdaStep", timeValues, lambda2, - designPlan, type, piecewiseSurvivalEnabled, - multiplyByHazardRatio = TRUE - ) - ) - } - } else { - if (designPlan$.piecewiseSurvivalTime$.isLambdaBased(minNumberOfLambdas = 1)) { - if (length(designPlan$lambda1) > 1) { - lambda1 <- designPlan$lambda1[1] - warning("Only the first 'lambda1' (", round(lambda1, 4), - ") was used for plotting", - call. = FALSE - ) - } - } else { - .warnInCaseOfUnusedValuesForPlottingRates(designPlan$pi1) - } - - if (!is.na(designPlan$pi1[1]) && !is.na(designPlan$pi2) && !is.na(designPlan$eventTime)) { - lambda2 <- (-log(1 - designPlan$pi2))^(1 / designPlan$kappa) / designPlan$eventTime - lambda1 <- (-log(1 - designPlan$pi1[1]))^(1 / designPlan$kappa) / designPlan$eventTime - } - - data$survival2 <- .getPiecewiseExponentialDistribution( - timeValues, - lambda2, 0, designPlan$kappa - ) - data$survival1 <- .getPiecewiseExponentialDistribution( - timeValues, - lambda1, 0, designPlan$kappa - ) - - yParameterNames <- .getSurvivalFunctionPlotCommand( - "pwExpDist", - timeValues, lambda2, designPlan, type, piecewiseSurvivalEnabled - ) - yParameterNames <- c( - yParameterNames, - .getSurvivalFunctionPlotCommand( - "pwExpDist", - timeValues, lambda1, designPlan, type, piecewiseSurvivalEnabled - ) - ) - yParameterNames <- c( - yParameterNames, - .getSurvivalFunctionPlotCommand( - "lambdaStep", - timeValues, lambda2, designPlan, type, piecewiseSurvivalEnabled - ) - ) - yParameterNames <- c( - yParameterNames, - .getSurvivalFunctionPlotCommand( - "lambdaStep", timeValues, lambda1, - designPlan, type, piecewiseSurvivalEnabled - ) - ) - } - - # two groups: 1 = treatment, 2 = control - if (type == 14) { - data$survival1 <- 1 - data$survival1 - data$survival2 <- 1 - data$survival2 - } - - if (piecewiseSurvivalEnabled) { - data$lambdaGroup2 <- .getLambdaStepFunction( - timeValues, - designPlan$piecewiseSurvivalTime, lambda2 - ) - if (length(lambda1) == 1) { - if (!is.na(lambda1)) { - data$lambdaGroup1 <- rep(lambda1, length(data$lambdaGroup2)) - } else { - data$lambdaGroup1 <- data$lambdaGroup2 * designPlan$hazardRatio[1] - } - } else { - data$lambdaGroup1 <- .getLambdaStepFunction( - timeValues, - designPlan$piecewiseSurvivalTime, lambda1 - ) - } - } else { - data$lambdaGroup2 <- .getLambdaStepFunction(timeValues, 0, lambda2) - data$lambdaGroup1 <- .getLambdaStepFunction(timeValues, 0, lambda1) - } - - scalingBaseValues1 <- na.omit(c(data$survival1, data$survival2)) - scalingBaseValues2 <- na.omit(c(data$lambdaGroup1, data$lambdaGroup2)) - scalingFactor <- 1 - if (length(scalingBaseValues1) > 0 && length(scalingBaseValues2) > 0) { - scalingFactor <- max(scalingBaseValues1) / max(.getNextHigherValue(scalingBaseValues2)) - } - data2 <- data.frame( - categories = c( - rep("Treatm. piecew. exp.", nrow(data)), - rep("Control piecew. exp.", nrow(data)), - rep("Treatm. piecew. lambda", nrow(data)), - rep("Control piecew. lambda", nrow(data)) - ), - xValues = rep(data$time, 4), - yValues = c( - data$survival1, - data$survival2, - data$lambdaGroup1 * scalingFactor, - data$lambdaGroup2 * scalingFactor - ) - ) - - if (is.na(legendPosition)) { - if (type == 13) { - legendPosition <- C_POSITION_LEFT_TOP - } else { - legendPosition <- C_POSITION_RIGHT_TOP - } - } - - if (is.na(palette) || palette == "Set1") { - palette <- "Paired" - } - - if (type == 13) { - yAxisLabel1 <- "Cumulative Distribution Function" - } else { - yAxisLabel1 <- "Survival Function" - } - - srcCmd <- .showPlotSourceInformation( - objectName = designPlanName, - xParameterName = "time", - yParameterNames = yParameterNames, - showSource = showSource, - xValues = timeValues - ) - if (!is.null(srcCmd)) { - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(srcCmd)) - } - return(srcCmd) - } - - if (is.null(plotSettings)) { - plotSettings <- designPlan$.plotSettings - } - - return(.plotDataFrame(data2, - mainTitle = main, - xlab = xlab, ylab = ylab, xAxisLabel = "Time", - yAxisLabel1 = yAxisLabel1, yAxisLabel2 = "Lambda", - plotPointsEnabled = FALSE, legendTitle = NA_character_, - legendPosition = legendPosition, scalingFactor1 = 1, - scalingFactor2 = scalingFactor, palette = palette, sided = designMaster$sided, - plotSettings = plotSettings - )) -} - -.warnInCaseOfUnusedValuesForPlottingMeans <- function(alternative) { - if (length(alternative) > 1) { - warning("Only the first 'alternative' (", round(alternative[1], 3), - ") was used for plotting", - call. = FALSE - ) - return(list(title = "alternative", value = alternative[1], subscript = NA_character_)) - } - return(NULL) -} - -.warnInCaseOfUnusedValuesForPlottingRates <- function(pi1) { - if (length(pi1) > 1) { - warning("Only the first 'pi1' (", round(pi1[1], 3), - ") was used for plotting", - call. = FALSE - ) - return(list(title = "pi", value = pi1[1], subscript = "1")) - } - return(NULL) -} - -.warnInCaseOfUnusedValuesForPlottingSurvival <- function(hazardRatio) { - if (length(hazardRatio) > 1) { - warning("Only the first 'hazardRatio' (", round(hazardRatio[1], 3), - ") was used for plotting", - call. = FALSE - ) - return(list(title = "hazardRatio", value = hazardRatio[1], subscript = NA_character_)) - } - return(NULL) -} - -.warnInCaseOfUnusedValuesForPlotting <- function(designPlan) { - if (.isTrialDesignPlanMeans(designPlan) && designPlan$.isSampleSizeObject()) { - return(.warnInCaseOfUnusedValuesForPlottingMeans(designPlan$alternative)) - } - if (.isTrialDesignPlanRates(designPlan) && designPlan$.isSampleSizeObject()) { - return(.warnInCaseOfUnusedValuesForPlottingRates(designPlan$pi1)) - } - if (.isTrialDesignPlanSurvival(designPlan) && designPlan$.isSampleSizeObject()) { - return(.warnInCaseOfUnusedValuesForPlottingSurvival(designPlan$hazardRatio)) - } - return(NULL) -} - #' #' @title #' Trial Design Plan Plotting diff --git a/R/class_design_power_and_asn_r6.R b/R/class_design_power_and_asn_r6.R new file mode 100644 index 00000000..537681bc --- /dev/null +++ b/R/class_design_power_and_asn_r6.R @@ -0,0 +1,329 @@ +## | +## | *Power and average sample number result classes* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | rpact package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File version: $Revision: 7126 $ +## | Last changed: $Date: 2023-06-23 14:26:39 +0200 (Fr, 23 Jun 2023) $ +## | Last changed by: $Author: pahlke $ +## | + + +#' +#' @name PowerAndAverageSampleNumberResult +#' +#' @title +#' Power and Average Sample Number Result +#' +#' @description +#' Class for power and average sample number (ASN) results. +#' +#' @template field_nMax +#' @template field_theta +#' @template field_averageSampleNumber +#' @template field_calculatedPower +#' @template field_overallEarlyStop +#' @template field_earlyStop +#' @template field_overallReject +#' @template field_rejectPerStage +#' @template field_overallFutility +#' @template field_futilityPerStage +#' +#' @details +#' This object cannot be created directly; use \code{\link[=getPowerAndAverageSampleNumber]{getPowerAndAverageSampleNumber()}} +#' with suitable arguments to create it. +#' +#' @include class_core_parameter_set.R +#' @include class_design.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +PowerAndAverageSampleNumberResultR6 <- R6Class("PowerAndAverageSampleNumberResultR6", + inherit = ParameterSetR6, + public = list( + .design = NULL, + nMax = NULL, + theta = NULL, + averageSampleNumber = NULL, + calculatedPower = NULL, + overallEarlyStop = NULL, + earlyStop = NULL, + overallReject = NULL, + rejectPerStage = NULL, + overallFutility = NULL, + futilityPerStage = NULL, + initialize = function(design, theta = seq(-1, 1, 0.05), nMax = 100L, ...) { + super$initialize(...) + + self$.design <- design + self$theta <- theta + self$nMax <- nMax + + self$theta <- .assertIsValidThetaRange(thetaRange = theta, thetaAutoSeqEnabled = FALSE) + self$.initPowerAndAverageSampleNumber() + self$.parameterNames <- .getParameterNames(design = design) + self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS + }, + show = function(showType = 1, digits = NA_integer_) { + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + }, + .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { + "Method for automatically printing a power and average sample size (ASN) result" + self$.resetCat() + if (showType == 2) { + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + } else { + self$.cat("Power and average sample size (ASN):\n\n", + heading = 1, + consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Output", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + if (self$.design$kMax > 1) { + self$.cat("Legend:\n", + heading = 2, + consoleOutputEnabled = consoleOutputEnabled + ) + if (self$.design$kMax > 1) { + self$.cat(" [k]: values at stage k\n", consoleOutputEnabled = consoleOutputEnabled) + } + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) + } + } + }, + .toString = function(startWithUpperCase = FALSE) { + s <- "power and average sample size (ASN)" + return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) + }, + .initPowerAndAverageSampleNumber = function() { + .assertIsTrialDesignInverseNormalOrGroupSequential(self$.design) + .assertIsValidSidedParameter(self$.design$sided) + + if (self$nMax <= 0) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'nMax' must be an integer > 0") + } + + self$.setParameterType("nMax", ifelse(self$nMax == C_NA_MAX_DEFAULT, C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) + + thetaIsDefault <- length(self$theta) == length(C_POWER_ASN_THETA_DEFAULT) && + sum(self$theta == C_POWER_ASN_THETA_DEFAULT) == length(self$theta) + self$.setParameterType("theta", ifelse(thetaIsDefault, C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) + + kMax <- self$.design$kMax + + # initialization + numberOfThetas <- length(self$theta) + + self$averageSampleNumber <- rep(NA_real_, numberOfThetas) + self$.setParameterType("averageSampleNumber", C_PARAM_GENERATED) + + self$calculatedPower <- rep(NA_real_, numberOfThetas) + self$.setParameterType("calculatedPower", C_PARAM_GENERATED) + + self$earlyStop <- matrix(NA_real_, kMax, numberOfThetas) + self$.setParameterType("earlyStop", C_PARAM_GENERATED) + + self$rejectPerStage <- matrix(NA_real_, kMax, numberOfThetas) + self$.setParameterType("rejectPerStage", C_PARAM_GENERATED) + + self$futilityPerStage <- matrix(NA_real_, kMax - 1, numberOfThetas) + self$.setParameterType("futilityPerStage", C_PARAM_GENERATED) + + rowNames <- paste("stage =", c(1:kMax)) + rownames(self$earlyStop) <- rowNames + rownames(self$rejectPerStage) <- rowNames + if (kMax > 1) { + rownames(self$futilityPerStage) <- rowNames[1:(kMax - 1)] + } + + for (i in 1:numberOfThetas) { + result <- self$.getPowerAndAverageSampleNumber(theta = self$theta[i]) + + self$averageSampleNumber[i] <- result$averageSampleNumber + self$calculatedPower[i] <- result$calculatedPower + self$earlyStop[1:(kMax - 1), i] <- result$earlyStop[1:(kMax - 1)] + self$rejectPerStage[, i] <- result$rejectPerStage[1:kMax] + self$futilityPerStage[, i] <- result$futilityPerStage[1:(kMax - 1)] + } + + self$overallEarlyStop <- self$.getOverallParameter(self$earlyStop) + self$.setParameterType("overallEarlyStop", C_PARAM_GENERATED) + + self$overallReject <- self$.getOverallParameter(self$rejectPerStage) + self$.setParameterType("overallReject", C_PARAM_GENERATED) + + self$overallFutility <- self$.getOverallParameter(self$futilityPerStage) + self$.setParameterType("overallFutility", C_PARAM_GENERATED) + }, + .getPowerAndAverageSampleNumber = function(theta) { + kMax <- self$.design$kMax + futilityBounds <- self$.design$futilityBounds + informationRates <- self$.design$informationRates + criticalValues <- self$.design$criticalValues + sided <- self$.design$sided + delayedInformation <- self$.design$delayedInformation + + .earlyStop <- rep(NA_real_, kMax) + .futilityPerStage <- rep(NA_real_, kMax) + + if (!any(is.na(delayedInformation))) { + contRegionLower <- futilityBounds + contRegionUpper <- criticalValues + decisionCriticalValues <- self$.design$decisionCriticalValues + probs <- .calculateDecisionProbabilities( + sqrtShift = sqrt(self$nMax) * theta, + informationRates, delayedInformation, contRegionUpper, contRegionLower, decisionCriticalValues + ) + + .averageSampleNumber <- self$nMax - sum(probs$stoppingProbabilities * + (informationRates[kMax] - delayedInformation - informationRates[1:(kMax - 1)]) * self$nMax) + .calculatedPower <- probs$power[kMax] + .rejectPerStage <- probs$rejectionProbabilities + .earlyStop <- probs$stoppingProbabilities + .futilityPerStage <- probs$futilityProbabilities + } else { + if (sided == 2) { + if (self$.design$typeOfDesign == C_TYPE_OF_DESIGN_PT || !is.null(self$.design$typeBetaSpending) && self$.design$typeBetaSpending != "none") { + futilityBounds[is.na(futilityBounds)] <- 0 + decisionMatrix <- matrix(c( + -criticalValues - theta * sqrt(self$nMax * informationRates), + c(-futilityBounds - theta * sqrt(self$nMax * informationRates[1:(kMax - 1)]), 0), + c(futilityBounds - theta * sqrt(self$nMax * informationRates[1:(kMax - 1)]), 0), + criticalValues - theta * sqrt(self$nMax * informationRates) + ), nrow = 4, byrow = TRUE) + } else { + decisionMatrix <- matrix(c( + -criticalValues - theta * sqrt(self$nMax * informationRates), + criticalValues - theta * sqrt(self$nMax * informationRates) + ), nrow = 2, byrow = TRUE) + } + } else { + shiftedFutilityBounds <- futilityBounds - theta * sqrt(self$nMax * informationRates[1:(kMax - 1)]) + shiftedFutilityBounds[futilityBounds <= C_FUTILITY_BOUNDS_DEFAULT] <- C_FUTILITY_BOUNDS_DEFAULT + decisionMatrix <- matrix(c( + shiftedFutilityBounds, C_FUTILITY_BOUNDS_DEFAULT, + criticalValues - theta * sqrt(self$nMax * informationRates) + ), nrow = 2, byrow = TRUE) + } + + probs <- .getGroupSequentialProbabilities(decisionMatrix, informationRates) + + if (nrow(probs) == 3) { + .averageSampleNumber <- self$nMax - sum((probs[3, 1:(kMax - 1)] - probs[2, 1:(kMax - 1)] + probs[1, 1:(kMax - 1)]) * + (informationRates[kMax] - informationRates[1:(kMax - 1)]) * self$nMax) + } else { + .averageSampleNumber <- self$nMax - sum((probs[5, 1:(kMax - 1)] - + probs[4, 1:(kMax - 1)] + probs[3, 1:(kMax - 1)] - probs[2, 1:(kMax - 1)] + probs[1, 1:(kMax - 1)]) * + (informationRates[kMax] - informationRates[1:(kMax - 1)]) * self$nMax) + } + + if (sided == 2) { + if (nrow(probs) == 3) { + .calculatedPower <- sum(probs[3, 1:kMax] - probs[2, 1:kMax] + probs[1, 1:kMax]) + .rejectPerStage <- probs[3, 1:kMax] - probs[2, 1:kMax] + probs[1, 1:kMax] + } else { + .calculatedPower <- sum(probs[5, 1:kMax] - probs[4, 1:kMax] + probs[1, 1:kMax]) + .rejectPerStage <- probs[5, 1:kMax] - probs[4, 1:kMax] + probs[1, 1:kMax] + if (kMax > 1) { + .futilityPerStage <- probs[3, 1:kMax] - probs[2, 1:kMax] + } + } + } else { + .calculatedPower <- sum(probs[3, 1:kMax] - probs[2, 1:kMax]) + .rejectPerStage <- probs[3, 1:kMax] - probs[2, 1:kMax] + if (kMax > 1) { + .futilityPerStage <- probs[1, 1:(kMax - 1)] + .rejectPerStage <- .getNoEarlyEfficacyZeroCorrectedValues(self$.design, .rejectPerStage) + } + } + + if (kMax > 1) { + if (nrow(probs) == 3) { + .earlyStop <- probs[3, 1:(kMax - 1)] - probs[2, 1:(kMax - 1)] + probs[1, 1:(kMax - 1)] + } else { + .earlyStop <- probs[5, 1:(kMax - 1)] - probs[4, 1:(kMax - 1)] + probs[3, 1:(kMax - 1)] - + probs[2, 1:(kMax - 1)] + probs[1, 1:(kMax - 1)] + } + } + } + + return(list( + averageSampleNumber = .averageSampleNumber, + calculatedPower = .calculatedPower, + earlyStop = .earlyStop, + rejectPerStage = .rejectPerStage, + futilityPerStage = .futilityPerStage + )) + }, + .getOverallParameter = function(parameter) { + if (is.null(parameter) || length(parameter) == 0) { + return(rep(NA_real_, length(self$theta))) + } + + overallParameter <- parameter + overallParameter[is.na(overallParameter)] <- 0 + overallParameter <- colSums(overallParameter) + return(overallParameter) + } + ) +) + +#' +#' @title +#' Coerce Power And Average Sample Number Result to a Data Frame +#' +#' @description +#' Returns the \code{\link{PowerAndAverageSampleNumberResult}} as data frame. +#' +#' @param x A \code{\link{PowerAndAverageSampleNumberResult}} object. +#' @inheritParams param_niceColumnNamesEnabled +#' @inheritParams param_includeAllParameters +#' @inheritParams param_three_dots +#' +#' @details +#' Coerces the \code{\link{PowerAndAverageSampleNumberResult}} object to a data frame. +#' +#' @template return_dataframe +#' +#' @examples +#' data <- as.data.frame(getPowerAndAverageSampleNumber(getDesignGroupSequential())) +#' head(data) +#' dim(data) +#' +#' @export +#' +#' @keywords internal +#' +as.data.frame.PowerAndAverageSampleNumberResultR6 <- function(x, row.names = NULL, + optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ...) { + parameterNames <- x$.getVisibleFieldNames() + parameterNames <- parameterNames[parameterNames != "nMax"] + dataFrame <- .getAsDataFrame( + parameterSet = x, + parameterNames = parameterNames, + niceColumnNamesEnabled = niceColumnNamesEnabled, + includeAllParameters = includeAllParameters, + tableColumnNames = .getTableColumnNames(design = x$.design) + ) + return(dataFrame) +} diff --git a/R/class_design_set.R b/R/class_design_set.R index b517d2c9..8f748907 100644 --- a/R/class_design_set.R +++ b/R/class_design_set.R @@ -22,82 +22,6 @@ #' @include f_core_utilities.R NULL -#' @title -#' Get Design Set -#' -#' @description -#' Creates a trial design set object and returns it. -#' -#' @param ... \code{designs} or \code{design} and one or more design parameters, e.g., \code{deltaWT = c(0.1, 0.3, 0.4)}. -#' \itemize{ -#' \item \code{design} The master design (optional, you need to specify an -#' additional parameter that shall be varied). -#' \item \code{designs} The designs to compare (optional, you need to specify the variable \code{variedParameters}). -#' } -#' -#' @details -#' Specify a master design and one or more design parameters or a list of designs. -#' -#' @return Returns a \code{\link{TrialDesignSet}} object. -#' The following generics (R generic functions) are available for this result object: -#' \itemize{ -#' \item \code{\link[=names.TrialDesignSet]{names}} to obtain the field names, -#' \item \code{\link[=length.TrialDesignSet]{length}} to obtain the number of design, -#' \item \code{\link[=print.FieldSet]{print()}} to print the object, -#' \item \code{\link[=summary.TrialDesignSet]{summary()}} to display a summary of the object, -#' \item \code{\link[=plot.TrialDesignSet]{plot()}} to plot the object, -#' \item \code{\link[=as.data.frame.TrialDesignSet]{as.data.frame()}} to coerce the object to a \code{\link[base]{data.frame}}, -#' \item \code{\link[=as.matrix.FieldSet]{as.matrix()}} to coerce the object to a \code{\link[base]{matrix}}. -#' } -#' @template how_to_get_help_for_generics -#' -#' @examples -#' # Example 1 -#' design <- getDesignGroupSequential( -#' alpha = 0.05, kMax = 6, -#' sided = 2, typeOfDesign = "WT", deltaWT = 0.1 -#' ) -#' designSet <- getDesignSet() -#' designSet$add(design = design, deltaWT = c(0.3, 0.4)) -#' \dontrun{ -#' if (require(ggplot2)) plot(designSet, type = 1) -#' } -#' -#' # Example 2 (shorter script) -#' design <- getDesignGroupSequential( -#' alpha = 0.05, kMax = 6, -#' sided = 2, typeOfDesign = "WT", deltaWT = 0.1 -#' ) -#' designSet <- getDesignSet(design = design, deltaWT = c(0.3, 0.4)) -#' \dontrun{ -#' if (require(ggplot2)) plot(designSet, type = 1) -#' } -#' -#' # Example 3 (use of designs instead of design) -#' d1 <- getDesignGroupSequential( -#' alpha = 0.05, kMax = 2, -#' sided = 1, beta = 0.2, typeOfDesign = "asHSD", -#' gammaA = 0.5, typeBetaSpending = "bsHSD", gammaB = 0.5 -#' ) -#' d2 <- getDesignGroupSequential( -#' alpha = 0.05, kMax = 4, -#' sided = 1, beta = 0.2, typeOfDesign = "asP", -#' typeBetaSpending = "bsP" -#' ) -#' designSet <- getDesignSet( -#' designs = c(d1, d2), -#' variedParameters = c("typeOfDesign", "kMax") -#' ) -#' \dontrun{ -#' if (require(ggplot2)) plot(designSet, type = 8, nMax = 20) -#' } -#' -#' @export -#' -getDesignSet <- function(...) { - return(TrialDesignSet(...)) -} - #' #' @title #' Trial Design Set Summary @@ -715,7 +639,7 @@ as.data.frame.TrialDesignSet <- function(x, row.names = NULL, } if (addPowerAndAverageSampleNumber) { - results <- PowerAndAverageSampleNumberResult(design, theta = theta, nMax = nMax) + results <- PowerAndAverageSampleNumberResultR6$new(design, theta = theta, nMax = nMax) suppressWarnings(df2 <- as.data.frame(results, niceColumnNamesEnabled = niceColumnNamesEnabled, includeAllParameters = includeAllParameters @@ -833,187 +757,4 @@ plot.TrialDesignSet <- function(x, y, ..., type = 1L, main = NA_character_, } return(.createPlotResultObject(plotList, grid)) -} - -.plotTrialDesignSet <- function(..., x, y, type = 1L, main = NA_character_, - xlab = NA_character_, ylab = NA_character_, palette = "Set1", - theta = seq(-1, 1, 0.02), nMax = NA_integer_, plotPointsEnabled = NA, - legendPosition = NA_integer_, showSource = FALSE, - designSetName = NA_character_, plotSettings = NULL) { - .assertGgplotIsInstalled() - if (!is.call(main) && !isS4(main)) { - .assertIsSingleCharacter(main, "main", naAllowed = TRUE) - } - .assertIsSingleCharacter(xlab, "xlab", naAllowed = TRUE) - .assertIsSingleCharacter(ylab, "ylab", naAllowed = TRUE) - .assertIsSingleCharacter(palette, "palette", naAllowed = TRUE) - theta <- .assertIsValidThetaRange(thetaRange = theta) - .assertIsSingleNumber(nMax, "nMax", naAllowed = TRUE) - .assertIsInClosedInterval(nMax, "nMax", lower = 1L, upper = 1e10) - .assertIsSingleLogical(plotPointsEnabled, "plotPointsEnabled", naAllowed = TRUE) - .assertIsValidLegendPosition(legendPosition) - .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) - - parameterSet <- x - designMaster <- parameterSet$getDesignMaster() - .assertIsTrialDesign(designMaster) - - if (type == 1) { - main <- if (!is.call(main) && !isS4(main) && is.na(main)) "Boundaries" else main - xParameterName <- "informationRates" - yParameterNames <- "criticalValues" - - if (designMaster$sided == 1 || (.isTrialDesignInverseNormalOrGroupSequential(designMaster) && - (designMaster$typeOfDesign == C_TYPE_OF_DESIGN_PT || grepl("^bs", designMaster$typeBetaSpending)))) { - if (.isTrialDesignWithValidFutilityBounds(designMaster)) { - yParameterNames <- c("futilityBounds", yParameterNames) - } - if (.isTrialDesignWithValidAlpha0Vec(designMaster)) { - yParameterNames <- c("alpha0Vec", yParameterNames) - } - } - } else if (type == 2) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "designs with undefined endpoint do not support plot type 2") - } else if (type == 3) { - main <- if (!is.call(main) && !isS4(main) && is.na(main)) "Stage Levels" else main - xParameterName <- "informationRates" - yParameterNames <- "stageLevels" - } else if (type == 4) { - main <- if (!is.call(main) && !isS4(main) && is.na(main)) "Error Spending" else main - xParameterName <- "informationRates" - yParameterNames <- c("alphaSpent") - if (!.isTrialDesignFisher(designMaster) && - designMaster$typeBetaSpending != C_TYPE_OF_DESIGN_BS_NONE) { - yParameterNames <- c(yParameterNames, "betaSpent") - palette <- "Paired" - } - plotPointsEnabled <- ifelse(is.na(plotPointsEnabled), FALSE, plotPointsEnabled) - } else if (type == 5) { - if (!is.call(main) && !isS4(main) && is.na(main)) { - main <- PlotSubTitleItemsR6$new(title = "Power and Early Stopping") - main$add("N", nMax, "max") - } - xParameterName <- "theta" - yParameterNames <- c("overallEarlyStop", "calculatedPower") - } else if (type == 6) { - if (!is.call(main) && !isS4(main) && is.na(main)) { - main <- PlotSubTitleItemsR6$new(title = "Average Sample Size and Power / Early Stop") - main$add("N", nMax, "max") - } - xParameterName <- "theta" - yParameterNames <- c("averageSampleNumber", "overallEarlyStop", "calculatedPower") - } else if (type == 7) { - if (!is.call(main) && !isS4(main) && is.na(main)) { - main <- PlotSubTitleItemsR6$new(title = "Power") - main$add("N", nMax, "max") - } - xParameterName <- "theta" - yParameterNames <- "calculatedPower" - } else if (type == 8) { - if (!is.call(main) && !isS4(main) && is.na(main)) { - main <- PlotSubTitleItemsR6$new(title = "Early Stopping") - main$add("N", nMax, "max") - } - xParameterName <- "theta" - yParameterNames <- "overallEarlyStop" - } else if (type == 9) { - if (!is.call(main) && !isS4(main) && is.na(main)) { - main <- PlotSubTitleItemsR6$new(title = "Average Sample Size") - main$add("N", nMax, "max") - } - xParameterName <- "theta" - yParameterNames <- "averageSampleNumber" - } else { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is not allowed; must be 1, 2, ..., 9") - } - - if (type >= 5 && type <= 9) { - designSetName <- paste0( - "getPowerAndAverageSampleNumber(", designSetName, - ", theta = ", .reconstructSequenceCommand(theta), ", nMax = ", nMax, ")" - ) - } - - xValues <- NA_real_ - if (xParameterName == "theta") { - xValues <- theta - } - srcCmd <- .showPlotSourceInformation( - objectName = designSetName, - xParameterName = xParameterName, - yParameterNames = yParameterNames, - nMax = nMax, - type = type, - showSource = showSource, - xValues = xValues - ) - if (!is.null(srcCmd)) { - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(srcCmd)) - } - return(srcCmd) - } - - p <- .plotParameterSet( - parameterSet = parameterSet, designMaster = designMaster, - xParameterName = xParameterName, - yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, - palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, - legendPosition = legendPosition, plotSettings = plotSettings # , ... - ) - - p <- .addDecistionCriticalValuesToPlot(p = p, designMaster = designMaster, type = type, nMax = nMax) - - return(p) -} - -.addDecistionCriticalValuesToPlot <- function(p, designMaster, type, nMax = NA_integer_) { - if (type != 1 || !.isTrialDesignInverseNormalOrGroupSequential(designMaster)) { - return(p) - } - - data <- as.data.frame(designMaster) - xyNames <- c("delayedInformationRates", "decisionCriticalValues") - if (!all(xyNames %in% colnames(data))) { - return(p) - } - - data <- unique(na.omit(data[, xyNames])) - data$legend <- rep("Decision critical value", nrow(data)) - - if (!is.na(nMax) && nMax > 1) { - data$delayedInformationRates <- data$delayedInformationRates * nMax - tryCatch( - { - data$delayedInformationRates <- as.numeric(.formatSampleSizes(data$delayedInformationRates)) - }, - error = function(e) { - warning("Failed to format delayed information rates on x-axis: ", e$message) - } - ) - } - - plotSettings <- designMaster$.plotSettings - p <- p + ggplot2::geom_point( - data = data, - mapping = ggplot2::aes( - x = .data[["delayedInformationRates"]], - y = .data[["decisionCriticalValues"]], - colour = .data[["legend"]] - ), - size = plotSettings$scaleSize(plotSettings$pointSize, TRUE), - shape = 4, stroke = 1.25, show.legend = FALSE - ) - - for (i in 1:nrow(data)) { - label <- paste0("(", round(data[i, 1], 3), ", ", round(data[i, 2], 3), ")") - p <- p + ggplot2::annotate("text", - x = data[i, 1], y = data[i, 2], - label = label, vjust = plotSettings$scaleSize(3.0), - size = plotSettings$scaleSize(2.5) - ) - } - - try(suppressWarnings(suppressMessages(p <- p + ggplot2::scale_color_manual(values = c("#4daf4a", "#377eb8", "#e41a1c"))))) - return(p) -} +} \ No newline at end of file diff --git a/R/class_design_set_r6.R b/R/class_design_set_r6.R index 7d420089..1578415a 100644 --- a/R/class_design_set_r6.R +++ b/R/class_design_set_r6.R @@ -679,7 +679,7 @@ as.data.frame.TrialDesignSetR6 <- function(x, row.names = NULL, } if (addPowerAndAverageSampleNumber) { - results <- PowerAndAverageSampleNumberResult(design, theta = theta, nMax = nMax) + results <- PowerAndAverageSampleNumberResultR6$new(design, theta = theta, nMax = nMax) suppressWarnings(df2 <- as.data.frame(results, niceColumnNamesEnabled = niceColumnNamesEnabled, includeAllParameters = includeAllParameters diff --git a/R/class_event_probabilities.R b/R/class_event_probabilities.R index 2064dda8..fbbac416 100644 --- a/R/class_event_probabilities.R +++ b/R/class_event_probabilities.R @@ -59,8 +59,8 @@ EventProbabilities <- setRefClass("EventProbabilities", contains = "ParameterSet", fields = list( - .piecewiseSurvivalTime = "PiecewiseSurvivalTime", - .accrualTime = "AccrualTime", + .piecewiseSurvivalTime = "ANY", + .accrualTime = "ANY", .plotSettings = "ANY", time = "numeric", accrualTime = "numeric", @@ -155,7 +155,7 @@ EventProbabilities <- setRefClass("EventProbabilities", NumberOfSubjects <- setRefClass("NumberOfSubjects", contains = "ParameterSet", fields = list( - .accrualTime = "AccrualTime", + .accrualTime = "ANY", .plotSettings = "ANY", time = "numeric", accrualTime = "numeric", diff --git a/R/class_event_probabilities_r6.R b/R/class_event_probabilities_r6.R new file mode 100644 index 00000000..83399b60 --- /dev/null +++ b/R/class_event_probabilities_r6.R @@ -0,0 +1,533 @@ +## | +## | *Event probabilities classes* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | rpact package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File version: $Revision: 7126 $ +## | Last changed: $Date: 2023-06-23 14:26:39 +0200 (Fr, 23 Jun 2023) $ +## | Last changed by: $Author: pahlke $ +## | + +#' +#' @name EventProbabilities +#' +#' @title +#' Event Probabilities +#' +#' @template field_time +#' @template field_accrualTime +#' @template field_accrualIntensity +#' @template field_kappa +#' @template field_piecewiseSurvivalTime +#' @template field_lambda1 +#' @template field_lambda2 +#' @template field_allocationRatioPlanned +#' @template field_hazardRatio +#' @template field_dropoutRate1 +#' @template field_dropoutRate2 +#' @template field_dropoutTime +#' @template field_maxNumberOfSubjects +#' @template field_overallEventProbabilities +#' @template field_cumulativeEventProbabilities +#' @template field_eventProbabilities1 +#' @template field_eventProbabilities2 +#' +#' @description +#' Class for the definition of event probabilities. +#' +#' @details +#' \code{EventProbabilities} is a class for the definition of event probabilities. +#' +#' @importFrom methods new +#' +#' @include f_core_constants.R +#' @include class_core_parameter_set.R +#' @include class_time.R +#' +#' @keywords internal +#' +EventProbabilitiesR6 <- R6Class("EventProbabilitiesR6", + inherit = ParameterSetR6, + public = list( + .piecewiseSurvivalTime = NULL, + .accrualTime = NULL, + .plotSettings = NULL, + time = NULL, + accrualTime = NULL, + accrualIntensity = NULL, + kappa = NULL, + piecewiseSurvivalTime = NULL, + lambda1 = NULL, + lambda2 = NULL, + allocationRatioPlanned = NULL, + hazardRatio = NULL, + dropoutRate1 = NULL, + dropoutRate2 = NULL, + dropoutTime = NULL, + maxNumberOfSubjects = NULL, + overallEventProbabilities = NULL, # deprecated + cumulativeEventProbabilities = NULL, + eventProbabilities1 = NULL, + eventProbabilities2 = NULL, + initialize = function(..., .piecewiseSurvivalTime = NULL, + .accrualTime = NULL, + time = NULL, + accrualTime = NULL, + accrualIntensity = NULL, + kappa = NULL, + piecewiseSurvivalTime = NULL, + lambda1 = NULL, + lambda2 = NULL, + allocationRatioPlanned = NULL, + hazardRatio = NULL, + dropoutRate1 = NULL, + dropoutRate2 = NULL, + dropoutTime = NULL, + maxNumberOfSubjects = NULL) { + self$.piecewiseSurvivalTime <- .piecewiseSurvivalTime + self$.accrualTime <- .accrualTime + self$time <- time + self$accrualTime <- accrualTime + self$accrualIntensity <- accrualIntensity + self$kappa <- kappa + self$piecewiseSurvivalTime <- piecewiseSurvivalTime + self$lambda1 <- lambda1 + self$lambda2 <- lambda2 + self$allocationRatioPlanned <- allocationRatioPlanned + self$hazardRatio <- hazardRatio + self$dropoutRate1 <- dropoutRate1 + self$dropoutRate2 <- dropoutRate2 + self$dropoutTime <- dropoutTime + self$maxNumberOfSubjects <- maxNumberOfSubjects + + #TODO callSuper(...) + super$initialize() + + self$.plotSettings <- PlotSettingsR6$new() + self$.parameterNames <- C_PARAMETER_NAMES + self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS + self$.setParameterType("overallEventProbabilities", C_PARAM_NOT_APPLICABLE) # deprecated + }, + getPlotSettings = function() { + return(self$.plotSettings) + }, + show = function(showType = 1, digits = NA_integer_) { + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + }, + .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { + "Method for automatically printing event probabilities objects" + self$.resetCat() + if (showType == 2) { + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + } else { + self$.cat("Event probabilities at given time:\n\n", + heading = 1, + consoleOutputEnabled = consoleOutputEnabled + ) + + self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Time and output", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + + self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" (i): values of treatment arm i\n", consoleOutputEnabled = consoleOutputEnabled) + + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) + } + } + ) +) + +#' +#' @name NumberOfSubjects +#' +#' @title +#' Number Of Subjects +#' +#' @description +#' Class for the definition of number of subjects results. +#' +#' @template field_time +#' @template field_accrualTime +#' @template field_accrualIntensity +#' @template field_maxNumberOfSubjects +#' @template field_numberOfSubjects +#' +#' @details +#' \code{NumberOfSubjects} is a class for the definition of number of subjects results. +#' +#' @importFrom methods new +#' +#' @include f_core_constants.R +#' @include class_core_parameter_set.R +#' @include class_time.R +#' +#' @keywords internal +#' +NumberOfSubjectsR6 <- R6Class("NumberOfSubjectsR6", + inherit = ParameterSetR6, + public = list( + .accrualTime = NULL, + .plotSettings = NULL, + time = NULL, + accrualTime = NULL, + accrualIntensity = NULL, + maxNumberOfSubjects = NULL, + numberOfSubjects = NULL, + initialize = function(..., accrualSetup = NULL, + time = NULL, + accrualTime = NULL, + accrualIntensity = NULL, + maxNumberOfSubjects = NULL, + numberOfSubjects = NULL) { + self$.accrualTime <- accrualSetup + self$time <- time + self$accrualTime <- accrualTime + self$accrualIntensity <- accrualIntensity + self$maxNumberOfSubjects <- maxNumberOfSubjects + self$numberOfSubjects <- numberOfSubjects + + #TODO callSuper(...) + super$initialize() + + self$.plotSettings <- PlotSettingsR6$new() + self$.parameterNames <- C_PARAMETER_NAMES + self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS + }, + getPlotSettings = function() { + return(self$.plotSettings) + }, + show = function(showType = 1, digits = NA_integer_) { + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + }, + .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { + "Method for automatically printing number of subjects objects" + self$.resetCat() + if (showType == 2) { + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + } else { + self$.cat("Number of recruited subjects at given time:\n\n", + heading = 1, + consoleOutputEnabled = consoleOutputEnabled + ) + + self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Time and output", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) + } + } + ) +) + +#' +#' @title +#' Event Probabilities Plotting +#' +#' @description +#' Plots an object that inherits from class \code{\link{EventProbabilities}}. +#' +#' @details +#' Generic function to plot an event probabilities object. +#' +#' @param x The object that inherits from \code{\link{EventProbabilities}}. +#' @param y An optional object that inherits from \code{\link{NumberOfSubjects}}. +#' @inheritParams param_allocationRatioPlanned +#' @param main The main title. +#' @param xlab The x-axis label. +#' @param ylab The y-axis label. +#' @param type The plot type (default = 1). Note that at the moment only one type is available. +#' @param legendTitle The legend title, default is \code{""}. +#' @inheritParams param_palette +#' @inheritParams param_plotPointsEnabled +#' @inheritParams param_showSource +#' @inheritParams param_plotSettings +#' @inheritParams param_legendPosition +#' @inheritParams param_three_dots_plot +#' +#' @details +#' Generic function to plot a parameter set. +#' +#' @template return_object_ggplot +#' +#' @export +#' +plot.EventProbabilitiesR6 <- function(x, y, ..., + allocationRatioPlanned = x$allocationRatioPlanned, + main = NA_character_, xlab = NA_character_, ylab = NA_character_, type = 1L, + legendTitle = NA_character_, palette = "Set1", + plotPointsEnabled = NA, legendPosition = NA_integer_, showSource = FALSE, + plotSettings = NULL) { + fCall <- match.call(expand.dots = FALSE) + xObjectName <- deparse(fCall$x) + yObjectName <- NA_character_ + + .assertGgplotIsInstalled() + .assertIsValidLegendPosition(legendPosition) + .assertIsValidAllocationRatioPlanned(allocationRatioPlanned, 2L) + # .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) + + numberOfSubjectsObject <- NULL + if (!missing(y) && inherits(y, "NumberOfSubjectsR6")) { + numberOfSubjectsObject <- y + yObjectName <- deparse(fCall$y) + } + + maxNumberOfSubjects <- 1 + maxNumberOfSubjects1 <- 1 + maxNumberOfSubjects2 <- 1 + + maxNumberOfSubjectsToUse <- NA_integer_ + if (!is.null(numberOfSubjectsObject)) { + maxNumberOfSubjectsToUse <- numberOfSubjectsObject$maxNumberOfSubjects + } + + if (is.na(maxNumberOfSubjectsToUse)) { + maxNumberOfSubjectsToUse <- x$maxNumberOfSubjects + } else if (!is.na(x$maxNumberOfSubjects) && x$maxNumberOfSubjects != maxNumberOfSubjectsToUse) { + stop("'x' (EventProbabilities) and 'y' (NumberOfSubjects) must have the same 'maxNumberOfSubjects' defined") + } + + if (!is.na(maxNumberOfSubjectsToUse)) { + maxNumberOfSubjects <- maxNumberOfSubjectsToUse + maxNumberOfSubjects1 <- .getNumberOfSubjects1(maxNumberOfSubjects, allocationRatioPlanned) + maxNumberOfSubjects2 <- .getNumberOfSubjects2(maxNumberOfSubjects, allocationRatioPlanned) + } + + if (is.na(maxNumberOfSubjectsToUse)) { + mainDefault <- "Event Probabilities" + } else { + mainDefault <- ifelse(!is.null(numberOfSubjectsObject), + "Number of subjects and expected number of events", + "Expected number of events" + ) + } + main <- ifelse(is.na(main), mainDefault, main) + if (!is.null(numberOfSubjectsObject)) { + ylabDefault <- "Number of subjects/events" + } else { + ylabDefault <- ifelse(is.na(maxNumberOfSubjectsToUse), + "Event probabilities", "Expected number of events" + ) + } + ylab <- ifelse(is.na(ylab), ylabDefault, ylab) + data <- data.frame( + xValues = c(x$time, x$time, x$time), + yValues = c( + x$cumulativeEventProbabilities * maxNumberOfSubjects, # cumulative + x$eventProbabilities1 * maxNumberOfSubjects1, # treatment + x$eventProbabilities2 * maxNumberOfSubjects2 # control + ), + categories = c( + rep("Overall", length(x$time)), + rep("Treatment", length(x$time)), + rep("Control", length(x$time)) + ) + ) + data$categories <- factor(data$categories, levels = c("Overall", "Treatment", "Control")) + + if (!is.null(numberOfSubjectsObject)) { + data <- rbind( + data, + data.frame( + xValues = numberOfSubjectsObject$time, + yValues = numberOfSubjectsObject$numberOfSubjects, + categories = "Number of subjects" + ) + ) + } + + if (is.na(legendPosition)) { + legendPosition <- C_POSITION_LEFT_TOP + } + if (is.na(legendTitle)) { + legendTitle <- "" + } + + srcCmd <- .showPlotSourceInformation( + objectName = xObjectName, + xParameterName = "time", + yParameterNames = c("cumulativeEventProbabilities", "eventProbabilities1", "eventProbabilities2"), + type = type, + showSource = showSource + ) + if (!is.na(yObjectName)) { + srcCmd2 <- .showPlotSourceInformation( + objectName = yObjectName, + xParameterName = "time", + yParameterNames = "numberOfSubjects", + type = type, + showSource = showSource + ) + if (is.list(srcCmd)) { + if (!is.null(srcCmd2[["y"]])) { + if (identical(x[["time"]], y[["time"]])) { + srcCmd$y <- c(srcCmd$y, srcCmd2$y) + } else { + srcCmd$x2 <- srcCmd2[["x"]] + srcCmd$y2 <- srcCmd2$y + } + } + } else { + srcCmd <- c(srcCmd, srcCmd2) + } + } + if (!is.null(srcCmd)) { + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(srcCmd)) + } + return(srcCmd) + } + + if (is.null(plotSettings)) { + plotSettings <- x$.plotSettings + } + + return(.plotDataFrame(data, + mainTitle = main, + xlab = xlab, ylab = ylab, xAxisLabel = "Time", + yAxisLabel1 = NA_character_, yAxisLabel2 = NA_character_, + palette = palette, plotPointsEnabled = plotPointsEnabled, + legendTitle = legendTitle, + legendPosition = legendPosition, scalingFactor1 = 1, scalingFactor2 = 1, + addPowerAndAverageSampleNumber = FALSE, mirrorModeEnabled = FALSE, + ratioEnabled = FALSE, plotSettings = plotSettings, sided = 1, ... + )) +} + +#' +#' @title +#' Number Of Subjects Plotting +#' +#' @description +#' Plots an object that inherits from class \code{\link{NumberOfSubjects}}. +#' +#' @details +#' Generic function to plot an "number of subjects" object. +#' +#' @param x The object that inherits from \code{\link{NumberOfSubjects}}. +#' @param y An optional object that inherits from \code{\link{EventProbabilities}}. +#' @param allocationRatioPlanned The planned allocation ratio \code{n1 / n2} for a two treatment groups +#' design, default is \code{1}. Will be ignored if \code{y} is undefined. +#' @param main The main title. +#' @param xlab The x-axis label. +#' @param ylab The y-axis label. +#' @param type The plot type (default = 1). Note that at the moment only one type is available. +#' @param legendTitle The legend title, default is \code{""}. +#' @inheritParams param_palette +#' @inheritParams param_plotPointsEnabled +#' @inheritParams param_showSource +#' @inheritParams param_plotSettings +#' @inheritParams param_legendPosition +#' @inheritParams param_three_dots_plot +#' +#' @details +#' Generic function to plot a parameter set. +#' +#' @template return_object_ggplot +#' +#' @export +#' +plot.NumberOfSubjectsR6 <- function(x, y, ..., + allocationRatioPlanned = NA_real_, + main = NA_character_, xlab = NA_character_, ylab = NA_character_, type = 1L, + legendTitle = NA_character_, palette = "Set1", + plotPointsEnabled = NA, legendPosition = NA_integer_, showSource = FALSE, + plotSettings = NULL) { + fCall <- match.call(expand.dots = FALSE) + objectName <- deparse(fCall$x) + + # .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) + + if (!missing(y) && inherits(y, "EventProbabilitiesR6")) { + return(plot.EventProbabilitiesR6( + x = y, y = x, + allocationRatioPlanned = ifelse(is.na(allocationRatioPlanned), y$allocationRatioPlanned, allocationRatioPlanned), + main = main, xlab = xlab, ylab = ylab, type = type, + legendTitle = legendTitle, palette = palette, + plotPointsEnabled = plotPointsEnabled, legendPosition = legendPosition, + showSource = showSource, plotSettings = plotSettings, ... + )) + } + + if (!is.na(allocationRatioPlanned)) { + warning("'allocationRatioPlanned' (", allocationRatioPlanned, + ") will be ignored because 'y' is undefined (for more information see ?plot.NumberOfSubjects)", + call. = FALSE + ) + } + + .assertGgplotIsInstalled() + .assertIsValidLegendPosition(legendPosition) + + main <- ifelse(is.na(main), "Number of Subjects", main) + ylab <- ifelse(is.na(ylab), "Number of subjects", ylab) + data <- data.frame( + xValues = x$time, + yValues = x$numberOfSubjects, + categories = "Number of subjects" + ) + + if (is.na(legendPosition)) { + legendPosition <- -1 + } + if (is.na(legendTitle)) { + legendTitle <- "" + } + + srcCmd <- .showPlotSourceInformation( + objectName = objectName, + xParameterName = "time", + yParameterNames = "numberOfSubjects", + type = type, + showSource = showSource + ) + if (!is.null(srcCmd)) { + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(srcCmd)) + } + return(srcCmd) + } + + if (is.null(plotSettings)) { + plotSettings <- x$.plotSettings + } + + return(.plotDataFrame(data, + mainTitle = main, + xlab = xlab, ylab = ylab, xAxisLabel = "Time", + yAxisLabel1 = NA_character_, yAxisLabel2 = NA_character_, + palette = palette, plotPointsEnabled = plotPointsEnabled, + legendTitle = legendTitle, + legendPosition = legendPosition, scalingFactor1 = 1, scalingFactor2 = 1, + addPowerAndAverageSampleNumber = FALSE, mirrorModeEnabled = FALSE, + ratioEnabled = FALSE, plotSettings = plotSettings, sided = 1, ... + )) +} diff --git a/R/class_performance_score_r6.R b/R/class_performance_score_r6.R new file mode 100644 index 00000000..6430692b --- /dev/null +++ b/R/class_performance_score_r6.R @@ -0,0 +1,81 @@ +## | +## | *Performance score classes* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | rpact package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File version: $Revision: 7148 $ +## | Last changed: $Date: 2023-07-03 15:50:22 +0200 (Mo, 03 Jul 2023) $ +## | Last changed by: $Author: pahlke $ +## | + +#' +#' @name PerformanceScore +#' +#' @title +#' Performance Score +#' +#' @description +#' Contains the conditional performance score, its sub-scores and components according to +#' Herrmann et al. (2020) for a given simulation result. +#' +#' @details +#' Use \link{getPerformanceScore} to calculate the performance score. +#' +#' @include f_core_constants.R +#' @include f_core_assertions.R +#' @include f_core_plot.R +#' @include class_core_parameter_set.R +#' @include class_simulation_results.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +PerformanceScoreR6 <- R6Class("PerformanceScoreR6", + inherit = ParameterSetR6, + public = list( + .simulationResults = NULL, + .plotSettings = NULL, + .alternative = NULL, + locationSampleSize = NULL, + variationSampleSize = NULL, + subscoreSampleSize = NULL, + locationConditionalPower = NULL, + variationConditionalPower = NULL, + subscoreConditionalPower = NULL, + performanceScore = NULL, + initialize = function(simulationResults, ...) { + super$initialize(...) + self$.simulationResults <- simulationResults + self$.plotSettings <- PlotSettingsR6$new() + self$.parameterNames <- C_PARAMETER_NAMES + self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS + }, + .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { + "Method for automatically printing performance score objects" + self$.resetCat() + if (!is.null(self$.simulationResults)) { + self$.simulationResults$.show( + showType = showType, + digits = digits, + showStatistics = FALSE, + consoleOutputEnabled = consoleOutputEnabled, + performanceScore = self + ) + } + }, + show = function(showType = 1, digits = NA_integer_) { + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + } + ) +) diff --git a/R/class_simulation_results.R b/R/class_simulation_results.R index e5bfd228..234bd116 100644 --- a/R/class_simulation_results.R +++ b/R/class_simulation_results.R @@ -90,7 +90,7 @@ SimulationResults <- setRefClass("SimulationResults", contains = "ParameterSet", fields = list( .plotSettings = "ANY", - .design = "TrialDesign", + .design = "ANY", .data = "data.frame", .rawData = "data.frame", .showStatistics = "logical", @@ -1138,8 +1138,8 @@ SimulationResultsBaseSurvival <- setRefClass("SimulationResultsBaseSurvival", SimulationResultsSurvival <- setRefClass("SimulationResultsSurvival", contains = "SimulationResultsBaseSurvival", fields = list( - .piecewiseSurvivalTime = "PiecewiseSurvivalTime", - .accrualTime = "AccrualTime", + .piecewiseSurvivalTime = "ANY", + .accrualTime = "ANY", pi1 = "numeric", pi2 = "numeric", median1 = "numeric", diff --git a/R/class_simulation_results_r6.R b/R/class_simulation_results_r6.R new file mode 100644 index 00000000..0bc177df --- /dev/null +++ b/R/class_simulation_results_r6.R @@ -0,0 +1,2842 @@ +## | +## | *Simulation result classes* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | rpact package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File version: $Revision: 7274 $ +## | Last changed: $Date: 2023-09-07 10:58:29 +0200 (Do, 07 Sep 2023) $ +## | Last changed by: $Author: pahlke $ +## | + +#' @include f_core_utilities.R +NULL + +#' +#' @title +#' Names of a Simulation Results Object +#' +#' @description +#' Function to get the names of a \code{\link{SimulationResults}} object. +#' +#' @param x A \code{\link{SimulationResults}} object created by \code{getSimulationResults[MultiArm/Enrichment][Means/Rates/Survival]}. +#' +#' @details +#' Returns the names of a simulation results that can be accessed by the user. +#' +#' @template return_names +#' +#' @export +#' +#' @keywords internal +#' +names.SimulationResultsR6 <- function(x) { + namesToShow <- c(".design", ".data", ".rawData") + if (inherits(x, "SimulationResultsSurvival") || inherits(x, "SimulationResultsSurvivalR6")) { + namesToShow <- c(namesToShow, ".piecewiseSurvivalTime", ".accrualTime") + } + namesToShow <- c(namesToShow, x$.getVisibleFieldNames()) + return(namesToShow) +} + +#' +#' @name SimulationResults +#' +#' @title +#' Class for Simulation Results +#' +#' @description +#' A class for simulation results. +#' +#' @template field_seed +#' @template field_iterations +#' +#' @details +#' \code{SimulationResults} is the basic class for +#' \itemize{ +#' \item \code{\link{SimulationResultsMeans}}, +#' \item \code{\link{SimulationResultsRates}}, +#' \item \code{\link{SimulationResultsSurvival}}, +#' \item \code{\link{SimulationResultsMultiArmMeans}}, +#' \item \code{\link{SimulationResultsMultiArmRates}}, +#' \item \code{\link{SimulationResultsMultiArmSurvival}}, +#' \item \code{\link{SimulationResultsEnrichmentMeans}}, +#' \item \code{\link{SimulationResultsEnrichmentRates}}, and +#' \item \code{\link{SimulationResultsEnrichmentSurvival}}. +#' } +#' +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include class_design.R +#' @include f_core_constants.R +#' @include class_time.R +#' @include f_simulation_base_survival.R +#' @include f_simulation_utilities.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +SimulationResultsR6 <- R6Class("SimulationResultsR6", + inherit = ParameterSetR6, + public = list( + .plotSettings = NULL, + .design = NULL, + .data = NULL, + .rawData = NULL, + .showStatistics = NULL, + maxNumberOfIterations = NULL, + seed = NULL, + allocationRatioPlanned = NULL, + conditionalPower = NULL, + iterations = NULL, + futilityPerStage = NULL, + futilityStop = NULL, + initialize = function(design, ..., showStatistics = FALSE) { + super$initialize(...) + self$.design <- design + self$.showStatistics <- showStatistics + + self$.plotSettings <- PlotSettingsR6$new() + self$.parameterNames <- .getParameterNames(design = design, designPlan = self) + self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS + }, + getPlotSettings = function() { + return(self$.plotSettings) + }, + setShowStatistics = function(showStatistics) { + .assertIsSingleLogical(showStatistics, "showStatistics") + self$.showStatistics <- showStatistics + }, + show = function(showType = 1, digits = NA_integer_, showStatistics = FALSE) { + self$.show( + showType = showType, digits = digits, showStatistics = showStatistics, + consoleOutputEnabled = TRUE + ) + }, + .show = function(..., showType = 1, digits = NA_integer_, + showStatistics = FALSE, consoleOutputEnabled = TRUE, performanceScore = NULL) { + "Method for automatically printing simulation result objects" + + self$.resetCat() + if (showType == 3) { + .createSummary(self, digits = digits)$.show( + showType = 1, + digits = digits, consoleOutputEnabled = consoleOutputEnabled + ) + } else if (showType == 2) { + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + } else { + if (is.null(showStatistics) || length(showStatistics) != 1) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'showStatistics' (", .arrayToString(showStatistics), + ") must be a single logical or character" + ) + } + + if (!is.character(showStatistics) || showStatistics != "exclusive") { + self$.cat(self$.toString(startWithUpperCase = TRUE), ":\n\n", + heading = 1, + consoleOutputEnabled = consoleOutputEnabled + ) + + self$.showParametersOfOneGroup(.getDesignParametersToShow(self), "Design parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + + userDefinedParameters <- self$.getUserDefinedParameters() + if ((inherits(self, "SimulationResultsSurvival") || inherits(self, "SimulationResultsSurvivalR6")) && + self$.piecewiseSurvivalTime$delayedResponseEnabled) { + userDefinedParameters <- c( + userDefinedParameters, + ".piecewiseSurvivalTime$delayedResponseEnabled" + ) + } + self$.showParametersOfOneGroup(userDefinedParameters, "User defined parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + derivedParameters <- self$.getDerivedParameters() + if (length(derivedParameters) > 0) { + self$.showParametersOfOneGroup(derivedParameters, "Derived from user defined parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + } + self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Results", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + } + + ## statistics of simulated data + if (isTRUE(showStatistics) || self$.showStatistics || + (is.character(showStatistics) && showStatistics == "exclusive")) { + self$.cat("Simulated data:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) + params <- c() + if (inherits(self, "SimulationResultsMeans") || inherits(self, "SimulationResultsMeansR6")) { + params <- c( + "effectMeasure", + "numberOfSubjects", + "testStatistic" + ) + } else if (inherits(self, "SimulationResultsRates") || inherits(self, "SimulationResultsRatesR6")) { + params <- c( + "effectMeasure", + "numberOfSubjects", + "testStatistic" + ) + } else if (inherits(self, "SimulationResultsSurvival") || inherits(self, "SimulationResultsSurvivalR6")) { + params <- c( + "effectMeasure", + "analysisTime", + "numberOfSubjects", + "eventsPerStage1", + "eventsPerStage2", + "eventsPerStage", + "testStatistic", + "logRankStatistic", + "hazardRatioEstimateLR" + ) + } else if (inherits(self, "SimulationResultsMultiArmMeans") || inherits(self, "SimulationResultsMultiArmMeansR6") || + inherits(self, "SimulationResultsMultiArmRates") || inherits(self, "SimulationResultsMultiArmRatesR6")) { + params <- c( + "effectMeasure", + "subjectsActiveArm", + "testStatistic", + "conditionalCriticalValue", + "rejectPerStage", + "successStop", + "futilityPerStage" + ) + } else if (inherits(self, "SimulationResultsEnrichmentMeans") || inherits(self, "SimulationResultsEnrichmentMeansR6") || + inherits(self, "SimulationResultsEnrichmentRates") || inherits(self, "SimulationResultsEnrichmentRatesR6")) { + params <- c( + "effectMeasure", + "subjectsPopulation", + "testStatistic", + "conditionalCriticalValue", + "rejectPerStage", + "successStop", + "futilityPerStage" + ) + } else if (inherits(self, "SimulationResultsMultiArmSurvival") || inherits(self, "SimulationResultsMultiArmSurvivalR6") || + inherits(self, "SimulationResultsEnrichmentSurvival") || inherits(self, "SimulationResultsEnrichmentSurvivalR6")) { + params <- c( + "effectMeasure", + "numberOfEvents", + "singleNumberOfEventsPerStage", + "testStatistic", + "conditionalCriticalValue", + "rejectPerStage", + "successStop", + "futilityPerStage" + ) + } + + if (!is.null(self[["conditionalPowerAchieved"]]) && + !all(is.na(self$conditionalPowerAchieved)) && + any(!is.na(self$conditionalPowerAchieved)) && + any(na.omit(self$conditionalPowerAchieved) != 0)) { + params <- c(params, "conditionalPowerAchieved") + } + + stages <- sort(unique(self$.data$stageNumber)) + + variedParameterName1 <- self$.getVariedParameterName(1) + variedParameterName2 <- self$.getVariedParameterName(2) + parameterValues1 <- self$.getVariedParameterValues(variedParameterName1) + parameterValues2 <- self$.getVariedParameterValues(variedParameterName2) + + for (parameterName in params) { + paramCaption <- self$.parameterNames[[parameterName]] + if (is.null(paramCaption)) { + paramCaption <- paste0("%", parameterName, "%") + } + + for (parameterValue1 in parameterValues1) { + for (parameterValue2 in parameterValues2) { + for (stage in stages) { + if (length(parameterValues1) > 1) { + self$.catStatisticsLine( + stage = stage, + parameterName = parameterName, + paramCaption = paramCaption, + parameterValue1 = parameterValue1, + variedParameterName1 = variedParameterName1, + parameterValue2 = parameterValue2, + variedParameterName2 = variedParameterName2, + consoleOutputEnabled = consoleOutputEnabled + ) + } else { + self$.catStatisticsLine( + stage = stage, + parameterName = parameterName, + paramCaption = paramCaption, + parameterValue1 = parameterValue2, + variedParameterName1 = variedParameterName2, + consoleOutputEnabled = consoleOutputEnabled + ) + } + } + } + if (parameterName == "subjectsActiveArm" && variedParameterName2 == "armNumber") { + parameterName2 <- "subjectsControlArm" + paramCaption2 <- self$.parameterNames[[parameterName2]] + if (is.null(paramCaption2)) { + paramCaption2 <- paste0("%", parameterName2, "%") + } + for (stage in stages) { + .catStatisticsLine( + stage = stage, + parameterName = parameterName2, + paramCaption = paramCaption2, + parameterValue1 = parameterValue1, + variedParameterName1 = variedParameterName1, + parameterValue2 = unique(parameterValues2), + variedParameterName2 = variedParameterName2, + consoleOutputEnabled = consoleOutputEnabled + ) + } + } + } + } + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) + } + + twoGroupsEnabled <- !(inherits(self, "SimulationResultsMeans") || inherits(self, "SimulationResultsMeansR6")) + multiArmSurvivalEnabled <- inherits(self, "SimulationResultsMultiArmSurvival") || inherits(self, "SimulationResultsMultiArmSurvivalR6") + enrichmentEnabled <- grepl("SimulationResultsEnrichment", .getClassName(self)) + + if (!is.null(performanceScore)) { + performanceScore$.showParametersOfOneGroup( + performanceScore$.getGeneratedParameters(), "Performance", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + performanceScore$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + } + + if (self$.design$kMax > 1 || twoGroupsEnabled || multiArmSurvivalEnabled) { + self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) + + if (multiArmSurvivalEnabled) { + self$.cat(" (i): values of treatment arm i compared to control\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" {j}: values of treatment arm j\n", consoleOutputEnabled = consoleOutputEnabled) + } else if (enrichmentEnabled) { + matrixName <- .getSimulationEnrichmentEffectMatrixName(self) + if (nrow(self$effectList[[matrixName]]) > 1) { + self$.cat(" (i): results of situation i\n", consoleOutputEnabled = consoleOutputEnabled) + } + } else if (twoGroupsEnabled) { + self$.cat(" (i): values of treatment arm i\n", consoleOutputEnabled = consoleOutputEnabled) + } + if (self$.design$kMax > 1) { + self$.cat(" [k]: values at stage k\n", consoleOutputEnabled = consoleOutputEnabled) + } + + if (enrichmentEnabled) { + if (length(self$effectList$subGroups) > 1) { + self$.cat(paste0(" S[i]: population i\n"), consoleOutputEnabled = consoleOutputEnabled) + } + self$.cat(paste0(" F: full population\n"), consoleOutputEnabled = consoleOutputEnabled) + if (length(self$effectList$subGroups) > 1) { + self$.cat(paste0(" R: remaining population\n"), consoleOutputEnabled = consoleOutputEnabled) + } + } + + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) + } + } + }, + .getVariedParameterName = function(number = 1) { + if (number == 2) { + if (!(inherits(self, "SimulationResultsMeans") || inherits(self, "SimulationResultsMeansR6")) && + !(inherits(self, "SimulationResultsRates") || inherits(self, "SimulationResultsRatesR6")) && + !(inherits(self, "SimulationResultsSurvival") || inherits(self, "SimulationResultsSurvivalR6")) && + grepl("MultiArm", .getClassName(self))) { + return("armNumber") + } + return(NA_character_) + } + + variedParameterName1 <- NA_character_ + if (inherits(self, "SimulationResultsMeans") || inherits(self, "SimulationResultsMeansR6")) { + variedParameterName1 <- "alternative" + } else if (inherits(self, "SimulationResultsRates") || inherits(self, "SimulationResultsRatesR6") || inherits(self, "SimulationResultsSurvival") || inherits(self, "SimulationResultsSurvivalR6")) { + variedParameterName1 <- "pi1" + } else if (grepl("MultiArm", .getClassName(self))) { + if (inherits(self, "SimulationResultsMultiArmMeans") || inherits(self, "SimulationResultsMultiArmMeansR6")) { + variedParameterName1 <- "muMax" + } else if (inherits(self, "SimulationResultsMultiArmRates") || inherits(self, "SimulationResultsMultiArmRatesR6")) { + variedParameterName1 <- "piMax" + } else if (inherits(self, "SimulationResultsMultiArmSurvival") || inherits(self, "SimulationResultsMultiArmSurvivalR6")) { + variedParameterName1 <- "omegaMax" + } + } + return(variedParameterName1) + }, + .getVariedParameterValues = function(variedParameterName) { + if (is.na(variedParameterName)) { + return(NA_real_) + } + + parameterValues <- self$.data[[variedParameterName]] + if (is.null(parameterValues)) { + return(NA_real_) + } + + parameterValues <- unique(parameterValues) + if (length(parameterValues) > 1 && !any(is.na(parameterValues))) { + parameterValues <- sort(parameterValues) + } + return(parameterValues) + }, + .getVariedParameterValueString = function(variedParameterName, parameterValue) { + if (variedParameterName %in% c("armNumber")) { + return(paste0(" (", parameterValue[1], ")")) + } + variedParameterName <- sub("Max$", "_max", variedParameterName) + return(paste0(", ", variedParameterName, " = ", round(parameterValue[1], 4))) + }, + .catStatisticsLine = function(..., stage, parameterName, paramCaption, + parameterValue1, variedParameterName1, parameterValue2 = NA_real_, + variedParameterName2 = NA_character_, consoleOutputEnabled = TRUE) { + if (stage == 1 && parameterName == "conditionalPowerAchieved") { + return(invisible()) + } + + postfix <- "" + if (!is.na(parameterValue1)) { + if (!all(is.na(parameterValue2))) { + postfix <- paste0(postfix, self$.getVariedParameterValueString( + variedParameterName1, parameterValue1 + )) + if (parameterName != "subjectsControlArm") { + postfix <- paste0(postfix, self$.getVariedParameterValueString( + variedParameterName2, parameterValue2 + )) + } + paramValue <- self$.data[[parameterName]][ + self$.data$stageNumber == stage & + self$.data[[variedParameterName1]] == parameterValue1 & + self$.data[[variedParameterName2]] %in% parameterValue2 + ] + } else { + postfix <- paste0(postfix, self$.getVariedParameterValueString( + variedParameterName1, parameterValue1 + )) + paramValue <- self$.data[[parameterName]][ + self$.data$stageNumber == stage & + self$.data[[variedParameterName1]] == parameterValue1 + ] + } + } else { + paramValue <- self$.data[[parameterName]][ + self$.data$stageNumber == stage + ] + } + if (self$.design$kMax > 1) { + postfix <- paste0(postfix, " [", stage, "]") + } + + if (!consoleOutputEnabled) { + paramCaption <- paste0("*", paramCaption, "*") + } + + variableNameFormatted <- .getFormattedVariableName( + name = paramCaption, + n = self$.getNChar(), prefix = "", postfix = postfix + ) + + if (!is.null(paramValue)) { + paramValue <- stats::na.omit(paramValue) + if (length(paramValue) > 0 && is.numeric(paramValue)) { + paramValueFormatted <- paste0( + "median [range]: ", round(stats::median(paramValue), 3), + " [", paste(round(base::range(paramValue), 3), collapse = " - "), "]; ", + "mean +/-sd: ", round(base::mean(paramValue), 3), " +/-", round(stats::sd(paramValue), 3) + ) + } else { + paramValueFormatted <- "median [range]: NA [NA - NA]; mean +/sd: NA +/-NA" + } + output <- paste(variableNameFormatted, paramValueFormatted, "\n") + if (!grepl(": median \\[range\\]: NA \\[NA - NA\\]", output)) { + self$.cat(output, consoleOutputEnabled = consoleOutputEnabled) + } + } + }, + .toString = function(startWithUpperCase = FALSE) { + s <- "simulation of" + + if (grepl("MultiArm", .getClassName(self)) && !is.null(self[["activeArms"]]) && self$activeArms > 1) { + s <- paste(s, "multi-arm") + } + + if (grepl("Enrichment", .getClassName(self)) && !is.null(self[["populations"]]) && self$populations > 1) { + s <- paste(s, "enrichment") + } + + if (inherits(self, "SimulationResultsBaseMeans") || inherits(self, "SimulationResultsBaseMeansR6")) { + s <- paste(s, "means") + } else if (inherits(self, "SimulationResultsBaseRates") || inherits(self, "SimulationResultsBaseRatesR6")) { + s <- paste(s, "rates") + } else if (inherits(self, "SimulationResultsBaseSurvival") || inherits(self, "SimulationResultsBaseSurvivalR6")) { + s <- paste(s, "survival data") + } else { + s <- paste(s, "results") + } + + if (self$.design$kMax > 1) { + if (.isTrialDesignGroupSequential(self$.design)) { + s <- paste(s, "(group sequential design)") + } else if (.isTrialDesignInverseNormal(self$.design)) { + s <- paste(s, "(inverse normal combination test design)") + } else if (.isTrialDesignFisher(self$.design)) { + s <- paste(s, "(Fisher's combination test design)") + } else if (.isTrialDesignConditionalDunnett(self$.design)) { + s <- paste(s, "(conditional Dunnett design)") + } + } else { + s <- paste(s, "(fixed sample size design)") + } + return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) + }, + .getParametersToShow = function() { + parametersToShow <- self$.getVisibleFieldNames() + y <- c( + "eventsPerStage", + "overallEventsPerStage", + "iterations", + "overallReject", # base + "rejectAtLeastOne", + "rejectPerStage", + "rejectedArmsPerStage", + "rejectedPopulationsPerStage" + ) + if (self$.design$kMax > 2) { + y <- c(y, "futilityStop") + } + y <- c( + y, + "futilityPerStage", + "earlyStop", # base + "successPerStage", + "selectedArms", + "selectedPopulations", + "numberOfActiveArms", + "numberOfPopulations", + "expectedNumberOfSubjects", + "expectedNumberOfEvents", + "sampleSizes", + "singleNumberOfEventsPerStage", + "conditionalPowerAchieved" # base + ) + parametersToShow <- c(parametersToShow[!(parametersToShow %in% y)], y[y %in% parametersToShow]) + return(parametersToShow) + }, + .isSampleSizeObject = function() { + return(FALSE) + }, + getRawDataResults = function(maxNumberOfIterations = NA_integer_) { + return(.getSimulationParametersFromRawData(self$.data, + variantName = self$.getVariedParameterName(), + maxNumberOfIterations = maxNumberOfIterations + )) + } + ) +) + +SimulationResultsBaseMeansR6 <- R6Class("SimulationResultsBaseMeansR6", + inherit = SimulationResultsR6, + public = list( + stDev =NULL, + plannedSubjects =NULL, + minNumberOfSubjectsPerStage =NULL, + maxNumberOfSubjectsPerStage =NULL, + thetaH1 =NULL, + stDevH1 =NULL, + calcSubjectsFunction =NULL, + expectedNumberOfSubjects =NULL, + initialize = function(design, ...) { + super$initialize(design = design, ...) + generatedParams <- c( + "iterations", + "expectedNumberOfSubjects", + "sampleSizes", + "overallReject", + "rejectPerStage", + "futilityPerStage", + "earlyStop" + ) + if (design$kMax > 2) { + generatedParams <- c(generatedParams, "futilityStop") + } + for (generatedParam in generatedParams) { + self$.setParameterType(generatedParam, C_PARAM_GENERATED) + } + } + ) +) + +#' +#' @name SimulationResultsMeans +#' +#' @title +#' Class for Simulation Results Means +#' +#' @description +#' A class for simulation results means. +#' +#' @template field_maxNumberOfIterations +#' @template field_seed +#' @template field_allocationRatioPlanned +#' @template field_conditionalPower +#' @template field_iterations +#' @template field_futilityPerStage +#' @template field_futilityStop +#' @template field_stDev +#' @template field_plannedSubjects +#' @template field_minNumberOfSubjectsPerStage +#' @template field_maxNumberOfSubjectsPerStage +#' @template field_thetaH1 +#' @template field_stDevH1 +#' @template field_calcSubjectsFunction +#' @template field_expectedNumberOfSubjects +#' @template field_meanRatio +#' @template field_thetaH0 +#' @template field_normalApproximation +#' @template field_alternative +#' @template field_groups +#' @template field_directionUpper +#' @template field_effect +#' @template field_earlyStop +#' @template field_sampleSizes +#' @template field_overallReject +#' @template field_rejectPerStage +#' @template field_conditionalPowerAchieved +#' +#' @details +#' Use \code{\link[=getSimulationMeans]{getSimulationMeans()}} to create an object of this type. +#' +#' \code{SimulationResultsMeans} is the basic class for +#' \itemize{ +#' \item \code{\link{SimulationResultsMeans}}, +#' \item \code{\link{SimulationResultsMultiArmMeans}}, and +#' \item \code{\link{SimulationResultsEnrichmentMeans}}. +#' } +#' +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include class_design.R +#' @include f_core_constants.R +#' @include class_time.R +#' @include f_simulation_base_survival.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +SimulationResultsMeansR6 <- R6Class("SimulationResultsMeansR6", + inherit = SimulationResultsBaseMeansR6, + public = list( + meanRatio =NULL, + thetaH0 =NULL, + normalApproximation =NULL, + alternative =NULL, + groups =NULL, + directionUpper =NULL, + effect =NULL, + earlyStop =NULL, + sampleSizes =NULL, + overallReject =NULL, # = rejectedArmsPerStage in multi-arm + rejectPerStage =NULL, + conditionalPowerAchieved =NULL, + initialize = function(design, ...) { + super$initialize(design = design, ...) + } + ) +) + + +#' +#' @name SimulationResultsMultiArmMeans +#' +#' @title +#' Class for Simulation Results Multi-Arm Means +#' +#' @description +#' A class for simulation results means in multi-arm designs. +#' +#' @template field_maxNumberOfIterations +#' @template field_seed +#' @template field_allocationRatioPlanned +#' @template field_conditionalPower +#' @template field_iterations +#' @template field_futilityPerStage +#' @template field_futilityStop +#' @template field_stDev +#' @template field_plannedSubjects +#' @template field_minNumberOfSubjectsPerStage +#' @template field_maxNumberOfSubjectsPerStage +#' @template field_thetaH1 +#' @template field_stDevH1 +#' @template field_calcSubjectsFunction +#' @template field_expectedNumberOfSubjects +#' @template field_activeArms +#' @template field_effectMatrix +#' @template field_typeOfShape +#' @template field_muMaxVector +#' @template field_gED50 +#' @template field_slope +#' @template field_intersectionTest +#' @template field_adaptations +#' @template field_typeOfSelection +#' @template field_effectMeasure +#' @template field_successCriterion +#' @template field_epsilonValue +#' @template field_rValue +#' @template field_threshold +#' @template field_selectArmsFunction +#' @template field_earlyStop +#' @template field_selectedArms +#' @template field_numberOfActiveArms +#' @template field_rejectAtLeastOne +#' @template field_rejectedArmsPerStage +#' @template field_successPerStage +#' @template field_sampleSizes +#' @template field_conditionalPowerAchieved +#' +#' @details +#' Use \code{\link[=getSimulationMultiArmMeans]{getSimulationMultiArmMeans()}} to create an object of this type. +#' +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include class_design.R +#' @include f_core_constants.R +#' @include class_time.R +#' @include f_simulation_base_survival.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +SimulationResultsMultiArmMeansR6 <- R6Class("SimulationResultsMultiArmMeansR6", + inherit = SimulationResultsBaseMeansR6, + public = list( + activeArms = NULL, + effectMatrix = NULL, + typeOfShape = NULL, + muMaxVector = NULL, + gED50 = NULL, + slope = NULL, + intersectionTest = NULL, + adaptations = NULL, + typeOfSelection = NULL, + effectMeasure = NULL, + successCriterion = NULL, + epsilonValue = NULL, + rValue = NULL, + threshold = NULL, + selectArmsFunction = NULL, + earlyStop = NULL, + selectedArms = NULL, + numberOfActiveArms = NULL, + rejectAtLeastOne = NULL, + rejectedArmsPerStage = NULL, + successPerStage = NULL, + sampleSizes = NULL, + conditionalPowerAchieved = matrix(), + initialize = function(design, ...) { + super$initialize(design = design, ...) + + for (generatedParam in c( + "rejectAtLeastOne", + "selectedArms", + "numberOfActiveArms", + "rejectedArmsPerStage", + "successPerStage" + )) { + self$.setParameterType(generatedParam, C_PARAM_GENERATED) + } + } + ) +) + +SimulationResultsBaseRatesR6 <- R6Class("SimulationResultsBaseRatesR6", + inherit = SimulationResultsR6, + public = list( + directionUpper = NULL, + plannedSubjects = NULL, + minNumberOfSubjectsPerStage = NULL, + maxNumberOfSubjectsPerStage = NULL, + calcSubjectsFunction = NULL, + expectedNumberOfSubjects = NULL, + initialize = function(design, ...) { + super$initialize(design = design, ...) + generatedParams <- c( + "iterations", + "expectedNumberOfSubjects", + "sampleSizes", + "overallReject", + "rejectPerStage", + "futilityPerStage", + "earlyStop" + ) + if (design$kMax > 2) { + generatedParams <- c(generatedParams, "futilityStop") + } + for (generatedParam in generatedParams) { + self$.setParameterType(generatedParam, C_PARAM_GENERATED) + } + } + ) +) + + +#' +#' @name SimulationResultsRates +#' +#' @title +#' Class for Simulation Results Rates +#' +#' @description +#' A class for simulation results rates. +#' +#' @template field_maxNumberOfIterations +#' @template field_seed +#' @template field_allocationRatioPlanned +#' @template field_conditionalPower +#' @template field_iterations +#' @template field_futilityPerStage +#' @template field_futilityStop +#' @template field_directionUpper +#' @template field_plannedSubjects +#' @template field_maxNumberOfSubjects +#' @template field_calcSubjectsFunction +#' @template field_expectedNumberOfSubjects +#' @template field_riskRatio +#' @template field_thetaH0 +#' @template field_normalApproximation +#' @template field_pi1 +#' @template field_pi2 +#' @template field_groups +#' @template field_pi1H1 +#' @template field_pi2H1 +#' @template field_effect +#' @template field_earlyStop +#' @template field_sampleSizes +#' @template field_overallReject +#' @template field_rejectPerStage +#' @template field_conditionalPowerAchieved +#' +#' +#' @details +#' Use \code{\link[=getSimulationRates]{getSimulationRates()}} to create an object of this type. +#' +#' \code{SimulationResultsRates} is the basic class for +#' \itemize{ +#' \item \code{\link{SimulationResultsRates}}, +#' \item \code{\link{SimulationResultsMultiArmRates}}, and +#' \item \code{\link{SimulationResultsEnrichmentRates}}. +#' } +#' +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include class_design.R +#' @include f_core_constants.R +#' @include class_time.R +#' @include f_simulation_base_survival.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +SimulationResultsRatesR6 <- R6Class("SimulationResultsRatesR6", + inherit = SimulationResultsBaseRatesR6, + public = list( + riskRatio = NULL, + thetaH0 = NULL, + normalApproximation = NULL, + pi1 = NULL, + pi2 = NULL, + groups = NULL, + #directionUpper = NULL, + pi1H1 = NULL, + pi2H1 = NULL, + effect = NULL, + earlyStop = NULL, + sampleSizes = NULL, + overallReject = NULL, + rejectPerStage = NULL, + conditionalPowerAchieved = matrix(), + initialize = function(design, ...) { + super$initialize(design = design, ...) + generatedParams <- c( + "effect", + "iterations", + "sampleSizes", + "eventsNotAchieved", + "expectedNumberOfSubjects", + "overallReject", + "rejectPerStage", + "futilityPerStage", + "earlyStop", + "analysisTime", + "studyDuration" + ) + if (design$kMax > 2) { + generatedParams <- c(generatedParams, "futilityStop") + } + for (generatedParam in generatedParams) { + self$.setParameterType(generatedParam, C_PARAM_GENERATED) + } + } + ) +) + + +#' +#' @name SimulationResultsMultiArmRates +#' +#' @title +#' Class for Simulation Results Multi-Arm Rates +#' +#' @description +#' A class for simulation results rates in multi-arm designs. +#' +#' @template field_maxNumberOfIterations +#' @template field_seed +#' @template field_allocationRatioPlanned +#' @template field_conditionalPower +#' @template field_iterations +#' @template field_futilityPerStage +#' @template field_futilityStop +#' @template field_directionUpper +#' @template field_plannedSubjects +#' @template field_maxNumberOfSubjects +#' @template field_calcSubjectsFunction +#' @template field_expectedNumberOfSubjects +#' @template field_activeArms +#' @template field_effectMatrix +#' @template field_typeOfShape +#' @template field_piMaxVector +#' @template field_piControl +#' @template field_piH1 +#' @template field_piControlH1 +#' @template field_gED50 +#' @template field_slope +#' @template field_intersectionTest +#' @template field_adaptations +#' @template field_typeOfSelection +#' @template field_effectMeasure +#' @template field_successCriterion +#' @template field_epsilonValue +#' @template field_rValue +#' @template field_threshold +#' @template field_selectArmsFunction +#' @template field_earlyStop +#' @template field_selectedArms +#' @template field_numberOfActiveArms +#' @template field_rejectAtLeastOne +#' @template field_rejectedArmsPerStage +#' @template field_successPerStage +#' @template field_sampleSizes +#' @template field_conditionalPowerAchieved +#' +#' +#' @details +#' Use \code{\link[=getSimulationMultiArmRates]{getSimulationMultiArmRates()}} to create an object of this type. +#' +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include class_design.R +#' @include f_core_constants.R +#' @include class_time.R +#' @include f_simulation_base_survival.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +SimulationResultsMultiArmRatesR6 <- R6Class("SimulationResultsMultiArmRatesR6", + inherit = SimulationResultsBaseRatesR6, + public = list( + activeArms = NULL, + effectMatrix = NULL, + typeOfShape = NULL, + piMaxVector = NULL, + piControl = NULL, + piTreatmentsH1 = NULL, + piControlH1 = NULL, + gED50 = NULL, + slope = NULL, + intersectionTest = NULL, + adaptations = NULL, + typeOfSelection = NULL, + effectMeasure = NULL, + successCriterion = NULL, + epsilonValue = NULL, + rValue = NULL, + threshold = NULL, + selectArmsFunction = NULL, + earlyStop = NULL, + selectedArms = NULL, + numberOfActiveArms = NULL, + rejectAtLeastOne = NULL, + rejectedArmsPerStage = NULL, + successPerStage = NULL, + sampleSizes = NULL, + conditionalPowerAchieved = matrix(), + initialize = function(design, ...) { + super$initialize(design = design, ...) + + for (generatedParam in c( + "rejectAtLeastOne", + "selectedArms", + "numberOfActiveArms", + "rejectedArmsPerStage", + "successPerStage" + )) { + self$.setParameterType(generatedParam, C_PARAM_GENERATED) + } + } + ) +) + +SimulationResultsBaseSurvivalR6 <- R6Class("SimulationResultsBaseSurvivalR6", + inherit = SimulationResultsR6, + public = list( + directionUpper = NULL, + plannedEvents = NULL, + minNumberOfEventsPerStage = NULL, + maxNumberOfEventsPerStage = NULL, + thetaH1 = NULL, + calcEventsFunction = NULL, + expectedNumberOfEvents = NULL, + conditionalPowerAchieved = matrix(), #TODO remove? + initialize = function(design, ...) { + super$initialize(design = design, ...) + generatedParams <- c( + "iterations", + "expectedNumberOfEvents", + "eventsPerStage", + "overallReject", + "rejectPerStage", + "futilityPerStage", + "earlyStop" + ) + if (design$kMax > 2) { + generatedParams <- c(generatedParams, "futilityStop") + } + for (generatedParam in generatedParams) { + self$.setParameterType(generatedParam, C_PARAM_GENERATED) + } + } + ) +) + +#' +#' @name SimulationResultsSurvival +#' +#' @title +#' Class for Simulation Results Survival +#' +#' @description +#' A class for simulation results survival. +#' +#' @template field_maxNumberOfIterations +#' @template field_seed +#' @template field_allocationRatioPlanned +#' @template field_conditionalPower +#' @template field_iterations +#' @template field_futilityPerStage +#' @template field_futilityStop +#' @template field_directionUpper +#' @template field_plannedEvents +#' @template field_minNumberOfEventsPerStage +#' @template field_maxNumberOfEventsPerStage +#' @template field_thetaH1 +#' @template field_calcEventsFunction +#' @template field_expectedNumberOfEvents +#' @template field_pi1_survival +#' @template field_pi2_survival +#' @template field_median1 +#' @template field_median2 +#' @template field_maxNumberOfSubjects +#' @template field_accrualTime +#' @template field_accrualIntensity +#' @template field_dropoutRate1 +#' @template field_dropoutRate2 +#' @template field_dropoutTime +#' @template field_eventTime +#' @template field_thetaH0 +#' @template field_allocation1 +#' @template field_allocation2 +#' @template field_kappa +#' @template field_piecewiseSurvivalTime +#' @template field_lambda1 +#' @template field_lambda2 +#' @template field_earlyStop +#' @template field_hazardRatio +#' @template field_studyDuration +#' @template field_eventsNotAchieved +#' @template field_numberOfSubjects +#' @template field_numberOfSubjects1 +#' @template field_numberOfSubjects2 +#' @template field_eventsPerStage +#' @template field_overallEventsPerStage +#' @template field_expectedNumberOfSubjects +#' @template field_rejectPerStage +#' @template field_overallReject +#' @template field_conditionalPowerAchieved +#' +#' @details +#' Use \code{\link[=getSimulationSurvival]{getSimulationSurvival()}} to create an object of this type. +#' +#' \code{SimulationResultsSurvival} is the basic class for +#' \itemize{ +#' \item \code{\link{SimulationResultsSurvival}}, +#' \item \code{\link{SimulationResultsMultiArmSurvival}}, and +#' \item \code{\link{SimulationResultsEnrichmentSurvival}}. +#' } +#' +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include class_design.R +#' @include f_core_constants.R +#' @include class_time.R +#' @include f_simulation_base_survival.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +SimulationResultsSurvivalR6 <- R6Class("SimulationResultsSurvivalR6", + inherit = SimulationResultsBaseSurvivalR6, + public = list( + .piecewiseSurvivalTime = NULL, + .accrualTime = NULL, + pi1 = NULL, + pi2 = NULL, + median1 = NULL, + median2 = NULL, + maxNumberOfSubjects = NULL, + accrualTime = NULL, + accrualIntensity = NULL, + dropoutRate1 = NULL, + dropoutRate2 = NULL, + dropoutTime = NULL, + eventTime = NULL, + thetaH0 = NULL, + allocation1 = NULL, + allocation2 = NULL, + kappa = NULL, + piecewiseSurvivalTime = NULL, + lambda1 = NULL, + lambda2 = NULL, + earlyStop = NULL, + hazardRatio = NULL, + analysisTime = NULL, + studyDuration = NULL, + eventsNotAchieved = NULL, + numberOfSubjects = NULL, + numberOfSubjects1 = NULL, + numberOfSubjects2 = NULL, + eventsPerStage = NULL, + overallEventsPerStage = NULL, + expectedNumberOfSubjects = NULL, + rejectPerStage = NULL, + overallReject = NULL, + conditionalPowerAchieved = matrix(), + initialize = function(design, ...) { + super$initialize(design = design, ...) + generatedParams <- c( + "hazardRatio", + "iterations", + "eventsPerStage", + "singleNumberOfEventsPerStage", + "expectedNumberOfEvents", + "eventsNotAchieved", + "numberOfSubjects", + "expectedNumberOfSubjects", + "overallReject", + "rejectPerStage", + "futilityPerStage", + "earlyStop", + "analysisTime", + "studyDuration", + "allocationRatioPlanned" + ) + if (design$kMax > 2) { + generatedParams <- c(generatedParams, "futilityStop") + } + for (generatedParam in generatedParams) { + self$.setParameterType(generatedParam, C_PARAM_GENERATED) + } + self$.setParameterType("numberOfSubjects1", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("numberOfSubjects2", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("median1", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("median2", C_PARAM_NOT_APPLICABLE) + } + ) +) + +#' +#' @name SimulationResultsMultiArmSurvival +#' +#' @title +#' Class for Simulation Results Multi-Arm Survival +#' +#' @description +#' A class for simulation results survival in multi-arm designs. +#' +#' @template field_maxNumberOfIterations +#' @template field_seed +#' @template field_allocationRatioPlanned +#' @template field_conditionalPower +#' @template field_iterations +#' @template field_futilityPerStage +#' @template field_futilityStop +#' @template field_directionUpper +#' @template field_plannedEvents +#' @template field_minNumberOfEventsPerStage +#' @template field_maxNumberOfEventsPerStage +#' @template field_expectedNumberOfEvents +#' @template field_activeArms +#' @template field_effectMatrix +#' @template field_typeOfShape +#' @template field_omegaMaxVector +#' @template field_gED50 +#' @template field_slope +#' @template field_intersectionTest +#' @template field_adaptations +#' @template field_epsilonValue +#' @template field_rValue +#' @template field_threshold +#' @template field_selectArmsFunction +#' @template field_correlationComputation +#' @template field_earlyStop +#' @template field_selectedArms +#' @template field_numberOfActiveArms +#' @template field_rejectAtLeastOne +#' @template field_rejectedArmsPerStage +#' @template field_successPerStage +#' @template field_eventsPerStage +#' @template field_singleNumberOfEventsPerStage +#' @template field_conditionalPowerAchieved +#' +#' @details +#' Use \code{\link[=getSimulationMultiArmSurvival]{getSimulationMultiArmSurvival()}} to create an object of this type. +#' +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include class_design.R +#' @include f_core_constants.R +#' @include class_time.R +#' @include f_simulation_base_survival.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +SimulationResultsMultiArmSurvivalR6 <- R6Class("SimulationResultsMultiArmSurvivalR6", + inherit = SimulationResultsBaseSurvivalR6, + public = list( + activeArms = NULL, + effectMatrix = NULL, + typeOfShape = NULL, + omegaMaxVector = NULL, + gED50 = NULL, + slope = NULL, + intersectionTest = NULL, + adaptations = NULL, + typeOfSelection = NULL, + effectMeasure = NULL, + successCriterion = NULL, + epsilonValue = NULL, + rValue = NULL, + threshold = NULL, + selectArmsFunction = NULL, + correlationComputation = NULL, + earlyStop = NULL, + selectedArms = NULL, + numberOfActiveArms = NULL, + rejectAtLeastOne = NULL, + rejectedArmsPerStage = NULL, + successPerStage = NULL, + eventsPerStage = NULL, + singleNumberOfEventsPerStage = NULL, + conditionalPowerAchieved = matrix(), + initialize = function(design, ...) { + super$initialize(design = design, ...) + + for (generatedParam in c( + "rejectAtLeastOne", + "selectedArms", + "numberOfActiveArms", + "rejectedArmsPerStage", + "successPerStage" + )) { + self$.setParameterType(generatedParam, C_PARAM_GENERATED) + } + } + ) +) + +#' +#' @name SimulationResultsEnrichmentMeans +#' +#' @title +#' Class for Simulation Results Enrichment Means +#' +#' @description +#' A class for simulation results means in enrichment designs. +#' +#' @template field_maxNumberOfIterations +#' @template field_seed +#' @template field_allocationRatioPlanned +#' @template field_conditionalPower +#' @template field_iterations +#' @template field_futilityPerStage +#' @template field_futilityStop +#' @template field_stDev +#' @template field_plannedSubjects +#' @template field_minNumberOfSubjectsPerStage +#' @template field_maxNumberOfSubjectsPerStage +#' @template field_thetaH1 +#' @template field_stDevH1 +#' @template field_calcSubjectsFunction +#' @template field_expectedNumberOfSubjects +#' @template field_populations +#' @template field_effectList +#' @template field_intersectionTest +#' @template field_stratifiedAnalysis +#' @template field_adaptations +#' @template field_typeOfSelection +#' @template field_effectMeasure +#' @template field_successCriterion +#' @template field_epsilonValue +#' @template field_rValue +#' @template field_threshold +#' @template field_selectPopulationsFunction +#' @template field_earlyStop +#' @template field_selectedPopulations +#' @template field_numberOfPopulations +#' @template field_rejectAtLeastOne +#' @template field_rejectedPopulationsPerStage +#' @template field_successPerStage +#' @template field_sampleSizes +#' @template field_conditionalPowerAchieved +#' +#' @details +#' Use \code{\link[=getSimulationEnrichmentMeans]{getSimulationEnrichmentMeans()}} to create an object of this type. +#' +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include class_design.R +#' @include f_core_constants.R +#' @include class_time.R +#' @include f_simulation_base_survival.R +#' @include class_simulation_results.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +SimulationResultsEnrichmentMeansR6 <- R6Class("SimulationResultsEnrichmentMeansR6", + inherit = SimulationResultsBaseMeansR6, + public = list( + populations = NULL, + effectList = NULL, + intersectionTest = NULL, + stratifiedAnalysis = NULL, + adaptations = NULL, + typeOfSelection = NULL, + effectMeasure = NULL, + successCriterion = NULL, + epsilonValue = NULL, + rValue = NULL, + threshold = NULL, + selectPopulationsFunction = NULL, + earlyStop = NULL, + selectedPopulations = NULL, + numberOfPopulations = NULL, + rejectAtLeastOne = NULL, + rejectedPopulationsPerStage = NULL, + successPerStage = NULL, + sampleSizes = NULL, + conditionalPowerAchieved = matrix(), + initialize = function(design, ...) { + super$initialize(design = design, ...) + + for (generatedParam in c( + "rejectAtLeastOne", + "selectedPopulations", + "numberOfPopulations", + "rejectedPopulationsPerStage", + "successPerStage" + )) { + self$.setParameterType(generatedParam, C_PARAM_GENERATED) + } + } + ) +) + +#' +#' @name SimulationResultsEnrichmentRates +#' +#' @title +#' Class for Simulation Results Enrichment Rates +#' +#' @description +#' A class for simulation results rates in enrichment designs. +#' +#' @template field_maxNumberOfIterations +#' @template field_seed +#' @template field_allocationRatioPlanned +#' @template field_conditionalPower +#' @template field_iterations +#' @template field_futilityPerStage +#' @template field_futilityStop +#' @template field_directionUpper +#' @template field_plannedSubjects +#' @template field_minNumberOfSubjectsPerStage +#' @template field_maxNumberOfSubjectsPerStage +#' @template field_calcSubjectsFunction +#' @template field_expectedNumberOfSubjects +#' @template field_populations +#' @template field_effectList +#' @template field_intersectionTest +#' @template field_stratifiedAnalysis +#' @template field_adaptations +#' @template field_piTreatmentH1 +#' @template field_piControlH1 +#' @template field_typeOfSelection +#' @template field_effectMeasure +#' @template field_successCriterion +#' @template field_epsilonValue +#' @template field_rValue +#' @template field_threshold +#' @template field_selectPopulationsFunction +#' @template field_earlyStop +#' @template field_selectedPopulations +#' @template field_numberOfPopulations +#' @template field_rejectAtLeastOne +#' @template field_rejectedPopulationsPerStage +#' @template field_successPerStage +#' @template field_sampleSizes +#' @template field_conditionalPowerAchieved +#' +#' @details +#' Use \code{\link[=getSimulationEnrichmentRates]{getSimulationEnrichmentRates()}} to create an object of this type. +#' +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include class_design.R +#' @include f_core_constants.R +#' @include class_time.R +#' @include f_simulation_base_survival.R +#' @include class_simulation_results.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +SimulationResultsEnrichmentRatesR6 <- R6Class("SimulationResultsEnrichmentRatesR6", + inherit = SimulationResultsBaseRatesR6, + public = list( + populations = NULL, + effectList = NULL, + intersectionTest = NULL, + stratifiedAnalysis = NULL, + adaptations = NULL, + piTreatmentH1 = NULL, + piControlH1 = NULL, + typeOfSelection = NULL, + effectMeasure = NULL, + successCriterion = NULL, + epsilonValue = NULL, + rValue = NULL, + threshold = NULL, + selectPopulationsFunction = NULL, + earlyStop = NULL, + selectedPopulations = NULL, + numberOfPopulations = NULL, + rejectAtLeastOne = NULL, + rejectedPopulationsPerStage = NULL, + successPerStage = NULL, + sampleSizes = NULL, + conditionalPowerAchieved = matrix(), + initialize = function(design, ...) { + super$initialize(design = design, ...) + + for (generatedParam in c( + "rejectAtLeastOne", + "selectedPopulations", + "numberOfPopulations", + "rejectedPopulationsPerStage", + "successPerStage" + )) { + self$.setParameterType(generatedParam, C_PARAM_GENERATED) + } + } + ) +) + +#' +#' @name SimulationResultsEnrichmentSurvival +#' +#' @title +#' Class for Simulation Results Enrichment Survival +#' +#' @description +#' A class for simulation results survival in enrichment designs. +#' +#' @template field_maxNumberOfIterations +#' @template field_seed +#' @template field_allocationRatioPlanned +#' @template field_conditionalPower +#' @template field_iterations +#' @template field_futilityPerStage +#' @template field_futilityStop +#' @template field_directionUpper +#' @template field_plannedSubjects +#' @template field_minNumberOfSubjectsPerStage +#' @template field_maxNumberOfSubjectsPerStage +#' @template field_thetaH1_survival +#' @template field_calcEventsFunction +#' @template field_expectedNumberOfEvents +#' @template field_populations +#' @template field_effectList +#' @template field_intersectionTest +#' @template field_stratifiedAnalysis +#' @template field_adaptations +#' @template field_typeOfSelection +#' @template field_effectMeasure +#' @template field_successCriterion +#' @template field_epsilonValue +#' @template field_rValue +#' @template field_threshold +#' @template field_selectPopulationsFunction +#' @template field_correlationComputation +#' @template field_earlyStop +#' @template field_selectedPopulations +#' @template field_numberOfPopulations +#' @template field_rejectAtLeastOne +#' @template field_rejectedPopulationsPerStage +#' @template field_successPerStage +#' @template field_eventsPerStage +#' @template field_singleNumberOfEventsPerStage +#' @template field_conditionalPowerAchieved +#' +#' @details +#' Use \code{\link[=getSimulationEnrichmentSurvival]{getSimulationEnrichmentSurvival()}} to create an object of this type. +#' +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include class_design.R +#' @include f_core_constants.R +#' @include class_time.R +#' @include f_simulation_base_survival.R +#' @include class_simulation_results.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +SimulationResultsEnrichmentSurvivalR6 <- R6Class("SimulationResultsEnrichmentSurvivalR6", + inherit = SimulationResultsBaseSurvivalR6, + public = list( + populations = NULL, + effectList = NULL, + intersectionTest = NULL, + stratifiedAnalysis = NULL, + adaptations = NULL, + typeOfSelection = NULL, + effectMeasure = NULL, + successCriterion = NULL, + epsilonValue = NULL, + rValue = NULL, + threshold = NULL, + selectPopulationsFunction = NULL, + correlationComputation = NULL, + earlyStop = NULL, + selectedPopulations = NULL, + numberOfPopulations = NULL, + rejectAtLeastOne = NULL, + rejectedPopulationsPerStage = NULL, + successPerStage = NULL, + eventsPerStage = NULL, + singleNumberOfEventsPerStage = NULL, + conditionalPowerAchieved = matrix(), + initialize = function(design, ...) { + super$initialize(design = design, ...) + + for (generatedParam in c( + "rejectAtLeastOne", + "selectedPopulations", + "numberOfPopulations", + "rejectedPopulationsPerStage", + "successPerStage" + )) { + self$.setParameterType(generatedParam, C_PARAM_GENERATED) + } + } + ) +) + +.assertIsValidVariedParameterVectorForSimulationResultsPlotting <- function(simulationResults, plotType) { + if (inherits(simulationResults, "SimulationResultsMeans") || inherits(simulationResults, "SimulationResultsMeansR6")) { + if (is.null(simulationResults$alternative) || + any(is.na(simulationResults$alternative)) || + length(simulationResults$alternative) <= 1) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "plot type ", plotType, + " is only available if 'alternative' with length > 1 is defined" + ) + } + } else if (inherits(simulationResults, "SimulationResultsRates") || inherits(simulationResults, "SimulationResultsRatesR6")) { + if (is.null(simulationResults$pi1) || + any(is.na(simulationResults$pi1)) || + length(simulationResults$pi1) <= 1) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "plot type ", plotType, + " is only available if 'pi1' with length > 1 is defined" + ) + } + } else if (inherits(simulationResults, "SimulationResultsSurvival") || inherits(simulationResults, "SimulationResultsSurvivalR6")) { + if (is.null(simulationResults$hazardRatio) || + any(is.na(simulationResults$hazardRatio)) || + length(simulationResults$hazardRatio) <= 1) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "plot type ", plotType, + " is only available if 'hazardRatio' with length > 1 is defined or derived" + ) + } + if (length(simulationResults$hazardRatio) != length(simulationResults$overallReject)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "plot type ", plotType, + " is not available for piecewise survival (only type 13 and 14)" + ) + } + } +} + +.getSimulationPlotXAxisParameterName <- function(simulationResults, + showSource = FALSE, simulationResultsName = NA_character_) { + if (grepl("SimulationResultsEnrichment", .getClassName(simulationResults))) { + effectDataList <- .getSimulationEnrichmentEffectData(simulationResults) + if (ncol(effectDataList$effectData) == 1) { + if (!isFALSE(showSource)) { + return(paste0(simulationResultsName, "$effectList$", effectDataList$effectMatrixName, "[, 1]")) + } + + return(sub("s$", "", effectDataList$effectMatrixName)) + } + + if (!isFALSE(showSource)) { + numberOfSituations <- nrow(simulationResults$effectList[[effectDataList$effectMatrixName]]) + return(paste0("c(1:", numberOfSituations, ")")) + } + + return("situation") + } + + survivalEnabled <- grepl("Survival", .getClassName(simulationResults)) + meansEnabled <- grepl("Means", .getClassName(simulationResults)) + if (grepl("MultiArm", .getClassName(simulationResults))) { + if (!isFALSE(showSource)) { + gMax <- nrow(simulationResults$effectMatrix) + return(paste0(simulationResultsName, "$effectMatrix[", gMax, ", ]")) + } + + return("effectMatrix") + } + + if (grepl("Survival", .getClassName(simulationResults))) { + return("hazardRatio") + } + + return("effect") +} + +.getSimulationPlotXAxisLabel <- function(simulationResults, xlab = NULL) { + if (grepl("SimulationResultsEnrichment", .getClassName(simulationResults))) { + effectDataList <- .getSimulationEnrichmentEffectData(simulationResults) + if (ncol(effectDataList$effectData) == 1) { + xLabel <- simulationResults$.parameterNames[[effectDataList$effectMatrixName]] + return(sub("s$", "", xLabel)) + } + + return("Situation") + } + + multiArmEnabled <- grepl("MultiArm", .getClassName(simulationResults)) + userDefinedEffectMatrix <- multiArmEnabled && simulationResults$.getParameterType("effectMatrix") == C_PARAM_USER_DEFINED + if (!is.null(xlab) && !is.na(xlab)) { + return(xlab) + } + + if (!multiArmEnabled) { + return("Effect") + } + + return(ifelse(userDefinedEffectMatrix, "Effect Matrix Row", "Maximum Effect")) +} + +.getPowerAndStoppingProbabilities <- function(simulationResults, xValues, parameters) { + yParameterNames <- c() + + if ("expectedNumberOfEvents" %in% parameters) { + yParameterNames <- c(yParameterNames, "expectedNumberOfEvents") + } + if ("expectedNumberOfSubjects" %in% parameters) { + yParameterNames <- c(yParameterNames, "expectedNumberOfSubjects") + } + if ("rejectAtLeastOne" %in% parameters) { + yParameterNames <- c(yParameterNames, "rejectAtLeastOne") + } + if ("futilityStop" %in% parameters) { + yParameterNames <- c(yParameterNames, "futilityStop") + } + + yParameterNamesSrc <- yParameterNames + + data <- NULL + for (yParameterName in yParameterNames) { + category <- simulationResults$.parameterNames[[yParameterName]] + part <- data.frame( + categories = rep(category, length(xValues)), + xValues = xValues, + yValues = simulationResults[[yParameterName]] + ) + if (is.null(data)) { + data <- part + } else { + data <- rbind(data, part) + } + } + + if ("earlyStop" %in% parameters) { + yParameterNames <- c(yParameterNames, "earlyStop") + + maxEarlyStoppingStages <- nrow(simulationResults$earlyStop) + for (k in 1:maxEarlyStoppingStages) { + category <- "Early stop" + if (maxEarlyStoppingStages > 1) { + category <- paste0(category, ", stage ", k) + } + part <- data.frame( + categories = rep(category, ncol(simulationResults$earlyStop)), + xValues = xValues, + yValues = simulationResults$earlyStop[k, ] + ) + data <- rbind(data, part) + yParameterNamesSrc <- c(yParameterNamesSrc, paste0("earlyStop[", k, ", ]")) + } + } + + return(list( + data = data, + yParameterNames = yParameterNames, + yParameterNamesSrc = yParameterNamesSrc + )) +} + +.plotSimulationResults <- function(simulationResults, designMaster, type = 5L, main = NA_character_, + xlab = NA_character_, ylab = NA_character_, palette = "Set1", + theta = seq(-1, 1, 0.02), plotPointsEnabled = NA, + legendPosition = NA_integer_, showSource = FALSE, + simulationResultsName = NA_character_, plotSettings = NULL, ...) { + .assertGgplotIsInstalled() + .assertIsSimulationResults(simulationResults) + .assertIsValidLegendPosition(legendPosition) + .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) + theta <- .assertIsValidThetaRange(thetaRange = theta) + + if (is.null(plotSettings)) { + plotSettings <- simulationResults$.plotSettings + } + + survivalEnabled <- grepl("Survival", .getClassName(simulationResults)) + meansEnabled <- grepl("Means", .getClassName(simulationResults)) + multiArmEnabled <- grepl("MultiArm", .getClassName(simulationResults)) + enrichmentEnabled <- grepl("Enrichment", .getClassName(simulationResults)) + userDefinedEffectMatrix <- multiArmEnabled && simulationResults$.getParameterType("effectMatrix") == C_PARAM_USER_DEFINED + + gMax <- NA_integer_ + if (multiArmEnabled || enrichmentEnabled) { + gMax <- ifelse(multiArmEnabled, + simulationResults$activeArms, + simulationResults$populations + ) + } + + if (survivalEnabled) { + nMax <- simulationResults$expectedNumberOfEvents[1] # use first value for plotting + } else { + nMax <- simulationResults$expectedNumberOfSubjects[1] # use first value for plotting + } + + if (type %in% c(1:3) && !multiArmEnabled && !enrichmentEnabled) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, + ") is not available for non-multi-arm/non-enrichment simulation results (type must be > 3)" + ) + } + + if ((!survivalEnabled || multiArmEnabled || enrichmentEnabled) && type %in% c(10:14)) { + if (multiArmEnabled || enrichmentEnabled) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, + ") is only available for non-multi-arm/non-enrichment survival simulation results" + ) + } else { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, + ") is only available for survival simulation results" + ) + } + } + + variedParameters <- logical(0) + + if (is.na(plotPointsEnabled)) { + plotPointsEnabled <- userDefinedEffectMatrix + } + + showSourceHint <- "" + + discreteXAxis <- FALSE + effectData <- NULL + xValues <- NA_integer_ + if (multiArmEnabled) { + effectData <- simulationResults$effectMatrix + effectDataParamName <- paste0("effectMatrix", "[", gMax, ", ]") + xParameterNameSrc <- paste0(simulationResultsName, "$", effectDataParamName) + xValues <- effectData[gMax, ] + } else { + if (enrichmentEnabled) { + effectDataList <- .getSimulationEnrichmentEffectData(simulationResults) + xValues <- effectDataList$xValues + discreteXAxis <- effectDataList$discreteXAxis + if (length(xValues) <= 1) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "2 ore more situations must be specifed in ", + sQuote(paste0("effectList$", effectDataList$effectMatrixName)) + ) + } + } + + xParameterNameSrc <- .getSimulationPlotXAxisParameterName(simulationResults, + showSource = showSource, simulationResultsName = simulationResultsName + ) + } + + armCaption <- ifelse(enrichmentEnabled, "Population", "Arm") + armsCaption <- paste0(armCaption, "s") + + srcCmd <- NULL + if (type == 1) { # Multi-arm, Overall Success + .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) + if (is.na(main)) { + main <- PlotSubTitleItems(title = "Overall Success") + .addPlotSubTitleItems(simulationResults, designMaster, main, type) + } + + data <- data.frame( + xValues = xValues, + yValues = colSums(simulationResults$successPerStage) + ) + if (userDefinedEffectMatrix) { + data$xValues <- 1:nrow(data) + } + + legendPosition <- ifelse(is.na(legendPosition), C_POSITION_LEFT_CENTER, legendPosition) + + srcCmd <- .showPlotSourceInformation( + objectName = simulationResultsName, + xParameterName = xParameterNameSrc, + yParameterNames = paste0("colSums(", simulationResultsName, "$successPerStage)"), + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + if (!is.null(srcCmd)) { + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(srcCmd)) + } + return(srcCmd) + } + + return(.plotDataFrame(data, + mainTitle = main, + xlab = NA_character_, ylab = NA_character_, + xAxisLabel = .getSimulationPlotXAxisLabel(simulationResults), + yAxisLabel1 = "Overall Success", + yAxisLabel2 = NA_character_, + plotPointsEnabled = plotPointsEnabled, legendTitle = NA_character_, + legendPosition = legendPosition, sided = designMaster$sided, + palette = palette, plotSettings = plotSettings, + discreteXAxis = discreteXAxis + )) + } else if (type == 2) { # Multi-arm, Success per Stage + .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) + if (is.na(main)) { + main <- PlotSubTitleItems(title = "Success per Stage") + .addPlotSubTitleItems(simulationResults, designMaster, main, type) + } + + yParameterNamesSrc <- c() + data <- NULL + if (designMaster$kMax > 1) { + for (k in 1:designMaster$kMax) { + part <- data.frame( + categories = rep(k, length(xValues)), + xValues = xValues, + yValues = simulationResults$successPerStage[k, ] + ) + if (userDefinedEffectMatrix) { + part$xValues <- 1:nrow(part) + } + if (is.null(data)) { + data <- part + } else { + data <- rbind(data, part) + } + yParameterNamesSrc <- c(yParameterNamesSrc, paste0("successPerStage[", k, ", ]")) + } + } else { + data <- data.frame( + xValues = xValues, + yValues = simulationResults$successPerStage[1, ] + ) + if (userDefinedEffectMatrix) { + data$xValues <- 1:nrow(data) + } + yParameterNamesSrc <- c(yParameterNamesSrc, "successPerStage[1, ]") + } + + legendPosition <- ifelse(is.na(legendPosition), C_POSITION_LEFT_TOP, legendPosition) + + srcCmd <- .showPlotSourceInformation( + objectName = simulationResultsName, + xParameterName = xParameterNameSrc, + yParameterNames = yParameterNamesSrc, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + if (!is.null(srcCmd)) { + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(srcCmd)) + } + return(srcCmd) + } + + return(.plotDataFrame(data, + mainTitle = main, + xlab = NA_character_, ylab = NA_character_, + xAxisLabel = .getSimulationPlotXAxisLabel(simulationResults), + yAxisLabel1 = "Success", + yAxisLabel2 = NA_character_, + plotPointsEnabled = plotPointsEnabled, legendTitle = "Stage", + legendPosition = legendPosition, sided = designMaster$sided, + palette = palette, plotSettings = plotSettings, + discreteXAxis = discreteXAxis + )) + } else if (type == 3) { # Multi-arm, Selected Arms/Populations per Stage + + .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) + if (is.na(main)) { + main <- PlotSubTitleItems(title = paste0("Selected ", armsCaption, " per Stage")) + .addPlotSubTitleItems(simulationResults, designMaster, main, type) + } + + selectedDataParamName <- ifelse(multiArmEnabled, "selectedArms", "selectedPopulations") + selectedData <- simulationResults[[selectedDataParamName]] + + yParameterNamesSrc <- c() + data <- NULL + if (designMaster$kMax > 1) { + for (g in 1:gMax) { + for (k in 2:designMaster$kMax) { + stages <- rep(k, length(xValues)) + + populationCaption <- g + if (enrichmentEnabled) { + populationCaption <- ifelse(g == gMax, "F", paste0("S", g)) + } + + part <- data.frame( + categories = ifelse(designMaster$kMax > 2, + paste0(populationCaption, ", ", stages), populationCaption + ), + xValues = xValues, + yValues = selectedData[k, , g] + ) + if (userDefinedEffectMatrix) { + part$xValues <- 1:nrow(part) + } + if (is.null(data)) { + data <- part + } else { + data <- rbind(data, part) + } + yParameterNamesSrc <- c(yParameterNamesSrc, paste0(selectedDataParamName, "[", k, ", , ", g, "]")) + } + } + } else { + for (g in 1:gMax) { + part <- data.frame( + categories = g, + xValues = xValues, + yValues = selectedData[1, , g] + ) + if (userDefinedEffectMatrix) { + data$xValues <- 1:nrow(data) + } + if (is.null(data)) { + data <- part + } else { + data <- rbind(data, part) + } + yParameterNamesSrc <- c(yParameterNamesSrc, paste0(selectedDataParamName, "[1, , ", g, "]")) + } + } + + legendPosition <- ifelse(is.na(legendPosition), C_POSITION_LEFT_TOP, legendPosition) + + srcCmd <- .showPlotSourceInformation( + objectName = simulationResultsName, + xParameterName = xParameterNameSrc, + yParameterNames = yParameterNamesSrc, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + if (!is.null(srcCmd)) { + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(srcCmd)) + } + return(srcCmd) + } + + legendTitle <- ifelse(gMax > 1, + ifelse(designMaster$kMax > 2, paste0(armCaption, ", Stage"), armCaption), + ifelse(designMaster$kMax > 2, "Stage", armCaption) + ) + return(.plotDataFrame(data, + mainTitle = main, + xlab = NA_character_, ylab = NA_character_, + xAxisLabel = .getSimulationPlotXAxisLabel(simulationResults), + yAxisLabel1 = paste0("Selected ", armsCaption), + yAxisLabel2 = NA_character_, + plotPointsEnabled = plotPointsEnabled, + legendTitle = legendTitle, + legendPosition = legendPosition, sided = designMaster$sided, + palette = palette, plotSettings = plotSettings, + discreteXAxis = discreteXAxis + )) + } else if (type == 4) { # Multi-arm, Rejected Arms/Populations per Stage + .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) + if (is.na(main)) { + main <- PlotSubTitleItems(title = ifelse(!multiArmEnabled, + "Reject per Stage", + ifelse(designMaster$kMax > 1, + paste0("Rejected ", armsCaption, " per Stage"), paste0("Rejected ", armsCaption) + ) + )) + .addPlotSubTitleItems(simulationResults, designMaster, main, type) + } + + yParameterNamesSrc <- c() + data <- NULL + if (multiArmEnabled || enrichmentEnabled) { + rejectedDataParamName <- ifelse(multiArmEnabled, "rejectedArmsPerStage", "rejectedPopulationsPerStage") + rejectedData <- simulationResults[[rejectedDataParamName]] + if (designMaster$kMax > 1) { + for (g in 1:gMax) { + for (k in 1:designMaster$kMax) { + stages <- rep(k, length(xValues)) + populationCaption <- g + if (enrichmentEnabled) { + populationCaption <- ifelse(g == gMax, "F", paste0("S", g)) + } + part <- data.frame( + categories = ifelse(gMax > 1, paste0(populationCaption, ", ", stages), stages), + xValues = xValues, + yValues = rejectedData[k, , g] + ) + if (userDefinedEffectMatrix) { + part$xValues <- 1:nrow(part) + } + if (is.null(data)) { + data <- part + } else { + data <- rbind(data, part) + } + yParameterNamesSrc <- c(yParameterNamesSrc, paste0(rejectedDataParamName, "[", k, ", , ", g, "]")) + } + } + } else { + for (g in 1:gMax) { + part <- data.frame( + categories = g, + xValues = xValues, + yValues = rejectedData[1, , g] + ) + if (userDefinedEffectMatrix) { + part$xValues <- 1:nrow(part) + } + if (is.null(data)) { + data <- part + } else { + data <- rbind(data, part) + } + yParameterNamesSrc <- c(yParameterNamesSrc, paste0(rejectedDataParamName, "[1, , ", g, "]")) + } + } + } else { + xParameterName <- .getSimulationPlotXAxisParameterName(simulationResults) + if (designMaster$kMax > 1) { + for (k in 1:designMaster$kMax) { + part <- data.frame( + categories = k, + xValues = simulationResults[[xParameterName]], + yValues = simulationResults$rejectPerStage[k, ] + ) + if (userDefinedEffectMatrix) { + part$xValues <- 1:nrow(part) + } + if (is.null(data)) { + data <- part + } else { + data <- rbind(data, part) + } + yParameterNamesSrc <- c(yParameterNamesSrc, paste0("rejectPerStage[", k, ", ]")) + } + } else { + data <- data.frame( + xValues = simulationResults[[xParameterName]], + yValues = simulationResults$rejectPerStage[1, ] + ) + if (userDefinedEffectMatrix) { + data$xValues <- 1:nrow(data) + } + yParameterNamesSrc <- c(yParameterNamesSrc, "rejectPerStage[1, ]") + } + } + + legendPosition <- ifelse(is.na(legendPosition), C_POSITION_LEFT_TOP, legendPosition) + + srcCmd <- .showPlotSourceInformation( + objectName = simulationResultsName, + xParameterName = xParameterNameSrc, + yParameterNames = yParameterNamesSrc, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + if (!is.null(srcCmd)) { + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(srcCmd)) + } + return(srcCmd) + } + + palette <- NULL + + legendTitle <- "Stage" + if (multiArmEnabled) { + legendTitle <- ifelse(designMaster$kMax > 1, paste0(armCaption, ", Stage"), armCaption) + } else if (enrichmentEnabled) { + legendTitle <- ifelse(gMax > 1, paste0(armCaption, ", Stage"), "Stage") + } + yAxisLabel1 <- ifelse(.isMultiArmSimulationResults(simulationResults), + paste0("Rejected ", armsCaption), "Rejection Probability" + ) + return(.plotDataFrame(data, + mainTitle = main, + xlab = NA_character_, ylab = NA_character_, + xAxisLabel = .getSimulationPlotXAxisLabel(simulationResults), + yAxisLabel1 = yAxisLabel1, + yAxisLabel2 = NA_character_, + plotPointsEnabled = plotPointsEnabled, + legendTitle = legendTitle, + legendPosition = legendPosition, sided = designMaster$sided, + palette = palette, plotSettings = plotSettings, + discreteXAxis = discreteXAxis + )) + } else if (type == 5) { # Power and Stopping Probabilities + + .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) + + if (is.na(main)) { + main <- PlotSubTitleItems(title = ifelse(designMaster$kMax == 1, + "Overall Power", "Overall Power and Early Stopping" + )) + .addPlotSubTitleItems(simulationResults, designMaster, main, type) + } + + xParameterName <- .getSimulationPlotXAxisParameterName(simulationResults) + + if ((multiArmEnabled || enrichmentEnabled) && designMaster$kMax > 1) { + powerAndStoppingProbabilities <- .getPowerAndStoppingProbabilities(simulationResults, + xValues = xValues, + parameters = c("rejectAtLeastOne", "futilityStop", "earlyStop") + ) + data <- powerAndStoppingProbabilities$data + yParameterNames <- powerAndStoppingProbabilities$yParameterNames + yParameterNamesSrc <- powerAndStoppingProbabilities$yParameterNamesSrc + } else { + yParameterNames <- ifelse(multiArmEnabled || enrichmentEnabled, "rejectAtLeastOne", "overallReject") + if (designMaster$kMax > 1) { + if (!multiArmEnabled && !enrichmentEnabled) { + yParameterNames <- c(yParameterNames, "earlyStop") + } + yParameterNames <- c(yParameterNames, "futilityStop") + } + yParameterNamesSrc <- yParameterNames + } + + xlab <- .getSimulationPlotXAxisLabel(simulationResults, xlab) + ylab <- ifelse(is.na(ylab), "", ylab) + legendPosition <- ifelse(is.na(legendPosition), C_POSITION_LEFT_TOP, legendPosition) + + srcCmd <- .showPlotSourceInformation( + objectName = simulationResultsName, + xParameterName = xParameterNameSrc, + yParameterNames = yParameterNamesSrc, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + if (!is.null(srcCmd)) { + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(srcCmd)) + } + return(srcCmd) + } + + if ((multiArmEnabled || enrichmentEnabled) && designMaster$kMax > 1) { + return(.plotDataFrame(data, + mainTitle = main, + xlab = xlab, ylab = ylab, + xAxisLabel = .getSimulationPlotXAxisLabel(simulationResults), + yAxisLabel1 = NA_character_, + yAxisLabel2 = NA_character_, + plotPointsEnabled = plotPointsEnabled, + legendTitle = NA_character_, + legendPosition = legendPosition, sided = designMaster$sided, + palette = palette, plotSettings = plotSettings, + discreteXAxis = discreteXAxis + )) + } else { + if (is.null(list(...)[["ylim"]])) { + ylim <- c(0, 1) + return(.plotParameterSet( + parameterSet = simulationResults, designMaster = designMaster, + xParameterName = xParameterName, + yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, + palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, + legendPosition = legendPosition, variedParameters = variedParameters, + qnormAlphaLineEnabled = FALSE, yAxisScalingEnabled = FALSE, + plotSettings = plotSettings, ylim = ylim # , ... + )) # ratioEnabled = TRUE + } else { + return(.plotParameterSet( + parameterSet = simulationResults, designMaster = designMaster, + xParameterName = xParameterName, + yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, + palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, + legendPosition = legendPosition, variedParameters = variedParameters, + qnormAlphaLineEnabled = FALSE, yAxisScalingEnabled = FALSE, + plotSettings = plotSettings # , ... + )) + } + } + } else if (type == 6) { # Average Sample Size / Average Event Number + .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) + + if (is.na(main)) { + titlePart <- paste0("Expected ", ifelse(survivalEnabled, "Number of Events", "Number of Subjects")) + main <- PlotSubTitleItems(title = paste0( + titlePart, + ifelse(designMaster$kMax == 1, "", paste0( + " and Power", + ifelse(multiArmEnabled, "", " / Early Stop") + )) + )) + .addPlotSubTitleItems(simulationResults, designMaster, main, type) + } + + xParameterName <- .getSimulationPlotXAxisParameterName(simulationResults) + yParameterNames <- ifelse(survivalEnabled, "expectedNumberOfEvents", "expectedNumberOfSubjects") + if (designMaster$kMax > 1) { + if (multiArmEnabled || enrichmentEnabled) { + yParameterNames <- c(yParameterNames, "rejectAtLeastOne") + } else { + yParameterNames <- c(yParameterNames, "overallReject") + } + yParameterNames <- c(yParameterNames, "earlyStop") + } + + xlab <- .getSimulationPlotXAxisLabel(simulationResults, xlab) + legendPosition <- ifelse(is.na(legendPosition), C_POSITION_LEFT_CENTER, legendPosition) + srcCmd <- .showPlotSourceInformation( + objectName = simulationResultsName, + xParameterName = xParameterNameSrc, + yParameterNames = yParameterNames, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + } else if (type == 7) { + .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) + if (is.na(main)) { + main <- PlotSubTitleItems(title = "Overall Power") + .addPlotSubTitleItems(simulationResults, designMaster, main, type) + } + + xParameterName <- .getSimulationPlotXAxisParameterName(simulationResults) + yParameterNames <- ifelse(multiArmEnabled || enrichmentEnabled, "rejectAtLeastOne", "overallReject") + xlab <- .getSimulationPlotXAxisLabel(simulationResults, xlab) + legendPosition <- ifelse(is.na(legendPosition), C_POSITION_RIGHT_CENTER, legendPosition) + srcCmd <- .showPlotSourceInformation( + objectName = simulationResultsName, + xParameterName = xParameterNameSrc, + yParameterNames = yParameterNames, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + } else if (type == 8) { + if (designMaster$kMax == 1) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "plot type 8 (Early Stopping) is not available for 'kMax' = 1") + } + + .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) + + futilityStopEnabled <- !is.null(simulationResults[["futilityStop"]]) && + !all(na.omit(simulationResults$futilityStop) == 0) + + if (is.na(main)) { + main <- PlotSubTitleItems(title = paste0( + "Overall Early Stopping", + ifelse(futilityStopEnabled, " and Futility Stopping", "") + )) + .addPlotSubTitleItems(simulationResults, designMaster, main, type) + } + + xParameterName <- .getSimulationPlotXAxisParameterName(simulationResults) + yParameterNames <- c("earlyStop") + if (futilityStopEnabled) { + yParameterNames <- c(yParameterNames, "futilityStop") + } + xlab <- .getSimulationPlotXAxisLabel(simulationResults, xlab) + legendPosition <- ifelse(is.na(legendPosition), C_POSITION_LEFT_CENTER, legendPosition) + srcCmd <- .showPlotSourceInformation( + objectName = simulationResultsName, + xParameterName = xParameterNameSrc, + yParameterNames = yParameterNames, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + } else if (type == 9) { + .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) + + if (is.na(main)) { + main <- PlotSubTitleItems(title = ifelse(survivalEnabled, + "Expected Number of Events", "Expected Number of Subjects" + )) + .addPlotSubTitleItems(simulationResults, designMaster, main, type) + } + + xParameterName <- .getSimulationPlotXAxisParameterName(simulationResults) + yParameterNames <- ifelse(survivalEnabled, "expectedNumberOfEvents", "expectedNumberOfSubjects") + xlab <- .getSimulationPlotXAxisLabel(simulationResults, xlab) + srcCmd <- .showPlotSourceInformation( + objectName = simulationResultsName, + xParameterName = xParameterNameSrc, + yParameterNames = yParameterNames, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + } else if (type == 10) { # Study Duration + .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) + if (is.na(main)) { + main <- PlotSubTitleItems(title = "Study Duration") + .addPlotSubTitleItems(simulationResults, designMaster, main, type) + } + xParameterName <- "hazardRatio" + yParameterNames <- "studyDuration" + srcCmd <- .showPlotSourceInformation( + objectName = simulationResultsName, + xParameterName = xParameterName, + yParameterNames = yParameterNames, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + } else if (type == 11) { + .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) + if (is.na(main)) { + main <- PlotSubTitleItems(title = "Expected Number of Subjects") + .addPlotSubTitleItems(simulationResults, designMaster, main, type) + } + xParameterName <- "hazardRatio" + yParameterNames <- "expectedNumberOfSubjects" + srcCmd <- .showPlotSourceInformation( + objectName = simulationResultsName, + xParameterName = xParameterName, + yParameterNames = yParameterNames, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + } else if (type == 12) { # Analysis Time + .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) + if (is.na(main)) { + main <- PlotSubTitleItems(title = "Analysis Time") + .addPlotSubTitleItems(simulationResults, designMaster, main, type) + } + + xParameterName <- "hazardRatio" + yParameterNames <- "analysisTime" + yParameterNamesSrc <- c() + for (i in 1:nrow(simulationResults[["analysisTime"]])) { + yParameterNamesSrc <- c(yParameterNamesSrc, paste0("analysisTime[", i, ", ]")) + } + + data <- NULL + for (k in 1:designMaster$kMax) { + part <- data.frame( + categories = rep(k, length(simulationResults$hazardRatio)), + xValues = simulationResults$hazardRatio, + yValues = simulationResults$analysisTime[k, ] + ) + if (is.null(data)) { + data <- part + } else { + data <- rbind(data, part) + } + } + + if (is.na(legendPosition)) { + legendPosition <- C_POSITION_LEFT_CENTER + } + + srcCmd <- .showPlotSourceInformation( + objectName = simulationResultsName, + xParameterName = xParameterName, + yParameterNames = yParameterNamesSrc, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + if (!is.null(srcCmd)) { + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(srcCmd)) + } + return(srcCmd) + } + + return(.plotDataFrame(data, + mainTitle = main, + xlab = NA_character_, ylab = NA_character_, xAxisLabel = "Hazard Ratio", + yAxisLabel1 = "Analysis Time", yAxisLabel2 = NA_character_, + plotPointsEnabled = TRUE, legendTitle = "Stage", + legendPosition = legendPosition, sided = designMaster$sided, plotSettings = plotSettings, + discreteXAxis = discreteXAxis + )) + } else if (type == 13 || type == 14) { # Cumulative Distribution Function / Survival function + return(.plotSurvivalFunction(simulationResults, + designMaster = designMaster, type = type, main = main, + xlab = xlab, ylab = ylab, palette = palette, + legendPosition = legendPosition, designPlanName = simulationResultsName, + showSource = showSource, plotSettings = plotSettings + )) + } else { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is not allowed; must be 5, 6, ..., 14") + } + + if (!is.null(srcCmd)) { + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(srcCmd)) + } + return(srcCmd) + } + + return(.plotParameterSet( + parameterSet = simulationResults, designMaster = designMaster, + xParameterName = xParameterName, + yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, + palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, + legendPosition = legendPosition, variedParameters = variedParameters, + qnormAlphaLineEnabled = (type != 2), ratioEnabled = TRUE, plotSettings = plotSettings # , ... + )) +} + +#' +#' @title +#' Simulation Results Plotting +#' +#' @param x The simulation results, obtained from \cr +#' \code{\link[=getSimulationSurvival]{getSimulationSurvival()}}. +#' @param y Not available for this kind of plot (is only defined to be compatible to the generic plot function). +#' @param main The main title. +#' @param xlab The x-axis label. +#' @param ylab The y-axis label. +#' @inheritParams param_palette +#' @inheritParams param_theta +#' @inheritParams param_plotPointsEnabled +#' @inheritParams param_showSource +#' @inheritParams param_plotSettings +#' @inheritParams param_legendPosition +#' @inheritParams param_grid +#' @param type The plot type (default = \code{1}). The following plot types are available: +#' \itemize{ +#' \item \code{1}: creates a 'Overall Success' plot (multi-arm and enrichment only) +#' \item \code{2}: creates a 'Success per Stage' plot (multi-arm and enrichment only) +#' \item \code{3}: creates a 'Selected Arms per Stage' plot (multi-arm and enrichment only) +#' \item \code{4}: creates a 'Reject per Stage' or 'Rejected Arms per Stage' plot +#' \item \code{5}: creates a 'Overall Power and Early Stopping' plot +#' \item \code{6}: creates a 'Expected Number of Subjects and Power / Early Stop' or +#' 'Expected Number of Events and Power / Early Stop' plot +#' \item \code{7}: creates an 'Overall Power' plot +#' \item \code{8}: creates an 'Overall Early Stopping' plot +#' \item \code{9}: creates an 'Expected Sample Size' or 'Expected Number of Events' plot +#' \item \code{10}: creates a 'Study Duration' plot (non-multi-arm and non-enrichment survival only) +#' \item \code{11}: creates an 'Expected Number of Subjects' plot (non-multi-arm and non-enrichment survival only) +#' \item \code{12}: creates an 'Analysis Times' plot (non-multi-arm and non-enrichment survival only) +#' \item \code{13}: creates a 'Cumulative Distribution Function' plot (non-multi-arm and non-enrichment survival only) +#' \item \code{14}: creates a 'Survival Function' plot (non-multi-arm and non-enrichment survival only) +#' \item \code{"all"}: creates all available plots and returns it as a grid plot or list +#' } +#' @inheritParams param_three_dots_plot +#' +#' @description +#' Plots simulation results. +#' +#' @details +#' Generic function to plot all kinds of simulation results. +#' +#' @template return_object_ggplot +#' +#' @examples +#' \dontrun{ +#' results <- getSimulationMeans( +#' alternative = 0:4, stDev = 5, +#' plannedSubjects = 40, maxNumberOfIterations = 1000 +#' ) +#' plot(results, type = 5) +#' } +#' +#' @export +#' +plot.SimulationResultsR6 <- function(x, y, ..., main = NA_character_, + xlab = NA_character_, ylab = NA_character_, type = 1L, palette = "Set1", + theta = seq(-1, 1, 0.01), plotPointsEnabled = NA, + legendPosition = NA_integer_, showSource = FALSE, + grid = 1, plotSettings = NULL) { + fCall <- match.call(expand.dots = FALSE) + simulationResultsName <- deparse(fCall$x) + .assertGgplotIsInstalled() + .assertIsSingleInteger(grid, "grid", validateType = FALSE) + typeNumbers <- .getPlotTypeNumber(type, x) + if (is.null(plotSettings)) { + plotSettings <- .getGridPlotSettings(x, typeNumbers, grid) + } + p <- NULL + plotList <- list() + for (typeNumber in typeNumbers) { + p <- .plotSimulationResults( + simulationResults = x, designMaster = x$.design, + main = main, xlab = xlab, ylab = ylab, type = typeNumber, + palette = palette, theta = theta, plotPointsEnabled = plotPointsEnabled, + legendPosition = .getGridLegendPosition(legendPosition, typeNumbers, grid), + showSource = showSource, simulationResultsName = simulationResultsName, + plotSettings = plotSettings, ... + ) + .printPlotShowSourceSeparator(showSource, typeNumber, typeNumbers) + if (length(typeNumbers) > 1) { + caption <- .getPlotCaption(x, typeNumber, stopIfNotFound = TRUE) + plotList[[caption]] <- p + } + } + if (length(typeNumbers) == 1) { + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(p)) + } + + return(p) + } + + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(plotList)) + } + + return(.createPlotResultObject(plotList, grid)) +} + +#' +#' @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.SimulationResultsR6 <- function(x, ..., showStatistics = FALSE, markdown = FALSE) { + if (markdown) { + x$.catMarkdownText(showStatistics = showStatistics) + return(invisible(x)) + } + + x$show(showStatistics = showStatistics) + invisible(x) +} + +#' +#' @title +#' Get Simulation Data +#' +#' @description +#' Returns the aggregated simulation data. +#' +#' @param x A \code{\link{SimulationResults}} object created by \code{\link[=getSimulationMeans]{getSimulationMeans()}},\cr +#' \code{\link[=getSimulationRates]{getSimulationRates()}}, \code{\link[=getSimulationSurvival]{getSimulationSurvival()}}, \code{\link[=getSimulationMultiArmMeans]{getSimulationMultiArmMeans()}},\cr +#' \code{\link[=getSimulationMultiArmRates]{getSimulationMultiArmRates()}}, or \code{\link[=getSimulationMultiArmSurvival]{getSimulationMultiArmSurvival()}}. +#' +#' @details +#' This function can be used to get the aggregated simulated data from an simulation results +#' object, for example, obtained by \code{\link[=getSimulationSurvival]{getSimulationSurvival()}}. +#' In this case, the data frame contains the following columns: +#' \enumerate{ +#' \item \code{iterationNumber}: The number of the simulation iteration. +#' \item \code{stageNumber}: The stage. +#' \item \code{pi1}: The assumed or derived event rate in the treatment group. +#' \item \code{pi2}: The assumed or derived event rate in the control group. +#' \item \code{hazardRatio}: The hazard ratio under consideration (if available). +#' \item \code{analysisTime}: The analysis time. +#' \item \code{numberOfSubjects}: The number of subjects under consideration when the +#' (interim) analysis takes place. +#' \item \code{eventsPerStage1}: The observed number of events per stage +#' in treatment group 1. +#' \item \code{eventsPerStage2}: The observed number of events per stage +#' in treatment group 2. +#' \item \code{eventsPerStage}: The observed number of events per stage +#' in both treatment groups. +#' \item \code{rejectPerStage}: 1 if null hypothesis can be rejected, 0 otherwise. +#' \item \code{eventsNotAchieved}: 1 if number of events could not be reached with +#' observed number of subjects, 0 otherwise. +#' \item \code{futilityPerStage}: 1 if study should be stopped for futility, 0 otherwise. +#' \item \code{testStatistic}: The test statistic that is used for the test decision, +#' depends on which design was chosen (group sequential, inverse normal, +#' or Fisher combination test)' +#' \item \code{logRankStatistic}: Z-score statistic which corresponds to a one-sided +#' log-rank test at considered stage. +#' \item \code{conditionalPowerAchieved}: The conditional power for the subsequent stage of the trial for +#' selected sample size and effect. The effect is either estimated from the data or can be +#' user defined with \code{thetaH1} or \code{pi1H1} and \code{pi2H1}. +#' \item \code{trialStop}: \code{TRUE} if study should be stopped for efficacy or futility or final stage, \code{FALSE} otherwise. +#' \item \code{hazardRatioEstimateLR}: The estimated hazard ratio, derived from the +#' log-rank statistic. +#' } +#' A subset of variables is provided for \code{\link[=getSimulationMeans]{getSimulationMeans()}}, \code{\link[=getSimulationRates]{getSimulationRates()}}, \code{\link[=getSimulationMultiArmMeans]{getSimulationMultiArmMeans()}},\cr +#' \code{\link[=getSimulationMultiArmRates]{getSimulationMultiArmRates()}}, or \code{\link[=getSimulationMultiArmSurvival]{getSimulationMultiArmSurvival()}}. +#' +#' @template return_dataframe +#' +#' @examples +#' results <- getSimulationSurvival( +#' pi1 = seq(0.3, 0.6, 0.1), pi2 = 0.3, eventTime = 12, +#' accrualTime = 24, plannedEvents = 40, maxNumberOfSubjects = 200, +#' maxNumberOfIterations = 50 +#' ) +#' data <- getData(results) +#' head(data) +#' dim(data) +#' +#' @export +#' +getData <- function(x) { + if (!(inherits(x, "SimulationResults") || inherits(x, "SimulationResultsR6"))) { # or 'Dataset' + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'x' must be a 'SimulationResults' object; for example, use getSimulationMeans() to create one" + ) + } + + return(x$.data) +} + +#' @rdname getData +#' @export +getData.SimulationResultsR6 <- function(x) { + return(x$.data) +} + +.getAggregatedDataByIterationNumber <- function(rawData, iterationNumber, pi1 = NA_real_) { + if (!is.na(pi1)) { + if (is.null(rawData[["pi1"]])) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'rawData' does not contains a 'pi1' column") + } + subData <- rawData[rawData$iterationNumber == iterationNumber & rawData$pi1 == pi1, ] + if (nrow(subData) == 0) { + return(NULL) + } + } else { + subData <- rawData[rawData$iterationNumber == iterationNumber, ] + } + + eventsPerStage1 <- sum(subData$event[subData$treatmentGroup == 1]) + eventsPerStage2 <- sum(subData$event[subData$treatmentGroup == 2]) + + result <- data.frame( + iterationNumber = iterationNumber, + pi1 = pi1, + stageNumber = subData$stopStage[1], + analysisTime = max(subData$observationTime), + numberOfSubjects = nrow(subData), + eventsPerStage1 = eventsPerStage1, + eventsPerStage2 = eventsPerStage2, + eventsPerStage = eventsPerStage1 + eventsPerStage2 + ) + + if (is.na(pi1)) { + result <- result[, colnames(result) != "pi1"] + } + + return(result) +} + +.getAggregatedData <- function(rawData) { + iterationNumbers <- sort(unique(rawData$iterationNumber)) + pi1Vec <- rawData[["pi1"]] + if (!is.null(pi1Vec)) { + pi1Vec <- sort(unique(na.omit(rawData$pi1))) + } + + data <- NULL + if (!is.null(pi1Vec) && length(pi1Vec) > 0) { + for (iterationNumber in iterationNumbers) { + for (pi1 in pi1Vec) { + row <- .getAggregatedDataByIterationNumber(rawData, iterationNumber, pi1) + if (!is.null(row)) { + if (is.null(data)) { + data <- row + } else { + data <- rbind(data, row) + } + } + } + } + } else { + for (iterationNumber in iterationNumbers) { + row <- .getAggregatedDataByIterationNumber(rawData, iterationNumber) + if (!is.null(row)) { + if (is.null(data)) { + data <- row + } else { + data <- rbind(data, row) + } + } + } + } + return(data) +} + +#' +#' @title +#' Get Simulation Raw Data for Survival +#' +#' @description +#' Returns the raw survival data which was generated for simulation. +#' +#' @param x A \code{\link{SimulationResults}} object created by \code{\link[=getSimulationSurvival]{getSimulationSurvival()}}. +#' @param aggregate Logical. If \code{TRUE} the raw data will be aggregated similar to +#' the result of \code{\link[=getData]{getData()}}, default is \code{FALSE}. +#' +#' @details +#' This function works only if \code{\link[=getSimulationSurvival]{getSimulationSurvival()}} was called with a \cr +#' \code{maxNumberOfRawDatasetsPerStage} > 0 (default is \code{0}). +#' +#' This function can be used to get the simulated raw data from a simulation results +#' object obtained by \code{\link[=getSimulationSurvival]{getSimulationSurvival()}}. Note that \code{\link[=getSimulationSurvival]{getSimulationSurvival()}} +#' must called before with \code{maxNumberOfRawDatasetsPerStage} > 0. +#' The data frame contains the following columns: +#' \enumerate{ +#' \item \code{iterationNumber}: The number of the simulation iteration. +#' \item \code{stopStage}: The stage of stopping. +#' \item \code{subjectId}: The subject id (increasing number 1, 2, 3, ...) +#' \item \code{accrualTime}: The accrual time, i.e., the time when the subject entered the trial. +#' \item \code{treatmentGroup}: The treatment group number (1 or 2). +#' \item \code{survivalTime}: The survival time of the subject. +#' \item \code{dropoutTime}: The dropout time of the subject (may be \code{NA}). +#' \item \code{observationTime}: The specific observation time. +#' \item \code{timeUnderObservation}: The time under observation is defined as follows:\cr +#' if (event == TRUE) {\cr +#' timeUnderObservation <- survivalTime;\cr +#' } else if (dropoutEvent == TRUE) {\cr +#' timeUnderObservation <- dropoutTime;\cr +#' } else {\cr +#' timeUnderObservation <- observationTime - accrualTime;\cr +#' } +#' \item \code{event}: \code{TRUE} if an event occurred; \code{FALSE} otherwise. +#' \item \code{dropoutEvent}: \code{TRUE} if an dropout event occurred; \code{FALSE} otherwise. +#' } +#' +#' @template return_dataframe +#' +#' @examples +#' \dontrun{ +#' results <- getSimulationSurvival( +#' pi1 = seq(0.3, 0.6, 0.1), pi2 = 0.3, eventTime = 12, +#' accrualTime = 24, plannedEvents = 40, maxNumberOfSubjects = 200, +#' maxNumberOfIterations = 50, maxNumberOfRawDatasetsPerStage = 5 +#' ) +#' rawData <- getRawData(results) +#' head(rawData) +#' dim(rawData) +#' } +#' +#' @export +#' +getRawData <- function(x, aggregate = FALSE) { + if (!(inherits(x, "SimulationResultsSurvival") || inherits(x, "SimulationResultsSurvivalR6"))) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'x' must be a 'SimulationResultsSurvival' object; use getSimulationSurvival() to create one" + ) + } + + rawData <- x$.rawData + if (is.null(rawData) || ncol(rawData) == 0 || nrow(rawData) == 0) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "simulation results contain no raw data; ", + "choose a 'maxNumberOfRawDatasetsPerStage' > 0, e.g., ", + "getSimulationSurvival(..., maxNumberOfRawDatasetsPerStage = 1)" + ) + } + + if (!aggregate) { + return(rawData) + } + + return(.getAggregatedData(rawData)) +} diff --git a/R/class_summary.R b/R/class_summary.R index cf6c0e3c..c9821c54 100644 --- a/R/class_summary.R +++ b/R/class_summary.R @@ -614,7 +614,7 @@ SummaryFactory <- setRefClass("SummaryFactory", } else { if (inherits(parameterSet, "Dataset")) { variedParameter <- "groups" - } else if (inherits(parameterSet, "PerformanceScore")) { + } else if (inherits(parameterSet, "PerformanceScore") || inherits(parameterSet, "PerformanceScoreR6")) { variedParameter <- ".alternative" } else { variedParameter <- parameterSet$.getVariedParameter(parameterNames, numberOfVariants) @@ -789,2822 +789,3 @@ SummaryFactory <- setRefClass("SummaryFactory", } ) ) - -.formatSummaryValues <- function(values, digits, smoothedZeroFormat = FALSE, formatRepeatedPValues = FALSE) { - if (is.na(digits)) { - digits <- 3 - } - - if (digits < 1) { - formattedValue <- as.character(values) - formattedValue[is.na(formattedValue) | trimws(formattedValue) == "NA"] <- getOption("rpact.summary.na", "") - return(formattedValue) - } - - if (sum(is.na(values)) == length(values)) { - formattedValue <- rep(getOption("rpact.summary.na", ""), length(values)) - return(formattedValue) - } - - threshold <- 10^-digits - text <- "<0." - if (digits > 1) { - for (i in 1:(digits - 1)) { - text <- paste0(text, "0") - } - } - text <- paste0(text, "1") - - if (smoothedZeroFormat) { - values[abs(values) < 1e-15] <- 0 - } - indices <- (!is.na(values) & values > 1e-10 & abs(values) < threshold) - values[!is.na(values) & !indices] <- round(values[!is.na(values) & !indices], digits) - if (sum(indices) > 0) { - values[indices] <- threshold - formattedValue <- .getFormattedValue(values, digits = digits, nsmall = digits, scientific = FALSE) - formattedValue[indices] <- text - } else { - formattedValue <- .getFormattedValue(values, digits = digits, nsmall = digits, scientific = FALSE) - formattedValue <- format(formattedValue, scientific = FALSE) - } - - if (formatRepeatedPValues) { - formattedValue[!is.na(formattedValue) & - nchar(gsub("\\D", "", (formattedValue))) > 0 & formattedValue > 0.4999] <- ">0.5" - } - - if (as.logical(getOption("rpact.summary.trim.zeroes", TRUE))) { - zeroes <- grepl("^0\\.0*$", formattedValue) - if (sum(zeroes) > 0) { - formattedValue[zeroes] <- "0" - } - } - - formattedValue[is.na(formattedValue) | trimws(formattedValue) == "NA"] <- getOption("rpact.summary.na", "") - - return(formattedValue) -} - -.getSummaryValuesFormatted <- function(fieldSet, parameterName, values, - roundDigits = NA_integer_, ceilingEnabled = FALSE, cumsumEnabled = FALSE, - smoothedZeroFormat = FALSE, formatRepeatedPValues = FALSE) { - if (!is.numeric(values)) { - return(values) - } - - if (cumsumEnabled) { - values <- cumsum(values) - } - - if (ceilingEnabled) { - values <- ceiling(values) - } else { - tryCatch( - { - formatFunctionName <- NULL - - if (!is.null(parameterName) && length(parameterName) == 1 && !is.na(parameterName)) { - if (parameterName == "futilityBounds") { - values[!is.na(values) & values <= -6] <- -Inf - } else if (parameterName %in% c("criticalValues", "decisionCriticalValue", "overallAdjustedTestStatistics")) { - design <- fieldSet - if (!.isTrialDesign(design)) { - design <- fieldSet[[".design"]] - } - if (!is.null(design) && .isTrialDesignFisher(design)) { - roundDigits <- 0 - } - } - if (!is.na(roundDigits) && roundDigits == 0) { - if (inherits(fieldSet, "Dataset") && - grepl("samplesize|event", tolower(parameterName))) { - } else { - if (inherits(fieldSet, "FieldSet")) { - formatFunctionName <- fieldSet$.parameterFormatFunctions[[parameterName]] - } - if (is.null(formatFunctionName)) { - formatFunctionName <- C_PARAMETER_FORMAT_FUNCTIONS[[parameterName]] - } - } - } - } - - if (!is.null(formatFunctionName)) { - values <- eval(call(formatFunctionName, values)) - } else { - values <- .formatSummaryValues(values, - digits = roundDigits, - smoothedZeroFormat = smoothedZeroFormat, - formatRepeatedPValues = formatRepeatedPValues - ) - } - }, - error = function(e) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to show parameter '", parameterName, "': ", e$message) - } - ) - } - - return(format(values)) -} - -.createSummaryTitleObject <- function(object) { - design <- NULL - designPlan <- NULL - if (inherits(object, "TrialDesignCharacteristics")) { - design <- object$.design - } else if (.isTrialDesignPlan(object) || inherits(object, "SimulationResults")) { - design <- object$.design - designPlan <- object - } else if (inherits(object, "AnalysisResults")) { - return(.createSummaryTitleAnalysisResults(object$.design, object)) - } else if (.isTrialDesign(object)) { - design <- object - } - if (!is.null(design)) { - return(.createSummaryTitleDesign(design, designPlan)) - } - return("") -} - -.createSummaryTitleAnalysisResults <- function(design, analysisResults) { - kMax <- design$kMax - - title <- "" - if (kMax == 1) { - title <- paste0(title, "Fixed sample analysis results") - } else { - title <- paste0(title, "Sequential analysis results with a maximum of ", kMax, " looks") - } - - if (!is.null(analysisResults)) { - if (.isMultiArmAnalysisResults(analysisResults)) { - title <- "Multi-arm analysis results for a " - } else if (.isEnrichmentAnalysisResults(analysisResults)) { - title <- "Enrichment analysis results for a " - } else { - title <- "Analysis results for a " - } - - if (grepl("Means", .getClassName(analysisResults$.dataInput))) { - title <- paste0(title, "continuous endpoint") - } else if (grepl("Rates", .getClassName(analysisResults$.dataInput))) { - title <- paste0(title, "binary endpoint") - } else if (grepl("Survival", .getClassName(analysisResults$.dataInput))) { - title <- paste0(title, "survival endpoint") - } - - if (.isMultiHypothesesAnalysisResults(analysisResults)) { - gMax <- analysisResults$.stageResults$getGMax() - if (.isMultiArmAnalysisResults(analysisResults)) { - title <- paste0(title, " (", gMax, " active arms vs. control)") - } else if (.isEnrichmentAnalysisResults(analysisResults)) { - title <- paste0(title, " (", gMax, " populations)") - } - } - } else if (kMax > 1) { - prefix <- ifelse(design$.isDelayedResponseDesign(), "delayed response ", "") - title <- .concatenateSummaryText(title, - paste0("(", prefix, design$.toString(startWithUpperCase = FALSE), ")"), - sep = " " - ) - } - - return(title) -} - -.createSummaryTitleDesign <- function(design, designPlan) { - kMax <- design$kMax - - title <- "" - if (kMax == 1) { - title <- paste0(title, "Fixed sample analysis") - } else { - title <- paste0(title, "Sequential analysis with a maximum of ", kMax, " looks") - } - if (!is.null(designPlan)) { - if (inherits(designPlan, "SimulationResults")) { - title <- "Simulation of a " - } else if (designPlan$.isSampleSizeObject()) { - title <- "Sample size calculation for a " - } else if (designPlan$.isPowerObject()) { - title <- "Power calculation for a " - } - - if (grepl("Means", .getClassName(designPlan))) { - title <- paste0(title, "continuous endpoint") - } else if (grepl("Rates", .getClassName(designPlan))) { - title <- paste0(title, "binary endpoint") - } else if (grepl("Survival", .getClassName(designPlan))) { - title <- paste0(title, "survival endpoint") - } - - if (grepl("MultiArm", .getClassName(designPlan)) && - !is.null(designPlan[["activeArms"]]) && designPlan$activeArms > 1) { - title <- .concatenateSummaryText(title, "(multi-arm design)", sep = " ") - } else if (grepl("Enrichment", .getClassName(designPlan))) { - title <- .concatenateSummaryText(title, "(enrichment design)", sep = " ") - } - } else if (kMax > 1) { - prefix <- ifelse(design$.isDelayedResponseDesign(), "delayed response ", "") - title <- .concatenateSummaryText(title, - paste0("(", prefix, design$.toString(startWithUpperCase = FALSE), ")"), - sep = " " - ) - } - - return(title) -} - -.isRatioComparisonEnabled <- function(object) { - if (!is.null(object[["meanRatio"]]) && isTRUE(object[["meanRatio"]])) { - return(TRUE) - } - - if (!is.null(object[["riskRatio"]]) && isTRUE(object[["riskRatio"]])) { - return(TRUE) - } - - return(FALSE) -} - -.getSummaryObjectSettings <- function(object) { - multiArmEnabled <- grepl("MultiArm", .getClassName(object)) - enrichmentEnabled <- grepl("Enrichment", .getClassName(object)) - simulationEnabled <- grepl("Simulation", .getClassName(object)) - ratioEnabled <- FALSE - populations <- NA_integer_ - if (inherits(object, "AnalysisResults") || inherits(object, "StageResults")) { - groups <- object$.dataInput$getNumberOfGroups() - meansEnabled <- grepl("Means", .getClassName(object$.dataInput)) - ratesEnabled <- grepl("Rates", .getClassName(object$.dataInput)) - survivalEnabled <- grepl("Survival", .getClassName(object$.dataInput)) - } else { - meansEnabled <- grepl("Means", .getClassName(object)) - ratesEnabled <- grepl("Rates", .getClassName(object)) - survivalEnabled <- grepl("Survival", .getClassName(object)) - if (simulationEnabled && multiArmEnabled) { - groups <- object$activeArms - } else if (simulationEnabled && enrichmentEnabled) { - groups <- 2 - populations <- object$populations - } else { - # for analysis multi-arm / enrichment always 2 groups are applicable - groups <- ifelse(multiArmEnabled || enrichmentEnabled || survivalEnabled, 2, object[["groups"]]) - } - ratioEnabled <- .isRatioComparisonEnabled(object) - } - - return(list( - meansEnabled = meansEnabled, - ratesEnabled = ratesEnabled, - survivalEnabled = survivalEnabled, - groups = groups, - populations = populations, - multiArmEnabled = multiArmEnabled, - enrichmentEnabled = enrichmentEnabled, - simulationEnabled = simulationEnabled, - ratioEnabled = ratioEnabled - )) -} - -.createSummaryHypothesisText <- function(object, summaryFactory) { - if (!inherits(object, "AnalysisResults") && !inherits(object, "TrialDesignPlan") && - !inherits(object, "SimulationResults")) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'object' must be an instance of class 'AnalysisResults', 'TrialDesignPlan' ", - "or 'SimulationResults' (is '", .getClassName(object), "')" - ) - } - - design <- object[[".design"]] - if (is.null(design)) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'.design' must be defined in specified ", .getClassName(object)) - } - - settings <- .getSummaryObjectSettings(object) - sided <- ifelse(settings$multiArmEnabled || settings$enrichmentEnabled, 1, design$sided) - directionUpper <- object[["directionUpper"]] - if (is.null(directionUpper) || length(directionUpper) != 1 || is.na(directionUpper)) { - directionUpper <- TRUE - } - - comparisonH0 <- " = " - comparisonH1 <- NA_character_ - if (inherits(object, "AnalysisResults") && !is.null(directionUpper)) { - comparisonH1 <- ifelse(sided == 2, " != ", ifelse(directionUpper, " > ", " < ")) - } - - if (!is.null(object[["thetaH0"]])) { - thetaH0 <- round(object$thetaH0, 3) - } else { - thetaH0 <- ifelse(settings$survivalEnabled, 1, 0) - } - - treatmentArmIndex <- ifelse(settings$groups > 1, "(i)", "(treatment)") - controlArmIndex <- ifelse(settings$groups > 1, "(i)", "(control)") - - if (settings$multiArmEnabled || settings$enrichmentEnabled) { - if ((settings$survivalEnabled) && (settings$multiArmEnabled)) { - treatmentArmIndex <- "(i)" - controlArmIndex <- "" - } else if ((settings$survivalEnabled) && (settings$enrichmentEnabled)) { - treatmentArmIndex <- "" - controlArmIndex <- "" - } else if (settings$groups == 1) { - treatmentArmIndex <- "(treatment)" - controlArmIndex <- "(control)" - } else { - if (settings$enrichmentEnabled) { - treatmentArmIndex <- "(treatment)" - } else { - treatmentArmIndex <- "(i)" - } - controlArmIndex <- "(control)" - } - } else { - if (settings$groups == 1 || settings$survivalEnabled) { - treatmentArmIndex <- "" - controlArmIndex <- "" - } else { - treatmentArmIndex <- "(1)" - controlArmIndex <- "(2)" - } - } - - value <- "?" - if (settings$meansEnabled) { - value <- "mu" - } else if (settings$ratesEnabled) { - value <- "pi" - } else if (settings$survivalEnabled) { - value <- "hazard ratio" - } - - calcSep <- ifelse(settings$ratioEnabled, " / ", " - ") - hypothesis <- "" - if (!settings$survivalEnabled && (settings$multiArmEnabled || settings$enrichmentEnabled || settings$groups == 2)) { - hypothesis <- paste0( - hypothesis, "H0: ", value, treatmentArmIndex, - calcSep, value, controlArmIndex, comparisonH0, thetaH0 - ) - if (!is.na(comparisonH1)) { - hypothesis <- paste0(hypothesis, " against ") - hypothesis <- paste0( - hypothesis, "H1: ", value, treatmentArmIndex, - calcSep, value, controlArmIndex, comparisonH1, thetaH0 - ) - } - } else { - hypothesis <- paste0(hypothesis, "H0: ", value, treatmentArmIndex, comparisonH0, thetaH0) - if (!is.na(comparisonH1)) { - hypothesis <- paste0(hypothesis, " against ") - hypothesis <- paste0(hypothesis, "H1: ", value, treatmentArmIndex, comparisonH1, thetaH0) - } - } - hypothesis <- .concatenateSummaryText( - hypothesis, - .createSummaryHypothesisPowerDirectionText(object, sided, directionUpper) - ) - return(hypothesis) -} - -.createSummaryHypothesisPowerDirectionText <- function(object, sided, directionUpper) { - if (sided == 2 || is.null(directionUpper)) { - return("") - } - - directionUpper <- unique(directionUpper) - if (length(directionUpper) != 1) { - return("") - } - - if (inherits(object, "AnalysisResults")) { - return("") - } - - if (.isTrialDesignPlan(object) && object$.objectType != "power") { - return("") - } - - if (directionUpper) { - return("power directed towards larger values") - } else { - return("power directed towards smaller values") - } -} - -.addSummaryLineBreak <- function(text, newLineLength) { - maxLineLength <- as.integer(getOption("rpact.summary.width", 83)) - lines <- strsplit(text, "\n", fixed = TRUE)[[1]] - lastLine <- lines[length(lines)] - if (nchar(lastLine) + newLineLength > maxLineLength) { - text <- paste0(text, "\n") - } - return(text) -} - -.concatenateSummaryText <- function(a, b, sep = ", ") { - .assertIsSingleCharacter(a, "a") - .assertIsSingleCharacter(b, "b") - if (is.na(b) || nchar(trimws(b)) == 0) { - return(a) - } - - if (a == "") { - return(b) - } - - a <- paste0(a, sep) - a <- .addSummaryLineBreak(a, nchar(b)) - return(paste0(a, b)) -} - -.createSummaryHeaderObject <- function(object, summaryFactory, digits = NA_integer_) { - if (inherits(object, "TrialDesignCharacteristics")) { - return(.createSummaryHeaderDesign(object$.design, NULL, summaryFactory)) - } - - if (.isTrialDesignPlan(object) || inherits(object, "SimulationResults")) { - return(.createSummaryHeaderDesign(object$.design, object, summaryFactory)) - } - - if (inherits(object, "AnalysisResults")) { - return(.createSummaryHeaderAnalysisResults(object$.design, object, summaryFactory, digits)) - } - - if (.isTrialDesign(object)) { - return(.createSummaryHeaderDesign(object, NULL, summaryFactory)) - } - - return("") -} - -.addAllocationRatioToHeader <- function(parameterSet, header, sep = ", ") { - if (!.isTrialDesignPlanSurvival(parameterSet) && !grepl("Simulation", .getClassName(parameterSet))) { - numberOfGroups <- 1 - if (inherits(parameterSet, "TrialDesignPlan")) { - numberOfGroups <- parameterSet$groups - } else if (inherits(parameterSet, "AnalysisResults")) { - numberOfGroups <- parameterSet$.dataInput$getNumberOfGroups() - } - if (numberOfGroups == 1) { - return(header) - } - } - - prefix <- "" - if (!is.null(parameterSet[["optimumAllocationRatio"]]) && - length(parameterSet$optimumAllocationRatio) == 1 && - parameterSet$optimumAllocationRatio) { - if (length(unique(parameterSet$allocationRatioPlanned)) > 1) { - return(.concatenateSummaryText(header, "optimum planned allocation ratio", sep = sep)) - } - prefix <- "optimum " - } - - allocationRatioPlanned <- round(unique(parameterSet$allocationRatioPlanned), 3) - if (identical(allocationRatioPlanned, 1) && prefix == "") { - return(header) - } - - if (!all(is.na(allocationRatioPlanned))) { - return(.concatenateSummaryText(header, - paste0( - prefix, "planned allocation ratio = ", - .arrayToString(allocationRatioPlanned, vectorLookAndFeelEnabled = length(allocationRatioPlanned) > 1) - ), - sep = sep - )) - } else { - return(header) - } -} - -.createSummaryHeaderAnalysisResults <- function(design, analysisResults, summaryFactory, digits) { - digitSettings <- .getSummaryDigits(digits) - digitsGeneral <- digitSettings$digitsGeneral - - stageResults <- analysisResults$.stageResults - dataInput <- analysisResults$.dataInput - - multiArmEnabled <- .isMultiArmAnalysisResults(analysisResults) - enrichmentEnabled <- .isEnrichmentAnalysisResults(analysisResults) - multiHypothesesEnabled <- .isMultiHypothesesAnalysisResults(analysisResults) - - header <- "" - if (design$kMax == 1) { - header <- paste0(header, "Fixed sample analysis.") - } else { - header <- paste0(header, "Sequential analysis with ", design$kMax, " looks") - header <- .concatenateSummaryText(header, - paste0("(", design$.toString(startWithUpperCase = FALSE), ")."), - sep = " " - ) - } - header <- paste0(header, "\n") - - header <- paste0(header, "The results were calculated using a ") - if (stageResults$isDatasetMeans()) { - if (dataInput$getNumberOfGroups() == 1) { - header <- paste0(header, "one-sample t-test") - } else if (dataInput$getNumberOfGroups() == 2) { - header <- paste0(header, "two-sample t-test") - } else { - header <- paste0(header, "multi-arm t-test") - } - } else if (stageResults$isDatasetRates()) { - if (dataInput$getNumberOfGroups() == 1) { - header <- paste0(header, "one-sample test for rates") - } else if (dataInput$getNumberOfGroups() == 2) { - header <- paste0(header, "two-sample test for rates") - } else { - header <- paste0(header, "multi-arm test for rates") - } - } else if (stageResults$isDatasetSurvival()) { - if (dataInput$getNumberOfGroups() == 2) { - header <- paste0(header, "two-sample logrank test") - } else { - header <- paste0(header, "multi-arm logrank test") - } - } - - 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") - } else if (stageResults$intersectionTest == "Bonferroni") { - header <- .concatenateSummaryText(header, "Bonferroni intersection test") - } else if (stageResults$intersectionTest == "Simes") { - header <- .concatenateSummaryText(header, "Simes intersection test") - } else if (stageResults$intersectionTest == "Sidak") { - header <- .concatenateSummaryText(header, "Sidak intersection test") - } else if (stageResults$intersectionTest == "Hierarchical") { - header <- .concatenateSummaryText(header, "Hierarchical intersection test") - } else if (stageResults$intersectionTest == "SpiessensDebois") { - header <- .concatenateSummaryText(header, "Spiessens and Debois intersection test") - } - } - - if (!is.null(stageResults[["normalApproximation"]]) && stageResults$normalApproximation) { - header <- .concatenateSummaryText(header, "normal approximation test") - } else if (stageResults$isDatasetRates()) { - if (dataInput$getNumberOfGroups() == 1) { - header <- .concatenateSummaryText(header, "exact test") - } else { - header <- .concatenateSummaryText(header, "exact test of Fisher") - } - } else { - # header <- .concatenateSummaryText(header, "exact t test") - } - - if (stageResults$isDatasetMeans() && multiHypothesesEnabled) { - if (stageResults$varianceOption == "overallPooled") { - header <- .concatenateSummaryText(header, "overall pooled variances option") - } else if (stageResults$varianceOption == "pairwisePooled") { - header <- .concatenateSummaryText(header, "pairwise pooled variances option") - } else if (stageResults$varianceOption == "pooledFromFull") { - header <- .concatenateSummaryText(header, "pooled from full population variances option") - } else if (stageResults$varianceOption == "pooled") { - header <- .concatenateSummaryText(header, "pooled variances option") - } else if (stageResults$varianceOption == "notPooled") { - header <- .concatenateSummaryText(header, "not pooled variances option") - } - } - - if (inherits(stageResults, "StageResultsMeans") && (dataInput$getNumberOfGroups() == 2)) { - if (stageResults$equalVariances) { - header <- .concatenateSummaryText(header, "equal variances option") - } else { - header <- .concatenateSummaryText(header, "unequal variances option") - } - } - - if (.isTrialDesignConditionalDunnett(design)) { - if (design$secondStageConditioning) { - header <- .concatenateSummaryText(header, "conditional second stage p-values") - } else { - header <- .concatenateSummaryText(header, "unconditional second stage p-values") - } - } - - if (enrichmentEnabled) { - header <- .concatenateSummaryText(header, paste0( - ifelse(analysisResults$stratifiedAnalysis, "", "non-"), "stratified analysis" - )) - } - - header <- paste0(header, ".\n", .createSummaryHypothesisText(analysisResults, summaryFactory)) - - if (stageResults$isDatasetMeans()) { - header <- .getSummaryHeaderEntryAnalysisResults(header, analysisResults, - paramName1 = "thetaH1", - paramName2 = ifelse(multiHypothesesEnabled, "assumedStDevs", "assumedStDev"), - paramCaption1 = "assumed effect", - paramCaption2 = "assumed standard deviation", - shortcut1 = "thetaH1", - shortcut2 = "sd", - digits1 = digitsGeneral, - digits2 = digitsGeneral - ) - } else if (stageResults$isDatasetRates()) { - header <- .getSummaryHeaderEntryAnalysisResults(header, analysisResults, - paramName1 = ifelse(enrichmentEnabled, "piTreatments", ifelse(multiArmEnabled, "piTreatments", "pi1")), - paramName2 = ifelse(enrichmentEnabled, "piControls", ifelse(multiArmEnabled, "piControl", "pi2")), - paramCaption1 = "assumed treatment rate", - paramCaption2 = "assumed control rate", - shortcut1 = "pi", - shortcut2 = "pi" - ) - } else if (stageResults$isDatasetSurvival()) { - header <- .getSummaryHeaderEntryAnalysisResults(header, analysisResults, - paramName1 = "thetaH1", - paramCaption1 = "assumed effect", - shortcut1 = "thetaH1", - digits1 = digitsGeneral - ) - } - - header <- paste0(header, ".") - return(header) -} - -.getSummaryHeaderEntryValueAnalysisResults <- function(shortcut, value, analysisResults) { - if (is.matrix(value)) { - stage <- analysisResults$.stageResults$stage - if (stage <= ncol(value)) { - value <- value[, stage] - } - } - - value[!is.na(value)] <- round(value[!is.na(value)], 2) - - if ((is.matrix(value) && nrow(value) > 1) || length(value) > 1) { - treatmentNames <- 1:length(value) - if (.isEnrichmentAnalysisResults(analysisResults)) { - populations <- paste0("S", treatmentNames) - gMax <- analysisResults$.stageResults$getGMax() - populations[treatmentNames == gMax] <- "F" - treatmentNames <- populations - } - value <- paste0(paste(paste0(shortcut, "(", treatmentNames, ") = ", value)), collapse = ", ") - } - return(value) -} - -.getSummaryHeaderEntryAnalysisResults <- function(header, analysisResults, ..., - paramName1, paramName2 = NA_character_, - paramCaption1, paramCaption2 = NA_character_, - shortcut1, shortcut2 = NA_character_, - digits1 = 2, digits2 = 2) { - if (analysisResults$.design$kMax == 1) { - return(header) - } - - if (length(analysisResults$nPlanned) == 0 || all(is.na(analysisResults$nPlanned))) { - return(header) - } - - paramValue1 <- analysisResults[[paramName1]] - case1 <- analysisResults$.getParameterType(paramName1) != C_PARAM_NOT_APPLICABLE && - !all(is.na(paramValue1)) - if (!is.na(paramCaption1) && analysisResults$.getParameterType(paramName1) == C_PARAM_GENERATED) { - paramCaption1 <- sub("assumed ", "overall ", paramCaption1) - } - - case2 <- FALSE - if (!is.na(paramName2)) { - paramValue2 <- analysisResults[[paramName2]] - case2 <- analysisResults$.getParameterType(paramName2) != C_PARAM_NOT_APPLICABLE && - !all(is.na(paramValue2)) - if (!is.na(paramCaption2) && analysisResults$.getParameterType(paramName2) == C_PARAM_GENERATED) { - paramCaption2 <- sub("assumed ", "overall ", paramCaption2) - } - } - - if (!case1 && !case2) { - return(header) - } - - if (.isTrialDesignFisher(analysisResults$.design) && - length(analysisResults$nPlanned[!is.na(analysisResults$nPlanned)]) > 1) { - header <- .concatenateSummaryText(header, paste0( - "The conditional power simulation with planned sample size and ", - analysisResults$iterations, " iterations is based on" - ), sep = ". ") - } else { - header <- .concatenateSummaryText(header, - "The conditional power calculation with planned sample size is based on", - sep = ". " - ) - } - - header <- .addAllocationRatioToHeader(analysisResults, header, sep = " ") - - sepPrefix <- ifelse(length(analysisResults$allocationRatioPlanned) == 0 || - identical(unique(analysisResults$allocationRatioPlanned), 1), "", ",") - - if (case1) { - if (!any(is.na(paramValue1)) && length(unique(paramValue1)) == 1) { - paramValue1 <- paramValue1[1] - } - if (length(paramValue1) == 1) { - header <- .concatenateSummaryText(header, - paste0(paramCaption1, " = ", ifelse(is.na(paramValue1), paramValue1, round(paramValue1, digits1))), - sep = paste0(sepPrefix, " ") - ) - } else { - header <- .concatenateSummaryText(header, - paste0(paramCaption1, ": ", .getSummaryHeaderEntryValueAnalysisResults( - shortcut1, paramValue1, analysisResults - )), - sep = paste0(sepPrefix, " ") - ) - } - } - - if (case2) { - if (length(paramValue2) == 1) { - header <- .concatenateSummaryText(header, - paste0(paramCaption2, " = ", ifelse(is.na(paramValue2), paramValue2, round(paramValue2, digits2))), - sep = ifelse(case1, paste0(sepPrefix, " and "), " ") - ) - } else { - header <- .concatenateSummaryText(header, - paste0(paramCaption2, ": ", .getSummaryHeaderEntryValueAnalysisResults( - shortcut2, paramValue2, analysisResults - )), - sep = ifelse(case1, paste0(sepPrefix, " and "), " ") - ) - } - } - return(header) -} - -.addEnrichmentEffectListToHeader <- function(header, designPlan) { - if (!grepl("SimulationResultsEnrichment", .getClassName(designPlan)) || - is.null(designPlan[["effectList"]])) { - return(header) - } - - - subGroups <- designPlan$effectList$subGroups - header <- .concatenateSummaryText(header, paste0( - "subgroup", - ifelse(length(subGroups) != 1, "s", ""), - " = ", - .arrayToString(subGroups, vectorLookAndFeelEnabled = TRUE) - )) - - prevalences <- designPlan$effectList$prevalences - header <- .concatenateSummaryText(header, paste0( - "prevalence", - ifelse(length(prevalences) != 1, "s", ""), - " = ", - .arrayToString(round(prevalences, 3), vectorLookAndFeelEnabled = TRUE) - )) - - if (!is.null(designPlan$effectList[["piControls"]])) { - piControls <- designPlan$effectList$piControls - if (length(piControls) > 0) { - if (length(unique(piControls)) == 1) { - piControls <- piControls[1] - } - controlRateText <- paste0( - "control rate", ifelse(length(piControls) == 1, "", "s"), " pi(control) = ", - .arrayToString(round(piControls, 3), vectorLookAndFeelEnabled = (length(unique(piControls)) > 1)) - ) - header <- .concatenateSummaryText(header, controlRateText) - } - } - - return(header) -} - -.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" - } else { - designType <- C_TYPE_OF_DESIGN_LIST[[design$typeOfDesign]] - } - header <- .firstCharacterToUpperCase(designType) - header <- paste0(header, " design") - if (design$.isDelayedResponseDesign()) { - header <- paste0(header, " with delayed response") - } - if (design$kMax > 1 && .isTrialDesignInverseNormalOrGroupSequential(design)) { - if (design$typeOfDesign == C_TYPE_OF_DESIGN_WT) { - header <- .concatenateSummaryText(header, - paste0("(deltaWT = ", round(design$deltaWT, 3), ")"), - sep = " " - ) - } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_WT_OPTIMUM) { - header <- .concatenateSummaryText(header, - paste0("(", design$optimizationCriterion, ", deltaWT = ", round(design$deltaWT, 3), ")"), - sep = " " - ) - } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_PT) { - header <- .concatenateSummaryText(header, - paste0("(deltaPT1 = ", round(design$deltaPT1, 3), ""), - sep = " " - ) - header <- .concatenateSummaryText(header, - paste0("deltaPT0 = ", round(design$deltaPT0, 3), ")"), - sep = ", " - ) - } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_HP) { - header <- .concatenateSummaryText(header, - paste0("(constant bounds = ", round(design$constantBoundsHP, 3), ")"), - sep = " " - ) - } else if (design$typeOfDesign %in% c(C_TYPE_OF_DESIGN_AS_KD, C_TYPE_OF_DESIGN_AS_HSD)) { - header <- .concatenateSummaryText(header, - paste0("(gammaA = ", round(design$gammaA, 3), ")"), - sep = " " - ) - } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_AS_USER) { - header <- .concatenateSummaryText(header, - paste0("(", .arrayToString(round(design$userAlphaSpending, 3)), ")"), - sep = " " - ) - } - - if (grepl("^as", design$typeOfDesign) && design$typeBetaSpending != C_TYPE_OF_DESIGN_BS_NONE) { - typeBetaSpending <- C_TYPE_OF_DESIGN_BS_LIST[[design$typeBetaSpending]] - header <- .concatenateSummaryText(header, typeBetaSpending, sep = " and ") - if (design$typeBetaSpending %in% c(C_TYPE_OF_DESIGN_BS_KD, C_TYPE_OF_DESIGN_BS_HSD)) { - header <- .concatenateSummaryText(header, - paste0("(gammaB = ", round(design$gammaB, 3), ")"), - sep = " " - ) - } else if (design$typeBetaSpending == C_TYPE_OF_DESIGN_BS_USER) { - header <- .concatenateSummaryText(header, - paste0("(", .arrayToString(round(design$userBetaSpending, 3)), ")"), - sep = " " - ) - } - } - } - if (!.isDelayedInformationEnabled(design = design) && - ((.isTrialDesignInverseNormalOrGroupSequential(design) && any(design$futilityBounds > -6, na.rm = TRUE)) || - (.isTrialDesignFisher(design) && any(design$alpha0Vec < 1)))) { - header <- .concatenateSummaryText( - header, - 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 <- .concatenateSummaryText(header, "undefined endpoint") - - if (design$kMax > 1 && .isTrialDesignInverseNormalOrGroupSequential(design)) { - outputSize <- getOption("rpact.summary.output.size", C_SUMMARY_OUTPUT_SIZE_DEFAULT) - designCharacteristics <- NULL - tryCatch( - { - designCharacteristics <- getDesignCharacteristics(design) - }, - error = function(e) { - .logError("Cannot add design characteristics to summary: ", e$message) - } - ) - if (!is.null(designCharacteristics)) { - header <- .concatenateSummaryText( - header, - paste0("inflation factor ", round(designCharacteristics$inflationFactor, 4)) - ) - if (outputSize == "large") { - header <- .concatenateSummaryText( - header, - paste0("ASN H1 ", round(designCharacteristics$averageSampleNumber1, 4)) - ) - header <- .concatenateSummaryText( - header, - paste0("ASN H01 ", round(designCharacteristics$averageSampleNumber01, 4)) - ) - header <- .concatenateSummaryText( - header, - paste0("ASN H0 ", round(designCharacteristics$averageSampleNumber0, 4)) - ) - } - } - } - - header <- paste0(header, ".") - return(header) - } - - header <- "" - if (design$kMax == 1) { - 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 ", "") - header <- .concatenateSummaryText(header, - paste0("(", prefix, design$.toString(startWithUpperCase = FALSE), ")"), - 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 <- paste0(header, "\n") - - header <- paste0(header, "The ", ifelse(inherits(designPlan, "SimulationResults") || - designPlan$.isPowerObject(), "results were ", "sample size was ")) - header <- paste0(header, ifelse(inherits(designPlan, "SimulationResults"), "simulated", "calculated")) - header <- paste0(header, " for a ") - settings <- .getSummaryObjectSettings(designPlan) - if (settings$meansEnabled) { - if (settings$multiArmEnabled && settings$groups > 1) { - header <- .concatenateSummaryText(header, "multi-arm comparisons for means", sep = "") - } else if (settings$enrichmentEnabled && settings$populations > 1) { - header <- .concatenateSummaryText(header, "population enrichment comparisons for means", sep = "") - } else if (settings$groups == 1 && !settings$multiArmEnabled) { - header <- .concatenateSummaryText(header, "one-sample t-test", sep = "") - } else if (settings$groups == 2 || settings$multiArmEnabled) { - header <- .concatenateSummaryText(header, "two-sample t-test", sep = "") - } - } else if (settings$ratesEnabled) { - if (settings$multiArmEnabled && settings$groups > 1) { - header <- .concatenateSummaryText(header, "multi-arm comparisons for rates", sep = "") - } else if (settings$enrichmentEnabled && settings$populations > 1) { - header <- .concatenateSummaryText(header, "population enrichment comparisons for rates", sep = "") - } else if (settings$groups == 1 && !settings$multiArmEnabled) { - header <- .concatenateSummaryText(header, "one-sample test for rates", sep = "") - } else if (settings$groups == 2 || settings$multiArmEnabled) { - header <- .concatenateSummaryText(header, "two-sample test for rates", sep = "") - } - } else if (settings$survivalEnabled) { - if (settings$multiArmEnabled && settings$groups > 1) { - header <- .concatenateSummaryText(header, "multi-arm logrank test", sep = "") - } else if (settings$enrichmentEnabled && settings$populations > 1) { - header <- .concatenateSummaryText(header, "population enrichment logrank test", sep = "") - } else if (settings$groups == 2 || settings$multiArmEnabled) { - header <- .concatenateSummaryText(header, "two-sample logrank test", sep = "") - } - } - - part <- "" - if (settings$multiArmEnabled && settings$groups > 1) { - part <- .concatenateSummaryText(part, paste0(settings$groups, " treatments vs. control")) - } else if (settings$enrichmentEnabled) { - if (settings$groups == 2) { - part <- .concatenateSummaryText(part, "treatment vs. control") - } else if (settings$groups > 2) { - part <- .concatenateSummaryText(part, paste0(settings$groups, " treatments vs. control")) - } - part <- .concatenateSummaryText(part, paste0( - settings$populations, " population", - ifelse(settings$populations == 1, "", "s") - )) - } - if (!is.null(designPlan) && (.isTrialDesignPlan(designPlan) || inherits(designPlan, "SimulationResults")) && - !settings$multiArmEnabled && !settings$enrichmentEnabled && !settings$survivalEnabled) { - if (settings$ratesEnabled) { - if (settings$groups == 1) { - part <- .concatenateSummaryText(part, ifelse(designPlan$normalApproximation, - "normal approximation", "exact test" - )) - } else { - part <- .concatenateSummaryText(part, ifelse(designPlan$normalApproximation, - "normal approximation", "exact test of Fisher" - )) - } - } else if (designPlan$normalApproximation) { - part <- .concatenateSummaryText(part, "normal approximation") - } - } - if (part != "") { - header <- .concatenateSummaryText(header, paste0("(", part, ")"), sep = " ") - } - if (settings$meansEnabled && (.isTrialDesignInverseNormalOrGroupSequential(design) || - inherits(designPlan, "SimulationResults"))) { - header <- .concatenateSummaryText(header, .createSummaryHypothesisText(designPlan, summaryFactory)) - if (!is.null(designPlan[["alternative"]]) && length(designPlan$alternative) == 1) { - alternativeText <- paste0("H1: effect = ", round(designPlan$alternative, 3)) - } else if (!is.null(designPlan[["muMaxVector"]]) && length(designPlan$muMaxVector) == 1) { - alternativeText <- paste0("H1: mu_max = ", round(designPlan$muMaxVector, 3)) - } else if (!is.null(designPlan[["effectList"]]) && !is.null(designPlan$effectList[["effects"]]) && - isTRUE(nrow(designPlan$effectList$effects) == 1)) { - alternativeText <- paste0( - "H1: effects = ", - .arrayToString(designPlan$effectList$effects, mode = "vector") - ) - } else { - alternativeText <- "H1: effect as specified" - } - header <- .concatenateSummaryText(header, alternativeText) - - header <- .addEnrichmentEffectListToHeader(header, designPlan) - - if (grepl("SimulationResultsEnrichment", .getClassName(designPlan))) { - stDevs <- designPlan$effectList$stDevs - if (length(unique(stDevs)) == 1) { - stDevs <- unique(stDevs) - } - s <- ifelse(length(stDevs) != 1, "s", "") - stDevCaption <- ifelse(.isRatioComparisonEnabled(designPlan), - paste0("coefficient", s, " of variation"), - paste0("standard deviation", s) - ) - header <- .concatenateSummaryText(header, paste0( - stDevCaption, " = ", - .arrayToString(round(stDevs, 3), vectorLookAndFeelEnabled = TRUE) - )) - } else { - stDevCaption <- ifelse(.isRatioComparisonEnabled(designPlan), "coefficient of variation", "standard deviation") - header <- .concatenateSummaryText(header, paste0(stDevCaption, " = ", round(designPlan$stDev, 3))) - } - header <- .addAdditionalArgumentsToHeader(header, designPlan, settings) - } else if (settings$ratesEnabled && (.isTrialDesignInverseNormalOrGroupSequential(design) || - inherits(designPlan, "SimulationResults"))) { - if (settings$groups == 1) { - if (!is.null(designPlan[["pi1"]]) && length(designPlan$pi1) == 1) { - treatmentRateText <- paste0("H1: treatment rate pi = ", round(designPlan$pi1, 3)) - } else { - treatmentRateText <- "H1: treatment rate pi as specified" - } - - header <- paste0(header, ",\n", .createSummaryHypothesisText(designPlan, summaryFactory)) - header <- .concatenateSummaryText(header, treatmentRateText) - header <- .addAdditionalArgumentsToHeader(header, designPlan, settings) - } else { - if (!is.null(designPlan[["pi1"]]) && length(designPlan$pi1) == 1) { - treatmentRateText <- paste0("H1: treatment rate pi(1) = ", round(designPlan$pi1, 3)) - } else if (!is.null(designPlan[["piMaxVector"]]) && length(designPlan$piMaxVector) == 1) { - treatmentRateText <- paste0( - "H1: treatment rate pi_max = ", - .arrayToString(round(designPlan$piMaxVector, 3), vectorLookAndFeelEnabled = TRUE) - ) - } else if (settings$enrichmentEnabled && !is.null(designPlan[["effectList"]]) && - !is.null(designPlan$effectList[["piTreatments"]])) { - piTreatments <- designPlan$effectList[["piTreatments"]] - if (is.matrix(piTreatments) && nrow(piTreatments) == 1) { - treatmentRateText <- paste0( - "H1: assumed treatment rate pi(treatment) = ", - .arrayToString(round(designPlan$effectList$piTreatments, 3), vectorLookAndFeelEnabled = TRUE) - ) - } else { - treatmentRateText <- paste0("H1: assumed treatment rate pi(treatment) as specified") - } - } else { - treatmentRateText <- paste0( - "H1: treatment rate pi", - ifelse(settings$multiArmEnabled, "_max", "(1)"), " as specified" - ) - } - - controlRateText <- NA_character_ - if (settings$multiArmEnabled && !is.null(designPlan[["piControl"]])) { - controlRateText <- paste0("control rate pi(control) = ", round(designPlan$piControl, 3)) - } else if (settings$enrichmentEnabled && !is.null(designPlan[["piControls"]])) { - controlRateText <- paste0( - "control rates pi(control) = ", - .arrayToString(round(designPlan$piControls, 3), vectorLookAndFeelEnabled = TRUE) - ) - } else if (settings$enrichmentEnabled && !is.null(designPlan[["effectList"]]) && - !is.null(designPlan$effectList[["piControls"]])) { - # controlRateText will be created in .addEnrichmentEffectListToHeader() - } else if (!is.null(designPlan[["pi2"]])) { - controlRateText <- paste0("control rate pi(2) = ", round(designPlan$pi2, 3)) - } else { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to identify case to build ", sQuote("controlRateText")) - } - header <- paste0(header, ",\n", .createSummaryHypothesisText(designPlan, summaryFactory)) - header <- .concatenateSummaryText(header, treatmentRateText) - if (!is.na(controlRateText)) { - header <- .concatenateSummaryText(header, controlRateText) - } - header <- .addEnrichmentEffectListToHeader(header, designPlan) - header <- .addAdditionalArgumentsToHeader(header, designPlan, settings) - } - } else if (settings$survivalEnabled && (.isTrialDesignInverseNormalOrGroupSequential(design) || - inherits(designPlan, "SimulationResults"))) { - parameterNames <- designPlan$.getVisibleFieldNamesOrdered() - numberOfVariants <- .getMultidimensionalNumberOfVariants(designPlan, parameterNames) - - if (grepl("SimulationResultsEnrichment", .getClassName(designPlan))) { - userDefinedParam <- "hazardRatios" - paramName <- "hazard ratios" - paramValue <- designPlan$effectList$hazardRatios - } else { - userDefinedParam <- "pi1" - for (param in c("pi1", "lambda1", "median1", "hazardRatio")) { - if (designPlan$.getParameterType(param) == C_PARAM_USER_DEFINED && - length(designPlan[[param]]) == numberOfVariants) { - userDefinedParam <- param - } - } - paramValue <- designPlan[[userDefinedParam]] - - if (is.null(paramValue) || length(paramValue) == 0 || all(is.na(paramValue))) { - userDefinedParam <- "hazardRatio" - } - paramName <- "treatment pi(1)" - if (userDefinedParam == "lambda1") { - paramName <- "treatment lambda(1)" - } else if (userDefinedParam == "median1") { - paramName <- "treatment median(1)" - } else if (userDefinedParam == "hazardRatio") { - paramName <- ifelse(grepl("SimulationResultsMultiArm", .getClassName(designPlan)), "omega_max", "hazard ratio") - } - } - - if (length(designPlan[[userDefinedParam]]) == 1) { - treatmentRateText <- paste0("H1: ", paramName, " = ", round(designPlan[[userDefinedParam]], 3)) - } else if (!is.null(designPlan[["omegaMaxVector"]]) && length(designPlan$omegaMaxVector) == 1) { - treatmentRateText <- paste0("H1: omega_max = ", round(designPlan$omegaMaxVector, 3)) - } else if (!is.null(designPlan[["hazardRatio"]]) && (length(designPlan$hazardRatio) == 1) || - (inherits(designPlan, "SimulationResults") && !is.null(designPlan[[".piecewiseSurvivalTime"]]) && - designPlan$.piecewiseSurvivalTime$piecewiseSurvivalEnabled)) { - treatmentRateText <- paste0( - "H1: hazard ratio = ", - .arrayToString(round(designPlan$hazardRatio, 3), vectorLookAndFeelEnabled = TRUE) - ) - } else if (settings$enrichmentEnabled && !is.null(designPlan[["effectList"]]) && - !is.null(designPlan$effectList[["hazardRatios"]]) && - is.matrix(designPlan$effectList$hazardRatios) && - nrow(designPlan$effectList$hazardRatios) == 1) { - treatmentRateText <- paste0( - "H1: hazard ratios = ", - .arrayToString(round(designPlan$effectList$hazardRatios, 3), vectorLookAndFeelEnabled = TRUE) - ) - } else { - treatmentRateText <- paste0("H1: ", paramName, " as specified") - } - if (userDefinedParam %in% c("hazardRatio", "pi1") && - (designPlan$.getParameterType("pi2") == C_PARAM_USER_DEFINED || - designPlan$.getParameterType("pi2") == C_PARAM_DEFAULT_VALUE) && - length(designPlan$pi2) == 1) { - treatmentRateText <- paste0(treatmentRateText, ", control pi(2) = ", round(designPlan$pi2, 3)) - } else if (userDefinedParam %in% c("hazardRatio", "lambda1") && - (designPlan$.getParameterType("lambda2") == C_PARAM_USER_DEFINED || - designPlan$.getParameterType("lambda2") == C_PARAM_DEFAULT_VALUE) && - length(designPlan$lambda2) == 1) { - treatmentRateText <- paste0(treatmentRateText, ", control lambda(2) = ", round(designPlan$lambda2, 3)) - } else if (userDefinedParam %in% c("hazardRatio", "median1") && - (designPlan$.getParameterType("median2") == C_PARAM_USER_DEFINED || - designPlan$.getParameterType("median2") == C_PARAM_GENERATED) && - length(designPlan$median2) == 1) { - treatmentRateText <- paste0(treatmentRateText, ", control median(2) = ", round(designPlan$median2, 3)) - } else if (!is.null(designPlan[[".piecewiseSurvivalTime"]]) && - designPlan$.piecewiseSurvivalTime$piecewiseSurvivalEnabled) { - treatmentRateText <- paste0(treatmentRateText, ", piecewise survival distribution") - treatmentRateText <- paste0( - treatmentRateText, ", \n", - "piecewise survival time = ", .arrayToString(round(designPlan$piecewiseSurvivalTime, 4), vectorLookAndFeelEnabled = TRUE), ", \n", - "control lambda(2) = ", .arrayToString(round(designPlan$lambda2, 4), vectorLookAndFeelEnabled = TRUE) - ) - } - header <- paste0(header, ", \n", .createSummaryHypothesisText(designPlan, summaryFactory)) - header <- .concatenateSummaryText(header, treatmentRateText) - 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(header, paste0("simulation runs = ", designPlan$maxNumberOfIterations)) - header <- .concatenateSummaryText(header, paste0("seed = ", designPlan$seed)) - } - header <- paste0(header, ".") - return(header) -} - -.addAdditionalArgumentsToHeader <- function(header, designPlan, settings) { - if (designPlan$.design$kMax > 1) { - if (settings$survivalEnabled) { - if (!is.null(designPlan[["plannedEvents"]])) { - header <- .concatenateSummaryText(header, paste0( - "planned cumulative events = ", - .arrayToString(designPlan$plannedEvents, - vectorLookAndFeelEnabled = (length(designPlan$plannedEvents) > 1) - ) - )) - } - } else { - if (!is.null(designPlan[["plannedSubjects"]])) { - header <- .concatenateSummaryText(header, paste0( - "planned cumulative sample size = ", - .arrayToString(designPlan$plannedSubjects, - vectorLookAndFeelEnabled = (length(designPlan$plannedSubjects) > 1) - ) - )) - } - } - - if (!is.null(designPlan[["maxNumberOfSubjects"]]) && - designPlan$.getParameterType("maxNumberOfSubjects") == C_PARAM_USER_DEFINED) { - header <- .concatenateSummaryText(header, paste0( - "maximum number of subjects = ", - ceiling(designPlan$maxNumberOfSubjects[1]) - )) - } - - if (settings$survivalEnabled) { - if (!is.null(designPlan[["maxNumberOfEvents"]]) && - designPlan$.getParameterType("maxNumberOfEvents") == C_PARAM_USER_DEFINED) { - header <- .concatenateSummaryText(header, paste0( - "maximum number of events = ", - ceiling(designPlan$maxNumberOfEvents[1]) - )) - } - } - } else { - if (settings$survivalEnabled) { - if (!is.null(designPlan[["plannedEvents"]])) { - header <- .concatenateSummaryText(header, paste0( - "planned events = ", - .arrayToString(designPlan$plannedEvents, - vectorLookAndFeelEnabled = (length(designPlan$plannedEvents) > 1) - ) - )) - } - } else { - if (!is.null(designPlan[["plannedSubjects"]])) { - header <- .concatenateSummaryText(header, paste0( - "planned sample size = ", - .arrayToString(designPlan$plannedSubjects, - vectorLookAndFeelEnabled = (length(designPlan$plannedSubjects) > 1) - ) - )) - } - } - - if (!is.null(designPlan[["maxNumberOfSubjects"]]) && - designPlan$.getParameterType("maxNumberOfSubjects") == C_PARAM_USER_DEFINED) { - header <- .concatenateSummaryText(header, paste0( - "number of subjects = ", - ceiling(designPlan$maxNumberOfSubjects[1]) - )) - } - - if (settings$survivalEnabled) { - if (!is.null(designPlan[["maxNumberOfEvents"]]) && - designPlan$.getParameterType("maxNumberOfEvents") == C_PARAM_USER_DEFINED) { - header <- .concatenateSummaryText(header, paste0( - "number of events = ", - designPlan$maxNumberOfEvents[1] - )) - } - } - } - - header <- .addAllocationRatioToHeader(designPlan, header) - - if (settings$survivalEnabled) { - if (!is.null(designPlan[["eventTime"]]) && !is.na(designPlan[["eventTime"]])) { - header <- .concatenateSummaryText(header, paste0( - "event time = ", - .arrayToString(designPlan$eventTime, - vectorLookAndFeelEnabled = (length(designPlan$eventTime) > 1) - ) - )) - } - if (!is.null(designPlan[["accrualTime"]])) { - header <- .concatenateSummaryText(header, paste0( - "accrual time = ", - .arrayToString(designPlan$accrualTime, - vectorLookAndFeelEnabled = (length(designPlan$accrualTime) > 1) - ) - )) - } - if (!is.null(designPlan[["accrualTime"]]) && - length(designPlan$accrualIntensity) == length(designPlan$accrualTime)) { - header <- .concatenateSummaryText(header, paste0( - "accrual intensity = ", - .arrayToString(designPlan$accrualIntensity, - digits = 1, - vectorLookAndFeelEnabled = (length(designPlan$accrualIntensity) > 1) - ) - )) - } - if (!is.null(designPlan[["dropoutTime"]])) { - if (designPlan$dropoutRate1 > 0 || designPlan$dropoutRate2 > 0) { - header <- .concatenateSummaryText(header, paste0( - "dropout rate(1) = ", - .arrayToString(designPlan$dropoutRate1, - vectorLookAndFeelEnabled = (length(designPlan$dropoutRate1) > 1) - ) - )) - header <- .concatenateSummaryText(header, paste0( - "dropout rate(2) = ", - .arrayToString(designPlan$dropoutRate2, - vectorLookAndFeelEnabled = (length(designPlan$dropoutRate2) > 1) - ) - )) - header <- .concatenateSummaryText(header, paste0( - "dropout time = ", - .arrayToString(designPlan$dropoutTime, - vectorLookAndFeelEnabled = (length(designPlan$dropoutTime) > 1) - ) - )) - } - } - } - - if (settings$multiArmEnabled && designPlan$activeArms > 1) { - header <- .addShapeToHeader(header, designPlan) - header <- .addSelectionToHeader(header, designPlan) - } - - if (settings$enrichmentEnabled && settings$populations > 1) { - header <- .addSelectionToHeader(header, designPlan) - } - - functionName <- ifelse(settings$survivalEnabled, "calcEventsFunction", "calcSubjectsFunction") - userDefinedFunction <- !is.null(designPlan[[functionName]]) && - designPlan$.getParameterType(functionName) == C_PARAM_USER_DEFINED - - if (userDefinedFunction || (!is.null(designPlan[["conditionalPower"]]) && !is.na(designPlan$conditionalPower))) { - if (userDefinedFunction) { - header <- .concatenateSummaryText( - header, - paste0("sample size reassessment: user defined '", functionName, "'") - ) - if ((!is.null(designPlan[["conditionalPower"]]) && !is.na(designPlan$conditionalPower))) { - header <- .concatenateSummaryText( - header, - paste0("conditional power = ", designPlan$conditionalPower) - ) - } - } else { - if ((!is.null(designPlan[["conditionalPower"]]) && !is.na(designPlan$conditionalPower))) { - header <- .concatenateSummaryText( - header, - paste0("sample size reassessment: conditional power = ", designPlan$conditionalPower) - ) - } - } - - paramName1 <- ifelse(settings$survivalEnabled, "minNumberOfEventsPerStage", "minNumberOfSubjectsPerStage") - paramName2 <- ifelse(settings$survivalEnabled, "maxNumberOfEventsPerStage", "maxNumberOfSubjectsPerStage") - paramCaption <- ifelse(settings$survivalEnabled, "events", "subjects") - if (!is.null(designPlan[[paramName1]])) { - header <- .concatenateSummaryText(header, paste0( - "minimum ", paramCaption, " per stage = ", - .arrayToString(designPlan[[paramName1]], - vectorLookAndFeelEnabled = (length(designPlan[[paramName1]]) > 1) - ) - )) - } - if (!is.null(designPlan[[paramName2]])) { - header <- .concatenateSummaryText(header, paste0( - "maximum ", paramCaption, " per stage = ", - .arrayToString(designPlan[[paramName2]], - vectorLookAndFeelEnabled = (length(designPlan[[paramName2]]) > 1) - ) - )) - } - - if (settings$meansEnabled) { - if (!is.na(designPlan$thetaH1)) { - header <- .concatenateSummaryText( - header, - paste0("theta H1 = ", round(designPlan$thetaH1, 3)) - ) - } - if (!is.na(designPlan$stDevH1)) { - header <- .concatenateSummaryText( - header, - paste0("standard deviation H1 = ", round(designPlan$stDevH1, 3)) - ) - } - } else if (settings$ratesEnabled) { - if (settings$multiArmEnabled || settings$enrichmentEnabled) { - if (settings$multiArmEnabled && !is.na(designPlan$piTreatmentsH1)) { - header <- .concatenateSummaryText( - header, - paste0("pi(treatment)H1 = ", round(designPlan$piTreatmentsH1, 3)) - ) - } else if (settings$enrichmentEnabled) { - piTreatmentH1 <- designPlan[["piTreatmentH1"]] - if (is.null(piTreatmentH1)) { - piTreatmentH1 <- designPlan[["piTreatmentsH1"]] - } - if (!is.null(piTreatmentH1) && !is.na(piTreatmentH1)) { - header <- .concatenateSummaryText( - header, - paste0("pi(treatment)H1 = ", round(piTreatmentH1, 3)) - ) - } - } - if (!is.na(designPlan$piControlH1)) { - header <- .concatenateSummaryText( - header, - paste0("pi(control)H1 = ", round(designPlan$piControlH1, 3)) - ) - } - } else { - if (!is.na(designPlan$pi1H1)) { - header <- .concatenateSummaryText( - header, - paste0("pi(treatment)H1 = ", round(designPlan$pi1H1, 3)) - ) - } - if (!is.na(designPlan$pi2H1)) { - header <- .concatenateSummaryText( - header, - paste0("pi(control)H1 = ", round(designPlan$pi2H1, 3)) - ) - } - } - } - - if (settings$survivalEnabled && !is.null(designPlan[["thetaH1"]]) && !is.na(designPlan$thetaH1)) { - header <- .concatenateSummaryText(header, paste0("thetaH1 = ", round(designPlan$thetaH1, 3))) - } - } - - return(header) -} - -.addShapeToHeader <- function(header, designPlan) { - header <- .concatenateSummaryText(header, paste0("effect shape = ", .formatCamelCase(designPlan$typeOfShape))) - if (designPlan$typeOfShape == "sigmoidEmax") { - header <- .concatenateSummaryText(header, paste0("slope = ", designPlan$slope)) - header <- .concatenateSummaryText(header, paste0("ED50 = ", designPlan$gED50)) - } - - return(header) -} - -.addSelectionToHeader <- function(header, designPlan) { - header <- .concatenateSummaryText(header, paste0("intersection test = ", designPlan$intersectionTest)) - - if (designPlan$.design$kMax > 1) { - typeOfSelectionText <- paste0("selection = ", .formatCamelCase(designPlan$typeOfSelection)) - if (designPlan$typeOfSelection == "rBest") { - typeOfSelectionText <- paste0(typeOfSelectionText, ", r = ", designPlan$rValue) - } else if (designPlan$typeOfSelection == "epsilon") { - typeOfSelectionText <- paste0(typeOfSelectionText, " rule, eps = ", designPlan$epsilonValue) - } - if (!is.null(designPlan$threshold) && length(designPlan$threshold) == 1 && designPlan$threshold > -Inf) { - typeOfSelectionText <- paste0(typeOfSelectionText, ", threshold = ", designPlan$threshold) - } - header <- .concatenateSummaryText(header, typeOfSelectionText) - - header <- .concatenateSummaryText( - header, - paste0("effect measure based on ", .formatCamelCase(designPlan$effectMeasure)) - ) - } - - header <- .concatenateSummaryText( - header, - paste0("success criterion: ", .formatCamelCase(designPlan$successCriterion)) - ) - - return(header) -} - -.createSummary <- function(object, digits = NA_integer_, output = c("all", "title", "overview", "body")) { - output <- match.arg(output) - if (inherits(object, "TrialDesignCharacteristics")) { - return(.createSummaryDesignPlan(object, digits = digits, output = output, showStageLevels = TRUE)) - } - - if (.isTrialDesign(object) || .isTrialDesignPlan(object) || inherits(object, "SimulationResults")) { - return(.createSummaryDesignPlan(object, digits = digits, output = output, showStageLevels = !.isTrialDesignPlan(object))) - } - - if (inherits(object, "AnalysisResults")) { - return(.createSummaryAnalysisResults(object, digits = digits, output = output)) - } - - if (inherits(object, "PerformanceScore")) { - return(.createSummaryPerformanceScore(object, digits = digits, output = output)) - } - - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "function 'summary' not implemented yet for class ", .getClassName(object)) -} - -.createSummaryPerformanceScore <- function(object, digits = NA_integer_, output = c("all", "title", "overview", "body")) { - .createSummaryDesignPlan(object$.simulationResults, - digits = digits, output = output, - showStageLevels = TRUE, performanceScore = object - ) -} - -.getSummaryParameterCaptionCriticalValues <- function(design) { - parameterCaption <- ifelse(.isTrialDesignFisher(design), - "Efficacy boundary (p product scale)", "Efficacy boundary (z-value scale)" - ) - parameterCaption <- ifelse(.isDelayedInformationEnabled(design = design), - "Upper bounds of continuation", parameterCaption - ) - return(parameterCaption) -} - -.getSummaryParameterCaptionFutilityBounds <- function(design) { - bindingInfo <- ifelse(design$bindingFutility, "binding", "non-binding") - parameterCaption <- ifelse(.isDelayedInformationEnabled(design = design), - paste0("Lower bounds of continuation (", bindingInfo, ")"), - paste0("Futility boundary (z-value scale)") - ) - return(parameterCaption) -} - -#' -#' Main function for creating a summary of an analysis result -#' -#' @noRd -#' -.createSummaryAnalysisResults <- function(object, digits = NA_integer_, output = c("all", "title", "overview", "body")) { - output <- match.arg(output) - if (!inherits(object, "AnalysisResults")) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'object' must be a valid analysis result object (is class ", .getClassName(object), ")" - ) - } - - digitSettings <- .getSummaryDigits(digits) - digits <- digitSettings$digits - digitsSampleSize <- digitSettings$digitsSampleSize - digitsGeneral <- digitSettings$digitsGeneral - digitsProbabilities <- digitSettings$digitsProbabilities - - outputSize <- getOption("rpact.summary.output.size", C_SUMMARY_OUTPUT_SIZE_DEFAULT) - - intervalFormat <- getOption("rpact.summary.intervalFormat", "[%s; %s]") - .assertIsValidSummaryIntervalFormat(intervalFormat) - - multiArmEnabled <- .isMultiArmAnalysisResults(object) - enrichmentEnabled <- .isEnrichmentAnalysisResults(object) - multiHypothesesEnabled <- .isMultiHypothesesAnalysisResults(object) - - analysisResults <- object - design <- analysisResults$.design - stageResults <- analysisResults$.stageResults - dataInput <- analysisResults$.dataInput - closedTestResults <- NULL - conditionalPowerResults <- NULL - if (multiHypothesesEnabled) { - closedTestResults <- analysisResults$.closedTestResults - if (length(analysisResults$nPlanned) > 0 && !all(is.na(analysisResults$nPlanned))) { - conditionalPowerResults <- analysisResults$.conditionalPowerResults - } - } - - summaryFactory <- SummaryFactory(object = object, intervalFormat = intervalFormat, output = output) - - .addDesignInformationToSummary(design, object, summaryFactory, output = output) - - if (!.isTrialDesignConditionalDunnett(design)) { - summaryFactory$addParameter(design, - parameterName = "criticalValues", - parameterCaption = .getSummaryParameterCaptionCriticalValues(design), - roundDigits = digitsProbabilities - ifelse(.isTrialDesignFisher(design) || digitsProbabilities <= 1, 0, 1), - smoothedZeroFormat = !.isTrialDesignFisher(design) - ) - } - - if (.isTrialDesignFisher(design)) { - if (any(design$alpha0Vec < 1)) { - summaryFactory$addParameter(design, - parameterName = "alpha0Vec", - parameterCaption = "Futility boundary (separate p-value scale)", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - } else if (!.isTrialDesignConditionalDunnett(design)) { - if (any(design$futilityBounds > -6)) { - summaryFactory$addParameter(design, - parameterName = "futilityBounds", - parameterCaption = .getSummaryParameterCaptionFutilityBounds(design), - roundDigits = ifelse(digitsProbabilities > 1, digitsProbabilities - 1, digitsProbabilities), - smoothedZeroFormat = TRUE - ) - } - } - - if (design$kMax > 1 && !.isTrialDesignConditionalDunnett(design)) { - summaryFactory$addParameter(design, - parameterName = "alphaSpent", - parameterCaption = "Cumulative alpha spent", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - - if (!.isTrialDesignConditionalDunnett(design)) { - summaryFactory$addParameter(design, - parameterName = "stageLevels", - parameterCaption = "Stage level", roundDigits = digitsProbabilities, - smoothedZeroFormat = TRUE - ) - } - - summaryFactory$addParameter(stageResults, - parameterName = "effectSizes", - parameterCaption = ifelse(stageResults$isDatasetRates() && dataInput$getNumberOfGroups() == 1, - "Cumulative treatment rate", "Cumulative effect size" - ), roundDigits = digitsGeneral - ) - - if (stageResults$isDatasetMeans()) { - parameterCaption <- ifelse(stageResults$isOneSampleDataset(), - "Cumulative standard deviation", "Cumulative (pooled) standard deviation" - ) - parameterName <- ifelse(inherits(stageResults, "StageResultsMultiArmMeans") && - !inherits(stageResults, "StageResultsEnrichmentMeans"), - "overallPooledStDevs", "overallStDevs" - ) - summaryFactory$addParameter(stageResults, - parameterName = parameterName, - parameterCaption = parameterCaption, roundDigits = digitsGeneral, - enforceFirstCase = (parameterName == "overallPooledStDevs") - ) - } else if (stageResults$isDatasetRates()) { - if (outputSize != "small" && dataInput$getNumberOfGroups() > 1) { - treatmentRateParamName <- "overallPi1" - controlRateParamName <- "overallPi2" - if (.isEnrichmentStageResults(stageResults)) { - treatmentRateParamName <- "overallPisTreatment" - controlRateParamName <- "overallPisControl" - } else if (.isMultiArmStageResults(stageResults)) { - treatmentRateParamName <- "overallPiTreatments" - controlRateParamName <- "overallPiControl" - } - summaryFactory$addParameter(stageResults, - parameterName = treatmentRateParamName, - parameterCaption = "Cumulative treatment rate", roundDigits = digitsGeneral - ) - summaryFactory$addParameter(stageResults, - parameterName = controlRateParamName, - parameterCaption = "Cumulative control rate", roundDigits = digitsGeneral, enforceFirstCase = TRUE - ) - } - } - - if (.isTrialDesignGroupSequential(design)) { - summaryFactory$addParameter(stageResults, - parameterName = "overallTestStatistics", - parameterCaption = "Overall test statistic", - roundDigits = ifelse(digitsProbabilities > 1, digitsProbabilities - 1, digitsProbabilities), - smoothedZeroFormat = TRUE - ) - summaryFactory$addParameter(stageResults, - parameterName = ifelse(multiHypothesesEnabled, "separatePValues", "overallPValues"), - parameterCaption = "Overall p-value", roundDigits = digitsProbabilities - ) - } else { - summaryFactory$addParameter(stageResults, - parameterName = "testStatistics", - parameterCaption = "Stage-wise test statistic", - roundDigits = ifelse(digitsProbabilities > 1, digitsProbabilities - 1, digitsProbabilities), - smoothedZeroFormat = TRUE - ) - summaryFactory$addParameter(stageResults, - parameterName = ifelse(multiHypothesesEnabled, "separatePValues", "pValues"), - parameterCaption = "Stage-wise p-value", roundDigits = digitsProbabilities - ) - } - - if (!is.null(closedTestResults)) { - if (outputSize == "large") { - if (.isTrialDesignConditionalDunnett(design)) { - summaryFactory$addParameter(closedTestResults, - parameterName = "conditionalErrorRate", - parameterCaption = "Conditional error rate", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - summaryFactory$addParameter(closedTestResults, - parameterName = "secondStagePValues", - parameterCaption = "Second stage p-value", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } else { - summaryFactory$addParameter(closedTestResults, - parameterName = "adjustedStageWisePValues", - parameterCaption = "Adjusted stage-wise p-value", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - summaryFactory$addParameter(closedTestResults, - parameterName = "overallAdjustedTestStatistics", - parameterCaption = "Overall adjusted test statistic", - roundDigits = digitsProbabilities - ifelse(.isTrialDesignFisher(design) || digitsProbabilities <= 1, 0, 1), - smoothedZeroFormat = !.isTrialDesignFisher(design) - ) - } - } else if (outputSize == "medium") { - legendEntry <- list("(i, j, ...)" = "comparison of treatment arms 'i, j, ...' vs. control arm") - gMax <- stageResults$getGMax() - if (.isTrialDesignConditionalDunnett(design)) { - summaryFactory$addParameter(closedTestResults, - parameterName = "adjustedStageWisePValues", - values = closedTestResults$conditionalErrorRate[1, ], - parameterCaption = paste0( - "Conditional error rate (", - paste0(1:gMax, collapse = ", "), ")" - ), roundDigits = digitsProbabilities, - smoothedZeroFormat = TRUE, - legendEntry = legendEntry - ) - summaryFactory$addParameter(closedTestResults, - parameterName = "overallAdjustedTestStatistics", - values = closedTestResults$secondStagePValues[1, ], - parameterCaption = paste0( - "Second stage p-value (", - paste0(1:gMax, collapse = ", "), ")" - ), - roundDigits = digitsProbabilities + ifelse(.isTrialDesignFisher(design), 1, 0), - smoothedZeroFormat = !.isTrialDesignFisher(design), - legendEntry = legendEntry - ) - } else { - summaryFactory$addParameter(closedTestResults, - parameterName = "adjustedStageWisePValues", - values = closedTestResults$adjustedStageWisePValues[1, ], - parameterCaption = paste0( - "Adjusted stage-wise p-value (", - paste0(1:gMax, collapse = ", "), ")" - ), roundDigits = digitsProbabilities, - smoothedZeroFormat = TRUE, legendEntry = legendEntry - ) - summaryFactory$addParameter(closedTestResults, - parameterName = "overallAdjustedTestStatistics", - values = closedTestResults$overallAdjustedTestStatistics[1, ], - parameterCaption = paste0( - "Overall adjusted test statistic (", - paste0(1:gMax, collapse = ", "), ")" - ), - roundDigits = digitsProbabilities - ifelse(.isTrialDesignFisher(design) || digitsProbabilities <= 1, 0, 1), - smoothedZeroFormat = !.isTrialDesignFisher(design), - legendEntry = legendEntry - ) - } - } - } - - if (multiHypothesesEnabled) { - summaryFactory$addParameter(closedTestResults, - parameterName = "rejected", - parameterCaption = "Test action: reject", roundDigits = digitsGeneral - ) - } else { - if (.isTrialDesignFisher(design)) { - summaryFactory$addParameter(stageResults, - parameterName = "combFisher", - parameterCaption = "Fisher combination", roundDigits = 0 - ) - } else if (.isTrialDesignInverseNormal(design)) { - summaryFactory$addParameter(stageResults, - parameterName = "combInverseNormal", - parameterCaption = "Inverse normal combination", - roundDigits = ifelse(digitsProbabilities > 1, digitsProbabilities - 1, digitsProbabilities), - smoothedZeroFormat = TRUE - ) - } - summaryFactory$addParameter(analysisResults, - parameterName = "testActions", - parameterCaption = "Test action", roundDigits = digitsGeneral - ) - } - - if (design$kMax > 1 && !.isTrialDesignConditionalDunnett(design)) { - summaryFactory$addParameter(analysisResults, - parameterName = "conditionalRejectionProbabilities", - parameterCaption = "Conditional rejection probability", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - - if (design$kMax > 1) { - if (!is.null(conditionalPowerResults)) { - summaryFactory$addParameter(conditionalPowerResults, - parameterName = "nPlanned", - parameterCaption = "Planned sample size", roundDigits = -1 - ) - } else if (analysisResults$.getParameterType("nPlanned") != C_PARAM_NOT_APPLICABLE) { - summaryFactory$addParameter(analysisResults, - parameterName = "nPlanned", - parameterCaption = "Planned sample size", roundDigits = -1 - ) - } - } - - if (design$kMax > 1) { - if (!is.null(conditionalPowerResults)) { - summaryFactory$addParameter(conditionalPowerResults, - parameterName = "conditionalPower", - parameterCaption = "Conditional power", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } else if (!multiHypothesesEnabled && analysisResults$.getParameterType("nPlanned") != C_PARAM_NOT_APPLICABLE) { - parameterName <- "conditionalPower" - if (!is.null(analysisResults[["conditionalPowerSimulated"]]) && - length(analysisResults[["conditionalPowerSimulated"]]) > 0) { - parameterName <- "conditionalPowerSimulated" - } - summaryFactory$addParameter(analysisResults, - parameterName = parameterName, - parameterCaption = "Conditional power", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - } - - ciLevel <- round((1 - design$alpha * (3 - design$sided)) * 100, 2) - if (.isTrialDesignConditionalDunnett(design)) { - parameterCaptionRepeatedPValues <- "Overall p-value" - parameterCaptionRepeatedCI <- paste0(ciLevel, "% overall confidence interval") - } else { - parameterCaptionRepeatedPValues <- ifelse(design$kMax == 1, - ifelse(design$sided == 1, "One-sided p-value", "Two-sided p-value"), - "Repeated p-value" - ) - parameterCaptionRepeatedCI <- paste0( - ciLevel, "% ", - ifelse(design$kMax == 1, "confidence interval", "repeated confidence interval") - ) - } - - summaryFactory$addParameter(analysisResults, - parameterName = c("repeatedConfidenceIntervalLowerBounds", "repeatedConfidenceIntervalUpperBounds"), - parameterCaption = parameterCaptionRepeatedCI, - roundDigits = digitsGeneral - ) - - summaryFactory$addParameter(analysisResults, - parameterName = "repeatedPValues", - parameterCaption = parameterCaptionRepeatedPValues, - roundDigits = digitsProbabilities, formatRepeatedPValues = TRUE - ) - - if (!multiHypothesesEnabled && !is.null(analysisResults[["finalStage"]]) && !all(is.na(analysisResults$finalStage))) { - summaryFactory$addParameter(analysisResults, - parameterName = "finalPValues", - parameterCaption = "Final p-value", roundDigits = digitsProbabilities - ) - summaryFactory$addParameter(analysisResults, - parameterName = c("finalConfidenceIntervalLowerBounds", "finalConfidenceIntervalUpperBounds"), - parameterCaption = "Final confidence interval", roundDigits = digitsGeneral - ) - summaryFactory$addParameter(analysisResults, - parameterName = "medianUnbiasedEstimates", - parameterCaption = "Median unbiased estimate", roundDigits = digitsGeneral - ) - } - - return(summaryFactory) -} - -.getSummaryDigits <- function(digits = NA_integer_) { - if (is.na(digits)) { - digits <- as.integer(getOption("rpact.summary.digits", 3)) - } - .assertIsSingleInteger(digits, "digits", validateType = FALSE, naAllowed = TRUE) - .assertIsInClosedInterval(digits, "digits", lower = -1, upper = 12, naAllowed = TRUE) - - digitsSampleSize <- 1 - if (digits > 0) { - digitsGeneral <- digits - digitsProbabilities <- NA_integer_ - tryCatch( - { - digitsProbabilities <- as.integer(getOption("rpact.summary.digits.probs", digits + 1)) - }, - warning = function(e) { - } - ) - if (is.na(digitsProbabilities)) { - digitsProbabilities <- digits + 1 - } - .assertIsSingleInteger(digitsProbabilities, "digitsProbabilities", validateType = FALSE, naAllowed = FALSE) - .assertIsInClosedInterval(digitsProbabilities, "digitsProbabilities", lower = -1, upper = 12, naAllowed = FALSE) - } else { - digitsSampleSize <- digits - digitsGeneral <- digits - digitsProbabilities <- digits - } - return(list( - digits = digits, - digitsSampleSize = digitsSampleSize, - digitsGeneral = digitsGeneral, - digitsProbabilities = digitsProbabilities - )) -} - -.getSummaryValuesInPercent <- function(values, percentFormatEnabled = TRUE, digits = 1) { - if (!percentFormatEnabled) { - return(as.character(round(values, digits + 2))) - } - return(paste0(round(100 * values, digits), "%")) -} - -.addDesignInformationToSummary <- function(design, designPlan, summaryFactory, - output = c("all", "title", "overview", "body")) { - if (!(output %in% c("all", "overview"))) { - return(invisible(summaryFactory)) - } - - if (design$kMax == 1) { - summaryFactory$addItem("Stage", "Fixed") - return(invisible(summaryFactory)) - } - - summaryFactory$addItem("Stage", c(1:design$kMax)) - - if (.isTrialDesignConditionalDunnett(design)) { - summaryFactory$addItem( - "Fixed information at interim", - .getSummaryValuesInPercent(design$informationAtInterim, FALSE) - ) - return(invisible(summaryFactory)) - } - - informationRatesCaption <- ifelse(inherits(designPlan, "SimulationResults") || - inherits(designPlan, "AnalysisResults"), "Fixed weight", "Information") - - if (inherits(designPlan, "SimulationResults") || inherits(designPlan, "AnalysisResults")) { - if (.isTrialDesignFisher(design)) { - weights <- .getWeightsFisher(design) - } else if (.isTrialDesignInverseNormal(design)) { - weights <- .getWeightsInverseNormal(design) - } else { - weights <- design$informationRates - } - summaryFactory$addItem(informationRatesCaption, .getSummaryValuesInPercent(weights, FALSE)) - } else { - summaryFactory$addItem( - paste0( - informationRatesCaption, - ifelse(inherits(designPlan, "SimulationResults"), "", " rate") - ), - .getSummaryValuesInPercent(design$informationRates) - ) - } - if (design$.isDelayedResponseDesign()) { - summaryFactory$addItem("Delayed information", .getSummaryValuesInPercent(design$delayedInformation, TRUE)) - } - - return(invisible(summaryFactory)) -} - -.addDesignParameterToSummary <- function(design, designPlan, - designCharacteristics, summaryFactory, digitsGeneral, digitsProbabilities) { - if (design$kMax > 1 && !inherits(designPlan, "SimulationResults") && - !.isTrialDesignConditionalDunnett(design)) { - summaryFactory$addParameter(design, - parameterName = "alphaSpent", - parameterCaption = "Cumulative alpha spent", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - if (design$.getParameterType("betaSpent") == C_PARAM_GENERATED) { - summaryFactory$addParameter(design, - parameterName = "betaSpent", - parameterCaption = "Cumulative beta spent", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - } - - if (!is.null(designPlan)) { - if (!grepl("SimulationResults(MultiArm|Enrichment)", .getClassName(designPlan))) { - outputSize <- getOption("rpact.summary.output.size", C_SUMMARY_OUTPUT_SIZE_DEFAULT) - if (outputSize == "large" && inherits(designPlan, "SimulationResults")) { - summaryFactory$addParameter(designPlan, - parameterName = "conditionalPowerAchieved", - parameterCaption = "Conditional power (achieved)", - roundDigits = digitsProbabilities - ) - } - } - } else { - powerObject <- NULL - if (!is.null(designCharacteristics)) { - powerObject <- designCharacteristics - } else if (design$.getParameterType("power") == C_PARAM_GENERATED) { - powerObject <- design - } - if (!is.null(powerObject)) { - summaryFactory$addParameter(powerObject, - parameterName = "power", - parameterCaption = ifelse(design$kMax == 1, "Power", "Overall power"), - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - if (design$kMax > 1 && .isTrialDesignInverseNormalOrGroupSequential(design)) { - tryCatch( - { - designCharacteristics <- getDesignCharacteristics(design) - }, - error = function(e) { - designCharacteristics <- NULL - } - ) - if (!is.null(designCharacteristics) && - !any(is.na(designCharacteristics$futilityProbabilities)) && - any(designCharacteristics$futilityProbabilities > 0)) { - summaryFactory$addParameter(designCharacteristics, - parameterName = "futilityProbabilities", - parameterCaption = "Futility probabilities under H1", - roundDigits = digitsGeneral, smoothedZeroFormat = TRUE - ) - } - } - } - - if (design$.isDelayedResponseDesign()) { - summaryFactory$addParameter(design, - parameterName = "decisionCriticalValues", - parameterCaption = "Decision critical values", - roundDigits = digitsGeneral, - smoothedZeroFormat = TRUE - ) - - outputSize <- getOption("rpact.summary.output.size", C_SUMMARY_OUTPUT_SIZE_DEFAULT) - if (outputSize == "large") { - summaryFactory$addParameter(design, - parameterName = "reversalProbabilities", - parameterCaption = "Reversal probabilities", - roundDigits = digitsProbabilities, - smoothedZeroFormat = TRUE - ) - } - } - - if (.isTrialDesignConditionalDunnett(design)) { - summaryFactory$addParameter(design, - parameterName = "alpha", - parameterCaption = "Significance level", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } else if (!is.null(designPlan) && !inherits(designPlan, "SimulationResults")) { - summaryFactory$addParameter(design, - parameterName = "stageLevels", - twoSided = design$sided == 2, - parameterCaption = paste0(ifelse(design$sided == 2, "Two", "One"), "-sided local significance level"), - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - return(summaryFactory) -} - -#' -#' Main function for creating a summary of a design or design plan -#' -#' @noRd -#' -.createSummaryDesignPlan <- function(object, digits = NA_integer_, - output = c("all", "title", "overview", "body"), showStageLevels = FALSE, - performanceScore = NULL) { - output <- match.arg(output) - designPlan <- NULL - if (.isTrialDesignPlan(object) || inherits(object, "SimulationResults")) { - design <- object$.design - designPlan <- object - } else if (inherits(object, "TrialDesignCharacteristics")) { - design <- object$.design - # designPlan <- object - } else if (.isTrialDesign(object)) { - design <- object - } else { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'object' must be a valid design, design plan, ", - "or simulation result object (is class ", .getClassName(object), ")" - ) - } - - digitSettings <- .getSummaryDigits(digits) - digits <- digitSettings$digits - digitsSampleSize <- digitSettings$digitsSampleSize - digitsGeneral <- digitSettings$digitsGeneral - digitsProbabilities <- digitSettings$digitsProbabilities - - outputSize <- getOption("rpact.summary.output.size", C_SUMMARY_OUTPUT_SIZE_DEFAULT) - - intervalFormat <- getOption("rpact.summary.intervalFormat", "[%s; %s]") - .assertIsValidSummaryIntervalFormat(intervalFormat) - - summaryFactory <- SummaryFactory(object = object, intervalFormat = intervalFormat, output = output) - - if (output %in% c("all", "title", "overview")) { - .addDesignInformationToSummary(design, designPlan, summaryFactory, output = output) - } - - if (!(output %in% c("all", "body"))) { - return(summaryFactory) - } - - if (!.isTrialDesignConditionalDunnett(design)) { - summaryFactory$addParameter(design, - parameterName = "criticalValues", - parameterCaption = .getSummaryParameterCaptionCriticalValues(design), - roundDigits = digitsGeneral - ) - - if (showStageLevels) { - summaryFactory$addParameter(design, - parameterName = "stageLevels", - parameterCaption = "Stage levels (one-sided)", - roundDigits = digitsProbabilities, - smoothedZeroFormat = TRUE - ) - } - } - - if (.isTrialDesignFisher(design)) { - if (any(design$alpha0Vec < 1)) { - summaryFactory$addParameter(design, - parameterName = "alpha0Vec", - parameterCaption = "Futility boundary (separate p-value scale)", - roundDigits = digitsGeneral - ) - } - } else if (!.isTrialDesignConditionalDunnett(design)) { - if (any(design$futilityBounds > C_FUTILITY_BOUNDS_DEFAULT, na.rm = TRUE)) { - summaryFactory$addParameter(design, - parameterName = "futilityBounds", - parameterCaption = .getSummaryParameterCaptionFutilityBounds(design), - roundDigits = digitsGeneral - ) - } - } - - designCharacteristics <- NULL - if (design$kMax > 1 && .isTrialDesignInverseNormalOrGroupSequential(design)) { - tryCatch( - { - designCharacteristics <- getDesignCharacteristics(design) - }, - error = function(e) { - designCharacteristics <- NULL - } - ) - } - - if (is.null(designPlan)) { - return(.addDesignParameterToSummary( - design, - designPlan, - designCharacteristics, - summaryFactory, - digitsGeneral, - digitsProbabilities - )) - } - - simulationEnabled <- grepl("SimulationResults", .getClassName(designPlan)) - multiArmEnabled <- grepl("MultiArm", .getClassName(designPlan)) - enrichmentEnabled <- grepl("Enrichment", .getClassName(designPlan)) - baseEnabled <- grepl("(TrialDesignPlan|SimulationResults)(Means|Rates|Survival)", .getClassName(designPlan)) - planningEnabled <- .isTrialDesignPlan(designPlan) - simulationEnabled <- .isSimulationResults(designPlan) - survivalEnabled <- grepl("Survival", .getClassName(designPlan)) - - probsH0 <- NULL - probsH1 <- NULL - if (design$kMax > 1) { - if (!is.null(designCharacteristics) && - .isTrialDesignInverseNormalOrGroupSequential(design) && - length(designCharacteristics$shift) == 1 && - !is.na(designCharacteristics$shift) && - designCharacteristics$shift >= 1) { - probsH0 <- getPowerAndAverageSampleNumber(design, theta = 0, nMax = designCharacteristics$shift) - probsH1 <- getPowerAndAverageSampleNumber(design, theta = 1, nMax = designCharacteristics$shift) - } - if (!is.null(designPlan[["rejectPerStage"]])) { - probsH1 <- list( - earlyStop = designPlan$rejectPerStage[1:(design$kMax - 1), ] + as.vector(designPlan$futilityPerStage), - rejectPerStage = designPlan$rejectPerStage, - futilityPerStage = designPlan$futilityPerStage - ) - numberOfVariants <- 1 - if (inherits(designPlan, "ParameterSet")) { - parameterNames <- designPlan$.getVisibleFieldNamesOrdered() - numberOfVariants <- .getMultidimensionalNumberOfVariants(designPlan, parameterNames) - } - if (numberOfVariants > 1 && is.matrix(probsH1$earlyStop) && ncol(probsH1$earlyStop) == 1) { - probsH1$earlyStop <- matrix(rep(probsH1$earlyStop, numberOfVariants), ncol = numberOfVariants) - probsH1$rejectPerStage <- matrix(rep(probsH1$rejectPerStage, numberOfVariants), ncol = numberOfVariants) - probsH1$futilityPerStage <- matrix(rep(probsH1$futilityPerStage, numberOfVariants), ncol = numberOfVariants) - } - } - } - - if (simulationEnabled && (multiArmEnabled || enrichmentEnabled)) { - # simulation multi-arm #1:rejectAtLeastOne per mu_max - summaryFactory$addParameter(designPlan, - parameterName = "rejectAtLeastOne", - parameterCaption = "Reject at least one", roundDigits = digitsProbabilities, - smoothedZeroFormat = TRUE, transpose = TRUE, - legendEntry = { - if (multiArmEnabled) list("(i)" = "treatment arm i") else list() - } - ) - - # simulation multi-arm #2: rejectedArmsPerStage - if (outputSize == "large" && multiArmEnabled) { - .addSimulationMultiArmArrayParameter(designPlan, - parameterName = "rejectedArmsPerStage", - parameterCaption = ifelse(design$kMax == 1, "Rejected arms", "Rejected arms per stage"), - summaryFactory, roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - # simulation enrichment #2: rejectedPopulationsPerStage - if (outputSize == "large" && enrichmentEnabled) { - .addSimulationArrayToSummary(designPlan, - parameterName = "rejectedPopulationsPerStage", - parameterCaption = ifelse(design$kMax == 1, "Rejected populations", "Rejected populations per stage"), - summaryFactory, digitsSampleSize = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - - # simulation multi-arm #3: successPerStage - summaryFactory$addParameter(designPlan, - parameterName = "successPerStage", - parameterCaption = "Success per stage", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE, transpose = TRUE - ) - - # simulation multi-arm #4: futilityPerStage - if (!planningEnabled && !baseEnabled && any(designPlan$futilityPerStage != 0)) { - summaryFactory$addParameter(designPlan, - parameterName = "futilityPerStage", - parameterCaption = "Exit probability for futility", # (under H1) - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE, transpose = TRUE - ) - } - - if (survivalEnabled) { - summaryFactory$addParameter(designPlan, - parameterName = "expectedNumberOfEvents", - parameterCaption = "Expected number of events", - roundDigits = digitsSampleSize, transpose = TRUE - ) - } else { - summaryFactory$addParameter(designPlan, - parameterName = "expectedNumberOfSubjects", - parameterCaption = "Expected number of subjects", - roundDigits = digitsSampleSize, transpose = TRUE - ) - } - - # simulation multi-arm #5: earlyStop per mu_max - if (outputSize %in% c("medium", "large")) { - summaryFactory$addParameter(designPlan, - parameterName = "earlyStop", - parameterCaption = "Overall exit probability", # (under H1) - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE, transpose = TRUE - ) - } - - # simulation multi-arm / enrichment #6: sampleSizes - if (outputSize %in% c("medium", "large")) { - if (survivalEnabled) { - if (enrichmentEnabled) { - parameterName <- "singleNumberOfEventsPerStage" - parameterCaption <- "Single number of events" - } else { - parameterName <- "eventsPerStage" - parameterCaption <- "Cumulative number of events" - } - } else { - parameterName <- "sampleSizes" - parameterCaption <- "Stagewise number of subjects" - } - .addSimulationArrayToSummary( - designPlan, - parameterName, - parameterCaption, - summaryFactory, - digitsSampleSize, - smoothedZeroFormat = TRUE - ) - } - - # simulation multi-arm #7: selectedArms - if (multiArmEnabled && outputSize %in% c("medium", "large")) { - .addSimulationMultiArmArrayParameter( - designPlan = designPlan, - parameterName = "selectedArms", - parameterCaption = "Selected arms", - summaryFactory = summaryFactory, - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - - # simulation enrichment #7: selectedPopulations - if (enrichmentEnabled && outputSize %in% c("medium", "large")) { - .addSimulationArrayToSummary( - designPlan = designPlan, - parameterName = "selectedPopulations", - parameterCaption = "Selected populations", - summaryFactory = summaryFactory, - digitsSampleSize = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - - # simulation multi-arm #8: numberOfActiveArms - if (multiArmEnabled && outputSize %in% c("medium", "large")) { - summaryFactory$addParameter(designPlan, - parameterName = "numberOfActiveArms", - parameterCaption = "Number of active arms", - roundDigits = digitsGeneral, transpose = TRUE - ) - } - - # simulation enrichment #8: numberOfPopulations - if (enrichmentEnabled && outputSize %in% c("medium", "large")) { - summaryFactory$addParameter(designPlan, - parameterName = "numberOfPopulations", - parameterCaption = "Number of populations", - roundDigits = digitsGeneral, transpose = TRUE - ) - } - - if (outputSize == "large") { - summaryFactory$addParameter(designPlan, - parameterName = "conditionalPowerAchieved", - parameterCaption = "Conditional power (achieved)", - roundDigits = digitsProbabilities, transpose = TRUE - ) - } - } - - if (baseEnabled) { - parameterName <- "rejectPerStage" - if (design$kMax == 1) { - parameterName <- "overallReject" - } - if (any(!is.na(designPlan[[parameterName]]))) { - summaryFactory$addParameter(designPlan, - parameterName = parameterName, - parameterCaption = ifelse(design$kMax == 1, "Power", "Overall power"), - roundDigits = digitsProbabilities, cumsumEnabled = TRUE, smoothedZeroFormat = TRUE - ) - } - - if (inherits(designPlan, "SimulationResults")) { - parameterName1 <- ifelse(survivalEnabled, "numberOfSubjects", "sampleSizes") - parameterName2 <- "eventsPerStage" - } else { - if (design$kMax == 1 && (designPlan$.isSampleSizeObject() || - .isTrialDesignPlanMeans(designPlan) || .isTrialDesignPlanRates(designPlan))) { - parameterName1 <- "nFixed" - parameterName2 <- "eventsFixed" - } else if (design$kMax == 1 && designPlan$.isPowerObject()) { - parameterName1 <- "expectedNumberOfSubjects" - parameterName2 <- "expectedNumberOfEvents" - } else { - parameterName1 <- "numberOfSubjects" - parameterName2 <- "eventsPerStage" - } - } - - if (design$kMax > 1) { - summaryFactory$addParameter(designPlan, - parameterName = ifelse(inherits(designPlan, "TrialDesignPlan") && designPlan$.isSampleSizeObject(), - "expectedNumberOfSubjectsH1", "expectedNumberOfSubjects" - ), - parameterCaption = "Expected number of subjects", - roundDigits = digitsSampleSize, transpose = TRUE - ) - } - - if (outputSize %in% c("medium", "large")) { - subjectsCaption <- ifelse(design$kMax > 1 && inherits(designPlan, "SimulationResults") && - !survivalEnabled, "Stagewise number of subjects", "Number of subjects") - summaryFactory$addParameter(designPlan, - parameterName = parameterName1, - parameterCaption = subjectsCaption, roundDigits = digitsSampleSize - ) - } - - 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 = parameterName2, - parameterCaption = ifelse(design$kMax == 1, - "Number of events", "Cumulative number of events" - ), - roundDigits = digitsSampleSize, cumsumEnabled = FALSE - ) - } - - if (outputSize == "large") { - summaryFactory$addParameter(designPlan, - parameterName = "analysisTime", - parameterCaption = "Analysis time", roundDigits = digitsSampleSize - ) - } - - summaryFactory$addParameter(designPlan, - parameterName = "studyDuration", - parameterCaption = "Expected study duration", - roundDigits = digitsSampleSize, smoothedZeroFormat = TRUE, transpose = TRUE - ) - } - } - - if (!is.null(designPlan[["allocationRatioPlanned"]]) && - length(unique(designPlan$allocationRatioPlanned)) > 1) { - summaryFactory$addParameter(designPlan, - parameterName = "allocationRatioPlanned", - parameterCaption = "Optimum allocation ratio", roundDigits = digitsGeneral - ) - } - - .addDesignParameterToSummary( - design, designPlan, designCharacteristics, - summaryFactory, digitsGeneral, digitsProbabilities - ) - - if (baseEnabled && !planningEnabled && !is.null(designPlan[["futilityPerStage"]]) && - !any(is.na(designPlan[["futilityPerStage"]])) && - any(designPlan$futilityPerStage != 0) && any(designPlan$futilityPerStage > 1e-08)) { - summaryFactory$addParameter(designPlan, - parameterName = "futilityPerStage", - parameterCaption = "Exit probability for futility", # (under H1) - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - - if (baseEnabled && simulationEnabled && design$kMax > 1) { - values <- NULL - if (!is.null(probsH1)) { - values <- probsH1$rejectPerStage - } - summaryFactory$addParameter(designPlan, - parameterName = "rejectPerStage", - values = values, - parameterCaption = "Exit probability for efficacy", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - - # sample size and power only - if (planningEnabled) { - legendEntry <- list("(t)" = "treatment effect scale") - - if (ncol(designPlan$criticalValuesEffectScale) > 0) { - summaryFactory$addParameter(designPlan, - parameterName = "criticalValuesEffectScale", - parameterCaption = ifelse(.isDelayedInformationEnabled(design = design), - "Upper bounds of continuation (t)", "Efficacy boundary (t)" - ), - roundDigits = digitsGeneral, legendEntry = legendEntry - ) - } else if (ncol(designPlan$criticalValuesEffectScaleUpper) > 0) { - summaryFactory$addParameter(designPlan, - parameterName = "criticalValuesEffectScaleLower", - parameterCaption = "Lower efficacy boundary (t)", - roundDigits = digitsGeneral, legendEntry = legendEntry - ) - summaryFactory$addParameter(designPlan, - parameterName = "criticalValuesEffectScaleUpper", - parameterCaption = "Upper efficacy boundary (t)", - roundDigits = digitsGeneral, legendEntry = legendEntry - ) - } - - if (ncol(designPlan$futilityBoundsEffectScale) > 0 && - !all(is.na(designPlan$futilityBoundsEffectScale))) { - summaryFactory$addParameter(designPlan, - parameterName = "futilityBoundsEffectScale", - parameterCaption = ifelse(.isDelayedInformationEnabled(design = design), - "Lower bounds of continuation (t)", "Futility boundary (t)" - ), - roundDigits = digitsGeneral, legendEntry = legendEntry - ) - } else if (ncol(designPlan$futilityBoundsEffectScaleUpper) > 0 && - (any(!is.na(designPlan$futilityBoundsEffectScaleLower)) || - any(!is.na(designPlan$futilityBoundsEffectScaleUpper)))) { - summaryFactory$addParameter(designPlan, - parameterName = "futilityBoundsEffectScaleLower", - parameterCaption = "Lower futility boundary (t)", - roundDigits = digitsGeneral, legendEntry = legendEntry - ) - summaryFactory$addParameter(designPlan, - parameterName = "futilityBoundsEffectScaleUpper", - parameterCaption = "Upper futility boundary (t)", - roundDigits = digitsGeneral, legendEntry = legendEntry - ) - } - - if (!is.null(probsH1) && !is.null(probsH0) && design$kMax > 1) { - probsH0$earlyStop <- matrix(probsH0$earlyStop[1:(design$kMax - 1), 1], ncol = 1) - probsH0$rejectPerStage <- matrix(probsH0$rejectPerStage[1:(design$kMax - 1), 1], ncol = 1) - - if (is.matrix(probsH1$rejectPerStage)) { - if (design$kMax > 1 && designPlan$.isSampleSizeObject()) { - probsH1$rejectPerStage <- probsH1$rejectPerStage[1:(design$kMax - 1), 1] - } else { - probsH1$rejectPerStage <- matrix(probsH1$rejectPerStage[1:(design$kMax - 1), ], - ncol = ncol(probsH1$rejectPerStage) - ) - } - } else { - probsH1$rejectPerStage <- probsH1$rejectPerStage[1:(design$kMax - 1)] - } - - if (any(design$futilityBounds > -6)) { - if (is.matrix(probsH1$earlyStop)) { - probsH1$earlyStop <- matrix(probsH1$earlyStop[1:(design$kMax - 1), ], - ncol = ncol(probsH1$earlyStop) - ) - } else { - probsH1$earlyStop <- probsH1$earlyStop[1:(design$kMax - 1)] - } - summaryFactory$addParameter(probsH0, - parameterName = "earlyStop", - parameterCaption = "Overall exit probability (under H0)", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - x <- designPlan - if (is.null(x)) { - x <- design - } - summaryFactory$addParameter(x, - parameterName = "earlyStop", - values = probsH1$earlyStop, - parameterCaption = "Overall exit probability (under H1)", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - summaryFactory$addParameter(probsH0, - parameterName = "rejectPerStage", - parameterCaption = "Exit probability for efficacy (under H0)", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - if (designPlan$.isPowerObject()) { - summaryFactory$addParameter(designPlan, - parameterName = "rejectPerStage", - values = probsH1$rejectPerStage, - parameterCaption = "Exit probability for efficacy (under H1)", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } else { - summaryFactory$addParameter(probsH1, - parameterName = "rejectPerStage", - parameterCaption = "Exit probability for efficacy (under H1)", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - - if (any(design$futilityBounds > -6)) { - summaryFactory$addParameter(probsH0, - parameterName = "futilityPerStage", - parameterCaption = "Exit probability for futility (under H0)", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - x <- designPlan - if (is.null(x)) { - x <- design - } - futilityPerStage <- probsH1$futilityPerStage - if (.isTrialDesignPlan(x) && x$.isSampleSizeObject() && ncol(futilityPerStage) > 1) { - futilityPerStage <- futilityPerStage[, 1] - } - summaryFactory$addParameter(x, - parameterName = "futilityPerStage", - values = futilityPerStage, - parameterCaption = "Exit probability for futility (under H1)", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - } - } - - if (!is.null(performanceScore)) { - print(performanceScore) - summaryFactory$addParameter(performanceScore, - parameterName = "performanceScore", - parameterCaption = "Performance score", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - - return(summaryFactory) -} - -.getSummaryVariedParameterNameEnrichment <- function(designPlan) { - if (grepl("Rates", .getClassName(designPlan))) { - return("piTreatments") - } - if (grepl("Survival", .getClassName(designPlan))) { - return("hazardRatios") - } - return("effects") -} - -.getSummaryGroup <- function(parameterCaption, - numberOfVariedParams, - variedParamNumber, - designPlan) { - if (numberOfVariedParams <= 1) { - return(list( - groupCaption = parameterCaption, - legendEntry = list() - )) - } - - enrichmentEnabled <- grepl("SimulationResultsEnrichment", .getClassName(designPlan)) - if (enrichmentEnabled) { - variedParameterName <- .getSummaryVariedParameterNameEnrichment(designPlan) - variedParameterValues <- designPlan$effectList[[variedParameterName]] - if (variedParameterName == "piTreatments") { - variedParameterCaption <- "pi(treatment)" - } else { - variedParameterCaption <- C_PARAMETER_NAMES[[variedParameterName]] - } - if (is.matrix(variedParameterValues) && ncol(variedParameterValues) == 1) { - variedParameterCaption <- sub("s$", "", variedParameterCaption) - } - } else { - variedParameterName <- .getVariedParameterSimulationMultiArm(designPlan) - variedParameterValues <- designPlan[[variedParameterName]] - variedParameterCaption <- C_PARAMETER_NAMES[[variedParameterName]] - } - - userDefinedEffectMatrix <- !enrichmentEnabled && - designPlan$.getParameterType("effectMatrix") == C_PARAM_USER_DEFINED - - if (userDefinedEffectMatrix) { - return(list( - groupCaption = paste0(parameterCaption, " [", variedParamNumber, "]"), - legendEntry = list("[j]" = "effect matrix row j (situation to consider)") - )) - } - if (is.matrix(variedParameterValues)) { - values <- variedParameterValues[variedParamNumber, ] - if (length(values) > 1) { - values <- .arrayToString(values, vectorLookAndFeelEnabled = TRUE) - } - } else { - values <- variedParameterValues[variedParamNumber] - } - if (is.numeric(values)) { - values <- round(values, 2) - } - return(list( - groupCaption = paste0( - parameterCaption, ", ", - tolower(variedParameterCaption), " = ", values - ), - legendEntry = list() - )) -} - -.getSummaryGroupCaption <- function(designPlan, parameterName, numberOfGroups, groupNumber) { - listItemPrefix <- getOption("rpact.summary.list.item.prefix", C_SUMMARY_LIST_ITEM_PREFIX_DEFAULT) - - if (grepl("Enrichment", .getClassName(designPlan))) { - categoryCaption <- .getCategoryCaptionEnrichment(designPlan, parameterName, groupNumber) - categoryCaption <- sub("^F$", "Full population F", categoryCaption) - categoryCaption <- sub("^R$", "Remaining population R", categoryCaption) - categoryCaption <- sub("^S", "Subset S", categoryCaption) - - return(paste0(listItemPrefix, categoryCaption)) - } - - treatmentCaption <- ifelse(numberOfGroups > 2, paste0("Treatment arm ", groupNumber), "Treatment arm") - - if (!grepl("Survival", .getClassName(designPlan)) || - (inherits(designPlan, "SimulationResultsMultiArmSurvival") && - parameterName == "singleNumberOfEventsPerStage")) { - return(ifelse(groupNumber == numberOfGroups, - paste0(listItemPrefix, "Control arm"), - paste0(listItemPrefix, treatmentCaption) - )) - } - - return(paste0(listItemPrefix, treatmentCaption, " vs. control")) -} - -.addSimulationArrayToSummary <- function(designPlan, - parameterName, parameterCaption, summaryFactory, - digitsSampleSize, smoothedZeroFormat = FALSE) { - arrayData <- designPlan[[parameterName]] - if (is.null(arrayData)) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, class(designPlan)[1], " does not contain the field ", sQuote(parameterName)) - } - - numberOfVariedParams <- dim(arrayData)[2] - numberOfGroups <- dim(arrayData)[3] - for (variedParamNumber in 1:numberOfVariedParams) { - summaryGroup <- .getSummaryGroup( - parameterCaption, - numberOfVariedParams, - variedParamNumber, - designPlan - ) - groupCaption <- summaryGroup$groupCaption - legendEntry <- summaryGroup$legendEntry - if (numberOfGroups > 1) { - summaryFactory$addItem(groupCaption, "", legendEntry = legendEntry) - } - - for (groupNumber in 1:numberOfGroups) { - dataPerGroupAndStage <- arrayData[, variedParamNumber, groupNumber] - if (numberOfGroups > 1) { - groupCaption <- .getSummaryGroupCaption( - designPlan, - parameterName, numberOfGroups, groupNumber - ) - } - summaryFactory$addParameter(designPlan, - parameterName = parameterName, - values = dataPerGroupAndStage, parameterCaption = groupCaption, - roundDigits = digitsSampleSize, - smoothedZeroFormat = smoothedZeroFormat, - enforceFirstCase = TRUE - ) - } - } -} - -.addSimulationMultiArmArrayParameter <- function(designPlan, parameterName, parameterCaption, - summaryFactory, roundDigits, smoothedZeroFormat = FALSE) { - arrayData <- designPlan[[parameterName]] - if (is.array(arrayData) && length(dim(arrayData)) == 3) { - totalNumberOfGroups <- dim(designPlan[[ifelse(grepl("Survival", .getClassName(designPlan)), - "eventsPerStage", "sampleSizes" - )]])[3] - - numberOfGroups <- dim(arrayData)[3] - if (parameterName == "selectedArms" && !grepl("Survival", .getClassName(designPlan))) { # remove control group - numberOfGroups <- numberOfGroups - 1 - } - numberOfVariedParams <- dim(arrayData)[2] - - for (variedParamNumber in 1:numberOfVariedParams) { - summaryGroup <- .getSummaryGroup( - parameterCaption, - numberOfVariedParams, - variedParamNumber, - designPlan - ) - groupCaption <- summaryGroup$groupCaption - legendEntry <- summaryGroup$legendEntry - if (numberOfGroups > 1) { - summaryFactory$addItem(groupCaption, "", legendEntry = legendEntry) - } - - for (groupNumber in 1:numberOfGroups) { - dataPerGroupAndStage <- arrayData[, variedParamNumber, groupNumber] - if (numberOfGroups > 1) { - groupCaption <- .getSummaryGroupCaption( - designPlan, - parameterName, totalNumberOfGroups, groupNumber - ) - } - summaryFactory$addParameter(designPlan, - parameterName = parameterName, - values = dataPerGroupAndStage, parameterCaption = groupCaption, - roundDigits = roundDigits, smoothedZeroFormat = smoothedZeroFormat, - enforceFirstCase = TRUE - ) - } - } - } else { - data <- designPlan[[parameterName]] - numberOfGroups <- ncol(data) - for (groupNumber in 1:numberOfGroups) { - dataPerGroupAndStage <- data[, groupNumber] - summaryFactory$addParameter(designPlan, - parameterName = parameterName, - values = dataPerGroupAndStage, - parameterCaption = ifelse(groupNumber == numberOfGroups, - paste0(parameterCaption, ", control"), - paste0(parameterCaption, ", treatment ", groupNumber) - ), - roundDigits = roundDigits, smoothedZeroFormat = smoothedZeroFormat - ) - } - } -} diff --git a/R/class_summary_r6.R b/R/class_summary_r6.R index 054805f0..87899823 100644 --- a/R/class_summary_r6.R +++ b/R/class_summary_r6.R @@ -614,7 +614,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", } else { if (inherits(parameterSet, "Dataset")) { variedParameter <- "groups" - } else if (inherits(parameterSet, "PerformanceScore")) { + } else if (inherits(parameterSet, "PerformanceScore") || inherits(parameterSet, "PerformanceScoreR6")) { variedParameter <- ".alternative" } else { variedParameter <- parameterSet$.getVariedParameter(parameterNames, numberOfVariants) @@ -914,7 +914,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", designPlan <- NULL if (inherits(object, "TrialDesignCharacteristics")) { design <- object$.design - } else if (.isTrialDesignPlan(object) || inherits(object, "SimulationResults")) { + } else if (.isTrialDesignPlan(object) || inherits(object, "SimulationResults") || inherits(object, "SimulationResultsR6")) { design <- object$.design designPlan <- object } else if (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) { @@ -984,7 +984,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", title <- paste0(title, "Sequential analysis with a maximum of ", kMax, " looks") } if (!is.null(designPlan)) { - if (inherits(designPlan, "SimulationResults")) { + if (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")) { title <- "Simulation of a " } else if (designPlan$.isSampleSizeObject()) { title <- "Sample size calculation for a " @@ -1071,7 +1071,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", .createSummaryHypothesisText <- function(object, summaryFactory) { if (!(inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) && !(inherits(object, "TrialDesignPlan") || inherits(object, "TrialDesignPlanR6")) && - !inherits(object, "SimulationResults")) { + !(inherits(object, "SimulationResults") || inherits(object, "SimulationResultsR6"))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'object' must be an instance of class 'AnalysisResults', 'TrialDesignPlan' ", @@ -1227,7 +1227,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", return(.createSummaryHeaderDesign(object$.design, NULL, summaryFactory)) } - if (.isTrialDesignPlan(object) || inherits(object, "SimulationResults")) { + if (.isTrialDesignPlan(object) || (inherits(object, "SimulationResults") || inherits(object, "SimulationResultsR6"))) { return(.createSummaryHeaderDesign(object$.design, object, summaryFactory)) } @@ -1732,9 +1732,9 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", header <- paste0(header, "\n") - header <- paste0(header, "The ", ifelse(inherits(designPlan, "SimulationResults") || + header <- paste0(header, "The ", ifelse((inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")) || designPlan$.isPowerObject(), "results were ", "sample size was ")) - header <- paste0(header, ifelse(inherits(designPlan, "SimulationResults"), "simulated", "calculated")) + header <- paste0(header, ifelse(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6"), "simulated", "calculated")) header <- paste0(header, " for a ") settings <- .getSummaryObjectSettings(designPlan) if (settings$meansEnabled) { @@ -1781,7 +1781,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", ifelse(settings$populations == 1, "", "s") )) } - if (!is.null(designPlan) && (.isTrialDesignPlan(designPlan) || inherits(designPlan, "SimulationResults")) && + if (!is.null(designPlan) && (.isTrialDesignPlan(designPlan) || (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6"))) && !settings$multiArmEnabled && !settings$enrichmentEnabled && !settings$survivalEnabled) { if (settings$ratesEnabled) { if (settings$groups == 1) { @@ -1801,7 +1801,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", header <- .concatenateSummaryText(header, paste0("(", part, ")"), sep = " ") } if (settings$meansEnabled && (.isTrialDesignInverseNormalOrGroupSequential(design) || - inherits(designPlan, "SimulationResults"))) { + (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")))) { header <- .concatenateSummaryText(header, .createSummaryHypothesisText(designPlan, summaryFactory)) if (!is.null(designPlan[["alternative"]]) && length(designPlan$alternative) == 1) { alternativeText <- paste0("H1: effect = ", round(designPlan$alternative, 3)) @@ -1840,7 +1840,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", } header <- .addAdditionalArgumentsToHeader(header, designPlan, settings) } else if (settings$ratesEnabled && (.isTrialDesignInverseNormalOrGroupSequential(design) || - inherits(designPlan, "SimulationResults"))) { + (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")))) { if (settings$groups == 1) { if (!is.null(designPlan[["pi1"]]) && length(designPlan$pi1) == 1) { treatmentRateText <- paste0("H1: treatment rate pi = ", round(designPlan$pi1, 3)) @@ -1902,7 +1902,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", header <- .addAdditionalArgumentsToHeader(header, designPlan, settings) } } else if (settings$survivalEnabled && (.isTrialDesignInverseNormalOrGroupSequential(design) || - inherits(designPlan, "SimulationResults"))) { + (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")))) { parameterNames <- designPlan$.getVisibleFieldNamesOrdered() numberOfVariants <- .getMultidimensionalNumberOfVariants(designPlan, parameterNames) @@ -1938,7 +1938,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", } else if (!is.null(designPlan[["omegaMaxVector"]]) && length(designPlan$omegaMaxVector) == 1) { treatmentRateText <- paste0("H1: omega_max = ", round(designPlan$omegaMaxVector, 3)) } else if (!is.null(designPlan[["hazardRatio"]]) && (length(designPlan$hazardRatio) == 1) || - (inherits(designPlan, "SimulationResults") && !is.null(designPlan[[".piecewiseSurvivalTime"]]) && + ((inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")) && !is.null(designPlan[[".piecewiseSurvivalTime"]]) && designPlan$.piecewiseSurvivalTime$piecewiseSurvivalEnabled)) { treatmentRateText <- paste0( "H1: hazard ratio = ", @@ -1984,12 +1984,12 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", header <- .addEnrichmentEffectListToHeader(header, designPlan) header <- .addAdditionalArgumentsToHeader(header, designPlan, settings) } - if (!inherits(designPlan, "SimulationResults") && designPlan$.isSampleSizeObject()) { + if (!(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")) && designPlan$.isSampleSizeObject()) { header <- .concatenateSummaryText(header, paste0("power ", round(100 * (1 - design$beta), 1), "%")) } - if (inherits(designPlan, "SimulationResults")) { + if (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")) { header <- .concatenateSummaryText(header, paste0("simulation runs = ", designPlan$maxNumberOfIterations)) header <- .concatenateSummaryText(header, paste0("seed = ", designPlan$seed)) } @@ -2286,11 +2286,11 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", .createSummary <- function(object, digits = NA_integer_, output = c("all", "title", "overview", "body")) { output <- match.arg(output) - if (inherits(object, "TrialDesignCharacteristics")) { + if (inherits(object, "TrialDesignCharacteristics") || inherits(object, "TrialDesignCharacteristicsR6")) { return(.createSummaryDesignPlan(object, digits = digits, output = output, showStageLevels = TRUE)) } - if (.isTrialDesign(object) || .isTrialDesignPlan(object) || inherits(object, "SimulationResults")) { + if (.isTrialDesign(object) || .isTrialDesignPlan(object) || inherits(object, "SimulationResults") || inherits(object, "SimulationResultsR6")) { return(.createSummaryDesignPlan(object, digits = digits, output = output, showStageLevels = !.isTrialDesignPlan(object))) } @@ -2298,7 +2298,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", return(.createSummaryAnalysisResults(object, digits = digits, output = output)) } - if (inherits(object, "PerformanceScore")) { + if (inherits(object, "PerformanceScore") || inherits(object, "PerformanceScoreR6")) { return(.createSummaryPerformanceScore(object, digits = digits, output = output)) } @@ -2743,10 +2743,10 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", return(invisible(summaryFactory)) } - informationRatesCaption <- ifelse(inherits(designPlan, "SimulationResults") || + informationRatesCaption <- ifelse(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6") || (inherits(designPlan, "AnalysisResults") || inherits(designPlan, "AnalysisResultsR6")), "Fixed weight", "Information") - if (inherits(designPlan, "SimulationResults") || (inherits(designPlan, "AnalysisResults") || inherits(designPlan, "AnalysisResultsR6"))) { + if (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6") || (inherits(designPlan, "AnalysisResults") || inherits(designPlan, "AnalysisResultsR6"))) { if (.isTrialDesignFisher(design)) { weights <- .getWeightsFisher(design) } else if (.isTrialDesignInverseNormal(design)) { @@ -2759,7 +2759,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", summaryFactory$addItem( paste0( informationRatesCaption, - ifelse(inherits(designPlan, "SimulationResults"), "", " rate") + ifelse(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6"), "", " rate") ), .getSummaryValuesInPercent(design$informationRates) ) @@ -2773,7 +2773,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", .addDesignParameterToSummary <- function(design, designPlan, designCharacteristics, summaryFactory, digitsGeneral, digitsProbabilities) { - if (design$kMax > 1 && !inherits(designPlan, "SimulationResults") && + if (design$kMax > 1 && !(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")) && !.isTrialDesignConditionalDunnett(design)) { summaryFactory$addParameter(design, parameterName = "alphaSpent", @@ -2792,7 +2792,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", if (!is.null(designPlan)) { if (!grepl("SimulationResults(MultiArm|Enrichment)", .getClassName(designPlan))) { outputSize <- getOption("rpact.summary.output.size", C_SUMMARY_OUTPUT_SIZE_DEFAULT) - if (outputSize == "large" && inherits(designPlan, "SimulationResults")) { + if (outputSize == "large" && (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6"))) { summaryFactory$addParameter(designPlan, parameterName = "conditionalPowerAchieved", parameterCaption = "Conditional power (achieved)", @@ -2859,7 +2859,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", parameterName = "alpha", parameterCaption = "Significance level", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) - } else if (!is.null(designPlan) && !inherits(designPlan, "SimulationResults")) { + } else if (!is.null(designPlan) && !(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6"))) { summaryFactory$addParameter(design, parameterName = "stageLevels", twoSided = design$sided == 2, @@ -2880,7 +2880,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", performanceScore = NULL) { output <- match.arg(output) designPlan <- NULL - if (.isTrialDesignPlan(object) || inherits(object, "SimulationResults")) { + if (.isTrialDesignPlan(object) || (inherits(object, "SimulationResults") || inherits(object, "SimulationResultsR6"))) { design <- object$.design designPlan <- object } else if (inherits(object, "TrialDesignCharacteristics") || inherits(object, "TrialDesignCharacteristicsR6")) { @@ -3172,7 +3172,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", ) } - if (inherits(designPlan, "SimulationResults")) { + if (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")) { parameterName1 <- ifelse(survivalEnabled, "numberOfSubjects", "sampleSizes") parameterName2 <- "eventsPerStage" } else { @@ -3200,7 +3200,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", } if (outputSize %in% c("medium", "large")) { - subjectsCaption <- ifelse(design$kMax > 1 && inherits(designPlan, "SimulationResults") && + subjectsCaption <- ifelse(design$kMax > 1 && (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")) && !survivalEnabled, "Stagewise number of subjects", "Number of subjects") summaryFactory$addParameter(designPlan, parameterName = parameterName1, @@ -3282,7 +3282,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", if (planningEnabled) { legendEntry <- list("(t)" = "treatment effect scale") - if (ncol(designPlan$criticalValuesEffectScale) > 0) { + if (!is.null(designPlan$criticalValuesEffectScale) && ncol(designPlan$criticalValuesEffectScale) > 0) { summaryFactory$addParameter(designPlan, parameterName = "criticalValuesEffectScale", parameterCaption = ifelse(.isDelayedInformationEnabled(design = design), @@ -3290,7 +3290,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", ), roundDigits = digitsGeneral, legendEntry = legendEntry ) - } else if (ncol(designPlan$criticalValuesEffectScaleUpper) > 0) { + } else if (!is.null(designPlan$criticalValuesEffectScaleUpper) && ncol(designPlan$criticalValuesEffectScaleUpper) > 0) { summaryFactory$addParameter(designPlan, parameterName = "criticalValuesEffectScaleLower", parameterCaption = "Lower efficacy boundary (t)", @@ -3303,7 +3303,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", ) } - if (ncol(designPlan$futilityBoundsEffectScale) > 0 && + if (!is.null(designPlan$futilityBoundsEffectScale) && ncol(designPlan$futilityBoundsEffectScale) > 0 && !all(is.na(designPlan$futilityBoundsEffectScale))) { summaryFactory$addParameter(designPlan, parameterName = "futilityBoundsEffectScale", @@ -3412,7 +3412,6 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", } if (!is.null(performanceScore)) { - print(performanceScore) summaryFactory$addParameter(performanceScore, parameterName = "performanceScore", parameterCaption = "Performance score", @@ -3506,7 +3505,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", treatmentCaption <- ifelse(numberOfGroups > 2, paste0("Treatment arm ", groupNumber), "Treatment arm") if (!grepl("Survival", .getClassName(designPlan)) || - (inherits(designPlan, "SimulationResultsMultiArmSurvival") && + ((inherits(designPlan, "SimulationResultsMultiArmSurvival") || inherits(designPlan, "SimulationResultsMultiArmSurvivalR6")) && parameterName == "singleNumberOfEventsPerStage")) { return(ifelse(groupNumber == numberOfGroups, paste0(listItemPrefix, "Control arm"), diff --git a/R/class_time.R b/R/class_time.R index e6fb0ebc..3078663a 100644 --- a/R/class_time.R +++ b/R/class_time.R @@ -155,206 +155,6 @@ TimeDefinition <- setRefClass("TimeDefinition", ) ) -#' @title -#' Get Piecewise Survival Time -#' -#' @description -#' Returns a \code{PiecewiseSurvivalTime} object that contains the all relevant parameters -#' of an exponential survival time cumulative distribution function. -#' Use \code{\link[base]{names}} to obtain the field names. -#' -#' @param piecewiseSurvivalTime A vector that specifies the time intervals for the piecewise -#' definition of the exponential survival time cumulative distribution function (see details). -#' @inheritParams param_lambda1 -#' @inheritParams param_lambda2 -#' @inheritParams param_median1 -#' @inheritParams param_median2 -#' @inheritParams param_pi1_survival -#' @inheritParams param_pi2_survival -#' @inheritParams param_hazardRatio -#' @inheritParams param_eventTime -#' @inheritParams param_kappa -#' @param delayedResponseAllowed If \code{TRUE}, delayed response is allowed; -#' otherwise it will be validated that the response is not delayed, default is \code{FALSE}. -#' @inheritParams param_three_dots -#' -#' @template details_piecewise_survival -#' -#' @return Returns a \code{\link{PiecewiseSurvivalTime}} object. -#' The following generics (R generic functions) are available for this result object: -#' \itemize{ -#' \item \code{\link[=names.FieldSet]{names()}} to obtain the field names, -#' \item \code{\link[=print.FieldSet]{print()}} to print the object, -#' \item \code{\link[=summary.ParameterSet]{summary()}} to display a summary of the object, -#' \item \code{\link[=plot.ParameterSet]{plot()}} to plot the object, -#' \item \code{\link[=as.data.frame.ParameterSet]{as.data.frame()}} to coerce the object to a \code{\link[base]{data.frame}}, -#' \item \code{\link[=as.matrix.FieldSet]{as.matrix()}} to coerce the object to a \code{\link[base]{matrix}}. -#' } -#' @template how_to_get_help_for_generics -#' -#' @template examples_get_piecewise_survival_time -#' -#' @export -#' -getPiecewiseSurvivalTime <- function(piecewiseSurvivalTime = NA_real_, - ..., - lambda1 = NA_real_, - lambda2 = NA_real_, - hazardRatio = NA_real_, - pi1 = NA_real_, - pi2 = NA_real_, - median1 = NA_real_, - median2 = NA_real_, - eventTime = 12, # C_EVENT_TIME_DEFAULT - kappa = 1, - delayedResponseAllowed = FALSE) { - .warnInCaseOfUnknownArguments( - functionName = "getPiecewiseSurvivalTime", ..., - ignore = c(".pi1Default", ".lambdaBased", ".silent"), exceptionEnabled = TRUE - ) - - if (inherits(piecewiseSurvivalTime, "TrialDesignPlanSurvival") || inherits(piecewiseSurvivalTime, "TrialDesignPlanSurvivalR6")) { - piecewiseSurvivalTime <- piecewiseSurvivalTime$.piecewiseSurvivalTime - } - - if (inherits(piecewiseSurvivalTime, "PiecewiseSurvivalTime")) { - lambdaBased <- .getOptionalArgument(".lambdaBased", ...) - if (!is.null(lambdaBased) && isTRUE(lambdaBased) && !piecewiseSurvivalTime$.isLambdaBased()) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'piecewiseSurvivalTime' must be lambda or median based; ", - "pi based defintion is not allowed" - ) - } - - .warnInCaseOfUnusedArgument(lambda1, "lambda1", NA_real_, "getPiecewiseSurvivalTime") - .warnInCaseOfUnusedArgument(lambda2, "lambda2", NA_real_, "getPiecewiseSurvivalTime") - .warnInCaseOfUnusedArgument(hazardRatio, "hazardRatio", NA_real_, "getPiecewiseSurvivalTime") - .warnInCaseOfUnusedArgument(pi1, "pi1", NA_real_, "getPiecewiseSurvivalTime") - .warnInCaseOfUnusedArgument(pi2, "pi2", NA_real_, "getPiecewiseSurvivalTime") - .warnInCaseOfUnusedArgument(eventTime, "eventTime", C_EVENT_TIME_DEFAULT, "getPiecewiseSurvivalTime") - .warnInCaseOfUnusedArgument(kappa, "kappa", 1, "getPiecewiseSurvivalTime") - - return(piecewiseSurvivalTime) - } - - .assertIsValidLambda(lambda1, 1) - .assertIsValidLambda(lambda2, 2) - .assertIsNumericVector(hazardRatio, "hazardRatio", naAllowed = TRUE) - .assertIsNumericVector(pi1, "pi1", naAllowed = TRUE) - .assertIsSingleNumber(pi2, "pi2", naAllowed = TRUE) - .assertIsNumericVector(median1, "median1", naAllowed = TRUE) - .assertIsSingleNumber(median2, "median2", naAllowed = TRUE) - .assertIsSingleNumber(eventTime, "eventTime", naAllowed = TRUE) - .assertIsValidKappa(kappa) - .assertIsSingleLogical(delayedResponseAllowed, "delayedResponseAllowed") - - return(PiecewiseSurvivalTime( - piecewiseSurvivalTime = piecewiseSurvivalTime, - lambda1 = lambda1, - lambda2 = lambda2, - hazardRatio = hazardRatio, - pi1 = pi1, - pi2 = pi2, - median1 = median1, - median2 = median2, - eventTime = eventTime, - kappa = kappa, - delayedResponseAllowed = delayedResponseAllowed, - ... - )) -} - -#' @title -#' Get Accrual Time -#' -#' @description -#' Returns an \code{AccrualTime} object that contains the accrual time and the accrual intensity. -#' -#' @inheritParams param_accrualTime -#' @inheritParams param_accrualIntensity -#' @inheritParams param_accrualIntensityType -#' @param maxNumberOfSubjects The maximum number of subjects. -#' @inheritParams param_three_dots -#' -#' @template details_piecewise_accrual -#' -#' @seealso \code{\link[=getNumberOfSubjects]{getNumberOfSubjects()}} for calculating the number of subjects at given time points. -#' -#' @return Returns an \code{\link{AccrualTime}} object. -#' The following generics (R generic functions) are available for this result object: -#' \itemize{ -#' \item \code{\link[=names.FieldSet]{names()}} to obtain the field names, -#' \item \code{\link[=print.FieldSet]{print()}} to print the object, -#' \item \code{\link[=summary.ParameterSet]{summary()}} to display a summary of the object, -#' \item \code{\link[=plot.ParameterSet]{plot()}} to plot the object, -#' \item \code{\link[=as.data.frame.ParameterSet]{as.data.frame()}} to coerce the object to a \code{\link[base]{data.frame}}, -#' \item \code{\link[=as.matrix.FieldSet]{as.matrix()}} to coerce the object to a \code{\link[base]{matrix}}. -#' } -#' @template how_to_get_help_for_generics -#' -#' @template examples_get_accrual_time -#' -#' @export -#' -getAccrualTime <- function(accrualTime = NA_real_, - ..., - accrualIntensity = NA_real_, - accrualIntensityType = c("auto", "absolute", "relative"), - maxNumberOfSubjects = NA_real_) { - .warnInCaseOfUnknownArguments( - functionName = "getAccrualTime", ..., - ignore = c("showWarnings") - ) - - if (inherits(accrualTime, "AccrualTime") || - inherits(accrualTime, "TrialDesignPlanSurvival") || inherits(accrualTime, "TrialDesignPlanSurvivalR6")) { - if (!identical(accrualIntensity, C_ACCRUAL_INTENSITY_DEFAULT)) { - .warnInCaseOfUnusedArgument(accrualIntensity, "accrualIntensity", NA_real_, "getAccrualTime") - } - .warnInCaseOfUnusedArgument(maxNumberOfSubjects, "maxNumberOfSubjects", NA_real_, "getAccrualTime") - } - - if (inherits(accrualTime, "AccrualTime")) { - return(accrualTime) - } - - if (inherits(accrualTime, "TrialDesignPlanSurvival") || inherits(accrualTime, "TrialDesignPlanSurvivalR6")) { - return(accrualTime$.accrualTime) - } - - accrualIntensityType <- match.arg(accrualIntensityType) - - .assertIsNumericVector(accrualIntensity, "accrualIntensity", naAllowed = TRUE) - .assertIsValidMaxNumberOfSubjects(maxNumberOfSubjects, naAllowed = TRUE) - .assertIsSingleCharacter(accrualIntensityType, "accrualIntensityType") - absoluteAccrualIntensityEnabled <- NA - if (accrualIntensityType == "absolute") { - absoluteAccrualIntensityEnabled <- TRUE - if (!all(is.na(accrualIntensity)) && any(na.omit(accrualIntensity) < 1)) { - stop( - C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, - "'accrualIntensityType' is 'absolute' and the 'accrualIntensity' (", - .arrayToString(accrualIntensity), ") therefore must be >= 1" - ) - } - } else if (accrualIntensityType == "relative") { - absoluteAccrualIntensityEnabled <- FALSE - } - - args <- list(...) - showWarnings <- args[["showWarnings"]] - if (is.null(showWarnings) || !is.logical(showWarnings)) { - showWarnings <- TRUE - } - - return(AccrualTime( - accrualTime = accrualTime, - accrualIntensity = accrualIntensity, - maxNumberOfSubjects = maxNumberOfSubjects, - showWarnings = showWarnings, - absoluteAccrualIntensityEnabled = absoluteAccrualIntensityEnabled - )) -} #' #' @name PiecewiseSurvivalTime diff --git a/R/class_time_r6.R b/R/class_time_r6.R new file mode 100644 index 00000000..5efb3c07 --- /dev/null +++ b/R/class_time_r6.R @@ -0,0 +1,2297 @@ +## | +## | *Time classes* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | rpact package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File version: $Revision: 7126 $ +## | Last changed: $Date: 2023-06-23 14:26:39 +0200 (Fr, 23 Jun 2023) $ +## | Last changed by: $Author: pahlke $ +## | + +C_REGEXP_GREATER_OR_EQUAL <- ">= ?" +C_REGEXP_SMALLER <- "< ?" +C_REGEXP_SMALLER_OR_EQUAL <- "<= ?" +C_REGEXP_DECIMAL_NUMBER <- "\\d*(\\.{1}\\d*)?" + +TimeDefinitionR6 <- R6Class("TimeDefinitionR6", + inherit = ParameterSetR6, + public = list( + initialize = function(...) { + super$initialize() + + self$.parameterNames <- C_PARAMETER_NAMES + self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS + }, + .getRegexpFromTo = function(..., from, to, fromPrefix = "", toPrefix = "") { + return(paste0("(^ *", fromPrefix, from, " *- *", toPrefix, to, " *$)")) + }, + .getRegexpSmallerThan = function() { + return(paste0("(^ *", C_REGEXP_SMALLER, C_REGEXP_DECIMAL_NUMBER, " *$)")) + }, + .getRegexpDecimalNumber = function() { + return(paste0("(^ *", C_REGEXP_DECIMAL_NUMBER, " *$)")) + }, + .getRegexpGreaterOrEqualThan = function() { + return(paste0("(^ *", C_REGEXP_GREATER_OR_EQUAL, C_REGEXP_DECIMAL_NUMBER, " *$)")) + }, + .getRegexpDecimalRangeStart = function() { + return(self$.getRegexpFromTo(from = "0", to = C_REGEXP_DECIMAL_NUMBER, toPrefix = C_REGEXP_SMALLER)) + }, + .getRegexpDecimalRange = function() { + return(self$.getRegexpFromTo( + from = C_REGEXP_DECIMAL_NUMBER, to = C_REGEXP_DECIMAL_NUMBER, + toPrefix = C_REGEXP_SMALLER + )) + }, + .getRegexpDecimalRangeEnd = function() { + return(self$.getRegexpFromTo( + from = C_REGEXP_DECIMAL_NUMBER, to = "(Inf|x|\\?)", + toPrefix = paste0("(", C_REGEXP_SMALLER, " *)?") + )) + }, + .getRegexpDecimalRangeFiniteEnd = function() { + return(self$.getRegexpFromTo( + from = C_REGEXP_DECIMAL_NUMBER, to = C_REGEXP_DECIMAL_NUMBER, + toPrefix = "<=? ?" + )) + }, + .getRegexpOr = function(...) { + args <- list(...) + if (length(args) == 0) { + return("") + } + + if (length(args) == 1) { + return(args[[1]]) + } + + return(paste(unlist(args, recursive = FALSE, use.names = FALSE), collapse = "|")) + }, + .validateTimePeriod = function(timePeriod, i, n, accrualTimeMode = FALSE) { + endOfAccrualIsUndefined <- FALSE + if (i == 1 && (n > 1 || !accrualTimeMode)) { + if (!grepl(self$.getRegexpOr(self$.getRegexpSmallerThan(), self$.getRegexpDecimalRangeStart()), + timePeriod, + perl = TRUE + )) { + if (!accrualTimeMode && n == 1 && !grepl("(0 *- ?)?=time\", \"time - Inf\" or \"time1 - <=time2\", ", + "e.g., \"20\", \">=20\" or \"20 - Inf\" or \"20 - <=30\"" + ) + } + if (grepl(self$.getRegexpOr(self$.getRegexpGreaterOrEqualThan(), self$.getRegexpDecimalRangeEnd()), + timePeriod, + perl = TRUE + )) { + endOfAccrualIsUndefined <- TRUE + } + timePeriod <- gsub("([Inf >=\\?x]*)|-", "", timePeriod) + } else { + if (!grepl(self$.getRegexpOr(self$.getRegexpGreaterOrEqualThan(), self$.getRegexpDecimalRangeEnd()), + timePeriod, + perl = TRUE + )) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "the name of the last region must have the format ", + "\">=time\" or \"time - Inf\", e.g., \">=20\" or \"20 - Inf\"" + ) + } + } + } else { + if (!grepl(self$.getRegexpDecimalRange(), timePeriod, perl = TRUE)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "the name of the inner regions must have the format \"time_1 - = 1" + ) + } + } else if (accrualIntensityType == "relative") { + absoluteAccrualIntensityEnabled <- FALSE + } + + args <- list(...) + showWarnings <- args[["showWarnings"]] + if (is.null(showWarnings) || !is.logical(showWarnings)) { + showWarnings <- TRUE + } + + return(AccrualTimeR6$new( + accrualTime = accrualTime, + accrualIntensity = accrualIntensity, + maxNumberOfSubjects = maxNumberOfSubjects, + showWarnings = showWarnings, + absoluteAccrualIntensityEnabled = absoluteAccrualIntensityEnabled + )) +} + +#' +#' @name PiecewiseSurvivalTime +#' +#' @title +#' Piecewise Exponential Survival Time +#' +#' @description +#' Class for the definition of piecewise survival times. +#' +#' @template field_piecewiseSurvivalTime +#' @template field_lambda1 +#' @template field_lambda2 +#' @template field_hazardRatio +#' @template field_pi1_survival +#' @template field_pi2_survival +#' @template field_median1 +#' @template field_median2 +#' @template field_eventTime +#' @template field_kappa +#' @template field_piecewiseSurvivalEnabled +#' @template field_delayedResponseAllowed +#' @template field_delayedResponseEnabled +#' +#' @details +#' \code{PiecewiseSurvivalTime} is a class for the definition of piecewise survival times. +#' +#' @include f_core_constants.R +#' @include class_core_parameter_set.R +#' @include f_core_utilities.R +#' @include f_logger.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +PiecewiseSurvivalTimeR6 <- R6Class("PiecewiseSurvivalTimeR6", + inherit = TimeDefinitionR6, + public = list( + .pi1Default = NULL, + .lambdaBased = NULL, + .silent = NULL, + piecewiseSurvivalTime = NULL, + lambda1 = NULL, + lambda2 = NULL, + hazardRatio = NULL, + pi1 = NULL, + pi2 = NULL, + median1 = NULL, + median2 = NULL, + eventTime = NULL, + kappa = NULL, + piecewiseSurvivalEnabled = NULL, + delayedResponseAllowed = NULL, + delayedResponseEnabled = NULL, + initialize = function(piecewiseSurvivalTime = NA_real_, + ..., + lambda1 = NA_real_, + lambda2 = NA_real_, + hazardRatio = NA_real_, + pi1 = NA_real_, + pi2 = NA_real_, + median1 = NA_real_, + median2 = NA_real_, + eventTime = C_EVENT_TIME_DEFAULT, + kappa = 1, + delayedResponseAllowed = FALSE) { + super$initialize() + self$piecewiseSurvivalTime <- piecewiseSurvivalTime + self$lambda1 <- lambda1 + self$lambda2 <- lambda2 + self$hazardRatio <- hazardRatio + self$pi1 <- pi1 + self$pi2 <- pi2 + self$median1 <- median1 + self$median2 <- median2 + self$eventTime <- eventTime + self$kappa <- kappa + self$delayedResponseAllowed <- delayedResponseAllowed + + if (length(self$piecewiseSurvivalTime) == 0) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'piecewiseSurvivalTime' must be defined (set to NA_real_ if not applicable)" + ) + } + + self$.stopInCaseOfConflictingArguments(self$lambda1, "lambda1", self$median1, "median1") + self$.stopInCaseOfConflictingArguments(self$lambda2, "lambda2", self$median2, "median2") + + self$.stopInCaseOfConflictingArguments(self$pi1, "pi1", self$median1, "median1") + self$.stopInCaseOfConflictingArguments(self$pi1, "pi1", self$median2, "median2") + self$.stopInCaseOfConflictingArguments(self$pi1, "pi1", self$lambda1, "lambda1") + self$.stopInCaseOfConflictingArguments(self$pi1, "pi1", self$lambda2, "lambda2") + self$.stopInCaseOfConflictingArguments(self$pi2, "pi2", self$median1, "median1") + self$.stopInCaseOfConflictingArguments(self$pi2, "pi2", self$median2, "median2") + self$.stopInCaseOfConflictingArguments(self$pi2, "pi2", self$lambda1, "lambda1") + self$.stopInCaseOfConflictingArguments(self$pi2, "pi2", self$lambda2, "lambda2") + + if (length(self$median1) > 0 && !all(is.na(self$median1))) { + self$lambda1 <- getLambdaByMedian(self$median1, kappa = self$kappa) + self$.setParameterType("median1", C_PARAM_USER_DEFINED) + self$.setParameterType("lambda1", C_PARAM_GENERATED) + } else { + self$.setParameterType("median1", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("lambda1", ifelse(length(self$lambda1) == 1 && is.na(self$lambda1), + C_PARAM_NOT_APPLICABLE, C_PARAM_USER_DEFINED + )) + } + if (length(self$median2) > 0 && !all(is.na(self$median2))) { + self$lambda2 <- getLambdaByMedian(self$median2, kappa = self$kappa) + self$.setParameterType("median2", C_PARAM_USER_DEFINED) + self$.setParameterType("lambda2", C_PARAM_GENERATED) + } else { + self$.setParameterType("median2", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("lambda2", C_PARAM_NOT_APPLICABLE) + } + + args <- list(...) + if (!is.null(args[[".pi1Default"]])) { + self$.pi1Default <- args[[".pi1Default"]] + } + if (!is.null(args[[".lambdaBased"]])) { + self$.lambdaBased <- args[[".lambdaBased"]] + } + if (!is.null(args[[".silent"]])) { + self$.silent <- args[[".silent"]] + } else { + self$.silent <- FALSE + } + + self$piecewiseSurvivalEnabled <- FALSE + self$delayedResponseEnabled <- FALSE + + self$.setParameterType("piecewiseSurvivalTime", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("piecewiseSurvivalEnabled", C_PARAM_GENERATED) + self$.setParameterType("delayedResponseEnabled", ifelse(isTRUE(self$delayedResponseAllowed), + C_PARAM_GENERATED, C_PARAM_NOT_APPLICABLE + )) + self$.setParameterType("delayedResponseAllowed", ifelse(isTRUE(self$delayedResponseAllowed), + C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE + )) + self$.setParameterType("pi1", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("pi2", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("eventTime", ifelse(length(self$eventTime) == 1 && is.na(self$eventTime), + C_PARAM_NOT_APPLICABLE, + ifelse(self$eventTime == C_EVENT_TIME_DEFAULT, C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED) + )) + self$.setParameterType("kappa", ifelse(length(self$kappa) == 1 && !is.na(self$kappa) && self$kappa == 1, + C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + + self$.init(self$piecewiseSurvivalTime) + + if (self$.getParameterType("median1") == C_PARAM_USER_DEFINED && + self$.getParameterType("lambda1") == C_PARAM_USER_DEFINED) { + self$.setParameterType("lambda1", C_PARAM_GENERATED) + } + + if (self$.getParameterType("median2") == C_PARAM_USER_DEFINED && + self$.getParameterType("lambda2") == C_PARAM_USER_DEFINED) { + self$.setParameterType("lambda2", C_PARAM_GENERATED) + } + + if (!is.na(self$eventTime) && + self$.getParameterType("pi1") != C_PARAM_USER_DEFINED && + self$.getParameterType("pi1") != C_PARAM_DEFAULT_VALUE && + self$.getParameterType("pi2") != C_PARAM_USER_DEFINED && + self$.getParameterType("pi2") != C_PARAM_DEFAULT_VALUE) { + if (self$.getParameterType("eventTime") == C_PARAM_USER_DEFINED) { + warning("'eventTime' (", round(self$eventTime, 3), ") will be ignored", call. = FALSE) + } + self$.setParameterType("eventTime", C_PARAM_NOT_APPLICABLE) + self$eventTime <- NA_real_ + } + + self$.validateCalculatedArguments() + }, + .validateCalculatedArguments = function() { + if (self$.getParameterType("median1") == C_PARAM_USER_DEFINED) { + if (!isTRUE(all.equal(getLambdaByMedian(self$median1, kappa = self$kappa), self$lambda1, tolerance = 1e-05))) { + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'lambda1' must be ", + round(getLambdaByMedian(self$median1, kappa = self$kappa), 5), ", but is ", round(self$lambda1, 5) + ) + } + if (!any(is.na(self$pi1)) && + !isTRUE(all.equal(getPiByMedian(self$median1, eventTime = self$eventTime, kappa = self$kappa), + self$pi1, + tolerance = 1e-05 + ))) { + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'pi1' must be ", + round(getPiByMedian(self$median1, eventTime = self$eventTime, kappa = self$kappa), 5), ", but is ", round(self$pi1, 5) + ) + } + } + + if (self$.getParameterType("median2") == C_PARAM_USER_DEFINED) { + if (!isTRUE(all.equal(getLambdaByMedian(self$median2, kappa = self$kappa), self$lambda2, tolerance = 1e-05))) { + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'lambda2' must be ", + round(getLambdaByMedian(self$median2, kappa = self$kappa), 5), ", but is ", round(self$lambda2, 5) + ) + } + if (!is.na(self$pi2) && + !isTRUE(all.equal(getPiByMedian(self$median2, eventTime = self$eventTime, kappa = self$kappa), + self$pi2, + tolerance = 1e-05 + ))) { + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'pi2' must be ", + round(getPiByMedian(self$median2, eventTime = self$eventTime, kappa = self$kappa), 5), ", but is ", round(self$pi2, 5) + ) + } + } + + if (self$.getParameterType("lambda1") == C_PARAM_USER_DEFINED || + self$.getParameterType("median1") == C_PARAM_USER_DEFINED || + self$.getParameterType("lambda2") == C_PARAM_USER_DEFINED || + self$.getParameterType("median2") == C_PARAM_USER_DEFINED) { + if (!any(is.na(self$pi1))) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'pi1' (", self$pi1, ") must be NA_real_") + } + if (self$.getParameterType("pi1") != C_PARAM_NOT_APPLICABLE) { + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, "parameter type of 'pi1' (", + self$.getParameterType("pi1"), ") must be C_PARAM_NOT_APPLICABLE" + ) + } + if (!any(is.na(self$pi1))) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'pi2' (", self$pi2, ") must be NA_real_") + } + if (self$.getParameterType("pi2") != C_PARAM_NOT_APPLICABLE) { + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, "parameter type of 'pi2' (", + self$.getParameterType("pi2"), ") must be C_PARAM_NOT_APPLICABLE" + ) + } + if (!any(is.na(self$eventTime))) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'eventTime' (", self$eventTime, ") must be NA_real_") + } + if (self$.getParameterType("eventTime") != C_PARAM_NOT_APPLICABLE) { + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, "parameter type of 'eventTime' (", + self$.getParameterType("eventTime"), ") must be C_PARAM_NOT_APPLICABLE" + ) + } + } + + if (self$.getParameterType("hazardRatio") == C_PARAM_TYPE_UNKNOWN) { + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, "parameter type of 'hazardRatio' (", + self$hazardRatio, ") must be != C_PARAM_TYPE_UNKNOWN" + ) + } + }, + .stopInCaseOfConflictingArguments = function(arg1, argName1, arg2, argName2) { + if (length(arg1) > 0 && !all(is.na(arg1)) && length(arg2) > 0 && !all(is.na(arg2))) { + stop( + C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, + "it is not allowed to specify '", argName1, "' (", .arrayToString(arg1), ")", + " and '", argName2, "' (", .arrayToString(arg2), ") concurrently" + ) + } + }, + .asDataFrame = function() { + data <- data.frame( + piecewiseSurvivalTime = self$piecewiseSurvivalTime, + lambda1 = self$lambda1, + lambda2 = self$lambda2 + ) + rownames(data) <- as.character(1:nrow(data)) + colnames(data) <- c( + "Start time", + C_PARAMETER_NAMES["lambda1"], # Hazard rate (1) + C_PARAMETER_NAMES["lambda2"] + ) # Hazard rate (2) + return(data) + }, + .isPiBased = function() { + return(!self$.isLambdaBased()) + }, + .isLambdaBased = function(minNumberOfLambdas = 2) { + if (self$.getParameterType("lambda2") == C_PARAM_USER_DEFINED || + self$.getParameterType("median2") == C_PARAM_USER_DEFINED) { + if (length(self$lambda2) >= minNumberOfLambdas && !any(is.na(self$lambda2))) { + return(TRUE) + } + } + + return((length(self$pi1) == 0 || any(is.na(self$pi1))) && (length(self$pi2) == 0 || any(is.na(self$pi2)))) + }, + show = function(showType = 1, digits = NA_integer_) { + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + }, + .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { + "Method for automatically printing piecewise survival time objects" + self$.resetCat() + if (showType == 2) { + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + } else { + self$.cat("Piecewise exponential survival times:\n", + sep = "", heading = 1, + consoleOutputEnabled = consoleOutputEnabled + ) + if (!self$piecewiseSurvivalEnabled) { + self$.cat(" Piecewise exponential survival is disabled.\n\n", consoleOutputEnabled = consoleOutputEnabled) + } else if (length(self$piecewiseSurvivalTime) == 1) { + self$.cat(" At all times:", self$lambda2[1], "\n\n", consoleOutputEnabled = consoleOutputEnabled) + } else { + piecewiseSurvivalTimeStr <- format(self$piecewiseSurvivalTime) + lambda2Str <- format(self$lambda2) + for (i in 1:length(self$piecewiseSurvivalTime)) { + if (i < length(self$piecewiseSurvivalTime)) { + self$.cat(" ", piecewiseSurvivalTimeStr[i], " - <", + piecewiseSurvivalTimeStr[i + 1], ": ", + lambda2Str[i], "\n", + sep = "", + consoleOutputEnabled = consoleOutputEnabled + ) + } else { + self$.cat(" ", rep(" ", 2 + max(nchar(piecewiseSurvivalTimeStr))), + ">=", piecewiseSurvivalTimeStr[i], ": ", + lambda2Str[i], "\n", + sep = "", + consoleOutputEnabled = consoleOutputEnabled + ) + } + } + if (self$delayedResponseEnabled) { + self$.cat("Delayed response is enabled.\n", consoleOutputEnabled = consoleOutputEnabled) + } + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) + } + + self$.cat("Details:\n\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) + self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Generated parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + } + }, + .toString = function(startWithUpperCase = FALSE) { + s <- "piecewise survival time" + return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) + }, + isDelayedResponseEnabled = function() { + return(self$delayedResponseEnabled) + }, + isPiecewiseSurvivalEnabled = function() { + if (length(self$piecewiseSurvivalTime) == 0) { + return(FALSE) + } + + if (length(self$piecewiseSurvivalTime) == 1 && is.na(self$piecewiseSurvivalTime)) { + return(FALSE) + } + + return(TRUE) + }, + .initFromList = function(pwSurvTimeList) { + if (!is.list(pwSurvTimeList)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'piecewiseSurvivalTime' must be a list") + } + + if (length(pwSurvTimeList) == 0) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'piecewiseSurvivalTime' must contain at least one entry" + ) + } + + if (is.null(names(pwSurvTimeList))) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'piecewiseSurvivalTime' must be a named list") + } + + if (!all(is.na(self$lambda2))) { + warning("'lambda2' (", .arrayToString(self$lambda2), + ") will be ignored because 'piecewiseSurvivalTime' is a list", + call. = FALSE + ) + } + + pwSurvStartTimes <- c(0) + pwSurvLambda2 <- c() + pwSurvTimeNames <- names(pwSurvTimeList) + for (i in 1:length(pwSurvTimeNames)) { + timePeriod <- pwSurvTimeNames[i] + lambdaValue <- pwSurvTimeList[[timePeriod]] + .assertIsSingleNumber(lambdaValue, paste0("pwSurvLambda[", i, "]")) + + timePeriod <- self$.validateTimePeriod(timePeriod, i = i, n = length(pwSurvTimeNames)) + + if (i < length(pwSurvTimeNames)) { + parts <- strsplit(timePeriod, "- *(< *)?", perl = TRUE)[[1]] + if (length(parts) != 2) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "all regions (", timePeriod, ") must have the format ", + "\"time_1 - 1 && self$delayedResponseAllowed) { + if (length(self$hazardRatio) != length(pwSurvLambda2)) { + warning("Only the first 'hazardRatio' (", round(self$hazardRatio[1], 4), + ") was used for piecewise survival time definition ", + "(use a loop over the function to simulate different hazard ratios)", + call. = FALSE + ) + self$hazardRatio <- self$hazardRatio[1] + } else { + self$delayedResponseEnabled <- TRUE + } + self$lambda1 <- pwSurvLambda2 * self$hazardRatio^(1 / self$kappa) + self$.setParameterType("lambda1", C_PARAM_GENERATED) + } else { + self$lambda1 <- NA_real_ + self$.setParameterType("lambda1", C_PARAM_NOT_APPLICABLE) + } + + self$lambda2 <- pwSurvLambda2 + self$.setParameterType("lambda2", C_PARAM_USER_DEFINED) + + self$piecewiseSurvivalEnabled <- !identical(self$piecewiseSurvivalTime, 0) + }, + .init = function(pwSurvTime) { + .logDebug("pwSurvTime %s, %s", ifelse(is.numeric(pwSurvTime), + .arrayToString(pwSurvTime), pwSurvTime + ), .getClassName(pwSurvTime[1])) + .logDebug("lambda1 %s, %s", self$lambda1, self$.getParameterType("lambda1")) + .logDebug("lambda2 %s, %s", self$lambda2, self$.getParameterType("lambda2")) + + # case 1: lambda1 and lambda2 = NA or generated + if (length(pwSurvTime) == 1 && (is.na(pwSurvTime) || is.numeric(pwSurvTime)) && + (all(is.na(self$lambda1)) || self$.getParameterType("lambda1") == C_PARAM_GENERATED) && + length(self$lambda2) == 1 && (is.na(self$lambda2) || self$.getParameterType("lambda2") == C_PARAM_GENERATED) + ) { + .logDebug(".init, case 1: lambda1 and lambda2 = NA") + + if (!is.null(self$.lambdaBased) && isTRUE(self$.lambdaBased)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'lambda1' and 'lambda2' must be specified") + } + + if (!any(is.na(self$hazardRatio))) { + self$.setParameterType("hazardRatio", C_PARAM_USER_DEFINED) + } + + if (!is.na(pwSurvTime)) { + warning("'piecewiseSurvivalTime' (", pwSurvTime, ") will be ignored") + } + + if (is.na(self$pi2)) { + if (!is.na(self$median2) || !any(is.na(self$median1))) { + .logDebug(".init: set pi2 to 'not applicable'") + self$.setParameterType("pi2", C_PARAM_NOT_APPLICABLE) + } else { + .logDebug(".init: set pi2 to default") + self$pi2 <- C_PI_2_DEFAULT + self$.setParameterType("pi2", C_PARAM_DEFAULT_VALUE) + } + } else { + .assertIsSingleNumber(self$pi2, "pi2") + self$.setParameterType("pi2", ifelse(self$pi2 == C_PI_2_DEFAULT, + C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + if (!any(is.na(self$median2))) { + warning("'median2' (", .arrayToString(self$median2), ") will be ignored") + self$median2 <- NA_real_ + } + } + + hazardRatioCalculationEnabled <- TRUE + if (all(is.na(self$pi1))) { + if (length(self$hazardRatio) > 0 && !all(is.na(self$hazardRatio))) { + self$.setParameterType("hazardRatio", C_PARAM_USER_DEFINED) + hazardRatioCalculationEnabled <- FALSE + } + + if (!any(is.na(self$median1))) { + .logDebug(".init: set pi1 to 'not applicable'") + self$.setParameterType("pi1", C_PARAM_NOT_APPLICABLE) + + if (is.na(self$median2)) { + if (any(is.na(self$hazardRatio))) { + stop( + C_EXCEPTION_TYPE_MISSING_ARGUMENT, + "'hazardRatio', 'lambda2', or 'median2' must be specified" + ) + } + + if (length(self$hazardRatio) != length(self$median1)) { + stop( + C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, + "length of 'hazardRatio' (", .arrayToString(self$hazardRatio), ") must be ", + "equal to length of 'median1' (", .arrayToString(self$median1), ")" + ) + } + + .logDebug(".init: calculate lambda2 and median2 by median1") + + self$lambda2 <- getLambdaByMedian(self$median1, self$kappa) / self$hazardRatio^(1 / self$kappa) + + if (!self$delayedResponseAllowed && length(unique(round(self$lambda2, 8))) > 1) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'lambda2' can only be calculated if 'unique(lambda1 / hazardRatio^(1 / kappa))' ", + "result in a single value; current result = ", + .arrayToString(round(self$lambda2, 4), vectorLookAndFeelEnabled = TRUE), + " (e.g., delayed response is not allowed)" + ) + } + + self$median2 <- getMedianByLambda(self$lambda2, self$kappa) + self$.setParameterType("lambda2", C_PARAM_GENERATED) + self$.setParameterType("median2", C_PARAM_GENERATED) + } + } else if (length(self$hazardRatio) > 0 && !all(is.na(self$hazardRatio))) { + self$.setParameterType("pi1", C_PARAM_NOT_APPLICABLE) + + if (!any(is.na(self$lambda1))) { + .logDebug(".init: calculate median1 by lambda1") + self$median1 <- getMedianByLambda(self$lambda1, self$kappa) + self$.setParameterType("median1", C_PARAM_GENERATED) + } else if (!is.na(self$median2)) { + .logDebug(".init: calculate lambda1 and median1 by median2") + self$lambda1 <- getLambdaByMedian(self$median2, self$kappa) * self$hazardRatio^(1 / self$kappa) + self$median1 <- getMedianByLambda(self$lambda1, self$kappa) + self$.setParameterType("lambda1", C_PARAM_GENERATED) + self$.setParameterType("median1", C_PARAM_GENERATED) + } + } else { + .logDebug(".init: set pi1 to default") + if (!is.null(self$.pi1Default) && is.numeric(self$.pi1Default) && + length(self$.pi1Default) > 0) { + self$pi1 <- self$.pi1Default + } else { + self$pi1 <- C_PI_1_SAMPLE_SIZE_DEFAULT + } + self$.setParameterType("pi1", C_PARAM_DEFAULT_VALUE) + } + } else { + .assertIsNumericVector(self$pi1, "pi1") + if (!any(is.na(self$median1))) { + .logDebug(".init: set median1 to NA") + warning("'median1' (", .arrayToString(self$median1), ") will be ignored") + self$median1 <- NA_real_ + } + } + + if (hazardRatioCalculationEnabled) { + if (length(self$hazardRatio) > 0 && !all(is.na(self$hazardRatio))) { + warning("'hazardRatio' (", .arrayToString(self$hazardRatio), + ") will be ignored because it will be calculated", + call. = FALSE + ) + } + + if (!any(is.na(self$lambda1)) && !is.na(self$lambda2)) { + .logDebug(".init: calculate hazardRatio by lambda1 and lambda2") + self$hazardRatio <- (self$lambda1 / self$lambda2)^self$kappa + self$.setParameterType("hazardRatio", C_PARAM_GENERATED) + } else if (!any(is.na(self$pi1)) && !is.na(self$pi2)) { + .logDebug(".init: calculate hazardRatio by pi1 and pi2") + self$hazardRatio <- getHazardRatioByPi(self$pi1, self$pi2, self$eventTime, kappa = self$kappa) + self$.setParameterType("hazardRatio", C_PARAM_GENERATED) + } + } + + if (length(self$pi1) > 0 && !any(is.na(self$pi1))) { + pi1Default <- C_PI_1_SAMPLE_SIZE_DEFAULT + if (!is.null(self$.pi1Default) && is.numeric(self$.pi1Default) && + length(self$.pi1Default) > 0) { + pi1Default <- self$.pi1Default + } + if (identical(self$pi1, pi1Default)) { + self$.setParameterType("pi1", C_PARAM_DEFAULT_VALUE) + } else if (hazardRatioCalculationEnabled && self$.getParameterType("pi1") != C_PARAM_GENERATED) { + self$.setParameterType("pi1", C_PARAM_USER_DEFINED) + } + } + + if (length(self$pi2) == 1 && !is.na(self$pi2)) { + if (length(self$eventTime) == 1 && !is.na(self$eventTime)) { + self$lambda2 <- getLambdaByPi(self$pi2, self$eventTime, kappa = self$kappa) + self$.setParameterType("lambda2", C_PARAM_GENERATED) + } + + if (length(self$pi1) == 1 && is.na(self$pi1) && !any(is.na(self$hazardRatio))) { + self$pi1 <- getPiByLambda( + getLambdaByPi( + self$pi2, self$eventTime, + kappa = self$kappa + ) * self$hazardRatio^(1 / self$kappa), + self$eventTime, + kappa = self$kappa + ) + self$.setParameterType("pi1", C_PARAM_GENERATED) + } + if (length(self$pi1) > 0 && !any(is.na(self$pi1)) && + length(self$eventTime) == 1 && !is.na(self$eventTime)) { + self$lambda1 <- getLambdaByPi(self$pi1, self$eventTime, kappa = self$kappa) + self$.setParameterType("lambda1", C_PARAM_GENERATED) + } + } + + self$.initMedian() + return(invisible()) + } + + if (length(pwSurvTime) == 1 && is.na(pwSurvTime)) { + pwSurvTime <- NA_real_ + } + + if (is.list(pwSurvTime)) { + .assertIsValidHazardRatioVector(self$hazardRatio) + self$.initFromList(pwSurvTime) + self$.initHazardRatio() + if (!self$piecewiseSurvivalEnabled) { + self$.initPi() + self$.initMedian() + } + } else if (self$delayedResponseAllowed && length(self$lambda2) == 1 && + !is.na(self$lambda2) && length(self$hazardRatio) > 0 && + (all(is.na(pwSurvTime)) || identical(pwSurvTime, 0))) { + .logDebug(".init, case 2: delayedResponseAllowed") + + self$piecewiseSurvivalEnabled <- FALSE + + if (!all(is.na(pwSurvTime)) && !identical(pwSurvTime, 0)) { + warning("'piecewiseSurvivalTime' (", .arrayToString(pwSurvTime), ") will be ignored") + } + self$piecewiseSurvivalTime <- 0 + + self$.initPi() + self$.initHazardRatio() + self$.initMedian() + } else if (!is.numeric(pwSurvTime)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'piecewiseSurvivalTime' must be a list, a numeric value, or vector" + ) + } else { + self$piecewiseSurvivalTime <- pwSurvTime + if ((all(is.na(self$piecewiseSurvivalTime)) || identical(self$piecewiseSurvivalTime, 0)) && + length(self$lambda2) == 1 && !is.na(self$lambda2)) { + .logDebug(".init, case 3: piecewise survival is disabled") + if (!all(is.na(self$piecewiseSurvivalTime)) && !identical(self$piecewiseSurvivalTime, 0)) { + warning("'piecewiseSurvivalTime' (", .arrayToString(self$piecewiseSurvivalTime), ") will be ignored") + } + self$piecewiseSurvivalTime <- 0 + self$.setParameterType("piecewiseSurvivalTime", C_PARAM_DEFAULT_VALUE) + self$piecewiseSurvivalEnabled <- FALSE + self$.initHazardRatio() + self$.initPi() + self$.initMedian() + } else { + .logDebug(".init, case 3: piecewise survival is enabled") + if (all(is.na(self$piecewiseSurvivalTime))) { + if (self$.getParameterType("median1") == C_PARAM_USER_DEFINED) { + stop( + C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, + "'median1' (", .arrayToString(self$median1), ") with length > 1 can only ", + "defined together with a single 'median2', 'lambda2' or 'pi2'" + ) + } + + if (self$delayedResponseAllowed && length(self$lambda1 > 0) && !all(is.na(self$lambda1)) && + length(self$lambda1) != length(self$lambda2) && self$delayedResponseAllowed) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "length of 'lambda1' (", length(self$lambda1), "), 'lambda2' (", length(self$lambda2), "), and ", + "'piecewiseSurvivalTime' (", length(self$piecewiseSurvivalTime), ") must be equal" + ) + } + + stop( + C_EXCEPTION_TYPE_MISSING_ARGUMENT, + "'piecewiseSurvivalTime' must be specified" + ) + } + self$.setParameterType("piecewiseSurvivalTime", C_PARAM_USER_DEFINED) + self$piecewiseSurvivalEnabled <- TRUE + self$.initHazardRatio() + self$.initPi() + } + } + + if (self$piecewiseSurvivalEnabled) { + for (param in c("pi", "median")) { + for (group in 1:2) { + paramName <- paste0(param, group) + if (self$.getParameterType(paramName) == C_PARAM_USER_DEFINED) { + warning( + "'", paramName, "' (", .arrayToString(self[[paramName]]), ") ", + "was converted to 'lambda", group, "' ", + "and is not available in output because piecewise ", + "exponential survival time is enabled" + ) + } + } + } + self$pi1 <- NA_real_ + self$pi2 <- NA_real_ + self$median1 <- NA_real_ + self$median2 <- NA_real_ + self$.setParameterType("pi1", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("pi2", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("median1", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("median2", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("eventTime", C_PARAM_NOT_APPLICABLE) + if (!is.na(self$eventTime) && self$eventTime != C_EVENT_TIME_DEFAULT) { + warning("Event time (", self$eventTime, ") will be ignored because it is not ", + "applicable for piecewise exponential survival time", + call. = FALSE + ) + self$eventTime <- C_EVENT_TIME_DEFAULT + } + } + + self$.validateInitialization() + }, + .initMedian = function() { + if (length(self$eventTime) == 1 && !is.na(self$eventTime)) { + if (length(self$pi1) > 0 && !all(is.na(self$pi1)) && self$.getParameterType("median1") != C_PARAM_USER_DEFINED) { + self$median1 <- getMedianByPi(self$pi1, self$eventTime, kappa = self$kappa) + self$.setParameterType("median1", C_PARAM_GENERATED) + } + if (length(self$pi2) == 1 && !is.na(self$pi2) && self$.getParameterType("median2") != C_PARAM_USER_DEFINED) { + self$median2 <- getMedianByPi(self$pi2, self$eventTime, kappa = self$kappa) + self$.setParameterType("median2", C_PARAM_GENERATED) + } + } else { + if (length(self$lambda1) > 0 && !all(is.na(self$lambda1)) && self$.getParameterType("median1") != C_PARAM_USER_DEFINED) { + self$median1 <- getMedianByLambda(self$lambda1, kappa =self$kappa) + self$.setParameterType("median1", C_PARAM_GENERATED) + } + if (length(self$lambda2) == 1 && !is.na(self$lambda2) && self$.getParameterType("median2") != C_PARAM_USER_DEFINED) { + self$median2 <- getMedianByLambda(self$lambda2, kappa = self$kappa) + self$.setParameterType("median2", C_PARAM_GENERATED) + } + } + }, + .initPi = function() { + .logDebug(".initPi: set pi1, pi2, and eventTime to NA") + + if (!is.na(self$eventTime) && self$.getParameterType("eventTime") == C_PARAM_USER_DEFINED) { + warning("'eventTime' (", round(self$eventTime, 3), ") will be ignored", call. = FALSE) + } + if (!is.na(self$pi1) && !identical(self$pi2, C_PI_1_DEFAULT) && !identical(self$pi2, C_PI_1_SAMPLE_SIZE_DEFAULT)) { + warning("'pi1' (", .arrayToString(self$pi1), ") will be ignored", call. = FALSE) + } + if (!is.na(self$pi2) && self$pi2 != C_PI_2_DEFAULT) { + warning("'pi2' (", self$pi2, ") will be ignored", call. = FALSE) + } + + self$.setParameterType("eventTime", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("pi1", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("pi2", C_PARAM_NOT_APPLICABLE) + self$eventTime <- NA_real_ + self$pi1 <- NA_real_ + self$pi2 <- NA_real_ + + if (length(self$lambda2) == 0 || any(is.na(self$lambda2))) { + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, + "'lambda2' must be defined before .initPi() can be called" + ) + } + + self$.setParameterType("lambda2", C_PARAM_USER_DEFINED) + + if (self$piecewiseSurvivalEnabled && length(self$hazardRatio) > 1) { + return(invisible()) + } + + if (length(self$lambda1) == 0 || any(is.na(self$lambda1))) { + if (length(self$hazardRatio) > 0 && !any(is.na(self$hazardRatio))) { + .logDebug(".initPi: calculate lambda1 by hazardRatio") + self$lambda1 <- self$lambda2 * self$hazardRatio^(1 / self$kappa) + self$.setParameterType("lambda1", C_PARAM_GENERATED) + } else if (length(self$lambda1) == 0) { + self$lambda1 <- NA_real_ + } else if (self$delayedResponseAllowed) { + self$.setParameterType("lambda1", C_PARAM_USER_DEFINED) + } + } + }, + .initHazardRatio = function() { + .logDebug(".initHazardRatio") + + if (!is.null(self$hazardRatio) && length(self$hazardRatio) > 0 && !all(is.na(self$hazardRatio))) { + if ((length(self$lambda1) == 1 && is.na(self$lambda1)) || + self$.getParameterType("lambda1") == C_PARAM_GENERATED) { + self$.setParameterType("hazardRatio", C_PARAM_USER_DEFINED) + return(invisible()) + } + + if (!self$.silent) { + warning("'hazardRatio' (", .arrayToString(self$hazardRatio), + ") will be ignored because it will be calculated", + call. = FALSE + ) + } + } + + if (any(is.na(self$lambda2))) { + stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'lambda2' must be specified") + } + + if (any(is.na(self$lambda1))) { + if (self$delayedResponseAllowed && any(is.na(self$hazardRatio) && + !any(is.na(self$piecewiseSurvivalTime)) && length(self$lambda2) == length(self$piecewiseSurvivalTime))) { + stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'hazardRatio' must be specified") + } + if (any(is.na(self$hazardRatio))) { + stop( + C_EXCEPTION_TYPE_MISSING_ARGUMENT, + "'hazardRatio', 'lambda1' or 'median1' must be specified" + ) + } + stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'lambda1' must be specified") + } + + self$.setParameterType("lambda1", C_PARAM_USER_DEFINED) + + hr <- unique(round(self$lambda1 / self$lambda2, 8)^self$kappa) + if (length(hr) != 1) { + if (length(self$lambda2) == 1 && length(self$lambda1) > 1) { + self$hazardRatio <- (self$lambda1 / self$lambda2)^self$kappa + self$.setParameterType("hazardRatio", C_PARAM_GENERATED) + return(invisible()) + } else if (self$delayedResponseAllowed) { + self$hazardRatio <- (self$lambda1 / self$lambda2)^self$kappa + self$.setParameterType("hazardRatio", C_PARAM_GENERATED) + self$delayedResponseEnabled <- TRUE + return(invisible()) + } else { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'hazardRatio' can only be calculated if 'unique(lambda1 / lambda2)' ", + "result in a single value; current result = ", + .arrayToString(round(hr, 4), vectorLookAndFeelEnabled = TRUE), + " (e.g., delayed response is not allowed)" + ) + } + } + + self$hazardRatio <- ((self$lambda1 / self$lambda2)^self$kappa)[1] + self$.setParameterType("hazardRatio", C_PARAM_GENERATED) + }, + .validateInitialization = function() { + if (length(self$piecewiseSurvivalTime) == 0) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'piecewiseSurvivalTime' must contain at least one survival start time" + ) + } + + if (any(is.na(self$piecewiseSurvivalTime))) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'piecewiseSurvivalTime' must contain valid survival start times" + ) + } + + if (self$piecewiseSurvivalTime[1] != 0) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "the first value of 'piecewiseSurvivalTime' must be 0" + ) + } + + if (length(self$piecewiseSurvivalTime) != length(self$lambda2)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "length of 'piecewiseSurvivalTime' (", length(self$piecewiseSurvivalTime), + ") and length of 'lambda2' (", length(self$lambda2), ") must be equal" + ) + } + + .assertValuesAreStrictlyIncreasing(self$piecewiseSurvivalTime, "piecewiseSurvivalTime") + + if ((length(self$lambda1) != 1 || is.na(self$lambda1)) && + !(self$.getParameterType("lambda1") %in% c(C_PARAM_GENERATED, C_PARAM_USER_DEFINED))) { + if (length(self$hazardRatio) == 1 && !is.na(self$hazardRatio)) { + self$lambda1 <- self$lambda2 * self$hazardRatio^(1 / self$kappa) + self$.setParameterType("lambda1", C_PARAM_GENERATED) + } else if (length(self$hazardRatio) > 1 && self$delayedResponseAllowed && + !is.na(self$hazardRatio[1])) { + if (!self$delayedResponseEnabled && self$.isLambdaBased()) { + if (self$delayedResponseAllowed) { + if (length(self$hazardRatio) != length(self$lambda2)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "length of 'hazardRatio' (", length(self$hazardRatio), + ") and length of 'lambda2' (", length(self$lambda2), ") must be equal" + ) + } + self$delayedResponseEnabled <- TRUE + } else { + warning("Only the first 'hazardRatio' (", round(self$hazardRatio[1], 4), + ") was used for piecewise survival time definition", + call. = FALSE + ) + self$hazardRatio <- self$hazardRatio[1] + } + self$lambda1 <- self$lambda2 * self$hazardRatio^(1 / self$kappa) + self$.setParameterType("lambda1", C_PARAM_GENERATED) + } + } else if (!self$delayedResponseEnabled && !(length(self$lambda2) == 1 && length(self$lambda1) > 1)) { + if (length(self$lambda1) > 1) { + warning("'lambda1' (", .arrayToString(self$lambda1), + ") will be ignored", + call. = FALSE + ) + } + self$lambda1 <- NA_real_ + self$.setParameterType("lambda1", C_PARAM_NOT_APPLICABLE) + } + } else if (length(self$hazardRatio) == 1 && !is.na(self$hazardRatio) && + length(self$lambda1) > 0 && !any(is.na(self$lambda1)) && + length(self$lambda2) > 0 && !any(is.na(self$lambda2))) { + target <- self$lambda2 * self$hazardRatio^(1 / self$kappa) + if (length(self$lambda1) > 0 && !all(is.na(self$lambda1)) && + !isTRUE(all.equal(target, self$lambda1))) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'lambda1' (", .arrayToString(self$lambda1), ") ", + "is not as expected (", .arrayToString(target), ") for given hazard ratio ", self$hazardRatio + ) + } + } + + if (self$piecewiseSurvivalEnabled && !(length(self$lambda1) == 1 && is.na(self$lambda1)) && + length(self$piecewiseSurvivalTime) != length(self$lambda1)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "length of 'piecewiseSurvivalTime' (", length(self$piecewiseSurvivalTime), + ") and length of 'lambda1' (", length(self$lambda1), ") must be equal" + ) + } + } + ) +) + +#' +#' @name AccrualTime +#' +#' @title +#' Accrual Time +#' +#' @description +#' Class for the definition of accrual time and accrual intensity. +#' +#' @template field_endOfAccrualIsUserDefined +#' @template field_followUpTimeMustBeUserDefined +#' @template field_maxNumberOfSubjectsIsUserDefined +#' @template field_maxNumberOfSubjectsCanBeCalculatedDirectly +#' @template field_absoluteAccrualIntensityEnabled +#' @template field_accrualTime +#' @template field_accrualIntensity +#' @template field_accrualIntensityRelative +#' @template field_maxNumberOfSubjects +#' @template field_remainingTime +#' @template field_piecewiseAccrualEnabled +#' +#' @details +#' \code{AccrualTime} is a class for the definition of accrual time and accrual intensity. +#' +#' @include f_core_constants.R +#' @include f_core_utilities.R +#' @include class_core_parameter_set.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +AccrualTimeR6 <- R6Class("AccrualTimeR6", + inherit = TimeDefinitionR6, + public = list( + .showWarnings = NULL, + endOfAccrualIsUserDefined = NULL, + followUpTimeMustBeUserDefined = NULL, + maxNumberOfSubjectsIsUserDefined = NULL, + maxNumberOfSubjectsCanBeCalculatedDirectly = NULL, + absoluteAccrualIntensityEnabled = NULL, + accrualTime = NULL, + accrualIntensity = NULL, + accrualIntensityRelative = NULL, + maxNumberOfSubjects = NULL, + remainingTime = NULL, + piecewiseAccrualEnabled = NULL, + initialize = function(accrualTime = NA_real_, + ..., + accrualIntensity = NA_real_, + maxNumberOfSubjects = NA_real_, + showWarnings = TRUE, + absoluteAccrualIntensityEnabled = NA) { + super$initialize() + self$accrualTime <- accrualTime + self$accrualIntensity <- accrualIntensity + self$maxNumberOfSubjects <- maxNumberOfSubjects + self$.showWarnings <- showWarnings + self$absoluteAccrualIntensityEnabled <- absoluteAccrualIntensityEnabled + + self$endOfAccrualIsUserDefined <- NA + self$followUpTimeMustBeUserDefined <- NA + self$maxNumberOfSubjectsIsUserDefined <- NA + self$maxNumberOfSubjectsCanBeCalculatedDirectly <- TRUE + # absoluteAccrualIntensityEnabled <<- NA + self$.setParameterType("endOfAccrualIsUserDefined", C_PARAM_GENERATED) + self$.setParameterType("followUpTimeMustBeUserDefined", C_PARAM_GENERATED) + self$.setParameterType("maxNumberOfSubjectsIsUserDefined", C_PARAM_GENERATED) + self$.setParameterType("maxNumberOfSubjectsCanBeCalculatedDirectly", C_PARAM_GENERATED) + self$.setParameterType( + "absoluteAccrualIntensityEnabled", + ifelse(is.na(self$absoluteAccrualIntensityEnabled), C_PARAM_GENERATED, C_PARAM_USER_DEFINED) + ) + + self$accrualIntensityRelative <- NA_real_ + self$.setParameterType("accrualIntensityRelative", C_PARAM_NOT_APPLICABLE) + self$remainingTime <- NA_real_ + + self$.init(self$accrualTime) + + # case 6 correction + if (!self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && + !self$absoluteAccrualIntensityEnabled) { + self$remainingTime <- NA_real_ + self$.setParameterType("remainingTime", C_PARAM_NOT_APPLICABLE) + self$accrualTime <- self$accrualTime[1:length(self$accrualIntensity)] + } + + self$.initAccrualIntensityAbsolute() + self$.validateFormula() + self$.showWarningIfCaseIsNotAllowed() + }, + .asDataFrame = function() { + accrualIntensityTemp <- self$accrualIntensity + if (!all(is.na(self$accrualIntensityRelative))) { + accrualIntensityTemp <- self$accrualIntensityRelative + } + if (length(accrualIntensityTemp) + 1 == length(self$accrualTime)) { + accrualIntensityTemp <- c(accrualIntensityTemp, NA_real_) + } + data <- data.frame( + accrualTime = self$accrualTime, + accrualIntensity = accrualIntensityTemp + ) + rownames(data) <- as.character(1:nrow(data)) + colnames(data) <- c( + "Start time", + C_PARAMETER_NAMES["accrualIntensity"] + ) + return(data) + }, + show = function(showType = 1, digits = NA_integer_) { + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + }, + .isAbsoluteAccrualIntensity = function(x) { + return(!self$.isRelativeAccrualIntensity(x)) + }, + .isRelativeAccrualIntensity = function(x) { + return(all(x < 1)) + }, + .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { + "Method for automatically printing accrual time objects" + self$.resetCat() + if (showType == 2) { + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + } else { + self$.cat("Accrual time and intensity:\n", + sep = "", heading = 1, + consoleOutputEnabled = consoleOutputEnabled + ) + if (!self$isAccrualTimeEnabled()) { + self$.cat(" Accrual time is disabled.\n", consoleOutputEnabled = consoleOutputEnabled) + } else if (length(self$accrualTime) == 1) { + self$.cat(" At all times:", self$accrualIntensity[1], "\n", consoleOutputEnabled = consoleOutputEnabled) + } else { + accrualTimeStr <- format(self$accrualTime) + accrualIntensityStr <- format(self$accrualIntensity) + for (i in 1:length(self$accrualTime)) { + prefix <- ifelse(i == length(self$accrualTime) - 1, "<=", " <") + suffix <- "" + if (!self$maxNumberOfSubjectsIsUserDefined) { + suffix <- " " + } + if (i < length(self$accrualTime)) { + self$.cat(" ", accrualTimeStr[i], " - ", prefix, accrualTimeStr[i + 1], suffix, ": ", + accrualIntensityStr[i], "\n", + consoleOutputEnabled = consoleOutputEnabled + ) + } else if (!self$maxNumberOfSubjectsIsUserDefined && !is.na(accrualIntensityStr[i]) && + accrualIntensityStr[i] != "NA") { + self$.cat(" ", accrualTimeStr[i], " - <=[?]: ", + accrualIntensityStr[i], "\n", + consoleOutputEnabled = consoleOutputEnabled + ) + } + } + self$.cat("", consoleOutputEnabled = consoleOutputEnabled) + } + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) + + if (self$isAccrualTimeEnabled()) { + self$.showFormula(consoleOutputEnabled = consoleOutputEnabled) + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) + + self$.showCase(consoleOutputEnabled = consoleOutputEnabled) + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) + } + + self$.cat("Details:\n\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) + self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Generated parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + } + }, + .getFormula = function() { + s <- "" + for (i in 1:length(self$accrualTime)) { + if (i < length(self$accrualTime)) { + s <- paste0( + s, (round(self$accrualTime[i + 1], 4) - round(self$accrualTime[i], 4)), + " * ", round(self$accrualIntensity[i], 4) + ) + if (!self$absoluteAccrualIntensityEnabled && + (!self$maxNumberOfSubjectsIsUserDefined || !self$endOfAccrualIsUserDefined)) { + s <- paste0(s, " * c ") + } + if (i < length(self$accrualIntensity)) { + s <- paste0(s, " + ") + } + } + } + return(s) + }, + .validateFormula = function() { + if (is.na(self$maxNumberOfSubjects) || length(self$accrualTime) != length(self$accrualIntensity) + 1) { + return(invisible()) + } + + numberOfSubjects <- 0 + for (i in 1:length(self$accrualTime)) { + if (i < length(self$accrualTime)) { + numberOfSubjects <- numberOfSubjects + + (self$accrualTime[i + 1] - self$accrualTime[i]) * self$accrualIntensity[i] + } + } + if (!isTRUE(all.equal(numberOfSubjects, self$maxNumberOfSubjects, tolerance = 1e-03)) && + self$absoluteAccrualIntensityEnabled) { + stop( + C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, + "'maxNumberOfSubjects' (", self$maxNumberOfSubjects, ") disagrees with ", + "the defined accrual time and intensity: ", + self$.getFormula(), " = ", numberOfSubjects + ) + } + }, + .showWarningIfCaseIsNotAllowed = function() { + caseIsAllowed <- TRUE + if (!self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && + !self$absoluteAccrualIntensityEnabled) { + caseIsAllowed <- FALSE + } else if (!self$endOfAccrualIsUserDefined && !self$maxNumberOfSubjectsIsUserDefined && + self$followUpTimeMustBeUserDefined && !self$absoluteAccrualIntensityEnabled) { + caseIsAllowed <- FALSE + } + if (!caseIsAllowed) { + warning("The specified accrual time and intensity cannot be ", + "supplemented automatically with the missing information; ", + "therefore further calculations are not possible", + call. = FALSE + ) + } + }, + .showFormula = function(consoleOutputEnabled) { + self$.cat("Formula:\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" ", consoleOutputEnabled = consoleOutputEnabled) + self$.cat("maxNumberOfSubjects = ", consoleOutputEnabled = consoleOutputEnabled) + if (!is.na(self$maxNumberOfSubjects)) { + self$.cat(self$maxNumberOfSubjects, " = ", consoleOutputEnabled = consoleOutputEnabled) + } + self$.cat(self$.getFormula(), consoleOutputEnabled = consoleOutputEnabled) + if (length(self$accrualTime) == length(self$accrualIntensity)) { + self$.cat("(x - ", self$accrualTime[length(self$accrualTime)], ") * ", + self$accrualIntensity[length(self$accrualIntensity)], + consoleOutputEnabled = consoleOutputEnabled + ) + if (!self$absoluteAccrualIntensityEnabled && + (!self$maxNumberOfSubjectsIsUserDefined || !self$endOfAccrualIsUserDefined)) { + self$.cat(" * c ", consoleOutputEnabled = consoleOutputEnabled) + } + self$.cat(", where 'x' is the unknown last accrual time", + consoleOutputEnabled = consoleOutputEnabled + ) + if (!self$absoluteAccrualIntensityEnabled && + (!self$maxNumberOfSubjectsIsUserDefined || !self$endOfAccrualIsUserDefined)) { + self$.cat(" and 'c' a constant factor", consoleOutputEnabled = consoleOutputEnabled) + } + } else if (!self$absoluteAccrualIntensityEnabled && + (!self$maxNumberOfSubjectsIsUserDefined || !self$endOfAccrualIsUserDefined)) { + self$.cat(", where 'c' is a constant factor", consoleOutputEnabled = consoleOutputEnabled) + } + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) + }, + .showCase = function(consoleOutputEnabled = TRUE) { + caseIsAllowed <- TRUE + + prefix <- " " + + # Case 1 + # example: getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(22, 33), + # maxNumberOfSubjects = 1000) + if (self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && + self$absoluteAccrualIntensityEnabled) { + self$.cat("Case (#1):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(prefix, "End of accrual, absolute accrual intensity and 'maxNumberOfSubjects' are given, ", + " 'followUpTime'** shall be calculated.\n", + consoleOutputEnabled = consoleOutputEnabled + ) + self$.cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6, 30), ", + "accrualIntensity = c(22, 33), maxNumberOfSubjects = 924)\n", + consoleOutputEnabled = consoleOutputEnabled + ) + } + + # Case 2 + # example: getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(0.22, 0.33), + # maxNumberOfSubjects = 1000) + else if (self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && + !self$absoluteAccrualIntensityEnabled) { + self$.cat("Case (#2):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(prefix, "End of accrual, relative accrual intensity and 'maxNumberOfSubjects' are given, ", + "absolute accrual intensity* and 'followUpTime'** shall be calculated.\n", + consoleOutputEnabled = consoleOutputEnabled + ) + self$.cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6, 30), ", + "accrualIntensity = c(0.22, 0.33), maxNumberOfSubjects = 1000)\n", + consoleOutputEnabled = consoleOutputEnabled + ) + } + + # Case 3 + # example: getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(22, 33)) + else if (self$endOfAccrualIsUserDefined && !self$maxNumberOfSubjectsIsUserDefined && + self$absoluteAccrualIntensityEnabled) { + self$.cat("Case (#3):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(prefix, "End of accrual and absolute accrual intensity are given, ", + "'maxNumberOfSubjects'* and 'followUpTime'** shall be calculated.\n", + consoleOutputEnabled = consoleOutputEnabled + ) + self$.cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(22, 33))\n", + consoleOutputEnabled = consoleOutputEnabled + ) + } + + # Case 4 + # example: getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(0.22, 0.33)) + else if (self$endOfAccrualIsUserDefined && !self$maxNumberOfSubjectsIsUserDefined && + !self$absoluteAccrualIntensityEnabled) { + self$.cat("Case (#4):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(prefix, "End of accrual, relative accrual intensity and 'followUpTime' are given, ", + "absolute accrual intensity** and 'maxNumberOfSubjects'** shall be calculated.\n", + consoleOutputEnabled = consoleOutputEnabled + ) + self$.cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(0.22, 0.33))\n", + consoleOutputEnabled = consoleOutputEnabled + ) + } + + # Case 5 + # example: getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(22, 33), + # maxNumberOfSubjects = 1000) + else if (!self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && + self$absoluteAccrualIntensityEnabled) { + self$.cat("Case (#5):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(prefix, "'maxNumberOfSubjects' and absolute accrual intensity are given, ", + "end of accrual* and 'followUpTime'** shall be calculated\n", + consoleOutputEnabled = consoleOutputEnabled + ) + self$.cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6), ", + "accrualIntensity = c(22, 33), maxNumberOfSubjects = 1000)\n", + consoleOutputEnabled = consoleOutputEnabled + ) + } + + # Case 6 + # example: getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(0.22, 0.33), + # maxNumberOfSubjects = 1000) + else if (!self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && + !self$absoluteAccrualIntensityEnabled) { + caseIsAllowed <- FALSE + self$.cat("Case (#6):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(prefix, "'maxNumberOfSubjects' and relative accrual intensity are given, ", + "absolute accrual intensity@, end of accrual* and 'followUpTime'** shall be calculated\n", + consoleOutputEnabled = consoleOutputEnabled + ) + self$.cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6), ", + "accrualIntensity = c(0.22, 0.33), maxNumberOfSubjects = 1000)\n", + consoleOutputEnabled = consoleOutputEnabled + ) + } + + # Case 7 + # example: getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(22, 33)) + else if (!self$endOfAccrualIsUserDefined && !self$maxNumberOfSubjectsIsUserDefined && + self$followUpTimeMustBeUserDefined && self$absoluteAccrualIntensityEnabled) { + self$.cat("Case (#7):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(prefix, "'followUpTime' and absolute accrual intensity are given, ", + "end of accrual** and 'maxNumberOfSubjects'** shall be calculated\n", + consoleOutputEnabled = consoleOutputEnabled + ) + self$.cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(22, 33))\n", + consoleOutputEnabled = consoleOutputEnabled + ) + } + + # Case 8 + # example: getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(0.22, 0.33)) + else if (!self$endOfAccrualIsUserDefined && !self$maxNumberOfSubjectsIsUserDefined && + self$followUpTimeMustBeUserDefined && !self$absoluteAccrualIntensityEnabled) { + caseIsAllowed <- FALSE + self$.cat("Case (#8):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(prefix, "'followUpTime' and relative accrual intensity are given, ", + "absolute accrual intensity@, end of accrual and 'maxNumberOfSubjects' shall be calculated\n", + consoleOutputEnabled = consoleOutputEnabled + ) + self$.cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(0.22, 0.33))\n", + consoleOutputEnabled = consoleOutputEnabled + ) + } + + # .cat("\n", consoleOutputEnabled = consoleOutputEnabled) + if (!caseIsAllowed) { + self$.cat(prefix, "(@) Cannot be calculated.\n", + consoleOutputEnabled = consoleOutputEnabled + ) + } + self$.cat(prefix, "(*) Can be calculated directly.\n", + consoleOutputEnabled = consoleOutputEnabled + ) + self$.cat(prefix, "(**) Cannot be calculated directly but with ", + "'getSampleSizeSurvival()' or 'getPowerSurvival()'.\n", + consoleOutputEnabled = consoleOutputEnabled + ) + }, + .followUpTimeShallBeCalculated = function() { + # Case 1: 'followUpTime'** shall be calculated + if (self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && + self$absoluteAccrualIntensityEnabled) { + return(TRUE) + } + + # Case 2: 'followUpTime'** shall be calculated + else if (self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && + !self$absoluteAccrualIntensityEnabled) { + return(TRUE) + } + + # Case 3: 'followUpTime'** shall be calculated + else if (self$endOfAccrualIsUserDefined && !self$maxNumberOfSubjectsIsUserDefined && + self$absoluteAccrualIntensityEnabled) { + return(TRUE) + } + + + # Case 5: 'followUpTime'** shall be calculated + else if (!self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && + self$absoluteAccrualIntensityEnabled) { + return(TRUE) + } + + # Case 6: 'followUpTime'** shall be calculated + else if (!self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && + !self$absoluteAccrualIntensityEnabled) { + return(TRUE) + } + + # (**) Cannot be calculated directly but with 'getSampleSizeSurvival()' or 'getPowerSurvival()' + + return(FALSE) + }, + .validate = function() { + # Case 6 + if (!self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && + !self$absoluteAccrualIntensityEnabled) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "the calculation of 'followUpTime' for given 'maxNumberOfSubjects' ", + "and relative accrual intensities (< 1) ", + "can only be done if end of accrual is defined" + ) + } + + # Case 8 + else if (!self$endOfAccrualIsUserDefined && !self$maxNumberOfSubjectsIsUserDefined && + self$followUpTimeMustBeUserDefined && !self$absoluteAccrualIntensityEnabled) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "the calculation of 'maxNumberOfSubjects' for given 'followUpTime' ", + "and relative accrual intensities (< 1) ", + "can only be done if end of accrual is defined" + ) + } + }, + .toString = function(startWithUpperCase = FALSE) { + s <- "accrual time" + return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) + }, + .getAccrualTimeWithoutLeadingZero = function() { + if (length(self$accrualTime) <= 1) { + return(NA_real_) + } + + return(self$accrualTime[2:length(self$accrualTime)]) + }, + isAccrualTimeEnabled = function() { + if (length(self$accrualTime) == 0) { + return(FALSE) + } + + if (length(self$accrualTime) == 1 && is.na(self$accrualTime)) { + return(FALSE) + } + + return(TRUE) + }, + .initFromList = function(accrualTimeList) { + if (!is.list(accrualTimeList)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'accrualTime' must be a list") + } + + if (length(accrualTimeList) == 0) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'accrualTime' must contain at least one entry") + } + + if (is.null(names(accrualTimeList))) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'accrualTime' must be a named list where the names specify ", + "the time regions and the values the accrual time" + ) + } + + if (self$.showWarnings && !all(is.na(self$accrualIntensity)) && (length(self$accrualIntensity) != 1 || + self$accrualIntensity != C_ACCRUAL_INTENSITY_DEFAULT)) { + warning("'accrualIntensity' (", .arrayToString(self$accrualIntensity), + ") will be ignored because 'accrualTime' is a list", + call. = FALSE + ) + } + + self$accrualTime <- numeric(0) + self$accrualIntensity <- numeric(0) + timeRegions <- names(accrualTimeList) + endOfAccrualIsUndefined <- FALSE + self$accrualTime <- c(self$accrualTime, 0) + for (i in 1:length(timeRegions)) { + timePeriod <- timeRegions[i] + accrualTimeValue <- accrualTimeList[[timePeriod]] + .assertIsSingleNumber(accrualTimeValue, paste0("accrualTime[", i, "]")) + + settings <- self$.validateTimePeriod(timePeriod, i = i, n = length(timeRegions), accrualTimeMode = TRUE) + timePeriod <- settings$timePeriod + endOfAccrualIsUndefined <- settings$endOfAccrualIsUndefined + + if (i < length(timeRegions)) { + parts <- strsplit(timePeriod, "- *(< *)?", perl = TRUE)[[1]] + if (length(parts) != 2) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "all regions (", timePeriod, ") must have the format ", + "\"time_1 - = 2 && length(self$accrualTime) == length(self$accrualIntensity) + 1 && + !any(is.na(self$accrualTime)) && !any(is.na(self$accrualIntensity))) { + len <- length(self$accrualIntensity) + accrualIntensityAbsolute <- self$maxNumberOfSubjects / sum((self$accrualTime[2:(len + 1)] - + self$accrualTime[1:len]) * self$accrualIntensity) * self$accrualIntensity + if (!isTRUE(all.equal(accrualIntensityAbsolute, self$accrualIntensity, tolerance = 1e-06)) && + !isTRUE(all.equal(accrualIntensityAbsolute, 0, tolerance = 1e-06))) { + self$.validateAccrualTimeAndIntensity() + + if (self$absoluteAccrualIntensityEnabled && + self$.getParameterType("maxNumberOfSubjects") == C_PARAM_USER_DEFINED) { + if (self$.getParameterType("accrualTime") == C_PARAM_DEFAULT_VALUE) { + self$accrualTime <- self$maxNumberOfSubjects / self$accrualIntensity + self$.setParameterType("accrualTime", C_PARAM_GENERATED) + self$remainingTime <- self$accrualTime + self$accrualTime <- c(0, self$accrualTime) + } else { + stop( + C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, + "'maxNumberOfSubjects' (", self$maxNumberOfSubjects, ") disagrees with ", + "the defined accrual time (", .arrayToString(self$accrualTime), ") and intensity: ", + self$.getFormula(), " = ", self$.getSampleSize() + ) + } + } else { + if (!self$absoluteAccrualIntensityEnabled && # .isRelativeAccrualIntensity(accrualIntensity) + self$.getParameterType("accrualIntensity") == C_PARAM_USER_DEFINED && + self$.getParameterType("accrualTime") == C_PARAM_DEFAULT_VALUE && + self$.getParameterType("maxNumberOfSubjects") == C_PARAM_USER_DEFINED) { + if (self$.showWarnings) { + warning("'accrualIntensity' (", self$accrualIntensity, ") will be ignored", call. = FALSE) + } + self$accrualIntensityRelative <- C_ACCRUAL_INTENSITY_DEFAULT + self$accrualIntensity <- accrualIntensityAbsolute + self$.setParameterType("accrualIntensity", C_PARAM_GENERATED) + self$.setParameterType("remainingTime", C_PARAM_NOT_APPLICABLE) + } else { + self$accrualIntensityRelative <- self$accrualIntensity + self$accrualIntensity <- accrualIntensityAbsolute + self$.setParameterType("accrualIntensity", C_PARAM_GENERATED) + self$.setParameterType("accrualIntensityRelative", C_PARAM_USER_DEFINED) + } + } + } + } + }, + .isNoPiecewiseAccrualTime = function(accrualTimeArg) { + if (length(accrualTimeArg) == 0 || any(is.na(accrualTimeArg)) || + !all(is.numeric(accrualTimeArg))) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'accrualTimeArg' must a be valid numeric vector") + } + + if (length(accrualTimeArg) == 1) { + return(TRUE) + } + + if (length(accrualTimeArg) == 2 && accrualTimeArg[1] == 0) { + return(TRUE) + } + + return(FALSE) + }, + .init = function(accrualTimeArg) { + if (length(accrualTimeArg) == 0) { + stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'accrualTime' must be defined") + } + + if (length(accrualTimeArg) == 1 && is.numeric(accrualTimeArg) && is.na(accrualTimeArg)) { + accrualTimeArg <- C_ACCRUAL_TIME_DEFAULT + } + + calculateLastAccrualTimeEnabled <- FALSE + if (is.list(accrualTimeArg)) { + endOfAccrualIsUndefined <- self$.initFromList(accrualTimeArg) + calculateLastAccrualTimeEnabled <- endOfAccrualIsUndefined && + !is.null(self$maxNumberOfSubjects) && length(self$maxNumberOfSubjects) == 1 && + !is.na(self$maxNumberOfSubjects) + } else if (is.numeric(accrualTimeArg)) { + .assertIsNumericVector(accrualTimeArg, "accrualTime") + if (length(self$accrualIntensity) > 1) { + .assertIsNumericVector(self$accrualIntensity, "accrualIntensity") + } + + if (self$.isNoPiecewiseAccrualTime(accrualTimeArg) && + (length(self$accrualIntensity) == 0 || is.null(self$accrualIntensity) || + all(is.na(self$accrualIntensity)) || + all(self$accrualIntensity == C_ACCRUAL_INTENSITY_DEFAULT))) { + accrualTimeArg <- accrualTimeArg[length(accrualTimeArg)] + self$accrualTime <- c(0L, accrualTimeArg) + self$.setParameterType("accrualTime", ifelse( + identical(as.integer(self$accrualTime), C_ACCRUAL_TIME_DEFAULT), + C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + + self$accrualIntensity <- C_ACCRUAL_INTENSITY_DEFAULT + self$.setParameterType("accrualIntensity", C_PARAM_DEFAULT_VALUE) + + self$.setParameterType( + "maxNumberOfSubjects", + ifelse(length(self$maxNumberOfSubjects) == 1 && is.na(self$maxNumberOfSubjects), + C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + ) + ) + + self$endOfAccrualIsUserDefined <- length(self$accrualTime) == length(self$accrualIntensity) + 1 + self$maxNumberOfSubjectsIsUserDefined <- + self$.getParameterType("maxNumberOfSubjects") == C_PARAM_USER_DEFINED + self$followUpTimeMustBeUserDefined <- !self$endOfAccrualIsUserDefined && + !self$maxNumberOfSubjectsIsUserDefined + self$absoluteAccrualIntensityEnabled <- FALSE + + if (self$maxNumberOfSubjectsIsUserDefined) { + self$accrualIntensity <- self$maxNumberOfSubjects / self$accrualTime[length(self$accrualTime)] + self$.setParameterType("accrualIntensity", C_PARAM_GENERATED) + } + + return(invisible()) + } + + self$accrualTime <- accrualTimeArg + if (length(self$accrualTime) == 0) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'accrualTime' must contain at least one time value" + ) + } + + if (self$accrualTime[1] != 0) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "the first value of 'accrualTime' (", .arrayToString(self$accrualTime), ") must be 0" + ) + } + + self$.setParameterType("accrualTime", ifelse( + identical(as.integer(self$accrualTime), C_ACCRUAL_TIME_DEFAULT), + C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + self$.setParameterType("accrualIntensity", C_PARAM_USER_DEFINED) + } else { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'accrualTime' must be a list or a numeric vector") + } + + if (is.na(self$absoluteAccrualIntensityEnabled)) { + self$absoluteAccrualIntensityEnabled <- self$.isAbsoluteAccrualIntensity(self$accrualIntensity) + } + if (is.null(self$maxNumberOfSubjects) || length(self$maxNumberOfSubjects) == 0 || + any(is.na(self$maxNumberOfSubjects))) { + if (length(self$accrualTime) != length(self$accrualIntensity) + 1 || + !self$absoluteAccrualIntensityEnabled) { + self$maxNumberOfSubjectsCanBeCalculatedDirectly <- FALSE + } + + self$.setParameterType("maxNumberOfSubjects", C_PARAM_NOT_APPLICABLE) + } else { + if (!(length(self$accrualTime) %in% c( + length(self$accrualIntensity), + length(self$accrualIntensity) + 1 + ))) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "length of 'accrualTime' (", length(self$accrualTime), + ") must be equal to length of 'accrualIntensity' if the last 'accrualTime' ", + "shall be calculated ", + "based on 'maxNumberOfSubjects' or length of 'accrualIntensity' (", + length(self$accrualIntensity), ") + 1 otherwise" + ) + } + if (length(self$accrualTime) == length(self$accrualIntensity)) { + calculateLastAccrualTimeEnabled <- TRUE + } + + self$.setParameterType("maxNumberOfSubjects", C_PARAM_USER_DEFINED) + } + + self$endOfAccrualIsUserDefined <- length(self$accrualTime) == length(self$accrualIntensity) + 1 + + if (calculateLastAccrualTimeEnabled) { + self$.calculateRemainingTime() + } else if (self$maxNumberOfSubjectsCanBeCalculatedDirectly) { + if (length(self$accrualTime) == 1) { + if (length(self$maxNumberOfSubjects) > 0 && !is.na(self$maxNumberOfSubjects) && + self$maxNumberOfSubjects > 0 && self$maxNumberOfSubjects < self$accrualIntensity[1]) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'maxNumberOfSubjects' (", self$maxNumberOfSubjects, ") ", + "must be >= ", self$accrualIntensity[1], " ('accrualIntensity')" + ) + } + self$remainingTime <- self$accrualTime + self$.setParameterType("remainingTime", C_PARAM_USER_DEFINED) + } else if (length(self$accrualTime) > 1) { + sampleSize <- self$.getSampleSize() + if (!isTRUE(all.equal(sampleSize, self$maxNumberOfSubjects, tolerance = 1e-04))) { + if (length(self$maxNumberOfSubjects) == 1 && !is.na(self$maxNumberOfSubjects) && + self$maxNumberOfSubjects > 0 && self$maxNumberOfSubjects < sampleSize) { + if (length(self$accrualIntensity) == 1 && length(self$accrualTime) == 1) { + self$.setParameterType("maxNumberOfSubjects", C_PARAM_USER_DEFINED) + self$accrualTime <- 0 + self$.calculateRemainingTime() + } else { + if (length(self$accrualTime) == length(self$accrualIntensity) + 1 && + self$absoluteAccrualIntensityEnabled) { + stop( + C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, + "'maxNumberOfSubjects' (", self$maxNumberOfSubjects, ") disagrees with ", + "the defined accrual time and intensity: ", + self$.getFormula(), " = ", sampleSize + ) + } else { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'maxNumberOfSubjects' (", + self$maxNumberOfSubjects, ") ", "must be >= ", sampleSize + ) + } + } + } else { + if ((length(self$maxNumberOfSubjects) != 1 || is.na(self$maxNumberOfSubjects)) && + self$absoluteAccrualIntensityEnabled) { + self$maxNumberOfSubjects <- sampleSize + self$.setParameterType("maxNumberOfSubjects", C_PARAM_GENERATED) + } + self$remainingTime <- self$accrualTime[length(self$accrualTime)] - self$accrualTime[length(self$accrualTime) - 1] + self$.setParameterType( + "remainingTime", + ifelse(!isTRUE(all.equal(0, self$remainingTime, tolerance = 1e-06)), + C_PARAM_GENERATED, C_PARAM_NOT_APPLICABLE + ) + ) + } + } + } + } + + self$.validateInitialization() + + self$maxNumberOfSubjectsIsUserDefined <- self$.getParameterType("maxNumberOfSubjects") == C_PARAM_USER_DEFINED + self$followUpTimeMustBeUserDefined <- !self$endOfAccrualIsUserDefined && !self$maxNumberOfSubjectsIsUserDefined + }, + .getSampleSize = function() { + if (length(self$accrualTime) < 2) { + return(0) + } + + sampleSize <- 0 + for (i in 2:length(self$accrualTime)) { + time <- self$accrualTime[i] - self$accrualTime[i - 1] + sampleSize <- sampleSize + time * self$accrualIntensity[i - 1] + } + return(sampleSize) + }, + .getValuesAfterDecimalPoint = function(x) { + values <- c() + for (value in x) { + baseLevel <- value - floor(value) + if (baseLevel == 0) { + baseLevel <- 1 + } + values <- c(values, baseLevel) + } + return(values) + }, + .getBaseLevel = function(x) { + return(min(self$.getValuesAfterDecimalPoint(x[x > 0]))) + }, + .calcSampleSize = function() { + if (length(self$accrualTime) <= 1) { + return(0) + } + + accrualTimeTemp <- self$accrualTime + accrualIntensityTemp <- self$accrualIntensity + + sampleSize <- 0 + for (i in 2:length(self$accrualTime)) { + time <- self$accrualTime[i] - self$accrualTime[i - 1] + sampleSize <- sampleSize + time * self$accrualIntensity[i - 1] + if (sampleSize >= self$maxNumberOfSubjects && + length(self$accrualTime) == length(self$accrualIntensity)) { + if (sampleSize > self$maxNumberOfSubjects) { + self$accrualTime <- self$accrualTime[1:(i - 1)] + } + + i2 <- i + if (length(self$accrualTime) == length(self$accrualIntensity) + 1) { + i2 <- i - 1 + } + self$accrualIntensity <- self$accrualIntensity[1:(i2 - 1)] + + while (length(self$accrualTime) > length(self$accrualIntensity) + 1) { + self$accrualTime <- self$accrualTime[1:(length(self$accrualTime) - 1)] + } + + sampleSize <- 0 + if (length(self$accrualTime) > 1) { + sampleSize <- self$.getSampleSize() + } + + if (self$.showWarnings) { + n1 <- length(accrualTimeTemp) - length(self$accrualTime) + n2 <- length(accrualIntensityTemp) - length(self$accrualIntensity) + + if (n1 == 1) { + warning("Last accrual time value (", + accrualTimeTemp[length(accrualTimeTemp)], ") ignored", + call. = FALSE + ) + } else if (n1 > 1) { + warning("Last ", n1, " accrual time values (", + .arrayToString(accrualTimeTemp[(length(accrualTimeTemp) - n1 + 1):length(accrualTimeTemp)]), + ") ignored", + call. = FALSE + ) + } + + if (n2 == 1) { + warning("Last accrual intensity value (", + accrualIntensityTemp[length(accrualIntensityTemp)], ") ignored", + call. = FALSE + ) + } else if (n2 > 1) { + warning("Last ", n2, " accrual intensity values (", + .arrayToString(accrualIntensityTemp[i2:length(accrualIntensityTemp)]), + ") ignored", + call. = FALSE + ) + } + } + + return(sampleSize) + } + } + return(sampleSize) + }, + .calculateRemainingTime = function(stopInCaseOfError = TRUE) { + .assertIsValidMaxNumberOfSubjects(self$maxNumberOfSubjects) + + sampleSize <- self$.calcSampleSize() + remainingSubjects <- self$maxNumberOfSubjects - sampleSize + if (remainingSubjects < 0) { + if (!stopInCaseOfError) { + return(invisible()) + } + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'maxNumberOfSubjects' (", self$maxNumberOfSubjects, ") ", + "is too small for the defined accrual time (minimum = ", sampleSize, ")" + ) + } + + lastAccrualIntensity <- self$accrualIntensity[length(self$accrualIntensity)] + self$remainingTime <- remainingSubjects / lastAccrualIntensity + self$.setParameterType( + "remainingTime", + ifelse(!isTRUE(all.equal(0, self$remainingTime, tolerance = 1e-06)), + C_PARAM_GENERATED, C_PARAM_NOT_APPLICABLE + ) + ) + if (length(self$accrualTime) == length(self$accrualIntensity)) { + self$accrualTime <- c(self$accrualTime, self$accrualTime[length(self$accrualTime)] + self$remainingTime) + } + # .setParameterType("accrualTime", C_PARAM_GENERATED) + if (any(self$accrualTime < 0)) { + if (!stopInCaseOfError) { + return(invisible()) + } + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'maxNumberOfSubjects' (", self$maxNumberOfSubjects, ") ", + "is too small for the defined accrual time" + ) + } + }, + .validateAccrualTimeAndIntensity = function() { + if ((length(self$accrualTime) >= 2 && any(self$accrualTime[2:length(self$accrualTime)] < 0))) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'accrualTime' (", .arrayToString(self$accrualTime), ") must be > 0" + ) + } + + .assertValuesAreStrictlyIncreasing(self$accrualTime, "accrualTime") + + if ((length(self$accrualTime) > 1) && any(self$accrualIntensity < 0)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'accrualIntensity' (", .arrayToString(self$accrualIntensity), ") must be >= 0" + ) + } + + if (length(self$accrualIntensity) == 1 && !is.na(self$accrualIntensity) && + self$accrualIntensity == 0) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "at least one 'accrualIntensity' value must be > 0" + ) + } + + if (length(self$accrualIntensity) > 0 && self$accrualIntensity[1] == 0) { + warning( + "It makes no sense to start 'accrualIntensity' (", + .arrayToString(self$accrualIntensity), ") with 0" + ) + } + }, + .validateInitialization = function() { + self$.validateAccrualTimeAndIntensity() + + self$piecewiseAccrualEnabled <- !self$.isNoPiecewiseAccrualTime(self$accrualTime) + } + ) +) diff --git a/R/f_analysis_base.R b/R/f_analysis_base.R index 3571aea3..ae88f5d0 100644 --- a/R/f_analysis_base.R +++ b/R/f_analysis_base.R @@ -28,15 +28,15 @@ NULL stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, sQuote("dataInput"), " must be specified") } - if (missing(dataInput) && !missing(design) && inherits(design, "Dataset")) { + if (missing(dataInput) && !missing(design) && (inherits(design, "Dataset") || inherits(design, "DatasetR6"))) { dataInput <- design - if (!is.null(dataInput$.design) && inherits(dataInput$.design, "TrialDesign")) { + if (!is.null(dataInput$.design) && (inherits(dataInput$.design, "TrialDesign") || inherits(dataInput$.design, "TrialDesignR6"))) { design <- dataInput$.design } else { design <- .getDefaultDesign(..., type = "analysis") } } else if (!missing(dataInput) && missing(design)) { - if (!is.null(dataInput$.design) && inherits(dataInput$.design, "TrialDesign")) { + if (!is.null(dataInput$.design) && (inherits(dataInput$.design, "TrialDesign") || inherits(dataInput$.design, "TrialDesignR6"))) { design <- dataInput$.design } else { design <- .getDefaultDesign(..., type = "analysis") @@ -50,7 +50,7 @@ NULL return(list( design = design, - dataInput = dataInput$copy(shallow = FALSE) + dataInput = dataInput$clone(deep=TRUE)#TODO was $copy shallow )) } diff --git a/R/f_core_assertions.R b/R/f_core_assertions.R index 5d1cfaa7..84f99389 100644 --- a/R/f_core_assertions.R +++ b/R/f_core_assertions.R @@ -197,7 +197,7 @@ NULL } .isSimulationResults <- function(simulationResults) { - return(inherits(simulationResults, "SimulationResults")) + return(inherits(simulationResults, "SimulationResults") || inherits(simulationResults, "SimulationResultsR6")) } .assertIsSimulationResults <- function(simulationResults) { @@ -447,15 +447,15 @@ NULL } .isDatasetMeans <- function(dataInput) { - return(inherits(dataInput, "DatasetMeans")) + return(inherits(dataInput, "DatasetMeans") || inherits(dataInput, "DatasetMeansR6")) } .isDatasetRates <- function(dataInput) { - return(inherits(dataInput, "DatasetRates")) + return(inherits(dataInput, "DatasetRates") || inherits(dataInput, "DatasetRatesR6")) } .isDatasetSurvival <- function(dataInput) { - return(inherits(dataInput, "DatasetSurvival") || inherits(dataInput, "DatasetEnrichmentSurvival")) + return(inherits(dataInput, "DatasetSurvival") || inherits(dataInput, "DatasetSurvivalR6") || inherits(dataInput, "DatasetEnrichmentSurvival") || inherits(dataInput, "DatasetEnrichmentSurvivalR6")) } .assertIsNumericVector <- function(x, argumentName, ..., naAllowed = FALSE, noDefaultAvailable = FALSE, call. = TRUE) { @@ -2146,7 +2146,7 @@ NULL } .isMultiArmDataset <- function(dataInput) { - return(inherits(dataInput, "Dataset") && dataInput$getNumberOfGroups() > 2) + return((inherits(dataInput, "Dataset") || inherits(dataInput, "DatasetR6")) && dataInput$getNumberOfGroups() > 2) } .isMultiArmStageResults <- function(stageResults) { @@ -2171,7 +2171,7 @@ NULL } .isEnrichmentDataset <- function(dataInput) { - return(inherits(dataInput, "Dataset") && dataInput$.enrichmentEnabled) + return((inherits(dataInput, "Dataset") || inherits(dataInput, "DatasetR6")) && dataInput$.enrichmentEnabled) } .isEnrichmentAnalysisResults <- function(analysisResults) { @@ -2179,11 +2179,11 @@ NULL } .isMultiArmSimulationResults <- function(simulationResults) { - return(inherits(simulationResults, "SimulationResults") && grepl("MultiArm", .getClassName(simulationResults))) + return((inherits(simulationResults, "SimulationResults") || inherits(simulationResults, "SimulationResultsR6")) && grepl("MultiArm", .getClassName(simulationResults))) } .isEnrichmentSimulationResults <- function(simulationResults) { - return(inherits(simulationResults, "SimulationResults") && grepl("Enrichment", .getClassName(simulationResults))) + return((inherits(simulationResults, "SimulationResults") || inherits(simulationResults, "SimulationResultsR6")) && grepl("Enrichment", .getClassName(simulationResults))) } .assertIsStageResultsMultiArm <- function(stageResults) { diff --git a/R/f_core_constants.R b/R/f_core_constants.R index be29bb3f..ca96ac42 100644 --- a/R/f_core_constants.R +++ b/R/f_core_constants.R @@ -1060,7 +1060,7 @@ C_TABLE_COLUMN_NAMES <- list( if (!is.null(designPlan) && ((inherits(designPlan, "TrialDesignPlanMeans") || inherits(designPlan, "TrialDesignPlanMeansR6")) || - inherits(designPlan, "SimulationResultsMeans")) && + (inherits(designPlan, "SimulationResultsMeans") || inherits(designPlan, "SimulationResultsMeansR6"))) && isTRUE(designPlan$meanRatio)) { parameterNames$stDev <- "Coefficient of variation" } diff --git a/R/f_core_plot.R b/R/f_core_plot.R index 9dec7e8d..599bc86c 100644 --- a/R/f_core_plot.R +++ b/R/f_core_plot.R @@ -76,11 +76,11 @@ NULL "Rejected Populations per Stage", "Rejected Populations" ), type, numberInCaptionEnabled)) } - } else if (inherits(obj, "SimulationResults") && type == 4) { + } else if ((inherits(obj, "SimulationResults") || inherits(obj, "SimulationResultsR6")) && type == 4) { return(.addNumberToPlotCaption("Reject per Stage", type, numberInCaptionEnabled)) } - if (inherits(obj, "TrialDesignPlan") || inherits(obj, "TrialDesignPlanR6") || inherits(obj, "SimulationResults")) { + if (inherits(obj, "TrialDesignPlan") || inherits(obj, "TrialDesignPlanR6") || inherits(obj, "SimulationResults") || inherits(obj, "SimulationResultsR6")) { if (type == 5) { if (obj$.isSampleSizeObject()) { return(.addNumberToPlotCaption("Sample Size", type, numberInCaptionEnabled)) @@ -92,7 +92,7 @@ NULL } } else if (type == 6) { return(.addNumberToPlotCaption(ifelse(.isTrialDesignPlanSurvival(obj) || - inherits(obj, "SimulationResultsSurvival"), + inherits(obj, "SimulationResultsSurvival") || inherits(obj, "SimulationResultsSurvivalR6"), "Number of Events", "Sample Size" ), type, numberInCaptionEnabled)) } else if (type == 7) { @@ -101,7 +101,7 @@ NULL return(.addNumberToPlotCaption("Overall Early Stopping", type, numberInCaptionEnabled)) } else if (type == 9) { if (.isTrialDesignPlanSurvival(obj) || - inherits(obj, "SimulationResultsSurvival")) { + inherits(obj, "SimulationResultsSurvival") || inherits(obj, "SimulationResultsSurvivalR6")) { return(.addNumberToPlotCaption("Expected Number of Events", type, numberInCaptionEnabled)) } else { return(.addNumberToPlotCaption("Expected Sample Size", type, numberInCaptionEnabled)) @@ -138,7 +138,7 @@ NULL } else if (type == 9) { return(.addNumberToPlotCaption("Average Sample Size", type, numberInCaptionEnabled)) } - } else if (inherits(obj, "AnalysisResults")) { + } else if (inherits(obj, "AnalysisResults") || inherits(obj, "AnalysisResultsR6")) { if (type == 1) { return(.addNumberToPlotCaption(C_PLOT_MAIN_CONDITIONAL_POWER_WITH_LIKELIHOOD, type, numberInCaptionEnabled)) } else if (type == 2) { @@ -415,7 +415,7 @@ getAvailablePlotTypes <- function(obj, output = c("numeric", "caption", "numcap" } } types <- .removeInvalidPlotTypes(obj, types, c(5:14)) - } else if (inherits(obj, "SimulationResults")) { + } else if (inherits(obj, "SimulationResults") || inherits(obj, "SimulationResultsR6")) { if (grepl("Enrichment", .getClassName(obj)) && !.getSimulationEnrichmentEffectData( obj, validatePlotCapability = FALSE @@ -446,7 +446,7 @@ getAvailablePlotTypes <- function(obj, output = c("numeric", "caption", "numcap" if (!grepl("MultiArm", .getClassName(obj)) || obj$.design$kMax > 1) { types <- c(types, 9) } - if (inherits(obj, "SimulationResultsSurvival")) { + if (inherits(obj, "SimulationResultsSurvival") || inherits(obj, "SimulationResultsSurvivalR6")) { types <- c(types, 10:14) } plotTypesToCheck <- c(4:14) diff --git a/R/f_design_group_sequential.R b/R/f_design_group_sequential.R index 3f46591f..53987f6c 100644 --- a/R/f_design_group_sequential.R +++ b/R/f_design_group_sequential.R @@ -2115,7 +2115,7 @@ getPowerAndAverageSampleNumber <- function(design, theta = seq(-1, 1, 0.02), nMa .assertIsTrialDesign(design) .assertIsSingleNumber(nMax, "nMax") .assertIsInClosedInterval(nMax, "nMax", lower = 1, upper = NULL) - return(PowerAndAverageSampleNumberResult(design = design, theta = theta, nMax = nMax)) + return(PowerAndAverageSampleNumberResultR6$new(design = design, theta = theta, nMax = nMax)) } .getSimulatedRejectionsDelayedResponse <- function(delta, informationRates, delayedInformation, diff --git a/R/f_design_sample_size_calculator.R b/R/f_design_sample_size_calculator.R index cf229530..3e784d50 100644 --- a/R/f_design_sample_size_calculator.R +++ b/R/f_design_sample_size_calculator.R @@ -2936,7 +2936,7 @@ getEventProbabilities <- function(time, ..., stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all rates (lambda2) must be > 0") } - eventProbabilities <- EventProbabilities( + eventProbabilities <- EventProbabilitiesR6$new( .piecewiseSurvivalTime = setting, .accrualTime = accrualSetup, time = time, @@ -3102,7 +3102,7 @@ getNumberOfSubjects <- function(time, ..., accrualIntensity = accrualIntensity, maxNumberOfSubjects = maxNumberOfSubjects ) - result <- NumberOfSubjects( + result <- NumberOfSubjectsR6$new( .accrualTime = accrualSetup, time = time, accrualTime = accrualTime, diff --git a/R/f_object_r_code.R b/R/f_object_r_code.R index 2aed3b35..7df3b150 100644 --- a/R/f_object_r_code.R +++ b/R/f_object_r_code.R @@ -153,7 +153,7 @@ NULL return(paste0("get", sub("^Trial", "", sub("R6","",.getClassName(obj))))) } - if (inherits(obj, "Dataset")) { + if (inherits(obj, "Dataset") || inherits(obj, "DatasetR6")) { return("getDataset") } @@ -169,47 +169,47 @@ NULL return("getDesignCharacteristics") } - if (inherits(obj, "SimulationResultsMeans")) { + if (inherits(obj, "SimulationResultsMeans") || inherits(obj, "SimulationResultsMeansR6")) { return("getSimulationMeans") } - if (inherits(obj, "SimulationResultsRates")) { + if (inherits(obj, "SimulationResultsRates") || inherits(obj, "SimulationResultsRatesR6")) { return("getSimulationRates") } - if (inherits(obj, "SimulationResultsSurvival")) { + if (inherits(obj, "SimulationResultsSurvival") || inherits(obj, "SimulationResultsSurvivalR6")) { return("getSimulationSurvival") } - if (inherits(obj, "SimulationResultsMultiArmMeans")) { + if (inherits(obj, "SimulationResultsMultiArmMeans") || inherits(obj, "SimulationResultsMultiArmMeansR6")) { return("getSimulationMultiArmMeans") } - if (inherits(obj, "SimulationResultsMultiArmRates")) { + if (inherits(obj, "SimulationResultsMultiArmRates") || inherits(obj, "SimulationResultsMultiArmRatesR6")) { return("getSimulationMultiArmRates") } - if (inherits(obj, "SimulationResultsMultiArmSurvival")) { + if (inherits(obj, "SimulationResultsMultiArmSurvival") || inherits(obj, "SimulationResultsMultiArmSurvivalR6")) { return("getSimulationMultiArmSurvival") } - if (inherits(obj, "SimulationResultsEnrichmentMeans")) { + if (inherits(obj, "SimulationResultsEnrichmentMeans") || inherits(obj, "SimulationResultsEnrichmentMeansR6")) { return("getSimulationEnrichmentMeans") } - if (inherits(obj, "SimulationResultsEnrichmentRates")) { + if (inherits(obj, "SimulationResultsEnrichmentRates") || inherits(obj, "SimulationResultsEnrichmentRatesR6")) { return("getSimulationEnrichmentRates") } - if (inherits(obj, "SimulationResultsEnrichmentSurvival")) { + if (inherits(obj, "SimulationResultsEnrichmentSurvival") || inherits(obj, "SimulationResultsEnrichmentSurvivalR6")) { return("getSimulationEnrichmentSurvival") } - if (inherits(obj, "PiecewiseSurvivalTime")) { + if (inherits(obj, "PiecewiseSurvivalTime") || inherits(obj, "PiecewiseSurvivalTimeR6")) { return("getPiecewiseSurvivalTime") } - if (inherits(obj, "AccrualTime")) { + if (inherits(obj, "AccrualTime") || inherits(obj, "AccrualTimeR6")) { return("getAccrualTime") } @@ -221,19 +221,19 @@ NULL return("getConditionalPower") } - if (inherits(obj, "PowerAndAverageSampleNumberResult")) { + if (inherits(obj, "PowerAndAverageSampleNumberResult") || inherits(obj, "PowerAndAverageSampleNumberResultR6")) { return("getPowerAndAverageSampleNumber") } - if (inherits(obj, "EventProbabilities")) { + if (inherits(obj, "EventProbabilities") || inherits(obj, "EventProbabilitiesR6")) { return("getEventProbabilities") } - if (inherits(obj, "NumberOfSubjects")) { + if (inherits(obj, "NumberOfSubjects") || inherits(obj, "NumberOfSubjectsR6")) { return("getNumberOfSubjects") } - if (inherits(obj, "PerformanceScore")) { + if (inherits(obj, "PerformanceScore") || inherits(obj, "PerformanceScoreR6")) { return("gePerformanceScore") } @@ -411,7 +411,7 @@ getObjectRCode <- function(obj, ..., } } } - if (inherits(obj, "PerformanceScore")) { + if (inherits(obj, "PerformanceScore") || inherits(obj, "PerformanceScoreR6")) { preconditionSimulationResults <- getObjectRCode(obj$.simulationResults, prefix = ifelse(pipeOperator == "none", "simulationResults <- ", ""), postfix = pipeOperatorPostfix, @@ -532,7 +532,7 @@ getObjectRCode <- function(obj, ..., precondition <- unique(precondition) - if (inherits(obj, "SummaryFactory") || "SummaryFactory" == .getClassName(obj)) { + if (inherits(obj, "SummaryFactory") || inherits(obj, "SummaryFactoryR6") || "SummaryFactory" == .getClassName(obj) || "SummaryFactoryR6" == .getClassName(obj)) { return(getObjectRCode(obj$object, prefix = ifelse(pipeOperator == "none", "summary(", ""), postfix = { @@ -561,21 +561,22 @@ getObjectRCode <- function(obj, ..., objNames <- obj$.getUserDefinedParameters() } objNames <- objNames[objNames != "stages"] + } - if (inherits(obj, "TrialDesign") && !inherits(obj, "TrialDesignConditionalDunnett") && + if ((inherits(obj, "TrialDesign") || inherits(obj, "TrialDesignR6")) && !(inherits(obj, "TrialDesignConditionalDunnett") || inherits(obj, "TrialDesignConditionalDunnettR6")) && !("informationRates" %in% objNames) && !("kMax" %in% objNames) && obj$kMax != 3) { objNames <- c("kMax", objNames) } thetaH0 <- NA_real_ - if (inherits(obj, "SimulationResultsSurvival") && + if ((inherits(obj, "SimulationResultsSurvival") || inherits(obj, "SimulationResultsSurvivalR6")) && obj$.getParameterType("thetaH1") == "g") { objNames <- c(objNames, "thetaH1") thetaH0 <- obj[["thetaH0"]] } - if (inherits(obj, "SimulationResultsSurvival")) { + if (inherits(obj, "SimulationResultsSurvival") || inherits(obj, "SimulationResultsSurvivalR6")) { objNames <- objNames[objNames != "allocationRatioPlanned"] # allocation1 and allocation2 are used instead } @@ -626,7 +627,7 @@ getObjectRCode <- function(obj, ..., objNames <- c(objNames, defaultParams) } - if (inherits(obj, "TrialDesign") && "informationRates" %in% objNames && + if ((inherits(obj, "TrialDesign") || inherits(obj, "TrialDesignR6")) && "informationRates" %in% objNames && !("informationRates" %in% newArgumentValueNames)) { informationRates <- obj[["informationRates"]] if (!is.null(informationRates) && length(informationRates) > 0) { @@ -643,7 +644,7 @@ getObjectRCode <- function(obj, ..., } } - if (inherits(obj, "Dataset")) { + if (inherits(obj, "Dataset") || inherits(obj, "DatasetR6")) { lines <- .getDatasetArgumentsRCodeLines(obj, complete = FALSE, digits = NA_integer_) argumentsRCode <- paste0(lines, collapse = ", ") } else { @@ -658,7 +659,7 @@ getObjectRCode <- function(obj, ..., value <- obj[[name]] } - if (name == "accrualTime" && inherits(obj, "AccrualTime") && + if (name == "accrualTime" && (inherits(obj, "AccrualTime") || inherits(obj, "AccrualTimeR6")) && !isTRUE(obj$endOfAccrualIsUserDefined) && isTRUE(length(obj$accrualIntensity) < length(value))) { value <- value[1:(length(value) - 1)] diff --git a/R/f_simulation_base_means.R b/R/f_simulation_base_means.R index 0a36a0c9..80312bbd 100644 --- a/R/f_simulation_base_means.R +++ b/R/f_simulation_base_means.R @@ -218,7 +218,7 @@ getSimulationMeans <- function(design = NULL, ..., .assertIsSingleLogical(normalApproximation, "normalApproximation", naAllowed = FALSE) .assertIsValidPlannedSubjectsOrEvents(design, plannedSubjects, parameterName = "plannedSubjects") - simulationResults <- SimulationResultsMeans(design, showStatistics = showStatistics) + simulationResults <- SimulationResultsMeansR6$new(design, showStatistics = showStatistics) if (design$sided == 2) { stop( diff --git a/R/f_simulation_base_rates.R b/R/f_simulation_base_rates.R index f26152a7..1a2168dd 100644 --- a/R/f_simulation_base_rates.R +++ b/R/f_simulation_base_rates.R @@ -258,7 +258,7 @@ getSimulationRates <- function(design = NULL, ..., ) } - simulationResults <- SimulationResultsRates(design, showStatistics = showStatistics) + simulationResults <- SimulationResultsRatesR6$new(design, showStatistics = showStatistics) conditionalPower <- .ignoreParameterIfNotUsed( "conditionalPower", diff --git a/R/f_simulation_base_survival.R b/R/f_simulation_base_survival.R index bc933a5d..d8a250e5 100644 --- a/R/f_simulation_base_survival.R +++ b/R/f_simulation_base_survival.R @@ -377,7 +377,7 @@ getSimulationSurvival <- function(design = NULL, ..., endpoint = "survival", calcSubjectsFunctionEnabled = FALSE ) - simulationResults <- SimulationResultsSurvival(design, showStatistics = showStatistics) + simulationResults <- SimulationResultsSurvivalR6$new(design, showStatistics = showStatistics) if (!is.na(conditionalPower)) { if (design$kMax > 1) { if (any(maxNumberOfEventsPerStage - minNumberOfEventsPerStage < 0) && diff --git a/R/f_simulation_calc_subjects_function.R b/R/f_simulation_calc_subjects_function.R index c5a496d3..d536eb64 100644 --- a/R/f_simulation_calc_subjects_function.R +++ b/R/f_simulation_calc_subjects_function.R @@ -322,13 +322,13 @@ C_SIMULATION_CALC_SUBJECTS_FUNCTION_ARGUMENTS[[C_SIMULATION_CALC_SUBJECTS_FUNCTI .assertIsSingleLogical(cppEnabled, "cppEnabled") cppCodeBodyType <- NA_character_ - if (inherits(simulationResults, "SimulationResultsMeans")) { + if (inherits(simulationResults, "SimulationResultsMeans") || inherits(simulationResults, "SimulationResultsMeansR6")) { cppCodeBodyType <- C_SIMULATION_CALC_SUBJECTS_FUNCTION_BASE_MEANS } - if (inherits(simulationResults, "SimulationResultsRates")) { + if (inherits(simulationResults, "SimulationResultsRates") || inherits(simulationResults, "SimulationResultsRatesR6")) { cppCodeBodyType <- C_SIMULATION_CALC_SUBJECTS_FUNCTION_BASE_RATES } - if (inherits(simulationResults, "SimulationResultsSurvival")) { + if (inherits(simulationResults, "SimulationResultsSurvival") || inherits(simulationResults, "SimulationResultsSurvivalR6")) { cppCodeBodyType <- C_SIMULATION_CALC_SUBJECTS_FUNCTION_BASE_SURVIVAL } if (is.na(cppCodeBodyType)) { @@ -338,7 +338,7 @@ C_SIMULATION_CALC_SUBJECTS_FUNCTION_ARGUMENTS[[C_SIMULATION_CALC_SUBJECTS_FUNCTI ) } - functionFieldName <- ifelse(inherits(simulationResults, "SimulationResultsSurvival"), + functionFieldName <- ifelse(inherits(simulationResults, "SimulationResultsSurvival") || inherits(simulationResults, "SimulationResultsSurvivalR6"), "calcEventsFunction", "calcSubjectsFunction" ) @@ -397,7 +397,7 @@ C_SIMULATION_CALC_SUBJECTS_FUNCTION_ARGUMENTS[[C_SIMULATION_CALC_SUBJECTS_FUNCTI if (.isCppCode(calcFunction)) { tryCatch( { - survivalEnabled <- inherits(simulationResults, "SimulationResultsSurvival") + survivalEnabled <- inherits(simulationResults, "SimulationResultsSurvival") || inherits(simulationResults, "SimulationResultsSurvivalR6") expectedFunctionName <- ifelse(survivalEnabled, "calcEventsFunctionCppTemp", "calcSubjectsFunctionCppTemp" ) diff --git a/R/f_simulation_enrichment.R b/R/f_simulation_enrichment.R index 49d29f56..40c8e682 100644 --- a/R/f_simulation_enrichment.R +++ b/R/f_simulation_enrichment.R @@ -351,11 +351,11 @@ NULL effectMeasure <- .assertIsValidEffectMeasure(effectMeasure) if (endpoint == "means") { - simulationResults <- SimulationResultsEnrichmentMeans(design, showStatistics = showStatistics) + simulationResults <- SimulationResultsEnrichmentMeansR6$new(design, showStatistics = showStatistics) } else if (endpoint == "rates") { - simulationResults <- SimulationResultsEnrichmentRates(design, showStatistics = showStatistics) + simulationResults <- SimulationResultsEnrichmentRatesR6$new(design, showStatistics = showStatistics) } else if (endpoint == "survival") { - simulationResults <- SimulationResultsEnrichmentSurvival(design, showStatistics = showStatistics) + simulationResults <- SimulationResultsEnrichmentSurvivalR6$new(design, showStatistics = showStatistics) } effectList <- .getValidatedEffectList(effectList, endpoint = endpoint) diff --git a/R/f_simulation_multiarm.R b/R/f_simulation_multiarm.R index 744416f6..151d36dd 100644 --- a/R/f_simulation_multiarm.R +++ b/R/f_simulation_multiarm.R @@ -468,11 +468,11 @@ NULL effectMeasure <- .assertIsValidEffectMeasure(effectMeasure) if (endpoint == "means") { - simulationResults <- SimulationResultsMultiArmMeans(design, showStatistics = showStatistics) + simulationResults <- SimulationResultsMultiArmMeansR6$new(design, showStatistics = showStatistics) } else if (endpoint == "rates") { - simulationResults <- SimulationResultsMultiArmRates(design, showStatistics = showStatistics) + simulationResults <- SimulationResultsMultiArmRatesR6$new(design, showStatistics = showStatistics) } else if (endpoint == "survival") { - simulationResults <- SimulationResultsMultiArmSurvival(design, showStatistics = showStatistics) + simulationResults <- SimulationResultsMultiArmSurvivalR6$new(design, showStatistics = showStatistics) } gMax <- activeArms diff --git a/R/f_simulation_performance_score.R b/R/f_simulation_performance_score.R index 8a8cf991..81e9fc5e 100644 --- a/R/f_simulation_performance_score.R +++ b/R/f_simulation_performance_score.R @@ -50,7 +50,7 @@ getPerformanceScore <- function(simulationResult) { design <- simulationResult$.design - if (!inherits(simulationResult, "SimulationResultsMeans")) { + if (!(inherits(simulationResult, "SimulationResultsMeans") || inherits(simulationResult, "SimulationResultsMeansR6"))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "performance score so far implemented only for single comparisons with continuous endpoints" @@ -94,10 +94,10 @@ getPerformanceScore <- function(simulationResult) { referenceValue <- NA_real_ # simulated alternative values - if (methods::is(simulationResult, "SimulationResultsMeans")) { + if (methods::is(simulationResult, "SimulationResultsMeans") || methods::is(simulationResult, "SimulationResultsMeansR6")) { alternativeParamName <- "alternative" referenceValue <- 0 - } else if (methods::is(simulationResult, "SimulationResultsRates")) { + } else if (methods::is(simulationResult, "SimulationResultsRates") || methods::is(simulationResult, "SimulationResultsRatesR6")) { alternativeParamName <- "pi1" referenceValue <- simulationResult$pi2 args$pi2 <- referenceValue @@ -116,9 +116,9 @@ getPerformanceScore <- function(simulationResult) { if (alternativeValue == referenceValue) { singleStageSampleSize <- plannedSubjects[2] - plannedSubjects[1] - } else if (methods::is(simulationResult, "SimulationResultsMeans")) { + } else if (methods::is(simulationResult, "SimulationResultsMeans") || methods::is(simulationResult, "SimulationResultsMeansR6")) { singleStageSampleSize <- do.call(getSampleSizeMeans, args)$numberOfSubjects - } else if (methods::is(simulationResult, "SimulationResultsRates")) { + } else if (methods::is(simulationResult, "SimulationResultsRates") || methods::is(simulationResult, "SimulationResultsRatesR6")) { singleStageSampleSize <- do.call(getSampleSizeRates, args)$numberOfSubjects } @@ -168,7 +168,7 @@ getPerformanceScore <- function(simulationResult) { )) }) - performanceScore <- PerformanceScore(simulationResult) + performanceScore <- PerformanceScoreR6$new(simulationResult) performanceScore$.alternative <- alternativeValues paramNames <- rownames(resultMatrix) for (k in 1:nrow(resultMatrix)) { diff --git a/R/f_simulation_utilities.R b/R/f_simulation_utilities.R index 9f8f3443..c800c718 100644 --- a/R/f_simulation_utilities.R +++ b/R/f_simulation_utilities.R @@ -95,7 +95,7 @@ NULL stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'data' must be a valid data.frame or a simulation result object") } - if (inherits(data, "SimulationResults")) { + if (inherits(data, "SimulationResults") || inherits(data, "SimulationResultsR6")) { data <- data[[".data"]] } diff --git a/load_source_files.R b/load_source_files.R index 6d12ae82..eab39581 100644 --- a/load_source_files.R +++ b/load_source_files.R @@ -35,7 +35,9 @@ library(rpact.as251) tic() Sys.setenv("RPACT_COMPILE_CPP_FILES" = FALSE) -Sys.setenv("RPACT_DEVELOPMENT_MODE" = TRUE) +#Sys.setenv("RPACT_DEVELOPMENT_MODE" = TRUE) +Sys.setenv("RPACT_DEVELOPMENT_MODE" = FALSE) +Sys.setenv("RPACT_COMPLETE_UNIT_TEST_SET_ENABLED" = TRUE) #print("The following packages are not up to date:") #pacman::p_update(FALSE) @@ -75,26 +77,32 @@ fileNames <- c( "class_design_r6", "class_core_plot_settings_r6", "class_design_set_r6", + "class_event_probabilities_r6", + "class_time_r6", + "class_design_power_and_asn_r6", + "class_performance_score_r6", "f_core_constants", "class_design_plan_r6", "f_design_utilities", "f_analysis_utilities", + "class_analysis_dataset_r6", "class_core_parameter_set", + "class_simulation_results_r6", #"class_core_plot_settings", "f_core_assertions", "f_core_utilities", #"class_design", #"class_design_set", - "class_design_power_and_asn", - "class_time", + #"class_design_power_and_asn", + #"class_time", "class_summary", "f_logger", #"class_design_plan", - "class_analysis_dataset", + #"class_analysis_dataset", #"class_analysis_stage_results", #"class_analysis_results", - "class_simulation_results", - "class_event_probabilities", + #"class_simulation_results", + #"class_event_probabilities", "f_core_output_formats", "f_core_plot", "f_design_group_sequential", @@ -112,6 +120,7 @@ fileNames <- c( "f_analysis_multiarm_rates", "f_analysis_multiarm_survival", "f_analysis_multiarm", + "f_simulation_calc_subjects_function", "f_simulation_base_means", "f_simulation_base_rates", "f_simulation_base_survival", @@ -120,7 +129,9 @@ fileNames <- c( "f_simulation_multiarm_rates", "f_simulation_multiarm_survival", "f_simulation_utilities", - "f_parameter_set_utilities" + "f_simulation_performance_score", + "f_parameter_set_utilities", + "f_object_r_code" ) # https://stackoverflow.com/questions/17635531/calling-cuda-compiled-dll-from-r @@ -178,6 +189,7 @@ if (as.logical(Sys.getenv("RPACT_COMPILE_CPP_FILES")) || !exists("getSimulationS } } + print("Initialization completed.") toc() diff --git a/tests/testthat/test-class_core_plot_settings.R b/tests/testthat/test-class_core_plot_settings.R index 115bada6..7653b647 100644 --- a/tests/testthat/test-class_core_plot_settings.R +++ b/tests/testthat/test-class_core_plot_settings.R @@ -27,15 +27,13 @@ test_that("Test plot settings", { expect_type(PlotSubTitleItems(), "S4") - expect_type(getPlotSettings(), "S4") + expect_type(getPlotSettings(), "environment") expect_type(PlotSettings(), "S4") expect_error(PlotSubTitleItemR6$new()) - expect_type(PlotSubTitleItemsR6$new(), "R6") + expect_type(PlotSubTitleItemsR6$new(), "environment") - expect_type(getPlotSettingsR6$new(), "R6") - - expect_type(PlotSettingsR6$new(), "R6") + expect_type(PlotSettingsR6$new(), "environment") }) From bebb1a841e9d45dec553714f99af94a74a51d227 Mon Sep 17 00:00:00 2001 From: Till Luca Jensen Date: Wed, 21 Feb 2024 14:02:07 +0100 Subject: [PATCH 09/28] changed filenames --- DESCRIPTION | 14 - NAMESPACE | 2 +- R/class_analysis_dataset.R | 3159 ++++++++---- R/class_analysis_dataset_r6.R | 4226 ----------------- R/class_analysis_results.R | 2404 +++++----- R/class_analysis_results_r6.R | 2078 -------- R/class_analysis_stage_results.R | 2270 +++++---- R/class_analysis_stage_results_r6.R | 1823 ------- R/class_core_parameter_set.R | 2499 ++++++---- R/class_core_parameter_set_r6.R | 1721 ------- R/class_core_plot_settings.R | 359 +- R/class_core_plot_settings_r6.R | 764 --- R/class_design.R | 1493 +++--- R/class_design_plan.R | 1956 ++++++-- R/class_design_plan_r6.R | 2153 --------- R/class_design_power_and_asn.R | 194 +- R/class_design_power_and_asn_r6.R | 329 -- R/class_design_r6.R | 1251 ----- R/class_design_set.R | 441 +- R/class_design_set_r6.R | 983 ---- R/class_event_probabilities.R | 192 +- R/class_event_probabilities_r6.R | 533 --- R/class_performance_score.R | 48 +- R/class_performance_score_r6.R | 81 - R/class_simulation_results.R | 855 ++-- R/class_simulation_results_r6.R | 2842 ----------- R/class_summary.R | 3017 +++++++++++- R/class_summary_r6.R | 3620 -------------- R/class_time.R | 1777 ++++--- R/class_time_r6.R | 2297 --------- R/f_design_utilities.R | 2 +- R/f_simulation_performance_score.R | 2 - .../testthat/test-class_core_plot_settings.R | 6 - .../test-f_simulation_performance_score.R | 6 +- 34 files changed, 13742 insertions(+), 31655 deletions(-) delete mode 100644 R/class_analysis_dataset_r6.R delete mode 100644 R/class_analysis_results_r6.R delete mode 100644 R/class_analysis_stage_results_r6.R delete mode 100644 R/class_core_parameter_set_r6.R delete mode 100644 R/class_core_plot_settings_r6.R delete mode 100644 R/class_design_plan_r6.R delete mode 100644 R/class_design_power_and_asn_r6.R delete mode 100644 R/class_design_r6.R delete mode 100644 R/class_design_set_r6.R delete mode 100644 R/class_event_probabilities_r6.R delete mode 100644 R/class_performance_score_r6.R delete mode 100644 R/class_simulation_results_r6.R delete mode 100644 R/class_summary_r6.R delete mode 100644 R/class_time_r6.R diff --git a/DESCRIPTION b/DESCRIPTION index eca4e39c..119803d0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -71,25 +71,11 @@ Config/testthat/parallel: true Config/testthat/start-first: *analysis* Collate: 'RcppExports.R' - 'class_core_parameter_set_r6.R' - 'class_core_plot_settings_r6.R' - 'class_analysis_results_r6.R' - 'class_analysis_stage_results_r6.R' - 'class_summary_r6.R' - 'class_design_r6.R' - 'class_design_set_r6.R' - 'class_event_probabilities_r6.R' - 'class_time_r6.R' - 'class_design_power_and_asn_r6.R' - 'class_performance_score_r6.R' 'f_core_constants.R' - 'class_design_plan_r6.R' - 'class_simulation_results_r6.R' 'f_logger.R' 'f_core_utilities.R' 'f_core_assertions.R' 'f_analysis_utilities.R' - 'class_analysis_dataset_r6.R' 'f_parameter_set_utilities.R' 'class_core_parameter_set.R' 'class_core_plot_settings.R' diff --git a/NAMESPACE b/NAMESPACE index 9de0d822..2eddc478 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -144,7 +144,7 @@ export(test_plan_section) export(writeDataset) export(writeDatasets) exportMethods("[") -exportMethods(t) +#exportMethods(t) import(graphics) import(methods) import(stats) diff --git a/R/class_analysis_dataset.R b/R/class_analysis_dataset.R index 6988a03a..e0632487 100644 --- a/R/class_analysis_dataset.R +++ b/R/class_analysis_dataset.R @@ -85,6 +85,1248 @@ C_KEY_WORDS <- c( C_KEY_WORDS_OVERALL_LOG_RANKS ) +#' @title +#' Read Dataset +#' +#' @description +#' Reads a data file and returns it as dataset object. +#' +#' @param file A CSV file (see \code{\link[utils]{read.table}}). +#' @param header A logical value indicating whether the file contains the names of +#' the variables as its first line. +#' @param sep The field separator character. Values on each line of the file are separated +#' by this character. If sep = "," (the default for \code{readDataset}) the separator is a comma. +#' @param quote The set of quoting characters. To disable quoting altogether, use +#' quote = "". See scan for the behavior on quotes embedded in quotes. Quoting is only +#' considered for columns read as character, which is all of them unless \code{colClasses} is specified. +#' @param dec The character used in the file for decimal points. +#' @param fill logical. If \code{TRUE} then in case the rows have unequal length, blank fields +#' are implicitly added. +#' @param comment.char character: a character vector of length one containing a single character +#' or an empty string. Use "" to turn off the interpretation of comments altogether. +#' @param fileEncoding character string: if non-empty declares the encoding used on a file +#' (not a connection) so the character data can be re-encoded. +#' See the 'Encoding' section of the help for file, the 'R Data Import/Export Manual' and 'Note'. +#' @param ... Further arguments to be passed to code{\link[utils]{read.table}}. +#' +#' @details +#' \code{readDataset} is a wrapper function that uses \code{\link[utils]{read.table}} to read the +#' CSV file into a data frame, transfers it from long to wide format with \code{\link[stats]{reshape}} +#' and puts the data to \code{\link[=getDataset]{getDataset()}}. +#' +#' @template return_object_dataset +#' +#' @seealso +#' \itemize{ +#' \item \code{\link[=readDatasets]{readDatasets()}} for reading multiple datasets, +#' \item \code{\link[=writeDataset]{writeDataset()}} for writing a single dataset, +#' \item \code{\link[=writeDatasets]{writeDatasets()}} for writing multiple datasets. +#' } +#' +#' @examples +#' \dontrun{ +#' dataFileRates <- system.file("extdata", +#' "dataset_rates.csv", +#' package = "rpact" +#' ) +#' if (dataFileRates != "") { +#' datasetRates <- readDataset(dataFileRates) +#' datasetRates +#' } +#' +#' dataFileMeansMultiArm <- system.file("extdata", +#' "dataset_means_multi-arm.csv", +#' package = "rpact" +#' ) +#' if (dataFileMeansMultiArm != "") { +#' datasetMeansMultiArm <- readDataset(dataFileMeansMultiArm) +#' datasetMeansMultiArm +#' } +#' +#' dataFileRatesMultiArm <- system.file("extdata", +#' "dataset_rates_multi-arm.csv", +#' package = "rpact" +#' ) +#' if (dataFileRatesMultiArm != "") { +#' datasetRatesMultiArm <- readDataset(dataFileRatesMultiArm) +#' datasetRatesMultiArm +#' } +#' +#' dataFileSurvivalMultiArm <- system.file("extdata", +#' "dataset_survival_multi-arm.csv", +#' package = "rpact" +#' ) +#' if (dataFileSurvivalMultiArm != "") { +#' datasetSurvivalMultiArm <- readDataset(dataFileSurvivalMultiArm) +#' datasetSurvivalMultiArm +#' } +#' } +#' +#' @export +#' +readDataset <- function(file, ..., header = TRUE, sep = ",", quote = "\"", + dec = ".", fill = TRUE, comment.char = "", fileEncoding = "UTF-8") { + if (!file.exists(file)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the file '", file, "' does not exist") + } + + data <- utils::read.table( + file = file, header = header, sep = sep, + quote = quote, dec = dec, fill = fill, fileEncoding = fileEncoding, ... + ) + dataWide <- stats::reshape(data = data, direction = "wide", idvar = "stages", timevar = "groups") + colnames(dataWide) <- gsub("\\.", "", colnames(dataWide)) + return(getDataset(dataWide)) +} + +#' @title +#' Write Dataset +#' +#' @description +#' Writes a dataset to a CSV file. +#' +#' @param dataset A dataset. +#' @param file The target CSV file. +#' @param append Logical. Only relevant if file is a character string. +#' If \code{TRUE}, the output is appended to the file. If \code{FALSE}, any existing file of the name is destroyed. +#' @param sep The field separator character. Values on each line of the file are separated +#' by this character. If sep = "," (the default for \code{writeDataset}) the separator is a comma. +#' @param quote The set of quoting characters. To disable quoting altogether, use +#' quote = "". See scan for the behavior on quotes embedded in quotes. Quoting is only +#' considered for columns read as character, which is all of them unless \code{colClasses} is specified. +#' @param dec The character used in the file for decimal points. +#' @param eol The character(s) to print at the end of each line (row). +#' @param na The string to use for missing values in the data. +#' @param row.names Either a logical value indicating whether the row names of \code{dataset} are +#' to be written along with \code{dataset}, or a character vector of row names to be written. +#' @param col.names Either a logical value indicating whether the column names of \code{dataset} are +#' to be written along with \code{dataset}, or a character vector of column names to be written. +#' See the section on 'CSV files' for the meaning of \code{col.names = NA}. +#' @param qmethod A character string specifying how to deal with embedded double quote characters +#' when quoting strings. Must be one of "double" (default in \code{writeDataset}) or "escape". +#' @param fileEncoding Character string: if non-empty declares the encoding used on a file +#' (not a connection) so the character data can be re-encoded. +#' See the 'Encoding' section of the help for file, the 'R Data Import/Export Manual' and 'Note'. +#' @param ... Further arguments to be passed to \code{\link[utils]{write.table}}. +#' +#' @details +#' \code{\link[=writeDataset]{writeDataset()}} is a wrapper function that coerces the dataset to a data frame and uses \cr +#' \code{\link[utils]{write.table}} to write it to a CSV file. +#' +#' @seealso +#' \itemize{ +#' \item \code{\link[=writeDatasets]{writeDatasets()}} for writing multiple datasets, +#' \item \code{\link[=readDataset]{readDataset()}} for reading a single dataset, +#' \item \code{\link[=readDatasets]{readDatasets()}} for reading multiple datasets. +#' } +#' +#' @examples +#' \dontrun{ +#' datasetOfRates <- getDataset( +#' n1 = c(11, 13, 12, 13), +#' n2 = c(8, 10, 9, 11), +#' events1 = c(10, 10, 12, 12), +#' events2 = c(3, 5, 5, 6) +#' ) +#' writeDataset(datasetOfRates, "dataset_rates.csv") +#' } +#' +#' @export +#' +writeDataset <- function(dataset, file, ..., append = FALSE, quote = TRUE, sep = ",", + eol = "\n", na = "NA", dec = ".", row.names = TRUE, + col.names = NA, qmethod = "double", + fileEncoding = "UTF-8") { + .assertIsDataset(dataset) + + x <- as.data.frame(dataset, niceColumnNamesEnabled = FALSE) + + utils::write.table( + x = x, file = file, append = append, quote = quote, sep = sep, + eol = eol, na = na, dec = dec, row.names = FALSE, + col.names = TRUE, qmethod = qmethod, + fileEncoding = fileEncoding + ) +} + +#' @title +#' Read Multiple Datasets +#' +#' @description +#' Reads a data file and returns it as a list of dataset objects. +#' +#' @param file A CSV file (see \code{\link[utils]{read.table}}). +#' @param header A logical value indicating whether the file contains the names of +#' the variables as its first line. +#' @param sep The field separator character. Values on each line of the file are separated +#' by this character. If sep = "," (the default for \code{readDatasets}) the separator is a comma. +#' @param quote The set of quoting characters. To disable quoting altogether, use +#' quote = "". See scan for the behavior on quotes embedded in quotes. Quoting is only +#' considered for columns read as character, which is all of them unless \code{colClasses} is specified. +#' @param dec The character used in the file for decimal points. +#' @param fill logical. If \code{TRUE} then in case the rows have unequal length, blank fields +#' are implicitly added. +#' @param comment.char character: a character vector of length one containing a single character +#' or an empty string. Use "" to turn off the interpretation of comments altogether. +#' @param fileEncoding character string: if non-empty declares the encoding used on a file +#' (not a connection) so the character data can be re-encoded. +#' See the 'Encoding' section of the help for file, the 'R Data Import/Export Manual' and 'Note'. +#' @param ... Further arguments to be passed to \code{\link[utils]{read.table}}. +#' +#' @details +#' Reads a file that was written by \code{\link[=writeDatasets]{writeDatasets()}} before. +#' +#' @return Returns a \code{\link[base]{list}} of \code{\link{Dataset}} objects. +#' +#' @seealso +#' \itemize{ +#' \item \code{\link[=readDataset]{readDataset()}} for reading a single dataset, +#' \item \code{\link[=writeDatasets]{writeDatasets()}} for writing multiple datasets, +#' \item \code{\link[=writeDataset]{writeDataset()}} for writing a single dataset. +#' } +#' +#' @examples +#' dataFile <- system.file("extdata", "datasets_rates.csv", package = "rpact") +#' if (dataFile != "") { +#' datasets <- readDatasets(dataFile) +#' datasets +#' } +#' @export +#' +readDatasets <- function(file, ..., header = TRUE, sep = ",", quote = "\"", + dec = ".", fill = TRUE, comment.char = "", fileEncoding = "UTF-8") { + if (!file.exists(file)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the file '", file, "' does not exist") + } + + data <- utils::read.table( + file = file, header = header, sep = sep, + quote = quote, dec = dec, fill = fill, fileEncoding = fileEncoding, ... + ) + + if (is.null(data[["datasetId"]])) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "data file must contain the column 'datasetId'") + } + + datasets <- list() + for (datasetId in unique(data$datasetId)) { + subData <- data[data$datasetId == datasetId, ] + dataFrame <- subset(subData, select = -datasetId) + description <- NA_character_ + if (!is.null(dataFrame[["description"]])) { + description <- as.character(dataFrame$description[1]) + dataFrame <- subset(dataFrame, select = -description) + } + if (length(unique(subData$groups)) == 2) { + dataWide <- stats::reshape(dataFrame, direction = "wide", idvar = "stages", timevar = "groups") + colnames(dataWide) <- gsub("\\.", "", colnames(dataWide)) + dataset <- getDataset(dataWide) + } else { + dataset <- getDataset(dataFrame) + } + dataset$setDescription(description) + datasets <- c(datasets, dataset) + } + return(datasets) +} + +#' @title +#' Write Multiple Datasets +#' +#' @description +#' Writes a list of datasets to a CSV file. +#' +#' @param datasets A list of datasets. +#' @param file The target CSV file. +#' @param append Logical. Only relevant if file is a character string. +#' If \code{TRUE}, the output is appended to the file. If FALSE, any existing file of the name is destroyed. +#' @param sep The field separator character. Values on each line of the file are separated +#' by this character. If sep = "," (the default for \code{writeDatasets}) the separator is a comma. +#' @param quote The set of quoting characters. To disable quoting altogether, use +#' quote = "". See scan for the behavior on quotes embedded in quotes. Quoting is only +#' considered for columns read as character, which is all of them unless \code{colClasses} is specified. +#' @param dec The character used in the file for decimal points. +#' @param eol The character(s) to print at the end of each line (row). +#' @param na The string to use for missing values in the data. +#' @param row.names Either a logical value indicating whether the row names of \code{dataset} are +#' to be written along with \code{dataset}, or a character vector of row names to be written. +#' @param col.names Either a logical value indicating whether the column names of \code{dataset} are +#' to be written along with \code{dataset}, or a character vector of column names to be written. +#' See the section on 'CSV files' for the meaning of \code{col.names = NA}. +#' @param qmethod A character string specifying how to deal with embedded double quote characters +#' when quoting strings. Must be one of "double" (default in \code{writeDatasets}) or "escape". +#' @param fileEncoding Character string: if non-empty declares the encoding used on a file +#' (not a connection) so the character data can be re-encoded. +#' See the 'Encoding' section of the help for file, the 'R Data Import/Export Manual' and 'Note'. +#' @param ... Further arguments to be passed to \code{\link[utils]{write.table}}. +#' +#' @details +#' The format of the CSV file is optimized for usage of \code{\link[=readDatasets]{readDatasets()}}. +#' +#' @seealso +#' \itemize{ +#' \item \code{\link[=writeDataset]{writeDataset()}} for writing a single dataset, +#' \item \code{\link[=readDatasets]{readDatasets()}} for reading multiple datasets, +#' \item \code{\link[=readDataset]{readDataset()}} for reading a single dataset. +#' } +#' +#' @examples +#' \dontrun{ +#' d1 <- getDataset( +#' n1 = c(11, 13, 12, 13), +#' n2 = c(8, 10, 9, 11), +#' events1 = c(10, 10, 12, 12), +#' events2 = c(3, 5, 5, 6) +#' ) +#' d2 <- getDataset( +#' n1 = c(9, 13, 12, 13), +#' n2 = c(6, 10, 9, 11), +#' events1 = c(10, 10, 12, 12), +#' events2 = c(4, 5, 5, 6) +#' ) +#' datasets <- list(d1, d2) +#' writeDatasets(datasets, "datasets_rates.csv") +#' } +#' +#' @export +#' +writeDatasets <- function(datasets, file, ..., append = FALSE, quote = TRUE, sep = ",", + eol = "\n", na = "NA", dec = ".", row.names = TRUE, + col.names = NA, qmethod = "double", + fileEncoding = "UTF-8") { + if (!is.list(datasets)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'datasets' must be a list of datasets") + } + + if (length(datasets) == 0) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'datasets' is empty") + } + + datasetType <- NA_character_ + dataFrames <- NULL + for (i in 1:length(datasets)) { + dataset <- datasets[[i]] + .assertIsDataset(dataset) + if (is.na(datasetType)) { + datasetType <- .getClassName(dataset) + } else if (.getClassName(dataset) != datasetType) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all datasets must have the same type") + } + + data <- as.data.frame(dataset, niceColumnNamesEnabled = FALSE) + datasetId <- ifelse(!is.null(dataset$getId()) && !is.na(dataset$getId()), dataset$getId(), i) + data <- cbind(rep(datasetId, nrow(data)), data) + colnames(data)[1] <- "datasetId" + + if (!is.null(dataset$getDescription()) && !is.na(dataset$getDescription())) { + data <- cbind(data, rep(dataset$getDescription(), nrow(data))) + colnames(data)[ncol(data)] <- "description" + } + + if (is.null(dataFrames)) { + dataFrames <- data + } else { + dataFrames <- rbind(dataFrames, data) + } + } + + if (is.null(dataFrames)) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to bind datasets") + } + + utils::write.table( + x = dataFrames, file = file, append = append, quote = quote, sep = sep, + eol = eol, na = na, dec = dec, row.names = FALSE, + col.names = TRUE, qmethod = qmethod, + fileEncoding = fileEncoding + ) +} + +.getDataset <- function(..., floatingPointNumbersEnabled = FALSE) { + args <- list(...) + if (length(args) == 0) { + stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "data.frame, data vectors, or datasets expected") + } + + if (.optionalArgsContainsDatasets(...)) { + if (length(args) == 1) { + return(args[[1]]) + } + + design <- .getDesignFromArgs(...) + if (length(args) == 2 && !is.null(design)) { + dataset <- .getDatasetFromArgs(...) + if (!is.null(dataset)) { + dataset <- dataset$clone(deep = TRUE) #TODO was $copy shallow + dataset$.design <- design + return(dataset) + } + } + + return(.getEnrichmentDatasetFromArgs(...)) + } + + exampleType <- args[["example"]] + if (!is.null(exampleType) && exampleType %in% c("means", "rates", "survival")) { + return(.getDatasetExample(exampleType = exampleType)) + } + + if (length(args) == 1 && !is.null(args[[1]]) && is.list(args[[1]]) && !is.data.frame(args[[1]])) { + return(.getDatasetMeansFromModelsByStage(emmeansResults = args[[1]])) + } + + emmeansResults <- .getDatasetMeansModelObjectsList(args) + if (!is.null(emmeansResults) && length(emmeansResults) > 0) { + return(.getDatasetMeansFromModelsByStage(emmeansResults = emmeansResults)) + } + + dataFrame <- .getDataFrameFromArgs(...) + + design <- .getDesignFromArgs(...) + + if (is.null(dataFrame)) { + args <- .removeDesignFromArgs(args) + + paramNames <- names(args) + paramNames <- paramNames[paramNames != ""] + + numberOfParameters <- length(args) + if (numberOfParameters > 0 && names(args)[1] == "" && .isTrialDesign(args[[1]])) { + numberOfParameters <- numberOfParameters - 1 + } + + if (length(paramNames) != numberOfParameters) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all parameters must be named") + } + + if (length(paramNames) != length(unique(paramNames))) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the parameter names must be unique") + } + + dataFrame <- .createDataFrame(...) + } + + enrichmentEnabled <- .isDataObjectEnrichment(...) + + if (.isDataObjectMeans(...)) { + return(DatasetMeansR6$new( + dataFrame = dataFrame, + floatingPointNumbersEnabled = floatingPointNumbersEnabled, + enrichmentEnabled = enrichmentEnabled, + .design = design + )) + } + + if (.isDataObjectRates(...)) { + return(DatasetRatesR6$new( + dataFrame = dataFrame, + floatingPointNumbersEnabled = floatingPointNumbersEnabled, + enrichmentEnabled = enrichmentEnabled, + .design = design + )) + } + + if (.isDataObjectNonStratifiedEnrichmentSurvival(...)) { + return(DatasetEnrichmentSurvivalR6$new( + dataFrame = dataFrame, + floatingPointNumbersEnabled = floatingPointNumbersEnabled, + enrichmentEnabled = enrichmentEnabled, + .design = design + )) + } + + if (.isDataObjectSurvival(...)) { + return(DatasetSurvivalR6$new( + dataFrame = dataFrame, + floatingPointNumbersEnabled = floatingPointNumbersEnabled, + enrichmentEnabled = enrichmentEnabled, + .design = design + )) + } + + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "failed to identify dataset type") +} + +#' @title +#' Get Dataset +#' +#' @description +#' Creates a dataset object and returns it. +#' +#' @param ... A \code{data.frame} or some data vectors defining the dataset. +#' @param floatingPointNumbersEnabled If \code{TRUE}, +#' sample sizes and event numbers can be specified as floating-point numbers +#' (this make sense, e.g., for theoretical comparisons); \cr +#' by default \code{floatingPointNumbersEnabled = FALSE}, i.e., +#' samples sizes and event numbers defined as floating-point numbers will be truncated. +#' +#' @details +#' The different dataset types \code{DatasetMeans}, of \code{DatasetRates}, or +#' \code{DatasetSurvival} can be created as follows: +#' \itemize{ +#' \item An element of \code{\link{DatasetMeans}} for one sample is created by \cr +#' \code{getDataset(sampleSizes =, means =, stDevs =)} where \cr +#' \code{sampleSizes}, \code{means}, \code{stDevs} are vectors with stage-wise sample sizes, +#' means and standard deviations of length given by the number of available stages. +#' \item An element of \code{\link{DatasetMeans}} for two samples is created by \cr +#' \code{getDataset(sampleSizes1 =, sampleSizes2 =, means1 =, means2 =, } \cr +#' \code{stDevs1 =, stDevs2 =)} where +#' \code{sampleSizes1}, \code{sampleSizes2}, \code{means1}, \code{means2}, +#' \code{stDevs1}, \code{stDevs2} are vectors with +#' stage-wise sample sizes, means and standard deviations for the two treatment groups +#' of length given by the number of available stages. +#' \item An element of \code{\link{DatasetRates}} for one sample is created by \cr +#' \code{getDataset(sampleSizes =, events =)} where \code{sampleSizes}, \code{events} are vectors +#' with stage-wise sample sizes and events of length given by the number of available stages. +#' \item An element of \code{\link{DatasetRates}} for two samples is created by \cr +#' \code{getDataset(sampleSizes1 =, sampleSizes2 =, events1 =, events2 =)} where +#' \code{sampleSizes1}, \code{sampleSizes2}, \code{events1}, \code{events2} +#' are vectors with stage-wise sample sizes +#' and events for the two treatment groups of length given by the number of available stages. +#' \item An element of \code{\link{DatasetSurvival}} is created by \cr +#' \code{getDataset(events =, logRanks =, allocationRatios =)} where +#' \code{events}, \code{logRanks}, and \code{allocation ratios} are the stage-wise events, +#' (one-sided) logrank statistics, and allocation ratios. +#' \item An element of \code{\link{DatasetMeans}}, \code{\link{DatasetRates}}, and \code{\link{DatasetSurvival}} +#' for more than one comparison is created by adding subsequent digits to the variable names. +#' The system can analyze these data in a multi-arm many-to-one comparison setting where the +#' group with the highest index represents the control group. +#' } +#' Prefix \code{overall[Capital case of first letter of variable name]...} for the variable +#' names enables entering the overall (cumulative) results and calculates stage-wise statistics. +#' Since rpact version 3.2, the prefix \code{cumulative[Capital case of first letter of variable name]...} or +#' \code{cum[Capital case of first letter of variable name]...} can alternatively be used for this. +#' +#' \code{n} can be used in place of \code{samplesizes}. +#' +#' Note that in survival design usually the overall (cumulative) events and logrank test statistics are provided +#' in the output, so \cr +#' \code{getDataset(cumulativeEvents=, cumulativeLogRanks =, cumulativeAllocationRatios =)} \cr +#' is the usual command for entering survival data. Note also that for \code{cumulativeLogranks} also the +#' z scores from a Cox regression can be used. +#' +#' For multi-arm designs, the index refers to the considered comparison. For example,\cr +#' \code{ +#' getDataset(events1=c(13, 33), logRanks1 = c(1.23, 1.55), events2 = c(16, NA), logRanks2 = c(1.55, NA)) +#' } \cr +#' refers to the case where one active arm (1) is considered at both stages whereas active arm 2 +#' was dropped at interim. Number of events and logrank statistics are entered for the corresponding +#' comparison to control (see Examples). +#' +#' For enrichment designs, the comparison of two samples is provided for an unstratified +#' (sub-population wise) or stratified data input.\cr +#' For unstratified (sub-population wise) data input the data sets are defined for the sub-populations +#' S1, S2, ..., F, where F refers to the full populations. Use of \code{getDataset(S1 = , S2, ..., F = )} +#' defines the data set to be used in \code{\link[=getAnalysisResults]{getAnalysisResults()}} (see examples)\cr +#' For stratified data input the data sets are defined for the strata S1, S12, S2, ..., R, where R +#' refers to the remainder of the strata such that the union of all sets is the full population. +#' Use of \code{getDataset(S1 = , S12 = , S2, ..., R = )} defines the data set to be used in +#' \code{\link[=getAnalysisResults]{getAnalysisResults()}} (see examples)\cr +#' For survival data, for enrichment designs the log-rank statistics should be entered as stratified +#' log-rank statistics in order to provide strong control of Type I error rate. For stratified data input, +#' the variables to be specified in \code{getDataset()} are \code{events}, \code{expectedEvents}, +#' \code{varianceEvents}, and \code{allocationRatios} or \code{overallEvents}, \code{overallExpectedEvents}, +#' \code{overallVarianceEvents}, and \code{overallAllocationRatios}. From this, (stratified) log-rank tests are +#' calculated. +#' +#' @template return_object_dataset +#' +#' @template examples_get_dataset +#' +#' @include f_analysis_base.R +#' @include f_analysis_utilities.R +#' +#' @export +#' +getDataset <- function(..., floatingPointNumbersEnabled = FALSE) { + dataset <- .getDataset(floatingPointNumbersEnabled = floatingPointNumbersEnabled, ...) + if (dataset$.enrichmentEnabled && dataset$getNumberOfGroups() != 2) { + warning("Only population enrichment data with 2 groups can be analyzed but ", + dataset$getNumberOfGroups(), " group", + ifelse(dataset$getNumberOfGroups() == 1, " is", "s are"), " defined", + call. = FALSE + ) + } + return(dataset) +} + +#' @rdname getDataset +#' @export +getDataSet <- function(..., floatingPointNumbersEnabled = FALSE) { + return(getDataset(floatingPointNumbersEnabled = floatingPointNumbersEnabled, ...)) +} + +.getDatasetMeansModelObjectsList <- function(args) { + if (is.null(args) || length(args) == 0 || !is.list(args)) { + return(NULL) + } + + emmeansResults <- list() + for (arg in args) { + if (inherits(arg, "emmGrid")) { + emmeansResults[[length(emmeansResults) + 1]] <- arg + } + } + if (length(emmeansResults) == 0) { + return(NULL) + } + + argNames <- names(args) + for (i in 1:length(args)) { + arg <- args[[i]] + if (!inherits(arg, "emmGrid")) { + argName <- argNames[i] + argInfo <- "" + if (length(argName) == 1 && argName != "") { + argInfo <- paste0(sQuote(argName), " ") + } + argInfo <- paste0(argInfo, "(", .arrayToString(arg), ")") + warning("Argument ", argInfo, " will be ignored because only 'emmGrid' objects will be respected") + } + } + + return(emmeansResults) +} + +.getStandardDeviationFromStandardError <- function(sampleSize, standardError, ..., + dfValue = NA_real_, alpha = 0.05, lmEnabled = TRUE, stDevCalcMode = "auto") { + qtCalcEnablbled <- length(stDevCalcMode) == 1 && !is.na(stDevCalcMode) && stDevCalcMode == "t" + if ((qtCalcEnablbled || !lmEnabled) && !is.na(dfValue) && !is.infinite(dfValue) && dfValue > 0) { + qValue <- stats::qt(1 - alpha / 2, df = dfValue) + stDev <- standardError * 2 / qValue * sqrt(sampleSize) + } else { + stDev <- standardError * sqrt(sampleSize) + } + + return(stDev) +} + +.getDatasetMeansFromModelsByStage <- function(emmeansResults, correctGroupOrder = TRUE) { + if (is.null(emmeansResults)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(emmeansResults), " must be a non-empty list") + } + if (!is.list(emmeansResults)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(emmeansResults), " must be a list") + } + if (length(emmeansResults) == 0) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(emmeansResults), " must be not empty") + } + + for (stage in 1:length(emmeansResults)) { + if (!inherits(emmeansResults[[stage]], "emmGrid")) { + stop(sprintf( + paste0( + "%s%s must contain %s objects created by emmeans(x), ", + "where x is a linear model result (one object per stage; class is %s at stage %s)" + ), + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("emmeansResults"), sQuote("emmGrid"), + .getClassName(emmeansResults[[stage]]), stage + )) + } + } + + stages <- integer(0) + groups <- integer(0) + means <- numeric(0) + stDevs <- numeric(0) + sampleSizes <- numeric(0) + + lmEnabled <- TRUE + tryCatch( + { + modelCall <- emmeansResults[[1]]@model.info$call + modelFunction <- as.character(modelCall)[1] + lmEnabled <- modelFunction == "lm" + if (!grepl(paste0("::", modelFunction), modelFunction)) { + packageName <- .getPackageName(modelFunction) + if (!is.na(packageName)) { + modelFunction <- paste0(packageName, "::", modelFunction) + } + } + + if (lmEnabled) { + warning("When using ", modelFunction, "() ", + "the estimated marginal means and standard deviations can be inaccurate ", + "and analysis results based on this values may be imprecise", + call. = FALSE + ) + } else { + warning("Using ", modelFunction, " emmeans result objects as ", + "arguments of getDataset() is experminental in this rpact version and not fully validated", + call. = FALSE + ) + } + }, + error = function(e) { + warning("Using emmeans result objects as ", + "arguments of getDataset() is experminental in this rpact version and not fully validated", + call. = FALSE + ) + } + ) + + stDevCalcMode <- getOption("rpact.dataset.stdev.calc.mode", "auto") # auto, sigma, norm, t + for (stage in 1:length(emmeansResults)) { + emmeansResult <- emmeansResults[[stage]] + emmeansResultsSummary <- summary(emmeansResult) + emmeansResultsList <- as.list(emmeansResult) + + if (is.null(emmeansResultsSummary[["emmean"]])) { + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, + "the objects in summary(emmeansResults) must contain the field 'emmean'" + ) + } + for (expectedField in c("sigma", "extras")) { + if (is.null(emmeansResultsList[[expectedField]])) { + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, + "the objects in as.list(emmeansResults) must contain the field ", sQuote(expectedField) + ) + } + } + + numberOfGroups <- length(emmeansResultsSummary$emmean) + rpactGroupNumbers <- 1:numberOfGroups + if (correctGroupOrder) { + rpactGroupNumbers <- 1 + if (numberOfGroups > 1) { + rpactGroupNumbers <- c(2:numberOfGroups, rpactGroupNumbers) + } + } + for (group in 1:length(emmeansResultsSummary$emmean)) { + stages <- c(stages, stage) + groups <- c(groups, group) + rpactGroupNumber <- rpactGroupNumbers[group] + + standardError <- emmeansResultsSummary$SE[rpactGroupNumber] + + sampleSize <- emmeansResultsList$extras[rpactGroupNumber, ] + meanValue <- emmeansResultsSummary$emmean[rpactGroupNumber] + dfValue <- emmeansResultsSummary$df[rpactGroupNumber] + if (length(stDevCalcMode) == 1 && !is.na(stDevCalcMode) && stDevCalcMode == "sigma") { + # pooled standard deviation from emmeans + stDev <- emmeansResultsList$sigma + } else { + stDev <- .getStandardDeviationFromStandardError(sampleSize, standardError, + dfValue = dfValue, lmEnabled = lmEnabled, stDevCalcMode = stDevCalcMode + ) + } + + means <- c(means, meanValue) + stDevs <- c(stDevs, stDev) + sampleSizes <- c(sampleSizes, sampleSize) + } + } + + data <- data.frame( + stages = stages, + groups = groups, + means = means, + stDevs = stDevs, + sampleSizes = sampleSizes + ) + data <- data[order(data$stages, data$groups), ] + dataWide <- stats::reshape(data = data, direction = "wide", idvar = "stages", timevar = "groups") + colnames(dataWide) <- gsub("\\.", "", colnames(dataWide)) + return(getDataset(dataWide)) +} + +.optionalArgsContainsDatasets <- function(...) { + args <- list(...) + if (length(args) == 0) { + return(FALSE) + } + + for (arg in args) { + if (inherits(arg, "Dataset") || inherits(arg, "DatasetR6")) { + return(TRUE) + } + } + return(FALSE) +} + +.getSubsetsFromArgs <- function(...) { + args <- list(...) + if (length(args) == 0) { + stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "one or more subset datasets expected") + } + + subsetNames <- names(args) + if (is.null(subsetNames)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all subsets must be named") + } + + if (!("R" %in% subsetNames) && !("F" %in% subsetNames)) { + stop( + C_EXCEPTION_TYPE_MISSING_ARGUMENT, + '"R" (stratified analysis)" or "F" (non-stratified analysis) must be defined as subset' + ) + } + + subsetNumbers <- gsub("\\D", "", subsetNames) + subsetNumbers <- subsetNumbers[subsetNumbers != ""] # & nchar(subsetNumbers) == 1 + if (length(subsetNumbers) == 0) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all subset names (", + .arrayToString(subsetNames), ") must be \"S[n]\", \"R\", or \"F\", ", + "where [n] is a number with increasing digits (starting with 1)" + ) + } + + stratifiedInput <- "R" %in% subsetNames + + subsetNumbers <- paste0(subsetNumbers, collapse = "") + subsetNumbers <- strsplit(subsetNumbers, "")[[1]] + subsetNumbers <- as.integer(subsetNumbers) + gMax <- max(subsetNumbers) + 1 + validSubsetNames <- .createSubsetsByGMax(gMax, stratifiedInput = stratifiedInput, all = FALSE) + for (subsetName in subsetNames) { + if (subsetName == "") { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all subsets must be named") + } + + if (!(subsetName %in% validSubsetNames)) { + suffix <- ifelse(stratifiedInput, " (stratified analysis)", " (non-stratified analysis)") + if (length(validSubsetNames) < 10) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "invalid subset name (", subsetName, "); ", + "valid names are ", .arrayToString(validSubsetNames), suffix + ) + } else { + restFull <- ifelse(stratifiedInput, '"R"', '"F"') + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "invalid subset name (", subsetName, "): ", + "all subset names must be \"S[n]\" or ", restFull, ", ", + "where [n] is a number with increasing digits", suffix + ) + } + } + } + + subsets <- NULL + subsetType <- NA_character_ + emptySubsetNames <- validSubsetNames[!(validSubsetNames %in% subsetNames)] + for (subsetName in subsetNames) { + subset <- args[[subsetName]] + if (is.null(subset) || (!(isS4(subset) || is.R6(subset)) && is.na(subset))) { + emptySubsetNames <- c(emptySubsetNames, subsetName) + } else { + if (!.isDataset(subset)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "subset ", subsetName, " is not a dataset (is ", .getClassName(subset), ")" + ) + } + if (!is.na(subsetType) && subsetType != .getClassName(subset)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "all subsets must have the same type (found ", subsetType, " and ", .getClassName(subset), ")" + ) + } + subsetType <- .getClassName(subset) + if (is.null(subset[[".data"]])) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "subset ", subsetName, " does not contain field '.data'" + ) + } + subset <- subset$.data + subset$subset <- rep(subsetName, nrow(subset)) + if (is.null(subsets)) { + subsets <- subset + } else { + subsets <- rbind(subsets, subset) + } + } + } + + if (length(emptySubsetNames) > 0) { + emptySubsetNames <- unique(emptySubsetNames) + template <- subsets[subsets$subset == ifelse(stratifiedInput, "R", "F"), ] + colNames <- colnames(template) + colNames <- colNames[!(colNames %in% c("stage", "group", "subset"))] + for (colName in colNames) { + template[[colName]] <- rep(NA_real_, nrow(template)) + } + + for (subsetName in emptySubsetNames) { + template$subset <- rep(subsetName, nrow(template)) + subsets <- rbind(subsets, template) + } + + if (length(emptySubsetNames) == 1) { + warning("The undefined subset ", emptySubsetNames, + " was defined as empty subset", + call. = FALSE + ) + } else { + warning(gettextf( + "The %s undefined subsets %s were defined as empty subsets", + length(emptySubsetNames), .arrayToString(emptySubsetNames) + ), call. = FALSE) + } + } + + return(subsets) +} + +.validateEnrichmentDataFrameAtFirstStage <- function(dataFrame, params) { + dataFrameStage1 <- dataFrame[dataFrame$stage == 1, ] + for (param in params) { + paramValue <- dataFrameStage1[[param]] + if (any(is.null(paramValue) || any(is.infinite(paramValue)))) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + gettextf( + "all %s values (%s) at first stage must be valid", + sQuote(param), .arrayToString(paramValue, maxLength = 10) + ) + ) + } + if (any(is.na(paramValue))) { + subsets <- unique(dataFrame$subset) + for (s in subsets) { + subData <- dataFrame[dataFrame$subset == s, ] + subsetParamValues <- subData[[param]] + if (!all(is.na(subsetParamValues)) && any(is.na(subsetParamValues[subData$stage == 1]))) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + gettextf( + "all %s values (%s) at first stage must be valid (NA is not allowed)", + sQuote(param), .arrayToString(paramValue, maxLength = 10) + ) + ) + } + } + } + } +} + +.getEndpointSpecificDataFrameParameterNames <- function(dataFrame) { + paramNames <- colnames(dataFrame) + paramNames <- paramNames[!(paramNames %in% c("stage", "group", "subset"))] + return(paramNames) +} + +.validateEnrichmentDataFrameDeselection <- function(dataFrame) { + paramNames <- .getEndpointSpecificDataFrameParameterNames(dataFrame) + for (i in 1:nrow(dataFrame)) { + row <- dataFrame[i, paramNames] + if (any(is.na(row)) && !all(is.na(row))) { + stop( + C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, + gettextf( + paste0( + "inconsistent deselection in group %s at stage %s (", + "%s: all or none must be NA)" + ), + dataFrame$group[i], dataFrame$stage[i], .arrayToString(paramNames, maxCharacters = 40) + ) + ) + } + } + + subsets <- unique(dataFrame$subset) + for (s in subsets) { + deselectedStage <- 0 + for (stage in unique(dataFrame$stage)) { + subData <- dataFrame[dataFrame$subset == s & dataFrame$stage == stage, paramNames] + + if (deselectedStage > 0 && !all(is.na(subData))) { + stop( + C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, + gettextf(paste0( + "%s was deselected at stage %s ", + "and therefore must be also deselected in the following stages, ", + "but is no longer deselected in stage %s" + ), s, deselectedStage, stage) + ) + } + + if (any(is.na(subData))) { + deselectedStage <- stage + } + } + } +} + +.validateEnrichmentDataFrameMeans <- function(dataFrame) { + if (any(na.omit(dataFrame$stDev) <= 0) || any(na.omit(dataFrame$overallStDev) <= 0)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all standard deviations must be > 0") + } + if (any(na.omit(dataFrame$sampleSize) <= 0) || any(na.omit(dataFrame$overallSampleSize) <= 0)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all sample sizes must be > 0") + } + + .validateEnrichmentDataFrameAtFirstStage(dataFrame, + params = c("sampleSize", "overallSampleSize", "mean", "overallMean", "stDev", "overallStDev") + ) + + .validateEnrichmentDataFrameDeselection(dataFrame) + + subsets <- unique(dataFrame$subset) + if ("F" %in% subsets) { + subsets <- subsets[subsets != "F"] + fullData <- dataFrame[dataFrame$subset == "F", ] + for (s in subsets) { + for (stage in unique(dataFrame$stage)) { + for (group in unique(dataFrame$group)) { + subData <- dataFrame[dataFrame$subset == s & dataFrame$stage == stage & dataFrame$group == group, ] + + stDevFull <- na.omit(fullData$stDev[fullData$stage == stage & fullData$group == group]) + stDevSubset <- na.omit(subData$stDev) + if (length(stDevFull) > 0 && length(stDevSubset) > 0 && any(stDevFull <= stDevSubset)) { + stop( + C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, + gettextf( + "'stDev' F (%s) must be > 'stDev' %s (%s) in group %s at stage %s", + .arrayToString(stDevFull), s, + .arrayToString(stDevSubset), group, stage + ) + ) + } + + sampleSizeFull <- na.omit(fullData$sampleSize[fullData$stage == stage & fullData$group == group]) + sampleSizeSubset <- na.omit(subData$sampleSize) + if (length(sampleSizeFull) > 0 && length(sampleSizeSubset) > 0 && any(sampleSizeFull < sampleSizeSubset)) { + stop( + C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, + gettextf( + "'sampleSize' F (%s) must be >= 'sampleSize' %s (%s) in group %s at stage %s", + .arrayToString(sampleSizeFull), s, + .arrayToString(sampleSizeSubset), group, stage + ) + ) + } + } + } + } + } +} + +.validateEnrichmentDataFrameSurvival <- function(dataFrame) { + if (any(na.omit(dataFrame$event) < 0) || any(na.omit(dataFrame$overallEvent) < 0)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all events must be >= 0") + } + + .validateEnrichmentDataFrameAtFirstStage(dataFrame, + params = c("event", "overallEvent") + ) + + .validateEnrichmentDataFrameDeselection(dataFrame) + + subsets <- unique(dataFrame$subset) + if ("F" %in% subsets) { + subsets <- subsets[subsets != "F"] + fullData <- dataFrame[dataFrame$subset == "F", ] + for (s in subsets) { + for (stage in unique(dataFrame$stage)) { + for (group in unique(dataFrame$group)) { + subData <- dataFrame[dataFrame$subset == s & dataFrame$stage == stage & dataFrame$group == group, ] + + eventFull <- na.omit(fullData$event[fullData$stage == stage & fullData$group == group]) + eventSubset <- na.omit(subData$event) + if (length(eventFull) > 0 && length(eventSubset) > 0 && any(eventFull < eventSubset)) { + stop( + C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, + gettextf( + "'event' F (%s) must be >= 'event' %s (%s) in group %s at stage %s", + .arrayToString(eventFull), s, + .arrayToString(eventSubset), group, stage + ) + ) + } + } + } + } + } +} + +.validateEnrichmentDataFrameRates <- function(dataFrame) { + if (any(na.omit(dataFrame$sampleSize) <= 0) || any(na.omit(dataFrame$overallSampleSize) <= 0)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all sample sizes must be > 0") + } + + .validateEnrichmentDataFrameAtFirstStage(dataFrame, + params = c("sampleSize", "overallSampleSize") + ) + + .validateEnrichmentDataFrameDeselection(dataFrame) + + subsets <- unique(dataFrame$subset) + if ("F" %in% subsets) { + subsets <- subsets[subsets != "F"] + fullData <- dataFrame[dataFrame$subset == "F", ] + for (s in subsets) { + for (stage in unique(dataFrame$stage)) { + for (group in unique(dataFrame$group)) { + subData <- dataFrame[dataFrame$subset == s & dataFrame$stage == stage & dataFrame$group == group, ] + + sampleSizeFull <- na.omit(fullData$sampleSize[fullData$stage == stage & fullData$group == group]) + sampleSizeSubset <- na.omit(subData$sampleSize) + if (length(sampleSizeFull) > 0 && length(sampleSizeSubset) > 0 && any(sampleSizeFull < sampleSizeSubset)) { + stop( + C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, + gettextf( + "'sampleSize' F (%s) must be >= 'sampleSize' %s (%s) in group %s at stage %s", + .arrayToString(sampleSizeFull), s, + .arrayToString(sampleSizeSubset), group, stage + ) + ) + } + } + } + } + } + + .validateEnrichmentDataFrameSurvival(dataFrame) +} + +.validateEnrichmentDataFrameHasConsistentNumberOfStages <- function(dataFrame) { + subsets <- unique(dataFrame$subset) + kMaxList <- list() + for (s in subsets) { + subsetStages <- as.integer(sort(unique(na.omit(as.character(dataFrame$stage[dataFrame$subset == s]))))) + kMax <- max(subsetStages) + if (!identical(1:kMax, subsetStages)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + gettextf("subset %s has incomplete stages (%s)", s, .arrayToString(subsetStages)) + ) + } + + kMaxList[[s]] <- kMax + } + + kMax <- unique(unlist(kMaxList)) + if (length(kMax) > 1) { + stop( + C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, + "all subsets must have the identical number of stages defined (kMax: ", .listToString(kMaxList), ")" + ) + } +} + +.validateEnrichmentDataFrame <- function(dataFrame) { + paramNames <- colnames(dataFrame) + if (any(grepl("(S|s)tDev", paramNames))) { + .validateEnrichmentDataFrameMeans(dataFrame) + } else if (any(grepl("(S|s)ampleSize", paramNames)) && any(grepl("(E|e)vent", paramNames))) { + .validateEnrichmentDataFrameRates(dataFrame) + } else if (any(grepl("(L|l)ogRank", paramNames)) || any(grepl("(E|e)xpectedEvent", paramNames))) { + .validateEnrichmentDataFrameSurvival(dataFrame) + } else { + print(paramNames) + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "could not identify the endpoint of the specified dataset") + } + + subsets <- unique(dataFrame$subset) + if ("R" %in% subsets) { + paramNames <- .getEndpointSpecificDataFrameParameterNames(dataFrame) + paramName <- paramNames[1] + subsets <- subsets[subsets != "R"] + subsets <- subsets[grepl("^S\\d$", subsets)] + if (length(subsets) > 0) { + restData <- dataFrame[dataFrame$subset == "R", ] + for (s in subsets) { + stages <- unique(dataFrame$stage) + stages <- stages[stages != 1] + if (length(stages) > 0) { + for (stage in stages) { + for (group in unique(dataFrame$group)) { + subData <- dataFrame[dataFrame$subset == s & dataFrame$stage == stage & dataFrame$group == group, ] + + paramValueRest <- restData[[paramName]][restData$stage == stage & restData$group == group] + paramValueSubset <- subData[[paramName]] + if (length(paramValueRest) > 0 && length(paramValueSubset) > 0 && + any(is.na(paramValueSubset)) && !all(is.na(paramValueRest))) { + stop( + C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, + gettextf( + paste0( + "if %s is deselected (NA) then R also must be deselected (NA) but, e.g., ", + "%s R is %s in group %s at stage %s" + ), + s, sQuote(paramName), .arrayToString(paramValueRest, vectorLookAndFeelEnabled = TRUE), + group, stage + ) + ) + } + } + } + } + } + } + } + + .validateEnrichmentDataFrameHasConsistentNumberOfStages(dataFrame) +} + +.getEnrichmentDataFrameFromArgs <- function(...) { + dataFrame <- .getSubsetsFromArgs(...) + + validColumns <- c() + for (j in 1:ncol(dataFrame)) { + if (!all(is.na(dataFrame[, j]))) { + validColumns <- c(validColumns, j) + } + } + if (length(validColumns) > 0) { + dataFrame <- dataFrame[, validColumns] + } + + return(dataFrame) +} + +.getEnrichmentDatasetFromArgs <- function(...) { + dataFrame <- .getEnrichmentDataFrameFromArgs(...) + .validateEnrichmentDataFrame(dataFrame) + dataFrame <- .getWideFormat(dataFrame) + return(.getDataset(dataFrame = dataFrame)) +} + +.getDatasetExample <- function(exampleType) { + if (exampleType == "means") { + return(getDataset( + n1 = c(13, 25), + n2 = c(15, NA), + n3 = c(14, 27), + n4 = c(12, 29), + means1 = c(24.2, 22.2), + means2 = c(18.8, NA), + means3 = c(26.7, 27.7), + means4 = c(9.2, 12.2), + stDevs1 = c(24.4, 22.1), + stDevs2 = c(21.2, NA), + stDevs3 = c(25.6, 23.2), + stDevs4 = c(21.5, 22.7) + )) + } else if (exampleType == "rates") { + return(getDataset( + n1 = c(23, 25), + n2 = c(25, NA), + n3 = c(24, 27), + n4 = c(22, 29), + events1 = c(15, 12), + events2 = c(19, NA), + events3 = c(18, 22), + events4 = c(12, 13) + )) + } else if (exampleType == "survival") { + return(getDataset( + events1 = c(25, 32), + events2 = c(18, NA), + events3 = c(22, 36), + logRanks1 = c(2.2, 1.8), + logRanks2 = c(1.99, NA), + logRanks3 = c(2.32, 2.11) + )) + } + + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'exampleType' (", exampleType, ") is not allowed") +} + #' #' @name Dataset #' @@ -118,77 +1360,77 @@ C_KEY_WORDS <- c( #' #' @importFrom methods new #' -Dataset <- setRefClass("Dataset", - contains = "ParameterSet", - fields = list( - .data = "data.frame", - .plotSettings = "ANY", - .id = "integer", - .description = "character", - .floatingPointNumbersEnabled = "logical", - .kMax = "integer", - .enrichmentEnabled = "logical", - .inputType = "character", - .design = "ANY", - stages = "integer", - groups = "integer", - subsets = "character" - ), - methods = list( - initialize = function(dataFrame, ..., floatingPointNumbersEnabled = FALSE, enrichmentEnabled = FALSE) { - callSuper( - .floatingPointNumbersEnabled = floatingPointNumbersEnabled, - .enrichmentEnabled = enrichmentEnabled, ... - ) - .plotSettings <<- PlotSettingsR6$new() - .parameterNames <<- .getParameterNames(dataset = .self) - .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS - - .id <<- NA_integer_ - .description <<- NA_character_ - .inputType <<- NA_character_ +DatasetR6 <- R6Class("DatasetR6", + inherit = ParameterSetR6, + public = list( + .data = NULL, + .plotSettings = NULL, + .id = NULL, + .description = NULL, + .floatingPointNumbersEnabled = NULL, + .kMax = NULL, + .enrichmentEnabled = NULL, + .inputType = NULL, + .design = NULL, + stages = NULL, + groups = NULL, + subsets = NULL, + initialize = function(dataFrame, ..., floatingPointNumbersEnabled = FALSE, enrichmentEnabled = FALSE, .design = NULL) { + super$initialize() + + self$.floatingPointNumbersEnabled <- floatingPointNumbersEnabled + self$.enrichmentEnabled <- enrichmentEnabled + self$.design <- .design + + self$.plotSettings <- PlotSettingsR6$new() + self$.parameterNames <- .getParameterNames(dataset = self) + self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS + + self$.id <- NA_integer_ + self$.description <- NA_character_ + self$.inputType <- NA_character_ if (!missing(dataFrame)) { - .initByDataFrame(dataFrame) - .kMax <<- getNumberOfStages() - if (!.enrichmentEnabled) { - .validateDataset() + self$.initByDataFrame(dataFrame) + self$.kMax <- self$getNumberOfStages() + if (!self$.enrichmentEnabled) { + self$.validateDataset() } } }, getPlotSettings = function() { - return(.plotSettings) + return(self$.plotSettings) }, show = function(showType = 1, digits = NA_integer_) { "Method for automatically printing dataset objects" - .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) }, .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { - .resetCat() + self$.resetCat() if (!is.null(showType) && length(showType) == 1 && !is.na(showType) && is.character(showType) && showType == "rcmd") { - s <- strsplit(getObjectRCode(.self, stringWrapParagraphWidth = NULL), "), *")[[1]] + s <- strsplit(getObjectRCode(self, stringWrapParagraphWidth = NULL), "), *")[[1]] s[2:length(s)] <- paste0("\t", s[2:length(s)]) s <- paste0(s, collapse = "),\n") cat(s, "\n") } else if (showType == 2) { - callSuper(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) } else { - .showParametersOfOneGroup(.getUserDefinedParameters(), - title = .toString(startWithUpperCase = TRUE), orderByParameterName = FALSE, + self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), + title = self$.toString(startWithUpperCase = TRUE), orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled ) - .showParametersOfOneGroup(.getGeneratedParameters(), + self$.showParametersOfOneGroup(self$.getGeneratedParameters(), title = "Calculated data", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled ) - .showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - if (!is.na(.description) && nchar(.description) > 0) { - .cat("Description: ", .description, "\n\n", + if (!is.na(self$.description) && nchar(self$.description) > 0) { + self$.cat("Description: ", self$.description, "\n\n", consoleOutputEnabled = consoleOutputEnabled ) } @@ -202,42 +1444,42 @@ Dataset <- setRefClass("Dataset", ) } - if (!.paramExists(dataFrame, "stage") && !.paramExists(dataFrame, "stages")) { + if (!self$.paramExists(dataFrame, "stage") && !self$.paramExists(dataFrame, "stages")) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'dataFrame' must contain parameter 'stages' or 'stage'" ) } - stages <<- as.integer(.getValuesByParameterName(dataFrame, c("stages", "stage"))) - if (!.enrichmentEnabled && length(unique(stages)) < length(stages)) { + self$stages <- as.integer(self$.getValuesByParameterName(dataFrame, c("stages", "stage"))) + if (!self$.enrichmentEnabled && length(unique(self$stages)) < length(self$stages)) { stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'stages' (", .arrayToString(stages), + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'stages' (", .arrayToString(self$stages), ") must be a unique vector of stage numbers" ) } - groups <<- rep(1L, length(stages)) + self$groups <- rep(1L, length(self$stages)) - .setParameterType("groups", C_PARAM_USER_DEFINED) - .setParameterType("stages", C_PARAM_USER_DEFINED) + self$.setParameterType("groups", C_PARAM_USER_DEFINED) + self$.setParameterType("stages", C_PARAM_USER_DEFINED) if (any(grepl("^subsets?\\d*$", colnames(dataFrame)))) { - numberOfTreatmentGroups <- .getNumberOfGroups(dataFrame, c(C_KEY_WORDS_SAMPLE_SIZES, C_KEY_WORDS_LOG_RANKS)) - subsets <<- character(0) + numberOfTreatmentGroups <- self$.getNumberOfGroups(dataFrame, c(C_KEY_WORDS_SAMPLE_SIZES, C_KEY_WORDS_LOG_RANKS)) + self$subsets <- character(0) for (group in 1:numberOfTreatmentGroups) { suffix <- ifelse(any(grepl("^subsets?\\d+$", colnames(dataFrame))), group, "") - subsets <<- c(subsets, .getValuesByParameterName(dataFrame, C_KEY_WORDS_SUBSETS, suffix = suffix)) + self$subsets <- c(self$subsets, self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_SUBSETS, suffix = suffix)) } - .setParameterType("subsets", C_PARAM_USER_DEFINED) + self$.setParameterType("subsets", C_PARAM_USER_DEFINED) } else { - subsets <<- rep(NA_character_, length(stages)) + self$subsets <- rep(NA_character_, length(self$stages)) } }, .validateDataset = function() { - .assertIsValidKMax(kMax = getNumberOfStages()) + .assertIsValidKMax(kMax = self$getNumberOfStages()) - for (var in names(.self)) { - values <- .self[[var]] + for (var in names(self)) { + values <- self[[var]] if (any(is.nan(values)) || any(is.infinite(values))) { stop( C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'", var, "' (", .arrayToString(values), @@ -247,11 +1489,11 @@ Dataset <- setRefClass("Dataset", } }, .validateValues = function(values, name) { - if (.enrichmentEnabled) { + if (self$.enrichmentEnabled) { return(invisible()) } - l1 <- length(unique(stages)) + l1 <- length(unique(self$stages)) l2 <- length(values) if (l1 != l2) { stop( @@ -259,89 +1501,89 @@ Dataset <- setRefClass("Dataset", "there ", ifelse(l1 == 1, paste("is", l1, "stage"), paste("are", l1, "stages") ), " defined", - " (", .arrayToString(unique(stages)), ") and '", name, "' has length ", l2 + " (", .arrayToString(unique(self$stages)), ") and '", name, "' has length ", l2 ) } }, .recreateDataFrame = function() { - .data <<- data.frame( - stage = factor(stages), - group = factor(groups), - subset = factor(subsets) + self$.data <- data.frame( + stage = factor(self$stages), + group = factor(self$groups), + subset = factor(self$subsets) ) }, .setDataToVariables = function() { - stages <<- as.integer(.data$stage) - groups <<- as.integer(.data$group) - subsets <<- as.character(.data$subset) + self$stages <- as.integer(self$.data$stage) + self$groups <- as.integer(self$.data$group) + self$subsets <- as.character(self$.data$subset) }, .fillWithNAs = function(kMax) { - numberOfStages <- getNumberOfStages() - .kMax <<- numberOfStages + numberOfStages <- self$getNumberOfStages() + self$.kMax <- numberOfStages if (numberOfStages >= kMax) { return(invisible()) } - numberOfGroups <- getNumberOfGroups(survivalCorrectionEnabled = FALSE) - if (.enrichmentEnabled) { + numberOfGroups <- self$getNumberOfGroups(survivalCorrectionEnabled = FALSE) + if (self$.enrichmentEnabled) { for (stage in (numberOfStages + 1):kMax) { for (group in 1:numberOfGroups) { - for (subset in levels(.data$subset)) { - stages <<- c(stages, stage) - groups <<- c(groups, group) - subsets <<- c(subsets, subset) + for (subset in levels(self$.data$subset)) { + self$stages <- c(self$stages, stage) + self$groups <- c(self$groups, group) + self$subsets <- c(self$subsets, subset) } } } } else { for (stage in (numberOfStages + 1):kMax) { for (group in 1:numberOfGroups) { - stages <<- c(stages, stage) - groups <<- c(groups, group) - subsets <<- c(subsets, NA_character_) + self$stages <- c(self$stages, stage) + self$groups <- c(self$groups, group) + self$subsets <- c(self$subsets, NA_character_) } } } }, .trim = function(kMax) { if (is.na(kMax)) { - kMax <- .kMax + kMax <- self$.kMax } - numberOfStages <- getNumberOfStages(FALSE) + numberOfStages <- self$getNumberOfStages(FALSE) if (numberOfStages <= kMax) { return(invisible(numeric(0))) } - indices <- which(stages <= kMax) + indices <- which(self$stages <= kMax) - stages <<- stages[indices] - groups <<- groups[indices] - subsets <<- subsets[indices] + self$stages <- self$stages[indices] + self$groups <- self$groups[indices] + self$subsets <- self$subsets[indices] return(indices) }, .orderDataByStageAndGroup = function() { - if (.enrichmentEnabled) { - dat <- .data - dat$char <- gsub("\\d", "", as.character(.data$subset)) + if (self$.enrichmentEnabled) { + dat <- self$.data + dat$char <- gsub("\\d", "", as.character(self$.data$subset)) dat$char[dat$char == "R"] <- "Z" dat$char[dat$char == "F"] <- "Z" - dat$num <- as.integer(gsub("\\D", "", as.character(.data$subset))) + dat$num <- as.integer(gsub("\\D", "", as.character(self$.data$subset))) - .data <<- .data[order(.data$stage, .data$group, dat$char, dat$num), ] + self$.data <- self$.data[order(self$.data$stage, self$.data$group, dat$char, dat$num), ] } else { - .data <<- .data[order(.data$stage, .data$group), ] + self$.data <- self$.data[order(self$.data$stage, self$.data$group), ] } }, .getNumberOfNAsToAdd = function(kMax) { - n <- kMax - getNumberOfStages() + n <- kMax - self$getNumberOfStages() if (n <= 0) { return(0) } - n <- n * getNumberOfGroups(survivalCorrectionEnabled = FALSE) - if (.enrichmentEnabled) { - n <- n * getNumberOfSubsets() + n <- n * self$getNumberOfGroups(survivalCorrectionEnabled = FALSE) + if (self$.enrichmentEnabled) { + n <- n * self$getNumberOfSubsets() } return(n) }, @@ -358,7 +1600,7 @@ Dataset <- setRefClass("Dataset", defaultValues = NULL, suffix = "") { for (parameterName in parameterNameVariants) { key <- paste0(parameterName, suffix) - if (.paramExists(dataFrame, key)) { + if (self$.paramExists(dataFrame, key)) { return(dataFrame[[key]]) } } @@ -380,8 +1622,8 @@ Dataset <- setRefClass("Dataset", return(sort(unique(na.omit(values)))) }, .getValues = function(paramName, paramValues) { - values <- .data[[paramName]] - valueLevels <- .getValueLevels(values) + values <- self$.data[[paramName]] + valueLevels <- self$.getValueLevels(values) if (!all(paramValues %in% valueLevels)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", paramName, "' (", .arrayToString(paramValues), @@ -391,61 +1633,61 @@ Dataset <- setRefClass("Dataset", return(values) }, .getIndexValues = function(paramName, paramValues, subset = NA_character_) { - values <- .getValues(paramName, paramValues) + values <- self$.getValues(paramName, paramValues) if (all(is.na(subset))) { return(which(values %in% paramValues)) } - .assertIsValidSubset(subset) - return(which(values %in% paramValues & .data$subset %in% subset)) + self$.assertIsValidSubset(subset) + return(which(values %in% paramValues & self$.data$subset %in% subset)) }, .assertIsValidSubset = function(subset) { for (s in subset) { - if (!(s %in% levels(.data$subset))) { + if (!(s %in% levels(self$.data$subset))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'subset' (", s, - ") is not a defined value [", .arrayToString(levels(.data$subset)), "]" + ") is not a defined value [", .arrayToString(levels(self$.data$subset)), "]" ) } } }, .getIndices = function(..., stage, group, subset = NA_character_) { - if (is.null(.data)) { + if (is.null(self$.data)) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'.data' must be defined") } if (!is.null(stage) && !any(is.na(stage)) && all(stage < 0)) { - index <- 1:getNumberOfStages() + index <- 1:self$getNumberOfStages() stage <- index[!(index %in% abs(stage))] } if (!is.null(group) && !any(is.na(group)) && all(group < 0)) { - index <- 1:getNumberOfGroups(survivalCorrectionEnabled = FALSE) + index <- 1:self$getNumberOfGroups(survivalCorrectionEnabled = FALSE) group <- index[!(index %in% abs(group))] } # stage only and optional subset if (!is.null(group) && length(group) == 1 && is.na(group)) { - return(.getIndexValues("stage", stage, subset)) + return(self$.getIndexValues("stage", stage, subset)) } # group only and optional subset if (!is.null(stage) && length(stage) == 1 && is.na(stage)) { - return(.getIndexValues("group", group, subset)) + return(self$.getIndexValues("group", group, subset)) } # stage and group and optional subset - stageValues <- .getValues("stage", stage) - groupValues <- .getValues("group", group) + stageValues <- self$.getValues("stage", stage) + groupValues <- self$.getValues("group", group) if (all(is.na(subset))) { return(which(stageValues %in% stage & groupValues %in% group)) } - .assertIsValidSubset(subset) - return(which(stageValues %in% stage & groupValues %in% group & .data$subset %in% subset)) + self$.assertIsValidSubset(subset) + return(which(stageValues %in% stage & groupValues %in% group & self$.data$subset %in% subset)) }, .getValidatedFloatingPointNumbers = function(x, parameterName = "Sample sizes") { - if (.floatingPointNumbersEnabled) { + if (self$.floatingPointNumbersEnabled) { return(x) } @@ -459,7 +1701,7 @@ Dataset <- setRefClass("Dataset", }, .keyWordExists = function(dataFrame, keyWords, suffix = "") { for (key in keyWords) { - if (.paramExists(dataFrame, paste0(key, suffix))) { + if (self$.paramExists(dataFrame, paste0(key, suffix))) { return(TRUE) } } @@ -467,7 +1709,7 @@ Dataset <- setRefClass("Dataset", }, .getNumberOfGroups = function(dataFrame, keyWords) { for (group in 2:1000) { - if (!.keyWordExists(dataFrame, keyWords, group)) { + if (!self$.keyWordExists(dataFrame, keyWords, group)) { return(group - 1) } } @@ -475,31 +1717,31 @@ Dataset <- setRefClass("Dataset", }, .getValidatedStage = function(stage = NA_integer_) { if (all(is.na(stage))) { - stage <- c(1:getNumberOfStages()) + stage <- c(1:self$getNumberOfStages()) } return(stage) }, getNumberOfGroups = function(survivalCorrectionEnabled = TRUE) { - data <- stats::na.omit(.data) + data <- stats::na.omit(self$.data) if (!survivalCorrectionEnabled) { return(length(levels(data$group))) } - return(length(levels(data$group)) + ifelse(inherits(.self, "DatasetSurvival"), 1, 0)) + return(length(levels(data$group)) + ifelse(inherits(self, "DatasetSurvival") || inherits(self, "DatasetSurvivalR6"), 1, 0)) }, getNumberOfStages = function(naOmitEnabled = TRUE) { if (naOmitEnabled) { - colNames <- colnames(.data) + colNames <- colnames(self$.data) validColNames <- character(0) for (colName in colNames) { - colValues <- .data[, colName] + colValues <- self$.data[, colName] if (length(colValues) > 0 && !all(is.na(colValues))) { validColNames <- c(validColNames, colName) } } - subData <- stats::na.omit(.data[, validColNames]) + subData <- stats::na.omit(self$.data[, validColNames]) numberOfStages <- length(unique(as.character(subData$stage))) if (numberOfStages == 0) { - print(.data[, validColNames]) + print(self$.data[, validColNames]) stop( C_EXCEPTION_TYPE_RUNTIME_ISSUE, ".data seems to contain an invalid column" @@ -507,48 +1749,48 @@ Dataset <- setRefClass("Dataset", } return(numberOfStages) } - return(length(levels(.data$stage))) + return(length(levels(self$.data$stage))) }, getNumberOfSubsets = function() { - return(length(levels(.data$subset))) + return(length(levels(self$.data$subset))) }, isDatasetMeans = function() { - return(inherits(.self, "DatasetMeans")) + return(inherits(self, "DatasetMeansR6")) }, isDatasetRates = function() { - return(inherits(.self, "DatasetRates")) + return(inherits(self, "DatasetRatesR6")) }, isDatasetSurvival = function() { - return(inherits(.self, "DatasetSurvival")) + return(inherits(self, "DatasetSurvivalR6")) }, isStratified = function() { - return(.enrichmentEnabled && "R" %in% levels(.data$subset)) + return(self$.enrichmentEnabled && "R" %in% levels(self$.data$subset)) }, setId = function(id) { - .id <<- as.integer(id) + self$.id <- as.integer(id) }, getId = function() { - return(.id) + return(self$.id) }, setDescription = function(description) { - .description <<- description + self$.description <- description }, getDescription = function() { - return(.description) + return(self$.description) }, .toString = function(startWithUpperCase = FALSE) { s <- "dataset of " - if (.enrichmentEnabled) { + if (self$.enrichmentEnabled) { s <- paste0(s, "enrichment ") - } else if (.self$getNumberOfGroups() > 2) { + } else if (self$getNumberOfGroups() > 2) { s <- paste0(s, "multi-arm ") } - if (isDatasetMeans()) { + if (self$isDatasetMeans()) { s <- paste0(s, "means") - } else if (isDatasetRates()) { + } else if (self$isDatasetRates()) { s <- paste0(s, "rates") - } else if (isDatasetSurvival()) { + } else if (self$isDatasetSurvival()) { s <- paste0(s, "survival data") } else { s <- paste0(s, "unknown endpoint") @@ -588,129 +1830,127 @@ Dataset <- setRefClass("Dataset", #' #' @importFrom methods new #' -DatasetMeans <- setRefClass("DatasetMeans", - contains = "Dataset", - fields = list( - sampleSizes = "numeric", - means = "numeric", - stDevs = "numeric", - overallSampleSizes = "numeric", - overallMeans = "numeric", - overallStDevs = "numeric" - ), - methods = list( +DatasetMeansR6 <- R6Class("DatasetMeansR6", + inherit = DatasetR6, + public = list( + sampleSizes = NULL, + means = NULL, + stDevs = NULL, + overallSampleSizes = NULL, + overallMeans = NULL, + overallStDevs = NULL, getSampleSize = function(stage, group = 1, subset = NA_character_) { - return(.data$sampleSize[.getIndices(stage = stage, group = group, subset = subset)]) + return(self$.data$sampleSize[self$.getIndices(stage = stage, group = group, subset = subset)]) }, getMean = function(stage, group = 1, subset = NA_character_) { - return(.data$mean[.getIndices(stage = stage, group = group, subset = subset)]) + return(self$.data$mean[self$.getIndices(stage = stage, group = group, subset = subset)]) }, getStDev = function(stage, group = 1, subset = NA_character_) { - return(.data$stDev[.getIndices(stage = stage, group = group, subset = subset)]) + return(self$.data$stDev[self$.getIndices(stage = stage, group = group, subset = subset)]) }, getSampleSizes = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(.data$sampleSize[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) + return(self$.data$sampleSize[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) }, getMeans = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(.data$mean[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) + return(self$.data$mean[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) }, getStDevs = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(.data$stDev[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) + return(self$.data$stDev[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) }, getSampleSizesUpTo = function(to, group = 1, subset = NA_character_) { - return(.data$sampleSize[.getIndices(stage = c(1:to), group = group, subset = subset)]) + return(self$.data$sampleSize[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) }, getMeansUpTo = function(to, group = 1, subset = NA_character_) { - return(.data$mean[.getIndices(stage = c(1:to), group = group, subset = subset)]) + return(self$.data$mean[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) }, getStDevsUpTo = function(to, group = 1, subset = NA_character_) { - return(.data$stDev[.getIndices(stage = c(1:to), group = group, subset = subset)]) + return(self$.data$stDev[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) }, getOverallSampleSize = function(stage, group = 1, subset = NA_character_) { - return(.data$overallSampleSize[.getIndices(stage = stage, group = group, subset = subset)]) + return(self$.data$overallSampleSize[self$.getIndices(stage = stage, group = group, subset = subset)]) }, getOverallMean = function(stage, group = 1, subset = NA_character_) { - return(.data$overallMean[.getIndices(stage = stage, group = group, subset = subset)]) + return(self$.data$overallMean[self$.getIndices(stage = stage, group = group, subset = subset)]) }, getOverallStDev = function(stage, group = 1, subset = NA_character_) { - return(.data$overallStDev[.getIndices(stage = stage, group = group, subset = subset)]) + return(self$.data$overallStDev[self$.getIndices(stage = stage, group = group, subset = subset)]) }, getOverallSampleSizes = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(.data$overallSampleSize[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) + return(self$.data$overallSampleSize[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) }, getOverallMeans = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(.data$overallMean[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) + return(self$.data$overallMean[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) }, getOverallStDevs = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(.data$overallStDev[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) + return(self$.data$overallStDev[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) }, getOverallSampleSizesUpTo = function(to, group = 1, subset = NA_character_) { - return(.data$overallSampleSize[.getIndices(stage = c(1:to), group = group, subset = subset)]) + return(self$.data$overallSampleSize[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) }, getOverallMeansUpTo = function(to, group = 1, subset = NA_character_) { - return(.data$overallMean[.getIndices(stage = c(1:to), group = group, subset = subset)]) + return(self$.data$overallMean[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) }, getOverallStDevsUpTo = function(to, group = 1, subset = NA_character_) { - return(.data$overallStDev[.getIndices(stage = c(1:to), group = group, subset = subset)]) + return(self$.data$overallStDev[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) }, .initByDataFrame = function(dataFrame) { - callSuper(dataFrame) + super$.initByDataFrame(dataFrame) # case: one mean - stage wise - if (.paramExists(dataFrame, C_KEY_WORDS_SAMPLE_SIZES)) { - .inputType <<- "stagewise" - sampleSizes <<- .getValidatedFloatingPointNumbers(.getValuesByParameterName( + if (self$.paramExists(dataFrame, C_KEY_WORDS_SAMPLE_SIZES)) { + self$.inputType <- "stagewise" + self$sampleSizes <- self$.getValidatedFloatingPointNumbers(self$.getValuesByParameterName( dataFrame, C_KEY_WORDS_SAMPLE_SIZES ), parameterName = "Sample sizes") - .validateValues(sampleSizes, "n") - if (any(stats::na.omit(sampleSizes) <= 0)) { + self$.validateValues(self$sampleSizes, "n") + if (any(stats::na.omit(self$sampleSizes) <= 0)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all sample sizes must be > 0, but 'n' = ", - .arrayToString(sampleSizes, vectorLookAndFeelEnabled = TRUE) + .arrayToString(self$sampleSizes, vectorLookAndFeelEnabled = TRUE) ) } - means <<- .getValuesByParameterName(dataFrame, C_KEY_WORDS_MEANS) - .validateValues(means, "means") + self$means <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_MEANS) + self$.validateValues(self$means, "means") - stDevs <<- .getValuesByParameterName(dataFrame, C_KEY_WORDS_ST_DEVS) - .validateValues(stDevs, "stDevs") + self$stDevs <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_ST_DEVS) + self$.validateValues(self$stDevs, "stDevs") } # case: one mean - overall - else if (.paramExists(dataFrame, C_KEY_WORDS_OVERALL_SAMPLE_SIZES)) { - .inputType <<- "overall" - overallSampleSizes <<- .getValidatedFloatingPointNumbers(.getValuesByParameterName( + else if (self$.paramExists(dataFrame, C_KEY_WORDS_OVERALL_SAMPLE_SIZES)) { + self$.inputType <- "overall" + self$overallSampleSizes <- self$.getValidatedFloatingPointNumbers(self$.getValuesByParameterName( dataFrame, C_KEY_WORDS_OVERALL_SAMPLE_SIZES ), parameterName = "Cumulative sample sizes ") - .validateValues(overallSampleSizes, "overallSampleSizes") + self$.validateValues(self$overallSampleSizes, "overallSampleSizes") - overallMeans <<- .getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_MEANS) - .validateValues(overallMeans, "overallMeans") + self$overallMeans <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_MEANS) + self$.validateValues(self$overallMeans, "overallMeans") - overallStDevs <<- .getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_ST_DEVS) - .validateValues(overallStDevs, "overallStDevs") + self$overallStDevs <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_ST_DEVS) + self$.validateValues(self$overallStDevs, "overallStDevs") } # case: two or more means - stage wise - else if (.paramExists(dataFrame, paste0(C_KEY_WORDS_SAMPLE_SIZES, 1)) && - .paramExists(dataFrame, paste0(C_KEY_WORDS_SAMPLE_SIZES, 2))) { - .inputType <<- "stagewise" - numberOfTreatmentGroups <- .getNumberOfGroups(dataFrame, C_KEY_WORDS_SAMPLE_SIZES) - stages <<- rep(stages, numberOfTreatmentGroups) - groups <<- integer(0) - sampleSizes <<- numeric(0) - means <<- numeric(0) - stDevs <<- numeric(0) + else if (self$.paramExists(dataFrame, paste0(C_KEY_WORDS_SAMPLE_SIZES, 1)) && + self$.paramExists(dataFrame, paste0(C_KEY_WORDS_SAMPLE_SIZES, 2))) { + self$.inputType <- "stagewise" + numberOfTreatmentGroups <- self$.getNumberOfGroups(dataFrame, C_KEY_WORDS_SAMPLE_SIZES) + self$stages <- rep(self$stages, numberOfTreatmentGroups) + self$groups <- integer(0) + self$sampleSizes <- numeric(0) + self$means <- numeric(0) + self$stDevs <- numeric(0) for (group in 1:numberOfTreatmentGroups) { - sampleSizesTemp <- .getValidatedFloatingPointNumbers(.getValuesByParameterName( + sampleSizesTemp <- self$.getValidatedFloatingPointNumbers(self$.getValuesByParameterName( dataFrame, C_KEY_WORDS_SAMPLE_SIZES, suffix = group ), parameterName = "Sample sizes") - .validateValues(sampleSizesTemp, paste0("n", group)) + self$.validateValues(sampleSizesTemp, paste0("n", group)) if (any(stats::na.omit(sampleSizesTemp) <= 0)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, @@ -718,56 +1958,56 @@ DatasetMeans <- setRefClass("DatasetMeans", .arrayToString(sampleSizesTemp, vectorLookAndFeelEnabled = TRUE) ) } - sampleSizes <<- c(sampleSizes, sampleSizesTemp) + self$sampleSizes <- c(self$sampleSizes, sampleSizesTemp) - meansTemp <- .getValuesByParameterName(dataFrame, C_KEY_WORDS_MEANS, suffix = group) - .validateValues(meansTemp, paste0("means", group)) - means <<- c(means, meansTemp) + meansTemp <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_MEANS, suffix = group) + self$.validateValues(meansTemp, paste0("means", group)) + self$means <- c(self$means, meansTemp) - stDevsTemp <- .getValuesByParameterName(dataFrame, C_KEY_WORDS_ST_DEVS, suffix = group) - .validateValues(stDevsTemp, paste0("stDevs", group)) - stDevs <<- c(stDevs, stDevsTemp) + stDevsTemp <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_ST_DEVS, suffix = group) + self$.validateValues(stDevsTemp, paste0("stDevs", group)) + self$stDevs <- c(self$stDevs, stDevsTemp) - groups <<- c(groups, rep(as.integer(group), length(sampleSizesTemp))) + self$groups <- c(self$groups, rep(as.integer(group), length(sampleSizesTemp))) } } # case: two or more means - overall - else if (.paramExists(dataFrame, paste0(C_KEY_WORDS_OVERALL_SAMPLE_SIZES, 1)) && - .paramExists(dataFrame, paste0(C_KEY_WORDS_OVERALL_SAMPLE_SIZES, 2))) { - .inputType <<- "overall" - numberOfTreatmentGroups <- .getNumberOfGroups(dataFrame, C_KEY_WORDS_OVERALL_SAMPLE_SIZES) - stages <<- rep(stages, numberOfTreatmentGroups) - groups <<- integer(0) - sampleSizes <<- numeric(0) - means <<- numeric(0) - stDevs <<- numeric(0) - overallSampleSizes <<- numeric(0) - overallMeans <<- numeric(0) - overallStDevs <<- numeric(0) + else if (self$.paramExists(dataFrame, paste0(C_KEY_WORDS_OVERALL_SAMPLE_SIZES, 1)) && + self$.paramExists(dataFrame, paste0(C_KEY_WORDS_OVERALL_SAMPLE_SIZES, 2))) { + self$.inputType <- "overall" + numberOfTreatmentGroups <- self$.getNumberOfGroups(dataFrame, C_KEY_WORDS_OVERALL_SAMPLE_SIZES) + self$stages <- rep(self$stages, numberOfTreatmentGroups) + self$groups <- integer(0) + self$sampleSizes <- numeric(0) + self$means <- numeric(0) + self$stDevs <- numeric(0) + self$overallSampleSizes <- numeric(0) + self$overallMeans <- numeric(0) + self$overallStDevs <- numeric(0) for (group in 1:numberOfTreatmentGroups) { - overallSampleSizesTemp <- .getValidatedFloatingPointNumbers(.getValuesByParameterName( + overallSampleSizesTemp <- self$.getValidatedFloatingPointNumbers(self$.getValuesByParameterName( dataFrame, C_KEY_WORDS_OVERALL_SAMPLE_SIZES, suffix = group ), parameterName = "Cumulative sample sizes") - .validateValues(overallSampleSizesTemp, paste0("overallSampleSizes", group)) - overallSampleSizes <<- c(overallSampleSizes, overallSampleSizesTemp) + self$.validateValues(overallSampleSizesTemp, paste0("overallSampleSizes", group)) + self$overallSampleSizes <- c(self$overallSampleSizes, overallSampleSizesTemp) - overallMeansTemp <- .getValuesByParameterName(dataFrame, + overallMeansTemp <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_MEANS, suffix = group ) - .validateValues(overallMeansTemp, paste0("overallMeans", group)) - overallMeans <<- c(overallMeans, overallMeansTemp) + self$.validateValues(overallMeansTemp, paste0("overallMeans", group)) + self$overallMeans <- c(self$overallMeans, overallMeansTemp) - overallStDevsTemp <- .getValuesByParameterName(dataFrame, + overallStDevsTemp <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_ST_DEVS, suffix = group ) - .validateValues(overallStDevsTemp, paste0("overallStDevs", group)) - overallStDevs <<- c(overallStDevs, overallStDevsTemp) + self$.validateValues(overallStDevsTemp, paste0("overallStDevs", group)) + self$overallStDevs <- c(self$overallStDevs, overallStDevsTemp) - groups <<- c(groups, rep(as.integer(group), length(overallSampleSizesTemp))) + self$groups <- c(self$groups, rep(as.integer(group), length(overallSampleSizesTemp))) } } else { stop( @@ -776,100 +2016,100 @@ DatasetMeans <- setRefClass("DatasetMeans", ) } - if (.inputType == "stagewise") { - n <- length(sampleSizes) - overallSampleSizes <<- rep(NA_real_, n) - overallMeans <<- rep(NA_real_, n) - overallStDevs <<- rep(NA_real_, n) + if (self$.inputType == "stagewise") { + n <- length(self$sampleSizes) + self$overallSampleSizes <- rep(NA_real_, n) + self$overallMeans <- rep(NA_real_, n) + self$overallStDevs <- rep(NA_real_, n) - .setParameterType("sampleSizes", C_PARAM_USER_DEFINED) - .setParameterType("means", C_PARAM_USER_DEFINED) - .setParameterType("stDevs", C_PARAM_USER_DEFINED) + self$.setParameterType("sampleSizes", C_PARAM_USER_DEFINED) + self$.setParameterType("means", C_PARAM_USER_DEFINED) + self$.setParameterType("stDevs", C_PARAM_USER_DEFINED) - .setParameterType("overallSampleSizes", C_PARAM_GENERATED) - .setParameterType("overallMeans", C_PARAM_GENERATED) - .setParameterType("overallStDevs", C_PARAM_GENERATED) + self$.setParameterType("overallSampleSizes", C_PARAM_GENERATED) + self$.setParameterType("overallMeans", C_PARAM_GENERATED) + self$.setParameterType("overallStDevs", C_PARAM_GENERATED) - .recreateDataFrame() - .createOverallData() + self$.recreateDataFrame() + self$.createOverallData() } else { - n <- length(overallSampleSizes) - sampleSizes <<- rep(NA_real_, n) - means <<- rep(NA_real_, n) - stDevs <<- rep(NA_real_, n) + n <- length(self$overallSampleSizes) + self$sampleSizes <- rep(NA_real_, n) + self$means <- rep(NA_real_, n) + self$stDevs <- rep(NA_real_, n) - .setParameterType("sampleSizes", C_PARAM_GENERATED) - .setParameterType("means", C_PARAM_GENERATED) - .setParameterType("stDevs", C_PARAM_GENERATED) + self$.setParameterType("sampleSizes", C_PARAM_GENERATED) + self$.setParameterType("means", C_PARAM_GENERATED) + self$.setParameterType("stDevs", C_PARAM_GENERATED) - .setParameterType("overallSampleSizes", C_PARAM_USER_DEFINED) - .setParameterType("overallMeans", C_PARAM_USER_DEFINED) - .setParameterType("overallStDevs", C_PARAM_USER_DEFINED) + self$.setParameterType("overallSampleSizes", C_PARAM_USER_DEFINED) + self$.setParameterType("overallMeans", C_PARAM_USER_DEFINED) + self$.setParameterType("overallStDevs", C_PARAM_USER_DEFINED) - .recreateDataFrame() - .createStageWiseData() + self$.recreateDataFrame() + self$.createStageWiseData() } - if (sum(stats::na.omit(sampleSizes) < 0) > 0) { + if (sum(stats::na.omit(self$sampleSizes) < 0) > 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all sample sizes must be >= 0") } - if (sum(stats::na.omit(stDevs) < 0) > 0) { + if (sum(stats::na.omit(self$stDevs) < 0) > 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all standard deviations must be >= 0") } }, .recreateDataFrame = function() { - callSuper() - .data <<- cbind(.data, data.frame( - sampleSize = sampleSizes, - mean = means, - stDev = stDevs, - overallSampleSize = overallSampleSizes, - overallMean = overallMeans, - overallStDev = overallStDevs + super$.recreateDataFrame() + self$.data <- cbind(self$.data, data.frame( + sampleSize = self$sampleSizes, + mean = self$means, + stDev = self$stDevs, + overallSampleSize = self$overallSampleSizes, + overallMean = self$overallMeans, + overallStDev = self$overallStDevs )) - .orderDataByStageAndGroup() - .setDataToVariables() + self$.orderDataByStageAndGroup() + self$.setDataToVariables() }, .setDataToVariables = function() { - callSuper() - sampleSizes <<- .data$sampleSize - means <<- .data$mean - stDevs <<- .data$stDev - overallSampleSizes <<- .data$overallSampleSize - overallMeans <<- .data$overallMean - overallStDevs <<- .data$overallStDev + super$.setDataToVariables() + self$sampleSizes <- self$.data$sampleSize + self$means <- self$.data$mean + self$stDevs <- self$.data$stDev + self$overallSampleSizes <- self$.data$overallSampleSize + self$overallMeans <- self$.data$overallMean + self$overallStDevs <- self$.data$overallStDev }, .fillWithNAs = function(kMax) { - callSuper(kMax) - n <- .getNumberOfNAsToAdd(kMax) + super$.fillWithNAs(kMax) + n <- self$.getNumberOfNAsToAdd(kMax) naRealsToAdd <- rep(NA_real_, n) - sampleSizes <<- c(sampleSizes, naRealsToAdd) - means <<- c(means, naRealsToAdd) - stDevs <<- c(stDevs, naRealsToAdd) + self$sampleSizes <- c(self$sampleSizes, naRealsToAdd) + self$means <- c(self$means, naRealsToAdd) + self$stDevs <- c(self$stDevs, naRealsToAdd) - overallSampleSizes <<- c(overallSampleSizes, naRealsToAdd) - overallMeans <<- c(overallMeans, naRealsToAdd) - overallStDevs <<- c(overallStDevs, naRealsToAdd) + self$overallSampleSizes <- c(self$overallSampleSizes, naRealsToAdd) + self$overallMeans <- c(self$overallMeans, naRealsToAdd) + self$overallStDevs <- c(self$overallStDevs, naRealsToAdd) - .recreateDataFrame() + self$.recreateDataFrame() }, .trim = function(kMax = NA_integer_) { - indices <- callSuper(kMax) + indices <- super$.trim(kMax) if (length(indices) == 0) { return(invisible(FALSE)) } - sampleSizes <<- sampleSizes[indices] - means <<- means[indices] - stDevs <<- stDevs[indices] + self$sampleSizes <- self$sampleSizes[indices] + self$means <- self$means[indices] + self$stDevs <- self$stDevs[indices] - overallSampleSizes <<- overallSampleSizes[indices] - overallMeans <<- overallMeans[indices] - overallStDevs <<- overallStDevs[indices] + self$overallSampleSizes <- self$overallSampleSizes[indices] + self$overallMeans <- self$overallMeans[indices] + self$overallStDevs <- self$overallStDevs[indices] - .recreateDataFrame() + self$.recreateDataFrame() return(invisible(TRUE)) }, .getOverallMeans = function(sampleSizes, means) { @@ -886,31 +2126,31 @@ DatasetMeans <- setRefClass("DatasetMeans", return(overallStDev) }, .createOverallData = function() { - .data$overallSampleSize <<- rep(NA_real_, nrow(.data)) - .data$overallMean <<- rep(NA_real_, nrow(.data)) - .data$overallStDev <<- rep(NA_real_, nrow(.data)) + self$.data$overallSampleSize <- rep(NA_real_, nrow(self$.data)) + self$.data$overallMean <- rep(NA_real_, nrow(self$.data)) + self$.data$overallStDev <- rep(NA_real_, nrow(self$.data)) subsetLevels <- NA_character_ - if (.enrichmentEnabled) { - subsetLevels <- levels(.data$subset) + if (self$.enrichmentEnabled) { + subsetLevels <- levels(self$.data$subset) } for (s in subsetLevels) { - for (g in levels(.data$group)) { + for (g in levels(self$.data$group)) { if (!is.na(s)) { - indices <- which(.data$subset == s & .data$group == g) + indices <- which(self$.data$subset == s & self$.data$group == g) } else { - indices <- which(.data$group == g) + indices <- which(self$.data$group == g) } - .data$overallSampleSize[indices] <<- cumsum(.data$sampleSize[indices]) - .data$overallMean[indices] <<- .getOverallMeans( - .data$sampleSize[indices], .data$mean[indices] + self$.data$overallSampleSize[indices] <- cumsum(self$.data$sampleSize[indices]) + self$.data$overallMean[indices] <- self$.getOverallMeans( + self$.data$sampleSize[indices], self$.data$mean[indices] ) - .data$overallStDev[indices] <<- .getOverallStDevs( - .data$sampleSize[indices], - .data$mean[indices], .data$stDev[indices], .data$overallMean[indices] + self$.data$overallStDev[indices] <- self$.getOverallStDevs( + self$.data$sampleSize[indices], + self$.data$mean[indices], self$.data$stDev[indices], self$.data$overallMean[indices] ) } } - .setDataToVariables() + self$.setDataToVariables() }, .getStageWiseSampleSizes = function(overallSampleSizes) { result <- overallSampleSizes @@ -958,54 +2198,282 @@ DatasetMeans <- setRefClass("DatasetMeans", } for (k in 2:length(overallStDevs)) { - result[k] <- .getStageWiseStDev(overallStDevs, sampleSizes, overallSampleSizes, means, overallMeans, k) + result[k] <- self$.getStageWiseStDev(overallStDevs, sampleSizes, overallSampleSizes, means, overallMeans, k) } return(result) }, .createStageWiseData = function() { "Calculates stage-wise means and standard deviation if cunulative data is available" - .data$sampleSize <<- rep(NA_real_, nrow(.data)) - .data$mean <<- rep(NA_real_, nrow(.data)) - .data$stDev <<- rep(NA_real_, nrow(.data)) + self$.data$sampleSize <- rep(NA_real_, nrow(self$.data)) + self$.data$mean <- rep(NA_real_, nrow(self$.data)) + self$.data$stDev <- rep(NA_real_, nrow(self$.data)) subsetLevels <- NA_character_ - if (.enrichmentEnabled) { - subsetLevels <- levels(.data$subset) + if (self$.enrichmentEnabled) { + subsetLevels <- levels(self$.data$subset) } for (s in subsetLevels) { - for (g in levels(.data$group)) { + for (g in levels(self$.data$group)) { if (!is.na(s)) { - indices <- which(.data$subset == s & .data$group == g) + indices <- which(self$.data$subset == s & self$.data$group == g) } else { - indices <- which(.data$group == g) + indices <- which(self$.data$group == g) } - .assertValuesAreStrictlyIncreasing(.data$overallSampleSize[indices], + .assertValuesAreStrictlyIncreasing(self$.data$overallSampleSize[indices], paste0("overallSampleSizes", g), endingNasAllowed = TRUE ) - .data$sampleSize[indices] <<- .getStageWiseSampleSizes(.data$overallSampleSize[indices]) - .data$mean[indices] <<- .getStageWiseMeans( - .data$sampleSize[indices], - .data$overallSampleSize[indices], .data$overallMean[indices] + self$.data$sampleSize[indices] <- self$.getStageWiseSampleSizes(self$.data$overallSampleSize[indices]) + self$.data$mean[indices] <- self$.getStageWiseMeans( + self$.data$sampleSize[indices], + self$.data$overallSampleSize[indices], self$.data$overallMean[indices] ) - .data$stDev[indices] <<- .getStageWiseStDevs( - .data$overallStDev[indices], .data$sampleSize[indices], - .data$overallSampleSize[indices], .data$mean[indices], .data$overallMean[indices] + self$.data$stDev[indices] <- self$.getStageWiseStDevs( + self$.data$overallStDev[indices], self$.data$sampleSize[indices], + self$.data$overallSampleSize[indices], self$.data$mean[indices], self$.data$overallMean[indices] ) } } - .setDataToVariables() + self$.setDataToVariables() }, getRandomData = function() { - return(.getRandomDataMeans(.self)) + return(self$.getRandomDataMeans(self)) } ) ) +#' @examples +#' +#' datasetExample <- getDataset( +#' means1 = c(112.3, 105.1, 121.3), +#' means2 = c(98.1, 99.3, 100.1), +#' means3 = c(98.1, 99.3, 100.1), +#' stDevs1 = c(44.4, 42.9, 41.4), +#' stDevs2 = c(46.7, 41.1, 39.5), +#' stDevs3 = c(46.7, 41.1, 39.5), +#' n1 = c(84, 81, 82), +#' n2 = c(87, 83, 81), +#' n3 = c(87, 82, 84) +#' ) +#' .getRandomDataMeans(datasetExample, +#' randomDataParamName = "outcome", numberOfVisits = 3, +#' fixedCovariates = list(gender = c("f", "m"), bmi = c(17, 40)) +#' ) +#' +#' @noRd +#' +.getRandomDataMeans <- function(dataset, ..., + treatmentName = "Treatment group", + controlName = "Control group", + randomDataParamName = "randomData", + numberOfVisits = 1L, + fixedCovariates = NULL, + covariateEffects = NULL, + seed = NA_real_) { + if (!is.null(fixedCovariates)) { + if (!is.list(fixedCovariates)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("fixedCovariates"), " must be a named list") + } + } + if (!is.null(covariateEffects)) { + if (!is.list(covariateEffects)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("covariateEffects"), " must be a named list") + } + } + + .assertIsSingleCharacter(treatmentName, "treatmentName") + .assertIsSingleCharacter(controlName, "controlName") + .assertIsSingleCharacter(randomDataParamName, "randomDataParamName") + .assertIsSinglePositiveInteger(numberOfVisits, "numberOfVisits", validateType = FALSE) + .assertIsSingleNumber(seed, "seed", naAllowed = TRUE) + + seed <- .setSeed(seed) + + numberOfGroups <- dataset$getNumberOfGroups() + + sampleSize <- 0 + for (stage in 1:dataset$getNumberOfStages()) { + for (group in 1:numberOfGroups) { + if (dataset$.enrichmentEnabled) { + for (subset in levels(dataset$.data$subset)) { + n <- dataset$getSampleSize(stage = stage, group = group, subset = subset) + if (n > sampleSize) { + sampleSize <- n + } + } + } else { + n <- dataset$getSampleSize(stage = stage, group = group) + n <- round(n / numberOfVisits) + if (n > sampleSize) { + sampleSize <- n + } + } + } + } + + idFactor <- 10^nchar(as.character(sampleSize)) + + data <- NULL + for (stage in 1:dataset$getNumberOfStages()) { + for (group in 1:numberOfGroups) { + for (visit in 1:numberOfVisits) { + if (dataset$.enrichmentEnabled) { + for (subset in levels(dataset$.data$subset)) { + n <- dataset$getSampleSize(stage = stage, group = group, subset = subset) + randomData <- stats::rnorm( + n = n, + mean = dataset$getMean(stage = stage, group = group, subset = subset), + sd = dataset$getStDev(stage = stage, group = group, subset = subset) + ) + row <- data.frame( + subject = idFactor * group + c(1:n), + stage = rep(stage, n), + group = rep(group, n), + subset = rep(subset, n), + randomData = randomData + ) + if (is.null(data)) { + data <- row + } else { + data <- rbind(data, row) + } + } + } else { + n <- dataset$getSampleSize(stage = stage, group = group) + n <- floor(n / numberOfVisits) + randomData <- stats::rnorm( + n = sampleSize, + mean = dataset$getMean(stage = stage, group = group), + sd = dataset$getStDev(stage = stage, group = group) + ) + + subjectIds <- (idFactor * 10 * stage) + (idFactor * group) + c(1:sampleSize) + indices <- 1:sampleSize + randomDataBefore <- NULL + numberOfDropOutsBefore <- 0 + if (visit > 1 && !is.null(data)) { + randomDataBefore <- data$randomData[data$stage == visit - 1 & data$subject %in% subjectIds] + numberOfDropOutsBefore <- sum(is.na(randomDataBefore)) + indices <- which(!is.na(randomDataBefore)) + } + sampleSizeBefore <- sampleSize - numberOfDropOutsBefore + if (n < sampleSizeBefore) { + numberOfDropOuts <- sampleSizeBefore - n + dropOuts <- sample(c(rep(1, n - numberOfDropOuts), rep(0, numberOfDropOuts))) + randomData[indices[dropOuts == 0]] <- NA_real_ + if (!is.null(randomDataBefore)) { + randomData[is.na(randomDataBefore)] <- NA_real_ + } + } + + row <- data.frame( + subject = subjectIds, + stage = rep(stage, sampleSize), + group = rep(group, sampleSize), + visit = rep(visit - 1, sampleSize), + randomData = randomData + ) + + if (is.null(data)) { + data <- row + } else { + data <- rbind(data, row) + } + } + } + } + } + data$stage <- factor(data$stage) + groupLevels <- paste(treatmentName, c(1:numberOfGroups)) + if (numberOfGroups > 1) { + if (numberOfGroups == 2) { + groupLevels[1] <- treatmentName + } + groupLevels[numberOfGroups] <- controlName + } + + data$group <- factor(data$group, labels = groupLevels) + if (dataset$.enrichmentEnabled) { + data$subset <- factor(data$subset) + } + + if (!is.null(randomDataParamName) && length(randomDataParamName) == 1 && !is.na(randomDataParamName)) { + colNames <- colnames(data) + colNames[colNames == "randomData"] <- randomDataParamName + colnames(data) <- colNames + } + + if (!is.null(fixedCovariates)) { + fixedCovariateNames <- names(fixedCovariates) + if (is.null(fixedCovariateNames) || any(nchar(trimws(fixedCovariateNames)) == 0)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("fixedCovariates"), " must be a named list") + } + + subjects <- sort(unique(data$subject)) + for (fixedCovariateName in fixedCovariateNames) { + data[[fixedCovariateName]] <- rep(NA, nrow(data)) + values <- fixedCovariates[[fixedCovariateName]] + if (is.null(values) || length(values) < 2 || any(is.na(values))) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(paste0("fixedCovariates$", fixedCovariateName)), + " (", .arrayToString(values), ") must be a valid numeric or character vector with a minimum of 2 values" + ) + } + + if (is.character(values)) { + if (length(unique(values)) < length(values)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(paste0("fixedCovariates$", fixedCovariateName)), + " (", .arrayToString(values, maxLength = 20), ") must be a unique vector" + ) + } + + fixedCovariateSample <- sample(values, length(subjects), replace = TRUE) + for (i in 1:length(subjects)) { + data[[fixedCovariateName]][data$subject == subjects[i]] <- fixedCovariateSample[i] + } + } else if (is.numeric(values)) { + if (length(values) == 2) { + minValue <- min(values) + maxValue <- max(values) + covMean <- runif(1, minValue, maxValue) + covSD <- covMean * 0.1 + showMessage <- TRUE + for (i in 1:length(subjects)) { + groupName <- as.character(data$group[data$subject == subjects[i]])[1] + covEffect <- 1 + if (groupName == controlName && !is.null(covariateEffects)) { + covEffect <- covariateEffects[[fixedCovariateName]] + if (is.null(covEffect)) { + covEffect <- 1 + } else { + .assertIsNumericVector(covEffect, paste0("covariateEffects$", fixedCovariateName)) + if (showMessage) { + message( + "Add effect ", covEffect, " to ", + sQuote(fixedCovariateName), " of ", sQuote(groupName) + ) + showMessage <- FALSE + } + } + } + continuesExample <- rnorm(sum(data$subject == subjects[i]), covMean * covEffect, covSD) + data[[fixedCovariateName]][data$subject == subjects[i]] <- continuesExample + } + } + } + } + } + + data$seed <- rep(seed, nrow(data)) + + return(data) +} + #' #' @title #' Dataset Plotting @@ -1057,7 +2525,7 @@ DatasetMeans <- setRefClass("DatasetMeans", #' #' @export #' -plot.Dataset <- function(x, y, ..., main = "Dataset", xlab = "Stage", ylab = NA_character_, +plot.DatasetR6 <- function(x, y, ..., main = "Dataset", xlab = "Stage", ylab = NA_character_, legendTitle = "Group", palette = "Set1", showSource = FALSE, plotSettings = NULL) { if (x$.enrichmentEnabled) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "plot of enrichment data is not implemented yet") @@ -1241,271 +2709,269 @@ plot.Dataset <- function(x, y, ..., main = "Dataset", xlab = "Stage", ylab = NA_ #' #' @importFrom methods new #' -DatasetRates <- setRefClass("DatasetRates", - contains = "Dataset", - fields = list( - sampleSizes = "numeric", - events = "numeric", - overallSampleSizes = "numeric", - overallEvents = "numeric" - ), - methods = list( +DatasetRatesR6 <- R6Class("DatasetRatesR6", + inherit = DatasetR6, + public = list( + sampleSizes = NULL, + events = NULL, + overallSampleSizes = NULL, + overallEvents = NULL, getSampleSize = function(stage, group = 1, subset = NA_character_) { - return(.data$sampleSize[.getIndices(stage = stage, group = group, subset = subset)]) + return(self$.data$sampleSize[self$.getIndices(stage = stage, group = group, subset = subset)]) }, getSampleSizes = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(.data$sampleSize[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) + return(self$.data$sampleSize[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) }, getSampleSizesUpTo = function(to, group = 1, subset = NA_character_) { - return(.data$sampleSize[.getIndices(stage = c(1:to), group = group, subset = subset)]) + return(self$.data$sampleSize[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) }, getEvent = function(stage, group = 1, subset = NA_character_) { - return(.data$event[.getIndices(stage = stage, group = group, subset = subset)]) + return(self$.data$event[self$.getIndices(stage = stage, group = group, subset = subset)]) }, getEvents = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(.data$event[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) + return(self$.data$event[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) }, getEventsUpTo = function(to, group = 1, subset = NA_character_) { - return(.data$event[.getIndices(stage = c(1:to), group = group, subset = subset)]) + return(self$.data$event[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) }, getOverallSampleSize = function(stage, group = 1, subset = NA_character_) { - return(.data$overallSampleSize[.getIndices(stage = stage, group = group, subset = subset)]) + return(self$.data$overallSampleSize[self$.getIndices(stage = stage, group = group, subset = subset)]) }, getOverallSampleSizes = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(.data$overallSampleSize[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) + return(self$.data$overallSampleSize[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) }, getOverallSampleSizesUpTo = function(to, group = 1, subset = NA_character_) { - return(.data$overallSampleSize[.getIndices(stage = c(1:to), group = group, subset = subset)]) + return(self$.data$overallSampleSize[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) }, getOverallEvent = function(stage, group = 1, subset = NA_character_) { - return(.data$overallEvent[.getIndices(stage = stage, group = group, subset = subset)]) + return(self$.data$overallEvent[self$.getIndices(stage = stage, group = group, subset = subset)]) }, getOverallEvents = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(.data$overallEvent[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) + return(self$.data$overallEvent[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) }, getOverallEventsUpTo = function(to, group = 1, subset = NA_character_) { - return(.data$overallEvent[.getIndices(stage = c(1:to), group = group, subset = subset)]) + return(self$.data$overallEvent[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) }, .initByDataFrame = function(dataFrame) { - callSuper(dataFrame) + super$.initByDataFrame(dataFrame) # case: one rate - stage wise - if (.paramExists(dataFrame, C_KEY_WORDS_SAMPLE_SIZES)) { - .inputType <<- "stagewise" + if (self$.paramExists(dataFrame, C_KEY_WORDS_SAMPLE_SIZES)) { + self$.inputType <- "stagewise" - sampleSizes <<- .getValidatedFloatingPointNumbers( - .getValuesByParameterName(dataFrame, C_KEY_WORDS_SAMPLE_SIZES), + self$sampleSizes <- self$.getValidatedFloatingPointNumbers( + self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_SAMPLE_SIZES), parameterName = "Sample sizes" ) - .validateValues(sampleSizes, "n") - if (any(stats::na.omit(sampleSizes) <= 0)) { + self$.validateValues(self$sampleSizes, "n") + if (any(stats::na.omit(self$sampleSizes) <= 0)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all sample sizes must be > 0, but 'n' = ", - .arrayToString(sampleSizes, vectorLookAndFeelEnabled = TRUE) + self$.arrayToString(self$sampleSizes, vectorLookAndFeelEnabled = TRUE) ) } - events <<- .getValidatedFloatingPointNumbers( - .getValuesByParameterName(dataFrame, C_KEY_WORDS_EVENTS), + self$events <- self$.getValidatedFloatingPointNumbers( + self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_EVENTS), parameterName = "Events" ) - .validateValues(events, "events") - if (any(stats::na.omit(events) < 0)) { + self$.validateValues(self$events, "events") + if (any(stats::na.omit(self$events) < 0)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all events must be >= 0, but 'events' = ", - .arrayToString(events, vectorLookAndFeelEnabled = TRUE) + self$.arrayToString(self$events, vectorLookAndFeelEnabled = TRUE) ) } - kMax <- length(sampleSizes) - stageNumber <- length(stats::na.omit(sampleSizes)) + kMax <- length(self$sampleSizes) + stageNumber <- length(stats::na.omit(self$sampleSizes)) dataInput <- data.frame( - sampleSizes = sampleSizes, - events = events + sampleSizes = self$sampleSizes, + events = self$events ) - dataInput <- .getOverallData(dataInput, kMax, stage = stageNumber) - overallSampleSizes <<- dataInput$overallSampleSizes - overallEvents <<- dataInput$overallEvents + dataInput <- self$.getOverallData(dataInput, kMax, stage = stageNumber) + self$overallSampleSizes <- dataInput$overallSampleSizes + self$overallEvents <- dataInput$overallEvents - .setParameterType("sampleSizes", C_PARAM_USER_DEFINED) - .setParameterType("events", C_PARAM_USER_DEFINED) + self$.setParameterType("sampleSizes", C_PARAM_USER_DEFINED) + self$.setParameterType("events", C_PARAM_USER_DEFINED) - .setParameterType("overallSampleSizes", C_PARAM_GENERATED) - .setParameterType("overallEvents", C_PARAM_GENERATED) + self$.setParameterType("overallSampleSizes", C_PARAM_GENERATED) + self$.setParameterType("overallEvents", C_PARAM_GENERATED) } # case: one rate - overall - else if (.paramExists(dataFrame, C_KEY_WORDS_OVERALL_SAMPLE_SIZES)) { - .inputType <<- "overall" - overallSampleSizes <<- .getValidatedFloatingPointNumbers( - .getValuesByParameterName( + else if (self$.paramExists(dataFrame, C_KEY_WORDS_OVERALL_SAMPLE_SIZES)) { + self$.inputType <- "overall" + self$overallSampleSizes <- self$.getValidatedFloatingPointNumbers( + self$.getValuesByParameterName( dataFrame, C_KEY_WORDS_OVERALL_SAMPLE_SIZES ), parameterName = "Cumulative sample sizes" ) - .validateValues(overallSampleSizes, "overallSampleSizes") - .assertValuesAreStrictlyIncreasing(overallSampleSizes, "overallSampleSizes", endingNasAllowed = TRUE) + self$.validateValues(self$overallSampleSizes, "overallSampleSizes") + .assertValuesAreStrictlyIncreasing(self$overallSampleSizes, "overallSampleSizes", endingNasAllowed = TRUE) - overallEvents <<- .getValidatedFloatingPointNumbers( - .getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_EVENTS), + self$overallEvents <- self$.getValidatedFloatingPointNumbers( + self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_EVENTS), parameterName = "Cumulative events" ) - .validateValues(overallEvents, "overallEvents") - .assertValuesAreMonotoneIncreasing(overallEvents, "overallEvents", endingNasAllowed = TRUE) - - kMax <- length(overallSampleSizes) - stageNumber <- length(stats::na.omit(overallSampleSizes)) - stageWiseData <- .getStageWiseData(data.frame( - overallSampleSizes = overallSampleSizes, - overallEvents = overallEvents + self$.validateValues(self$overallEvents, "overallEvents") + .assertValuesAreMonotoneIncreasing(self$overallEvents, "overallEvents", endingNasAllowed = TRUE) + + kMax <- length(self$overallSampleSizes) + stageNumber <- length(stats::na.omit(self$overallSampleSizes)) + stageWiseData <- self$.getStageWiseData(data.frame( + overallSampleSizes = self$overallSampleSizes, + overallEvents = self$overallEvents ), kMax, stage = stageNumber) - sampleSizes <<- stageWiseData$sampleSizes - events <<- stageWiseData$events + self$sampleSizes <- stageWiseData$sampleSizes + self$events <- stageWiseData$events - .setParameterType("sampleSizes", C_PARAM_GENERATED) - .setParameterType("events", C_PARAM_GENERATED) + self$.setParameterType("sampleSizes", C_PARAM_GENERATED) + self$.setParameterType("events", C_PARAM_GENERATED) - .setParameterType("overallSampleSizes", C_PARAM_USER_DEFINED) - .setParameterType("overallEvents", C_PARAM_USER_DEFINED) + self$.setParameterType("overallSampleSizes", C_PARAM_USER_DEFINED) + self$.setParameterType("overallEvents", C_PARAM_USER_DEFINED) } # case: two or more rates - stage wise - else if (.paramExists(dataFrame, paste0(C_KEY_WORDS_SAMPLE_SIZES, 1)) && - .paramExists(dataFrame, paste0(C_KEY_WORDS_SAMPLE_SIZES, 2))) { - .inputType <<- "stagewise" + else if (self$.paramExists(dataFrame, paste0(C_KEY_WORDS_SAMPLE_SIZES, 1)) && + self$.paramExists(dataFrame, paste0(C_KEY_WORDS_SAMPLE_SIZES, 2))) { + self$.inputType <- "stagewise" - numberOfTreatmentGroups <- .getNumberOfGroups(dataFrame, C_KEY_WORDS_SAMPLE_SIZES) + numberOfTreatmentGroups <- self$.getNumberOfGroups(dataFrame, C_KEY_WORDS_SAMPLE_SIZES) - stages <<- rep(stages, numberOfTreatmentGroups) + self$stages <- rep(self$stages, numberOfTreatmentGroups) - groups <<- integer(0) - sampleSizes <<- numeric(0) - events <<- numeric(0) - overallSampleSizes <<- numeric(0) - overallEvents <<- numeric(0) + self$groups <- integer(0) + self$sampleSizes <- numeric(0) + self$events <- numeric(0) + self$overallSampleSizes <- numeric(0) + self$overallEvents <- numeric(0) for (group in 1:numberOfTreatmentGroups) { - sampleSizesTemp <- .getValidatedFloatingPointNumbers( - .getValuesByParameterName( + sampleSizesTemp <- self$.getValidatedFloatingPointNumbers( + self$.getValuesByParameterName( dataFrame, C_KEY_WORDS_SAMPLE_SIZES, suffix = group ), parameterName = "Sample sizes" ) - .validateValues(sampleSizesTemp, paste0("n", group)) + self$.validateValues(sampleSizesTemp, paste0("n", group)) if (any(stats::na.omit(sampleSizesTemp) <= 0)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all sample sizes must be > 0, but 'n", group, "' = ", - .arrayToString(sampleSizesTemp, vectorLookAndFeelEnabled = TRUE) + self$.arrayToString(sampleSizesTemp, vectorLookAndFeelEnabled = TRUE) ) } - sampleSizes <<- c(sampleSizes, sampleSizesTemp) + self$sampleSizes <- c(self$sampleSizes, sampleSizesTemp) - eventsTemp <- .getValidatedFloatingPointNumbers( - .getValuesByParameterName(dataFrame, C_KEY_WORDS_EVENTS, suffix = group), + eventsTemp <- self$.getValidatedFloatingPointNumbers( + self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_EVENTS, suffix = group), parameterName = "Events" ) - .validateValues(eventsTemp, paste0("events", group)) + self$.validateValues(eventsTemp, paste0("events", group)) if (any(stats::na.omit(eventsTemp) < 0)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all events must be >= 0, but 'events", group, "' = ", - .arrayToString(eventsTemp, vectorLookAndFeelEnabled = TRUE) + self$.arrayToString(eventsTemp, vectorLookAndFeelEnabled = TRUE) ) } - events <<- c(events, eventsTemp) + self$events <- c(self$events, eventsTemp) - groups <<- c(groups, rep(as.integer(group), length(sampleSizesTemp))) + self$groups <- c(self$groups, rep(as.integer(group), length(sampleSizesTemp))) kMax <- length(sampleSizesTemp) numberOfValidStages <- length(stats::na.omit(sampleSizesTemp)) - overallData <- .getOverallData(data.frame( + overallData <- self$.getOverallData(data.frame( sampleSizes = sampleSizesTemp, events = eventsTemp ), kMax, stage = numberOfValidStages) - overallSampleSizes <<- c(overallSampleSizes, overallData$overallSampleSizes) - overallEvents <<- c(overallEvents, overallData$overallEvents) + self$overallSampleSizes <- c(self$overallSampleSizes, overallData$overallSampleSizes) + self$overallEvents <- c(self$overallEvents, overallData$overallEvents) } - if (sum(stats::na.omit(sampleSizes) < 0) > 0) { + if (sum(stats::na.omit(self$sampleSizes) < 0) > 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all sample sizes must be >= 0") } - .setParameterType("sampleSizes", C_PARAM_USER_DEFINED) - .setParameterType("events", C_PARAM_USER_DEFINED) + self$.setParameterType("sampleSizes", C_PARAM_USER_DEFINED) + self$.setParameterType("events", C_PARAM_USER_DEFINED) - .setParameterType("overallSampleSizes", C_PARAM_GENERATED) - .setParameterType("overallEvents", C_PARAM_GENERATED) + self$.setParameterType("overallSampleSizes", C_PARAM_GENERATED) + self$.setParameterType("overallEvents", C_PARAM_GENERATED) } # case: two or more rates - overall - else if (.paramExists(dataFrame, paste0(C_KEY_WORDS_OVERALL_SAMPLE_SIZES, 1)) && - .paramExists(dataFrame, paste0(C_KEY_WORDS_OVERALL_SAMPLE_SIZES, 2))) { - .inputType <<- "overall" + else if (self$.paramExists(dataFrame, paste0(C_KEY_WORDS_OVERALL_SAMPLE_SIZES, 1)) && + self$.paramExists(dataFrame, paste0(C_KEY_WORDS_OVERALL_SAMPLE_SIZES, 2))) { + self$.inputType <- "overall" - numberOfTreatmentGroups <- .getNumberOfGroups(dataFrame, C_KEY_WORDS_OVERALL_SAMPLE_SIZES) + numberOfTreatmentGroups <- self$.getNumberOfGroups(dataFrame, C_KEY_WORDS_OVERALL_SAMPLE_SIZES) - stages <<- rep(stages, numberOfTreatmentGroups) + self$stages <- rep(self$stages, numberOfTreatmentGroups) - groups <<- integer(0) - sampleSizes <<- numeric(0) - events <<- numeric(0) - overallSampleSizes <<- numeric(0) - overallEvents <<- numeric(0) + self$groups <- integer(0) + self$sampleSizes <- numeric(0) + self$events <- numeric(0) + self$overallSampleSizes <- numeric(0) + self$overallEvents <- numeric(0) for (group in 1:numberOfTreatmentGroups) { - overallSampleSizesTemp <- .getValidatedFloatingPointNumbers( - .getValuesByParameterName( + overallSampleSizesTemp <- self$.getValidatedFloatingPointNumbers( + self$.getValuesByParameterName( dataFrame, C_KEY_WORDS_OVERALL_SAMPLE_SIZES, suffix = group ), parameterName = "Cumulative sample sizes" ) - .validateValues(overallSampleSizesTemp, paste0("overallSampleSizes", group)) + self$.validateValues(overallSampleSizesTemp, paste0("overallSampleSizes", group)) .assertValuesAreStrictlyIncreasing(overallSampleSizesTemp, paste0("overallSampleSizes", group), endingNasAllowed = TRUE ) - overallSampleSizes <<- c(overallSampleSizes, overallSampleSizesTemp) + self$overallSampleSizes <- c(self$overallSampleSizes, overallSampleSizesTemp) - overallEventsTemp <- .getValidatedFloatingPointNumbers( - .getValuesByParameterName(dataFrame, + overallEventsTemp <- self$.getValidatedFloatingPointNumbers( + self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_EVENTS, suffix = group ), parameterName = "Cumulative events" ) - .validateValues(overallEventsTemp, paste0("overallEvents", group)) + self$.validateValues(overallEventsTemp, paste0("overallEvents", group)) .assertValuesAreMonotoneIncreasing(overallEventsTemp, paste0("overallEvents", group), endingNasAllowed = TRUE ) - overallEvents <<- c(overallEvents, overallEventsTemp) + self$overallEvents <- c(self$overallEvents, overallEventsTemp) - groups <<- c(groups, rep(as.integer(group), length(overallSampleSizesTemp))) + self$groups <- c(self$groups, rep(as.integer(group), length(overallSampleSizesTemp))) kMax <- length(overallSampleSizesTemp) numberOfValidStages <- length(stats::na.omit(overallSampleSizesTemp)) - stageWiseData <- .getStageWiseData(data.frame( + stageWiseData <- self$.getStageWiseData(data.frame( overallSampleSizes = overallSampleSizesTemp, overallEvents = overallEventsTemp ), kMax, stage = numberOfValidStages) validatedSampleSizes <- stageWiseData$sampleSizes - .validateValues(validatedSampleSizes, paste0("n", group)) - sampleSizes <<- c(sampleSizes, validatedSampleSizes) - events <<- c(events, stageWiseData$events) + self$.validateValues(validatedSampleSizes, paste0("n", group)) + self$sampleSizes <- c(self$sampleSizes, validatedSampleSizes) + self$events <- c(self$events, stageWiseData$events) - if (sum(stats::na.omit(sampleSizes) < 0) > 0) { + if (sum(stats::na.omit(self$sampleSizes) < 0) > 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all sample sizes must be >= 0") } } - .setParameterType("sampleSizes", C_PARAM_GENERATED) - .setParameterType("events", C_PARAM_GENERATED) + self$.setParameterType("sampleSizes", C_PARAM_GENERATED) + self$.setParameterType("events", C_PARAM_GENERATED) - .setParameterType("overallSampleSizes", C_PARAM_USER_DEFINED) - .setParameterType("overallEvents", C_PARAM_USER_DEFINED) + self$.setParameterType("overallSampleSizes", C_PARAM_USER_DEFINED) + self$.setParameterType("overallEvents", C_PARAM_USER_DEFINED) } else { stop( C_EXCEPTION_TYPE_MISSING_ARGUMENT, @@ -1513,72 +2979,72 @@ DatasetRates <- setRefClass("DatasetRates", ) } - if (sum(stats::na.omit(events) < 0) > 0) { + if (sum(stats::na.omit(self$events) < 0) > 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all events must be >= 0") } - .recreateDataFrame() - if (.enrichmentEnabled) { - .createOverallDataEnrichment() + self$.recreateDataFrame() + if (self$.enrichmentEnabled) { + self$.createOverallDataEnrichment() } }, .recreateDataFrame = function() { - callSuper() - .data <<- cbind(.data, data.frame( - sampleSize = sampleSizes, - event = events, - overallSampleSize = overallSampleSizes, - overallEvent = overallEvents + super$.recreateDataFrame() + self$.data <- cbind(self$.data, data.frame( + sampleSize = self$sampleSizes, + event = self$events, + overallSampleSize = self$overallSampleSizes, + overallEvent = self$overallEvents )) - .orderDataByStageAndGroup() - .setDataToVariables() + self$.orderDataByStageAndGroup() + self$.setDataToVariables() }, .setDataToVariables = function() { - callSuper() - sampleSizes <<- .data$sampleSize - events <<- .data$event - overallSampleSizes <<- .data$overallSampleSize - overallEvents <<- .data$overallEvent + super$.setDataToVariables() + self$sampleSizes <- self$.data$sampleSize + self$events <- self$.data$event + self$overallSampleSizes <- self$.data$overallSampleSize + self$overallEvents <- self$.data$overallEvent }, .fillWithNAs = function(kMax) { - callSuper(kMax) - n <- .getNumberOfNAsToAdd(kMax) + super$.fillWithNAs(kMax) + n <- self$.getNumberOfNAsToAdd(kMax) - sampleSizes <<- c(sampleSizes, rep(NA_real_, n)) - events <<- c(events, rep(NA_real_, n)) + self$sampleSizes <- c(self$sampleSizes, rep(NA_real_, n)) + self$events <- c(self$events, rep(NA_real_, n)) - overallSampleSizes <<- c(overallSampleSizes, rep(NA_real_, n)) - overallEvents <<- c(overallEvents, rep(NA_real_, n)) + self$overallSampleSizes <- c(self$overallSampleSizes, rep(NA_real_, n)) + self$overallEvents <- c(self$overallEvents, rep(NA_real_, n)) - .recreateDataFrame() + self$.recreateDataFrame() }, .trim = function(kMax = NA_integer_) { - indices <- callSuper(kMax) + indices <- super$.trim(kMax) if (length(indices) == 0) { return(invisible(FALSE)) } - sampleSizes <<- sampleSizes[indices] - events <<- events[indices] + self$sampleSizes <- self$sampleSizes[indices] + self$events <- self$events[indices] - overallSampleSizes <<- overallSampleSizes[indices] - overallEvents <<- overallEvents[indices] + self$overallSampleSizes <- self$overallSampleSizes[indices] + self$overallEvents <- self$overallEvents[indices] - .recreateDataFrame() + self$.recreateDataFrame() return(invisible(TRUE)) }, getRandomData = function() { data <- NULL - for (stage in 1:getNumberOfStages()) { - for (group in 1:getNumberOfGroups()) { - if (.enrichmentEnabled) { - for (subset in levels(.data$subset)) { - n <- getSampleSize(stage = stage, group = group, subset = subset) - numberOfEvents <- getEvent(stage = stage, group = group, subset = subset) - randomIndizes <- sample(x = c(1:n), size = numberOfEvents, replace = FALSE) + for (stage in 1:self$getNumberOfStages()) { + for (group in 1:self$getNumberOfGroups()) { + if (self$.enrichmentEnabled) { + for (subset in levels(self$.data$subset)) { + n <- self$getSampleSize(stage = stage, group = group, subset = subset) + numberOfEvents <- self$getEvent(stage = stage, group = group, subset = subset) + randomIndices <- sample(x = c(1:n), size = numberOfEvents, replace = FALSE) randomData <- rep(0, n) - randomData[randomIndizes] <- 1 + randomData[randomIndices] <- 1#TODO indices -> indizes row <- data.frame( stage = stage, @@ -1593,11 +3059,11 @@ DatasetRates <- setRefClass("DatasetRates", } } } else { - n <- getSampleSize(stage = stage, group = group) - numberOfEvents <- getEvent(stage = stage, group = group) - randomIndizes <- sample(x = c(1:n), size = numberOfEvents, replace = FALSE) + n <- self$getSampleSize(stage = stage, group = group) + numberOfEvents <- self$getEvent(stage = stage, group = group) + randomIndices <- sample(x = c(1:n), size = numberOfEvents, replace = FALSE) randomData <- rep(0, n) - randomData[randomIndizes] <- 1 + randomData[randomIndices] <- 1 row <- data.frame( stage = stage, @@ -1613,25 +3079,25 @@ DatasetRates <- setRefClass("DatasetRates", } } data$stage <- factor(data$stage) - data$group <- factor(data$group, label = paste("Group", c(1:getNumberOfGroups()))) + data$group <- factor(data$group, label = paste("Group", c(1:self$getNumberOfGroups()))) return(data) }, .createOverallDataEnrichment = function() { - if (!.enrichmentEnabled) { + if (!self$.enrichmentEnabled) { return(invisible()) } - .data$overallSampleSize <<- rep(NA_real_, nrow(.data)) - .data$overallEvent <<- rep(NA_real_, nrow(.data)) - for (s in levels(.data$subset)) { - for (g in levels(.data$group)) { - indices <- which(.data$subset == s & .data$group == g) - .data$overallSampleSize[indices] <<- cumsum(.data$sampleSize[indices]) - .data$overallEvent[indices] <<- cumsum(.data$event[indices]) + self$.data$overallSampleSize <- rep(NA_real_, nrow(self$.data)) + self$.data$overallEvent <- rep(NA_real_, nrow(self$.data)) + for (s in levels(self$.data$subset)) { + for (g in levels(self$.data$group)) { + indices <- which(self$.data$subset == s & self$.data$group == g) + self$.data$overallSampleSize[indices] <- cumsum(self$.data$sampleSize[indices]) + self$.data$overallEvent[indices] <- cumsum(self$.data$event[indices]) } } - .setDataToVariables() + self$.setDataToVariables() }, .getOverallData = function(dataInput, kMax, stage) { "Calculates cumulative values if stage-wise data is available" @@ -1717,70 +3183,68 @@ DatasetRates <- setRefClass("DatasetRates", #' #' @importFrom methods new #' -DatasetSurvival <- setRefClass("DatasetSurvival", - contains = "Dataset", - fields = list( - overallEvents = "numeric", - overallAllocationRatios = "numeric", - overallLogRanks = "numeric", - events = "numeric", - allocationRatios = "numeric", - logRanks = "numeric" - ), - methods = list( +DatasetSurvivalR6 <- R6Class("DatasetSurvivalR6", + inherit = DatasetR6, + public = list( + overallEvents = NULL, + overallAllocationRatios = NULL, + overallLogRanks = NULL, + events = NULL, + allocationRatios = NULL, + logRanks = NULL, getEvent = function(stage, group = 1, subset = NA_character_) { - return(.data$event[.getIndices(stage = stage, group = group, subset = subset)]) + return(self$.data$event[self$.getIndices(stage = stage, group = group, subset = subset)]) }, getEvents = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(.data$event[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) + return(self$.data$event[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) }, getEventsUpTo = function(to, group = 1, subset = NA_character_) { - return(.data$event[.getIndices(stage = c(1:to), group = group, subset = subset)]) + return(self$.data$event[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) }, getAllocationRatio = function(stage, group = 1, subset = NA_character_) { - return(.data$allocationRatio[.getIndices(stage = stage, group = group, subset = subset)]) + return(self$.data$allocationRatio[self$.getIndices(stage = stage, group = group, subset = subset)]) }, getAllocationRatios = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(.data$allocationRatio[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) + return(self$.data$allocationRatio[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) }, getAllocationRatiosUpTo = function(to, group = 1, subset = NA_character_) { - return(.data$allocationRatio[.getIndices(stage = c(1:to), group = group, subset = subset)]) + return(self$.data$allocationRatio[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) }, getLogRank = function(stage, group = 1, subset = NA_character_) { - return(.data$logRank[.getIndices(stage = stage, group = group, subset = subset)]) + return(self$.data$logRank[self$.getIndices(stage = stage, group = group, subset = subset)]) }, getLogRanks = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(.data$logRank[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) + return(self$.data$logRank[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) }, getLogRanksUpTo = function(to, group = 1, subset = NA_character_) { - return(.data$logRank[.getIndices(stage = c(1:to), group = group, subset = subset)]) + return(self$.data$logRank[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) }, getOverallEvent = function(stage, group = 1, subset = NA_character_) { - return(.data$overallEvent[.getIndices(stage = stage, group = group, subset = subset)]) + return(self$.data$overallEvent[self$.getIndices(stage = stage, group = group, subset = subset)]) }, getOverallEvents = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(.data$overallEvent[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) + return(self$.data$overallEvent[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) }, getOverallEventsUpTo = function(to, group = 1, subset = NA_character_) { - return(.data$overallEvent[.getIndices(stage = c(1:to), group = group, subset = subset)]) + return(self$.data$overallEvent[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) }, getOverallAllocationRatio = function(stage, group = 1, subset = NA_character_) { - return(.data$overallAllocationRatio[.getIndices(stage = stage, group = group, subset = subset)]) + return(self$.data$overallAllocationRatio[self$.getIndices(stage = stage, group = group, subset = subset)]) }, getOverallAllocationRatios = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(.data$overallAllocationRatio[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) + return(self$.data$overallAllocationRatio[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) }, getOverallAllocationRatiosUpTo = function(to, group = 1, subset = NA_character_) { - return(.data$overallAllocationRatio[.getIndices(stage = c(1:to), group = group, subset = subset)]) + return(self$.data$overallAllocationRatio[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) }, getOverallLogRank = function(stage, group = 1, subset = NA_character_) { - return(.data$overallLogRank[.getIndices(stage = stage, group = group, subset = subset)]) + return(self$.data$overallLogRank[self$.getIndices(stage = stage, group = group, subset = subset)]) }, getOverallLogRanks = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(.data$overallLogRank[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) + return(self$.data$overallLogRank[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) }, getOverallLogRanksUpTo = function(to, group = 1, subset = NA_character_) { - return(.data$overallLogRank[.getIndices(stage = c(1:to), group = group, subset = subset)]) + return(self$.data$overallLogRank[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) }, .getAllocationRatioDefaultValues = function(stages, events, logRanks) { allocationRatioDefaultValues <- rep(C_ALLOCATION_RATIO_DEFAULT, length(stages)) @@ -1789,307 +3253,307 @@ DatasetSurvival <- setRefClass("DatasetSurvival", return(allocationRatioDefaultValues) }, .initByDataFrame = function(dataFrame) { - callSuper(dataFrame) + super$.initByDataFrame(dataFrame) - if (inherits(.self, "DatasetEnrichmentSurvival")) { - if (.paramExists(dataFrame, C_KEY_WORDS_EXPECTED_EVENTS) || - .paramExists(dataFrame, C_KEY_WORDS_VARIANCE_EVENTS)) { - .inputType <<- "stagewise" + if (inherits(self, "DatasetEnrichmentSurvivalR6")) { + if (self$.paramExists(dataFrame, C_KEY_WORDS_EXPECTED_EVENTS) || + self$.paramExists(dataFrame, C_KEY_WORDS_VARIANCE_EVENTS)) { + self$.inputType <- "stagewise" - events <<- .getValidatedFloatingPointNumbers( - .getValuesByParameterName(dataFrame, C_KEY_WORDS_EVENTS), + self$events <- self$.getValidatedFloatingPointNumbers( + self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_EVENTS), parameterName = "Events" ) - .validateValues(events, "events") + self$.validateValues(self$events, "events") - allocationRatios <<- .getValuesByParameterName( + self$allocationRatios <- self$.getValuesByParameterName( dataFrame, C_KEY_WORDS_ALLOCATION_RATIOS, - defaultValues = .getAllocationRatioDefaultValues(stages, events, expectedEvents) + defaultValues = .getAllocationRatioDefaultValues(self$stages, self$events, self$expectedEvents) ) - .validateValues(allocationRatios, "allocationRatios") - } else if (.paramExists(dataFrame, C_KEY_WORDS_OVERALL_EXPECTED_EVENTS) || - .paramExists(dataFrame, C_KEY_WORDS_OVERALL_VARIANCE_EVENTS)) { - .inputType <<- "overall" + self$.validateValues(self$allocationRatios, "allocationRatios") + } else if (self$.paramExists(dataFrame, C_KEY_WORDS_OVERALL_EXPECTED_EVENTS) || + self$.paramExists(dataFrame, C_KEY_WORDS_OVERALL_VARIANCE_EVENTS)) { + self$.inputType <- "overall" - overallEvents <<- .getValidatedFloatingPointNumbers( - .getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_EVENTS), + self$overallEvents <- self$.getValidatedFloatingPointNumbers( + self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_EVENTS), parameterName = "Cumulative events" ) - .validateValues(overallEvents, "overallEvents") + self$.validateValues(self$overallEvents, "overallEvents") - overallAllocationRatios <<- .getValuesByParameterName( + self$overallAllocationRatios <- self$.getValuesByParameterName( dataFrame, parameterNameVariants = C_KEY_WORDS_OVERALL_ALLOCATION_RATIOS, - defaultValues = .getAllocationRatioDefaultValues(stages, overallEvents, overallExpectedEvents) + defaultValues = self$.getAllocationRatioDefaultValues(self$stages, self$overallEvents, self$overallExpectedEvents) ) - .validateValues(overallAllocationRatios, "overallAllocationRatios") + self$.validateValues(self$overallAllocationRatios, "overallAllocationRatios") } # stratified enrichment: do nothing more here } # case: survival, two groups - overall - else if (.paramExists(dataFrame, C_KEY_WORDS_OVERALL_LOG_RANKS)) { - .inputType <<- "overall" - overallEvents <<- .getValidatedFloatingPointNumbers( - .getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_EVENTS), + else if (self$.paramExists(dataFrame, C_KEY_WORDS_OVERALL_LOG_RANKS)) { + self$.inputType <- "overall" + self$overallEvents <- self$.getValidatedFloatingPointNumbers( + self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_EVENTS), parameterName = "Cumulative events" ) - .validateValues(overallEvents, "overallEvents") - if (!.enrichmentEnabled) { - .assertValuesAreStrictlyIncreasing(overallEvents, "overallEvents", endingNasAllowed = TRUE) + self$.validateValues(self$overallEvents, "overallEvents") + if (!self$.enrichmentEnabled) { + .assertValuesAreStrictlyIncreasing(self$overallEvents, "overallEvents", endingNasAllowed = TRUE) } - overallLogRanks <<- .getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_LOG_RANKS) - .validateValues(overallLogRanks, "overallLogRanks") + self$overallLogRanks <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_LOG_RANKS) + self$.validateValues(self$overallLogRanks, "overallLogRanks") - overallAllocationRatios <<- .getValuesByParameterName( + self$overallAllocationRatios <- self$.getValuesByParameterName( dataFrame, parameterNameVariants = C_KEY_WORDS_OVERALL_ALLOCATION_RATIOS, - defaultValues = .getAllocationRatioDefaultValues(stages, overallEvents, overallLogRanks) + defaultValues = self$.getAllocationRatioDefaultValues(self$stages, self$overallEvents, self$overallLogRanks) ) - .validateValues(overallAllocationRatios, "overallAllocationRatios") + self$.validateValues(self$overallAllocationRatios, "overallAllocationRatios") - .setParameterType("groups", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("groups", C_PARAM_NOT_APPLICABLE) } # case: survival, two groups - stage wise - else if (.paramExists(dataFrame, C_KEY_WORDS_LOG_RANKS)) { - .inputType <<- "stagewise" - events <<- .getValidatedFloatingPointNumbers(.getValuesByParameterName( + else if (self$.paramExists(dataFrame, C_KEY_WORDS_LOG_RANKS)) { + self$.inputType <- "stagewise" + self$events <- self$.getValidatedFloatingPointNumbers(self$.getValuesByParameterName( dataFrame, C_KEY_WORDS_EVENTS ), parameterName = "Events") - .validateValues(events, "events") - if (any(stats::na.omit(events) < 0)) { + self$.validateValues(self$events, "events") + if (any(stats::na.omit(self$events) < 0)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all events must be >= 0") } - logRanks <<- .getValuesByParameterName(dataFrame, C_KEY_WORDS_LOG_RANKS) - .validateValues(logRanks, "logRanks") + self$logRanks <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_LOG_RANKS) + self$.validateValues(self$logRanks, "logRanks") - allocationRatios <<- .getValuesByParameterName( + self$allocationRatios <- self$.getValuesByParameterName( dataFrame, C_KEY_WORDS_ALLOCATION_RATIOS, - defaultValues = .getAllocationRatioDefaultValues(stages, events, logRanks) + defaultValues = self$.getAllocationRatioDefaultValues(self$stages, self$events, self$logRanks) ) - .validateValues(allocationRatios, "allocationRatios") + self$.validateValues(self$allocationRatios, "allocationRatios") - .setParameterType("groups", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("groups", C_PARAM_NOT_APPLICABLE) } # case: survival, three ore more groups - overall - else if (.paramExists(dataFrame, paste0(C_KEY_WORDS_OVERALL_LOG_RANKS, 1)) && - .paramExists(dataFrame, paste0(C_KEY_WORDS_OVERALL_LOG_RANKS, 2))) { - .inputType <<- "overall" + else if (self$.paramExists(dataFrame, paste0(C_KEY_WORDS_OVERALL_LOG_RANKS, 1)) && + self$.paramExists(dataFrame, paste0(C_KEY_WORDS_OVERALL_LOG_RANKS, 2))) { + self$.inputType <- "overall" - numberOfTreatmentGroups <- .getNumberOfGroups(dataFrame, C_KEY_WORDS_OVERALL_LOG_RANKS) + numberOfTreatmentGroups <- self$.getNumberOfGroups(dataFrame, C_KEY_WORDS_OVERALL_LOG_RANKS) - stages <<- rep(stages, numberOfTreatmentGroups) + self$stages <- rep(self$stages, numberOfTreatmentGroups) - groups <<- integer(0) - overallEvents <<- numeric(0) - overallAllocationRatios <<- numeric(0) - overallLogRanks <<- numeric(0) + self$groups <- integer(0) + self$overallEvents <- numeric(0) + self$overallAllocationRatios <- numeric(0) + self$overallLogRanks <- numeric(0) for (group in 1:numberOfTreatmentGroups) { - overallEventsTemp <- .getValuesByParameterName(dataFrame, + overallEventsTemp <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_EVENTS, suffix = group ) - .validateValues(overallEventsTemp, paste0("overallEvents", group)) + self$.validateValues(overallEventsTemp, paste0("overallEvents", group)) if (is.null(dataFrame[["subset"]]) || length(unique(dataFrame[["subset"]])) <= 1) { .assertValuesAreStrictlyIncreasing(overallEventsTemp, paste0("overallEvents", group), endingNasAllowed = TRUE ) } - overallEvents <<- c(overallEvents, overallEventsTemp) + self$overallEvents <- c(self$overallEvents, overallEventsTemp) - overallLogRanksTemp <- .getValuesByParameterName( + overallLogRanksTemp <- self$.getValuesByParameterName( dataFrame, C_KEY_WORDS_OVERALL_LOG_RANKS, suffix = group ) - .validateValues(overallLogRanksTemp, paste0("overallLogRanks", group)) - overallLogRanks <<- c(overallLogRanks, overallLogRanksTemp) + self$.validateValues(overallLogRanksTemp, paste0("overallLogRanks", group)) + self$overallLogRanks <- c(self$overallLogRanks, overallLogRanksTemp) - overallAllocationRatiosTemp <- .getValuesByParameterName( + overallAllocationRatiosTemp <- self$.getValuesByParameterName( dataFrame, C_KEY_WORDS_OVERALL_ALLOCATION_RATIOS, suffix = group, - defaultValues = .getAllocationRatioDefaultValues( + defaultValues = self$.getAllocationRatioDefaultValues( overallEventsTemp, overallEventsTemp, overallLogRanksTemp ) ) - .validateValues(overallAllocationRatiosTemp, paste0("overallAllocationRatios", group)) - overallAllocationRatios <<- c(overallAllocationRatios, overallAllocationRatiosTemp) + self$.validateValues(overallAllocationRatiosTemp, paste0("overallAllocationRatios", group)) + self$overallAllocationRatios <- c(self$overallAllocationRatios, overallAllocationRatiosTemp) - groups <<- c(groups, rep(as.integer(group), length(overallLogRanksTemp))) + self$groups <- c(self$groups, rep(as.integer(group), length(overallLogRanksTemp))) } } # case: survival, three ore more groups - stage wise - else if (.paramExists(dataFrame, paste0(C_KEY_WORDS_LOG_RANKS, 1)) && - .paramExists(dataFrame, paste0(C_KEY_WORDS_LOG_RANKS, 2))) { - .inputType <<- "stagewise" - numberOfTreatmentGroups <- .getNumberOfGroups(dataFrame, C_KEY_WORDS_LOG_RANKS) + else if (self$.paramExists(dataFrame, paste0(C_KEY_WORDS_LOG_RANKS, 1)) && + self$.paramExists(dataFrame, paste0(C_KEY_WORDS_LOG_RANKS, 2))) { + self$.inputType <- "stagewise" + numberOfTreatmentGroups <- self$.getNumberOfGroups(dataFrame, C_KEY_WORDS_LOG_RANKS) - stages <<- rep(stages, numberOfTreatmentGroups) + self$stages <- rep(self$stages, numberOfTreatmentGroups) - groups <<- integer(0) - events <<- numeric(0) - allocationRatios <<- numeric(0) - logRanks <<- numeric(0) + self$groups <- integer(0) + self$events <- numeric(0) + self$allocationRatios <- numeric(0) + self$logRanks <- numeric(0) for (group in 1:numberOfTreatmentGroups) { - eventsTemp <- .getValidatedFloatingPointNumbers(.getValuesByParameterName( + eventsTemp <- self$.getValidatedFloatingPointNumbers(self$.getValuesByParameterName( dataFrame, C_KEY_WORDS_EVENTS, suffix = group ), parameterName = "Events") if (any(stats::na.omit(eventsTemp) < 0)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all events must be >= 0, but 'events", group, "' = ", - .arrayToString(eventsTemp, vectorLookAndFeelEnabled = TRUE) + self$.arrayToString(eventsTemp, vectorLookAndFeelEnabled = TRUE) ) } - events <<- c(events, eventsTemp) + self$events <- c(self$events, eventsTemp) - logRanksTemp <- .getValuesByParameterName( + logRanksTemp <- self$.getValuesByParameterName( dataFrame, C_KEY_WORDS_LOG_RANKS, suffix = group ) - .validateValues(logRanksTemp, paste0("n", group)) - logRanks <<- c(logRanks, logRanksTemp) + self$.validateValues(logRanksTemp, paste0("n", group)) + self$logRanks <- c(self$logRanks, logRanksTemp) - allocationRatiosTemp <- .getValuesByParameterName( + allocationRatiosTemp <- self$.getValuesByParameterName( dataFrame, C_KEY_WORDS_ALLOCATION_RATIOS, suffix = group, - defaultValues = .getAllocationRatioDefaultValues( + defaultValues = self$.getAllocationRatioDefaultValues( eventsTemp, eventsTemp, logRanksTemp ) ) - .validateValues(allocationRatiosTemp, paste0("allocationRatios", group)) - allocationRatios <<- c(allocationRatios, allocationRatiosTemp) + self$.validateValues(allocationRatiosTemp, paste0("allocationRatios", group)) + self$allocationRatios <- c(self$allocationRatios, allocationRatiosTemp) - groups <<- c(groups, rep(as.integer(group), length(eventsTemp))) + self$groups <- c(self$groups, rep(as.integer(group), length(eventsTemp))) } } else { stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, "unable to identify case for ", .getClassName(.self), " and columns ", - .arrayToString(colnames(dataFrame)) + C_EXCEPTION_TYPE_RUNTIME_ISSUE, "unable to identify case for ", .getClassName(self), " and columns ", + self$.arrayToString(colnames(dataFrame)) ) } - if (.inputType == "stagewise") { - n <- length(events) - overallEvents <<- rep(NA_real_, n) - overallAllocationRatios <<- rep(NA_real_, n) - overallLogRanks <<- rep(NA_real_, n) + if (self$.inputType == "stagewise") { + n <- length(self$events) + self$overallEvents <- rep(NA_real_, n) + self$overallAllocationRatios <- rep(NA_real_, n) + self$overallLogRanks <- rep(NA_real_, n) - .setParameterType("events", C_PARAM_USER_DEFINED) - .setParameterType("allocationRatios", C_PARAM_USER_DEFINED) - if (!inherits(.self, "DatasetEnrichmentSurvival")) { - .setParameterType("logRanks", C_PARAM_USER_DEFINED) + self$.setParameterType("events", C_PARAM_USER_DEFINED) + self$.setParameterType("allocationRatios", C_PARAM_USER_DEFINED) + if (!inherits(self, "DatasetEnrichmentSurvivalR6")) { + self$.setParameterType("logRanks", C_PARAM_USER_DEFINED) } - .setParameterType("overallEvents", C_PARAM_GENERATED) - .setParameterType("overallAllocationRatios", C_PARAM_GENERATED) - if (!inherits(.self, "DatasetEnrichmentSurvival")) { - .setParameterType("overallLogRanks", C_PARAM_GENERATED) + self$.setParameterType("overallEvents", C_PARAM_GENERATED) + self$.setParameterType("overallAllocationRatios", C_PARAM_GENERATED) + if (!inherits(self, "DatasetEnrichmentSurvivalR6")) { + self$.setParameterType("overallLogRanks", C_PARAM_GENERATED) } - if (!inherits(.self, "DatasetEnrichmentSurvival")) { - .recreateDataFrame() - .createOverallData() + if (!inherits(self, "DatasetEnrichmentSurvivalR6")) { + self$.recreateDataFrame() + self$.createOverallData() } } else { - n <- length(overallEvents) - events <<- rep(NA_real_, n) - allocationRatios <<- rep(NA_real_, n) - logRanks <<- rep(NA_real_, n) - - .setParameterType("events", C_PARAM_GENERATED) - .setParameterType("allocationRatios", C_PARAM_GENERATED) - if (!inherits(.self, "DatasetEnrichmentSurvival")) { - .setParameterType("logRanks", C_PARAM_GENERATED) + n <- length(self$overallEvents) + self$events <- rep(NA_real_, n) + self$allocationRatios <- rep(NA_real_, n) + self$logRanks <- rep(NA_real_, n) + + self$.setParameterType("events", C_PARAM_GENERATED) + self$.setParameterType("allocationRatios", C_PARAM_GENERATED) + if (!inherits(self, "DatasetEnrichmentSurvivalR6")) { + self$.setParameterType("logRanks", C_PARAM_GENERATED) } - .setParameterType("overallEvents", C_PARAM_USER_DEFINED) - .setParameterType("overallAllocationRatios", C_PARAM_USER_DEFINED) - if (!inherits(.self, "DatasetEnrichmentSurvival")) { - .setParameterType("overallLogRanks", C_PARAM_USER_DEFINED) + self$.setParameterType("overallEvents", C_PARAM_USER_DEFINED) + self$.setParameterType("overallAllocationRatios", C_PARAM_USER_DEFINED) + if (!inherits(self, "DatasetEnrichmentSurvivalR6")) { + self$.setParameterType("overallLogRanks", C_PARAM_USER_DEFINED) } - if (!inherits(.self, "DatasetEnrichmentSurvival")) { - .recreateDataFrame() - .createStageWiseData() + if (!inherits(self, "DatasetEnrichmentSurvivalR6")) { + self$.recreateDataFrame() + self$.createStageWiseData() } } }, .recreateDataFrame = function() { - callSuper() - - if (inherits(.self, "DatasetEnrichmentSurvival")) { - .data <<- cbind(.data, data.frame( - overallEvent = overallEvents, - overallExpectedEvent = overallExpectedEvents, - overallVarianceEvent = overallVarianceEvents, - overallAllocationRatio = overallAllocationRatios, - event = events, - expectedEvent = expectedEvents, + super$.recreateDataFrame() + + if (inherits(self, "DatasetEnrichmentSurvivalR6")) { + self$.data <- cbind(self$.data, data.frame( + overallEvent = self$overallEvents, + overallExpectedEvent = self$overallExpectedEvents, + overallVarianceEvent = self$overallVarianceEvents, + overallAllocationRatio = self$overallAllocationRatios, + event = self$events, + expectedEvent = self$expectedEvents, # varianceEvent = varianceEvents, # maybe implemented later - allocationRatio = allocationRatios + allocationRatio = self$allocationRatios )) } else { - .data <<- cbind(.data, data.frame( - overallEvent = overallEvents, - overallAllocationRatio = overallAllocationRatios, - overallLogRank = overallLogRanks, - event = events, - allocationRatio = allocationRatios, - logRank = logRanks + self$.data <- cbind(self$.data, data.frame( + overallEvent = self$overallEvents, + overallAllocationRatio = self$overallAllocationRatios, + overallLogRank = self$overallLogRanks, + event = self$events, + allocationRatio = self$allocationRatios, + logRank = self$logRanks )) } - .orderDataByStageAndGroup() - .setDataToVariables() + self$.orderDataByStageAndGroup() + self$.setDataToVariables() }, .setDataToVariables = function() { - callSuper() - overallEvents <<- .data$overallEvent - overallAllocationRatios <<- .data$overallAllocationRatio - events <<- .data$event - allocationRatios <<- .data$allocationRatio - if (!inherits(.self, "DatasetEnrichmentSurvival")) { - overallLogRanks <<- .data$overallLogRank - logRanks <<- .data$logRank + super$.setDataToVariables() + self$overallEvents <- self$.data$overallEvent + self$overallAllocationRatios <- self$.data$overallAllocationRatio + self$events <- self$.data$event + self$allocationRatios <- self$.data$allocationRatio + if (!inherits(self, "DatasetEnrichmentSurvivalR6")) { + self$overallLogRanks <- self$.data$overallLogRank + self$logRanks <- self$.data$logRank } }, .fillWithNAs = function(kMax) { - callSuper(kMax) - n <- .getNumberOfNAsToAdd(kMax) + super$.fillWithNAs(kMax) + n <- self$.getNumberOfNAsToAdd(kMax) - overallEvents <<- c(overallEvents, rep(NA_real_, n)) - overallAllocationRatios <<- c(overallAllocationRatios, rep(NA_real_, n)) - overallLogRanks <<- c(overallLogRanks, rep(NA_real_, n)) + self$overallEvents <- c(self$overallEvents, rep(NA_real_, n)) + self$overallAllocationRatios <- c(self$overallAllocationRatios, rep(NA_real_, n)) + self$overallLogRanks <- c(self$overallLogRanks, rep(NA_real_, n)) - events <<- c(events, rep(NA_real_, n)) - allocationRatios <<- c(allocationRatios, rep(NA_real_, n)) - logRanks <<- c(logRanks, rep(NA_real_, n)) + self$events <- c(self$events, rep(NA_real_, n)) + self$allocationRatios <- c(self$allocationRatios, rep(NA_real_, n)) + self$logRanks <- c(self$logRanks, rep(NA_real_, n)) - .recreateDataFrame() + self$.recreateDataFrame() }, .trim = function(kMax = NA_integer_) { - indices <- callSuper(kMax) + indices <- super$.trim(kMax) if (length(indices) == 0) { return(invisible(FALSE)) } - events <<- events[indices] - allocationRatios <<- allocationRatios[indices] - logRanks <<- logRanks[indices] + self$events <- self$events[indices] + self$allocationRatios <- self$allocationRatios[indices] + self$logRanks <- self$logRanks[indices] - overallEvents <<- overallEvents[indices] - overallAllocationRatios <<- overallAllocationRatios[indices] - overallLogRanks <<- overallLogRanks[indices] + self$overallEvents <- self$overallEvents[indices] + self$overallAllocationRatios <- self$overallAllocationRatios[indices] + self$overallLogRanks <- self$overallLogRanks[indices] - .recreateDataFrame() + self$.recreateDataFrame() return(invisible(TRUE)) }, @@ -2130,37 +3594,37 @@ DatasetSurvival <- setRefClass("DatasetSurvival", return(result) }, .createOverallData = function() { - .data$overallEvent <<- rep(NA_real_, nrow(.data)) - if (inherits(.self, "DatasetEnrichmentSurvival")) { - .data$overallExpectedEvent <<- rep(NA_real_, nrow(.data)) - .data$overallVarianceEvent <<- rep(NA_real_, nrow(.data)) + self$.data$overallEvent <- rep(NA_real_, nrow(self$.data)) + if (inherits(self, "DatasetEnrichmentSurvivalR6")) { + self$.data$overallExpectedEvent <- rep(NA_real_, nrow(self$.data)) + self$.data$overallVarianceEvent <- rep(NA_real_, nrow(self$.data)) } else { - .data$overallLogRank <<- rep(NA_real_, nrow(.data)) + self$.data$overallLogRank <- rep(NA_real_, nrow(self$.data)) } - .data$overallAllocationRatio <<- rep(NA_real_, nrow(.data)) + self$.data$overallAllocationRatio <- rep(NA_real_, nrow(self$.data)) subsetLevels <- NA_character_ - if (.enrichmentEnabled) { - subsetLevels <- levels(.data$subset) + if (self$.enrichmentEnabled) { + subsetLevels <- levels(self$.data$subset) } for (s in subsetLevels) { - for (g in levels(.data$group)) { + for (g in levels(self$.data$group)) { if (!is.na(s)) { - indices <- which(.data$subset == s & .data$group == g) + indices <- which(self$.data$subset == s & self$.data$group == g) } else { - indices <- which(.data$group == g) + indices <- which(self$.data$group == g) } - .data$overallEvent[indices] <<- cumsum(.data$event[indices]) - .data$overallExpectedEvent[indices] <<- cumsum(.data$expectedEvent[indices]) + self$.data$overallEvent[indices] <- cumsum(self$.data$event[indices]) + self$.data$overallExpectedEvent[indices] <- cumsum(self$.data$expectedEvent[indices]) # .data$overallVarianceEvent[indices] <<- # maybe implemented later - .data$overallLogRank[indices] <<- .getOverallLogRanks( - .data$logRank[indices], .data$event[indices], .data$overallEvent[indices] + self$.data$overallLogRank[indices] <- self$.getOverallLogRanks( + self$.data$logRank[indices], self$.data$event[indices], self$.data$overallEvent[indices] ) - .data$overallAllocationRatio[indices] <<- .getOverallAllocationRatios( - .data$allocationRatio[indices], .data$event[indices], .data$overallEvent[indices] + self$.data$overallAllocationRatio[indices] <- self$.getOverallAllocationRatios( + self$.data$allocationRatio[indices], self$.data$event[indices], self$.data$overallEvent[indices] ) } } - .setDataToVariables() + self$.setDataToVariables() }, .getStageWiseEvents = function(overallEvents) { result <- overallEvents @@ -2210,57 +3674,57 @@ DatasetSurvival <- setRefClass("DatasetSurvival", .createStageWiseData = function() { "Calculates stage-wise logrank statistics, events, and allocation ratios if cumulative data is available" - .data$event <<- rep(NA_real_, nrow(.data)) - if (inherits(.self, "DatasetEnrichmentSurvival")) { - .data$expectedEvent <<- rep(NA_real_, nrow(.data)) - .data$varianceEvent <<- rep(NA_real_, nrow(.data)) + self$.data$event <- rep(NA_real_, nrow(self$.data)) + if (inherits(self, "DatasetEnrichmentSurvivalR6")) { + self$.data$expectedEvent <- rep(NA_real_, nrow(self$.data)) + self$.data$varianceEvent <- rep(NA_real_, nrow(self$.data)) } else { - .data$logRank <<- rep(NA_real_, nrow(.data)) + self$.data$logRank <- rep(NA_real_, nrow(self$.data)) } - .data$allocationRatio <<- rep(NA_real_, nrow(.data)) + self$.data$allocationRatio <- rep(NA_real_, nrow(self$.data)) subsetLevels <- NA_character_ - if (.enrichmentEnabled) { - subsetLevels <- levels(.data$subset) + if (self$.enrichmentEnabled) { + subsetLevels <- levels(self$.data$subset) } for (s in subsetLevels) { - for (g in levels(.data$group)) { + for (g in levels(self$.data$group)) { if (!is.na(s)) { - indices <- which(.data$subset == s & .data$group == g) + indices <- which(self$.data$subset == s & self$.data$group == g) } else { - indices <- which(.data$group == g) + indices <- which(self$.data$group == g) } - groupNumber <- ifelse(levels(.data$group) > 1, g, "") - if (.enrichmentEnabled) { - .assertValuesAreStrictlyIncreasing(.data$overallEvent[indices], + groupNumber <- ifelse(levels(self$.data$group) > 1, g, "") + if (self$.enrichmentEnabled) { + .assertValuesAreStrictlyIncreasing(self$.data$overallEvent[indices], paste0("overallEvents", groupNumber, "[subset == \"", s, "\"]"), endingNasAllowed = TRUE ) } else { - .assertValuesAreStrictlyIncreasing(.data$overallEvent[indices], + .assertValuesAreStrictlyIncreasing(self$.data$overallEvent[indices], paste0("overallEvents", groupNumber), endingNasAllowed = TRUE ) } - .data$event[indices] <<- .getStageWiseEvents(.data$overallEvent[indices]) - if (inherits(.self, "DatasetEnrichmentSurvival")) { - .data$expectedEvent[indices] <<- .getStageWiseEvents(.data$overallExpectedEvent[indices]) + self$.data$event[indices] <- self$.getStageWiseEvents(self$.data$overallEvent[indices]) + if (inherits(self, "DatasetEnrichmentSurvivalR6")) { + self$.data$expectedEvent[indices] <- self$.getStageWiseEvents(self$.data$overallExpectedEvent[indices]) # .data$varianceEvent[indices] <<- # maybe implemented later } else { - .data$logRank[indices] <<- .getStageWiseLogRanks( - .data$overallLogRank[indices], .data$overallEvent[indices] + self$.data$logRank[indices] <- self$.getStageWiseLogRanks( + self$.data$overallLogRank[indices], self$.data$overallEvent[indices] ) } - .data$allocationRatio[indices] <<- .getStageWiseAllocationRatios( - .data$overallAllocationRatio[indices], - .data$event[indices], .data$overallEvent[indices] + self$.data$allocationRatio[indices] <- self$.getStageWiseAllocationRatios( + self$.data$overallAllocationRatio[indices], + self$.data$event[indices], self$.data$overallEvent[indices] ) } } - .setDataToVariables() + self$.setDataToVariables() } ) ) @@ -2270,148 +3734,177 @@ DatasetSurvival <- setRefClass("DatasetSurvival", #' #' @keywords internal #' -DatasetEnrichmentSurvival <- setRefClass("DatasetEnrichmentSurvival", - contains = "DatasetSurvival", - fields = list( - expectedEvents = "numeric", - varianceEvents = "numeric", - overallExpectedEvents = "numeric", - overallVarianceEvents = "numeric" - ), - methods = list( +DatasetEnrichmentSurvivalR6 <- R6Class("DatasetEnrichmentSurvivalR6", + inherit = DatasetSurvivalR6, + public = list( + expectedEvents = NULL, + varianceEvents = NULL, + overallExpectedEvents = NULL, + overallVarianceEvents = NULL, .initByDataFrame = function(dataFrame) { - callSuper(dataFrame) + super$.initByDataFrame(dataFrame) - if (.paramExists(dataFrame, C_KEY_WORDS_OVERALL_EXPECTED_EVENTS) || - .paramExists(dataFrame, C_KEY_WORDS_OVERALL_VARIANCE_EVENTS)) { - if (!.paramExists(dataFrame, C_KEY_WORDS_OVERALL_EXPECTED_EVENTS)) { + if (self$.paramExists(dataFrame, C_KEY_WORDS_OVERALL_EXPECTED_EVENTS) || + self$.paramExists(dataFrame, C_KEY_WORDS_OVERALL_VARIANCE_EVENTS)) { + if (!self$.paramExists(dataFrame, C_KEY_WORDS_OVERALL_EXPECTED_EVENTS)) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'overallExpectedEvents' is missing") } - if (!.paramExists(dataFrame, C_KEY_WORDS_OVERALL_VARIANCE_EVENTS)) { + if (!self$.paramExists(dataFrame, C_KEY_WORDS_OVERALL_VARIANCE_EVENTS)) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'overallVarianceEvents' is missing") } - .inputType <<- "overall" + self$.inputType <- "overall" - overallEvents <<- .getValidatedFloatingPointNumbers( - .getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_EVENTS), + self$overallEvents <- self$.getValidatedFloatingPointNumbers( + self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_EVENTS), parameterName = "Cumulative events" ) - .validateValues(overallEvents, "overallEvents") + self$.validateValues(self$overallEvents, "overallEvents") - overallExpectedEvents <<- .getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_EXPECTED_EVENTS) - .validateValues(overallExpectedEvents, "overallExpectedEvents") + self$overallExpectedEvents <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_EXPECTED_EVENTS) + self$.validateValues(self$overallExpectedEvents, "overallExpectedEvents") - overallVarianceEvents <<- .getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_VARIANCE_EVENTS) - .validateValues(overallVarianceEvents, "overallVarianceEvents") + self$overallVarianceEvents <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_VARIANCE_EVENTS) + self$.validateValues(self$overallVarianceEvents, "overallVarianceEvents") - overallAllocationRatios <<- .getValuesByParameterName( + self$overallAllocationRatios <- self$.getValuesByParameterName( dataFrame, parameterNameVariants = C_KEY_WORDS_OVERALL_ALLOCATION_RATIOS, - defaultValues = .getAllocationRatioDefaultValues(stages, overallEvents, overallExpectedEvents) + defaultValues = self$.getAllocationRatioDefaultValues(self$stages, self$overallEvents, self$overallExpectedEvents) ) - .validateValues(overallAllocationRatios, "overallAllocationRatios") - } else if (.paramExists(dataFrame, C_KEY_WORDS_EXPECTED_EVENTS) || - .paramExists(dataFrame, C_KEY_WORDS_VARIANCE_EVENTS)) { - if (!.paramExists(dataFrame, C_KEY_WORDS_EXPECTED_EVENTS)) { + self$.validateValues(self$overallAllocationRatios, "overallAllocationRatios") + } else if (self$.paramExists(dataFrame, C_KEY_WORDS_EXPECTED_EVENTS) || + self$.paramExists(dataFrame, C_KEY_WORDS_VARIANCE_EVENTS)) { + if (!self$.paramExists(dataFrame, C_KEY_WORDS_EXPECTED_EVENTS)) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'expectedEvents' is missing") } - if (!.paramExists(dataFrame, C_KEY_WORDS_VARIANCE_EVENTS)) { + if (!self$.paramExists(dataFrame, C_KEY_WORDS_VARIANCE_EVENTS)) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'varianceEvents' is missing") } - .inputType <<- "stagewise" + self$.inputType <- "stagewise" - events <<- .getValidatedFloatingPointNumbers( - .getValuesByParameterName(dataFrame, C_KEY_WORDS_EVENTS), + self$events <- self$.getValidatedFloatingPointNumbers( + self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_EVENTS), parameterName = "Events" ) - .validateValues(events, "events") + self$.validateValues(self$events, "events") - expectedEvents <<- .getValuesByParameterName(dataFrame, C_KEY_WORDS_EXPECTED_EVENTS) - .validateValues(expectedEvents, "expectedEvents") + self$expectedEvents <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_EXPECTED_EVENTS) + self$.validateValues(self$expectedEvents, "expectedEvents") - varianceEvents <<- .getValuesByParameterName(dataFrame, C_KEY_WORDS_VARIANCE_EVENTS) - .validateValues(varianceEvents, "varianceEvents") + self$varianceEvents <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_VARIANCE_EVENTS) + self$.validateValues(varianceEvents, "varianceEvents") - allocationRatios <<- .getValuesByParameterName( + self$allocationRatios <- self$.getValuesByParameterName( dataFrame, parameterNameVariants = C_KEY_WORDS_ALLOCATION_RATIOS, - defaultValues = .getAllocationRatioDefaultValues(stages, events, expectedEvents) + defaultValues = self$.getAllocationRatioDefaultValues(self$stages, self$events, self$expectedEvents) ) - .validateValues(allocationRatios, "allocationRatios") + self$.validateValues(self$allocationRatios, "allocationRatios") } - .setParameterType("groups", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("groups", C_PARAM_NOT_APPLICABLE) - if (.inputType == "stagewise") { - n <- length(events) - overallExpectedEvents <<- rep(NA_real_, n) - overallVarianceEvents <<- rep(NA_real_, n) + if (self$.inputType == "stagewise") { + n <- length(self$events) + self$overallExpectedEvents <- rep(NA_real_, n) + self$overallVarianceEvents <- rep(NA_real_, n) - .setParameterType("events", C_PARAM_USER_DEFINED) - .setParameterType("allocationRatios", C_PARAM_USER_DEFINED) - .setParameterType("expectedEvents", C_PARAM_USER_DEFINED) - .setParameterType("varianceEvents", C_PARAM_USER_DEFINED) + self$.setParameterType("events", C_PARAM_USER_DEFINED) + self$.setParameterType("allocationRatios", C_PARAM_USER_DEFINED) + self$.setParameterType("expectedEvents", C_PARAM_USER_DEFINED) + self$.setParameterType("varianceEvents", C_PARAM_USER_DEFINED) - .setParameterType("overallEvents", C_PARAM_GENERATED) - .setParameterType("overallAllocationRatios", C_PARAM_GENERATED) - .setParameterType("overallExpectedEvents", C_PARAM_GENERATED) - .setParameterType("overallVarianceEvents", C_PARAM_GENERATED) + self$.setParameterType("overallEvents", C_PARAM_GENERATED) + self$.setParameterType("overallAllocationRatios", C_PARAM_GENERATED) + self$.setParameterType("overallExpectedEvents", C_PARAM_GENERATED) + self$.setParameterType("overallVarianceEvents", C_PARAM_GENERATED) - .recreateDataFrame() - .createOverallData() + self$.recreateDataFrame() + self$.createOverallData() } else { - n <- length(overallEvents) - expectedEvents <<- rep(NA_real_, n) - varianceEvents <<- rep(NA_real_, n) - - .setParameterType("events", C_PARAM_GENERATED) - .setParameterType("allocationRatios", C_PARAM_GENERATED) - .setParameterType("expectedEvents", C_PARAM_GENERATED) - .setParameterType("varianceEvents", C_PARAM_GENERATED) - - .setParameterType("overallEvents", C_PARAM_USER_DEFINED) - .setParameterType("overallAllocationRatios", C_PARAM_USER_DEFINED) - .setParameterType("overallExpectedEvents", C_PARAM_USER_DEFINED) - .setParameterType("overallVarianceEvents", C_PARAM_USER_DEFINED) - - .recreateDataFrame() - .createStageWiseData() + n <- length(self$overallEvents) + self$expectedEvents <- rep(NA_real_, n) + self$varianceEvents <- rep(NA_real_, n) + + self$.setParameterType("events", C_PARAM_GENERATED) + self$.setParameterType("allocationRatios", C_PARAM_GENERATED) + self$.setParameterType("expectedEvents", C_PARAM_GENERATED) + self$.setParameterType("varianceEvents", C_PARAM_GENERATED) + + self$.setParameterType("overallEvents", C_PARAM_USER_DEFINED) + self$.setParameterType("overallAllocationRatios", C_PARAM_USER_DEFINED) + self$.setParameterType("overallExpectedEvents", C_PARAM_USER_DEFINED) + self$.setParameterType("overallVarianceEvents", C_PARAM_USER_DEFINED) + + self$.recreateDataFrame() + self$.createStageWiseData() } }, .getVisibleFieldNames = function() { - visibleFieldNames <- callSuper() + visibleFieldNames <- super$.getVisibleFieldNames() visibleFieldNames <- visibleFieldNames[!(visibleFieldNames %in% c("logRanks", "overallLogRanks"))] return(visibleFieldNames) }, .setDataToVariables = function() { - callSuper() - overallExpectedEvents <<- .data$overallExpectedEvent - overallVarianceEvents <<- .data$overallVarianceEvent - expectedEvents <<- .data$expectedEvent + super$.setDataToVariables() + self$overallExpectedEvents <- self$.data$overallExpectedEvent + self$overallVarianceEvents <- self$.data$overallVarianceEvent + self$expectedEvents <- self$.data$expectedEvent }, getOverallExpectedEvent = function(stage, group = 1, subset = NA_character_) { - return(.data$overallExpectedEvent[.getIndices(stage = stage, group = group, subset = subset)]) + return(self$.data$overallExpectedEvent[self$.getIndices(stage = stage, group = group, subset = subset)]) }, getOverallExpectedEvents = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(.data$overallExpectedEvent[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) + return(self$.data$overallExpectedEvent[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) }, getOverallExpectedEventsUpTo = function(to, group = 1, subset = NA_character_) { - return(.data$overallExpectedEvent[.getIndices(stage = c(1:to), group = group, subset = subset)]) + return(self$.data$overallExpectedEvent[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) }, getOverallVarianceEvent = function(stage, group = 1, subset = NA_character_) { - return(.data$overallVarianceEvent[.getIndices(stage = stage, group = group, subset = subset)]) + return(self$.data$overallVarianceEvent[self$.getIndices(stage = stage, group = group, subset = subset)]) }, getOverallVarianceEvents = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(.data$overallVarianceEvent[.getIndices(stage = .getValidatedStage(stage), group = group, subset = subset)]) + return(self$.data$overallVarianceEvent[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) }, getOverallVarianceEventsUpTo = function(to, group = 1, subset = NA_character_) { - return(.data$overallVarianceEvent[.getIndices(stage = c(1:to), group = group, subset = subset)]) + return(self$.data$overallVarianceEvent[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) } ) ) +.isFloatingPointSampleSize <- function(object, param) { + values <- object[[param]] + if (is.null(values)) { + return(FALSE) + } + + values <- na.omit(values) + if (length(values) == 0) { + return(FALSE) + } + + if (any(floor(values) != values)) { + return(TRUE) + } + + return(FALSE) +} + +.getMaxDigits <- function(values) { + values <- na.omit(values) + if (length(values) == 0) { + return(0) + } + + values <- trimws(format(values, scientific = FALSE, digits = 15)) + values <- gsub("^\\d*\\.", "", values) + values <- gsub("\\D", "", values) + max(nchar(values)) +} + + #' #' @title #' Dataset Summary @@ -2435,10 +3928,10 @@ DatasetEnrichmentSurvival <- setRefClass("DatasetEnrichmentSurvival", #' #' @keywords internal #' -summary.Dataset <- function(object, ..., type = 1, digits = NA_integer_) { +summary.DatasetR6 <- function(object, ..., type = 1, digits = NA_integer_) { .warnInCaseOfUnknownArguments(functionName = "summary", ...) - if (type == 1 && inherits(object, "SummaryFactory")) { + if (type == 1 && inherits(object, "SummaryFactoryR6")) { return(object) } @@ -2449,7 +3942,7 @@ summary.Dataset <- function(object, ..., type = 1, digits = NA_integer_) { intervalFormat <- getOption("rpact.summary.intervalFormat", "[%s; %s]") .assertIsValidSummaryIntervalFormat(intervalFormat) - summaryFactory <- SummaryFactory(object = object, intervalFormat = intervalFormat) + summaryFactory <- SummaryFactoryR6$new(object = object, intervalFormat = intervalFormat) s <- object$.toString() @@ -2640,6 +4133,34 @@ summary.Dataset <- function(object, ..., type = 1, digits = NA_integer_) { return(summaryFactory) } +.getDatasetArgumentsRCodeLines <- function(x, complete = FALSE, digits = 4) { + m <- getWideFormat(x) + lines <- character(0) + paramNames <- colnames(m) + if (!complete) { + if (x$.inputType == "stagewise") { + paramNames <- paramNames[!grepl("^overall", paramNames)] + } else { + paramNames <- paramNames[grepl("^(stage|group|subset|overall)", paramNames)] + } + } + + for (paramName in paramNames) { + encapsulate <- grepl("^subset", paramName) + if (!encapsulate || isTRUE(x$.enrichmentEnabled)) { + values <- m[[paramName]] + if (!encapsulate && is.numeric(values) && !is.null(digits) && length(digits) == 1 && !is.na(digits)) { + values <- round(values, digits = digits) + } + lines <- c(lines, paste0(paramName, " = ", .arrayToString(values, + vectorLookAndFeelEnabled = TRUE, encapsulate = encapsulate, digits = NA_integer_ + ))) + } + } + + return(lines) +} + #' #' @title #' Print Dataset Values @@ -2659,7 +4180,7 @@ summary.Dataset <- function(object, ..., type = 1, digits = NA_integer_) { #' #' @keywords internal #' -print.Dataset <- function(x, ..., markdown = FALSE, output = c("list", "long", "wide", "r", "rComplete")) { +print.DatasetR6 <- function(x, ..., markdown = FALSE, output = c("list", "long", "wide", "r", "rComplete")) { fCall <- match.call(expand.dots = FALSE) datasetName <- deparse(fCall$x) diff --git a/R/class_analysis_dataset_r6.R b/R/class_analysis_dataset_r6.R deleted file mode 100644 index 580c6e35..00000000 --- a/R/class_analysis_dataset_r6.R +++ /dev/null @@ -1,4226 +0,0 @@ -## | -## | *Dataset classes* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | rpact package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File version: $Revision: 7139 $ -## | Last changed: $Date: 2023-06-28 08:15:31 +0200 (Mi, 28 Jun 2023) $ -## | Last changed by: $Author: pahlke $ -## | - -#' @include f_analysis_utilities.R -#' @include f_core_utilities.R -#' @include f_object_r_code.R -NULL - -C_KEY_WORDS_GROUPS <- c("group", "groups") - -C_KEY_WORDS_STAGES <- c("stage", "stages") - -C_KEY_WORDS_SUBSETS <- c("subset", "subsets") - -C_KEY_WORDS_SAMPLE_SIZES <- .getAllParameterNameVariants(c("n", "N", "sampleSizes", "sampleSize")) - -C_KEY_WORDS_MEANS <- c("means", "mean") - -C_KEY_WORDS_ST_DEVS <- .getAllParameterNameVariants(c("stDevs", "stDev", "stds", "sd")) - -C_KEY_WORDS_EVENTS <- c("event", "events") - -C_KEY_WORDS_OVERALL_EVENTS <- .getAllParameterNameVariants(c("overallEvents", "overallEvent")) - -C_KEY_WORDS_EXPECTED_EVENTS <- .getAllParameterNameVariants(c("expectedEvents", "expectedEvent")) - -C_KEY_WORDS_VARIANCE_EVENTS <- .getAllParameterNameVariants(c("varianceEvents", "varianceEvent")) - -C_KEY_WORDS_OVERALL_EXPECTED_EVENTS <- .getAllParameterNameVariants(c("overallExpectedEvents", "overallExpectedEvent")) - -C_KEY_WORDS_OVERALL_VARIANCE_EVENTS <- .getAllParameterNameVariants(c("overallVarianceEvents", "overallVarianceEvent")) - -C_KEY_WORDS_OVERALL_SAMPLE_SIZES <- .getAllParameterNameVariants(c( - "overallN", "overallSampleSizes", "overallSampleSize" -)) - -C_KEY_WORDS_OVERALL_MEANS <- .getAllParameterNameVariants(c("overallMeans", "overallMean")) - -C_KEY_WORDS_OVERALL_ST_DEVS <- .getAllParameterNameVariants(c( - "overallStDevs", "overallStDev", "overall.sd", "overall_sd" -)) - -C_KEY_WORDS_ALLOCATION_RATIOS <- .getAllParameterNameVariants(c("ar", "allocationRatios", "allocationRatio")) - -C_KEY_WORDS_LOG_RANKS <- .getAllParameterNameVariants(c("logRanks", "logRank", "lr")) - -C_KEY_WORDS_OVERALL_ALLOCATION_RATIOS <- .getAllParameterNameVariants(c( - "oar", "car", "overallAllocationRatios", "overallAllocationRatio" -)) - -C_KEY_WORDS_OVERALL_LOG_RANKS <- .getAllParameterNameVariants(c("olr", "clr", "overallLogRanks", "overallLogRank")) - -C_KEY_WORDS <- c( - C_KEY_WORDS_GROUPS, - C_KEY_WORDS_STAGES, - C_KEY_WORDS_SUBSETS, - C_KEY_WORDS_SAMPLE_SIZES, - C_KEY_WORDS_MEANS, - C_KEY_WORDS_ST_DEVS, - C_KEY_WORDS_EVENTS, - C_KEY_WORDS_OVERALL_EVENTS, - C_KEY_WORDS_OVERALL_SAMPLE_SIZES, - C_KEY_WORDS_OVERALL_MEANS, - C_KEY_WORDS_OVERALL_ST_DEVS, - C_KEY_WORDS_ALLOCATION_RATIOS, - C_KEY_WORDS_LOG_RANKS, - C_KEY_WORDS_OVERALL_ALLOCATION_RATIOS, - C_KEY_WORDS_OVERALL_LOG_RANKS -) - -#' @title -#' Read Dataset -#' -#' @description -#' Reads a data file and returns it as dataset object. -#' -#' @param file A CSV file (see \code{\link[utils]{read.table}}). -#' @param header A logical value indicating whether the file contains the names of -#' the variables as its first line. -#' @param sep The field separator character. Values on each line of the file are separated -#' by this character. If sep = "," (the default for \code{readDataset}) the separator is a comma. -#' @param quote The set of quoting characters. To disable quoting altogether, use -#' quote = "". See scan for the behavior on quotes embedded in quotes. Quoting is only -#' considered for columns read as character, which is all of them unless \code{colClasses} is specified. -#' @param dec The character used in the file for decimal points. -#' @param fill logical. If \code{TRUE} then in case the rows have unequal length, blank fields -#' are implicitly added. -#' @param comment.char character: a character vector of length one containing a single character -#' or an empty string. Use "" to turn off the interpretation of comments altogether. -#' @param fileEncoding character string: if non-empty declares the encoding used on a file -#' (not a connection) so the character data can be re-encoded. -#' See the 'Encoding' section of the help for file, the 'R Data Import/Export Manual' and 'Note'. -#' @param ... Further arguments to be passed to code{\link[utils]{read.table}}. -#' -#' @details -#' \code{readDataset} is a wrapper function that uses \code{\link[utils]{read.table}} to read the -#' CSV file into a data frame, transfers it from long to wide format with \code{\link[stats]{reshape}} -#' and puts the data to \code{\link[=getDataset]{getDataset()}}. -#' -#' @template return_object_dataset -#' -#' @seealso -#' \itemize{ -#' \item \code{\link[=readDatasets]{readDatasets()}} for reading multiple datasets, -#' \item \code{\link[=writeDataset]{writeDataset()}} for writing a single dataset, -#' \item \code{\link[=writeDatasets]{writeDatasets()}} for writing multiple datasets. -#' } -#' -#' @examples -#' \dontrun{ -#' dataFileRates <- system.file("extdata", -#' "dataset_rates.csv", -#' package = "rpact" -#' ) -#' if (dataFileRates != "") { -#' datasetRates <- readDataset(dataFileRates) -#' datasetRates -#' } -#' -#' dataFileMeansMultiArm <- system.file("extdata", -#' "dataset_means_multi-arm.csv", -#' package = "rpact" -#' ) -#' if (dataFileMeansMultiArm != "") { -#' datasetMeansMultiArm <- readDataset(dataFileMeansMultiArm) -#' datasetMeansMultiArm -#' } -#' -#' dataFileRatesMultiArm <- system.file("extdata", -#' "dataset_rates_multi-arm.csv", -#' package = "rpact" -#' ) -#' if (dataFileRatesMultiArm != "") { -#' datasetRatesMultiArm <- readDataset(dataFileRatesMultiArm) -#' datasetRatesMultiArm -#' } -#' -#' dataFileSurvivalMultiArm <- system.file("extdata", -#' "dataset_survival_multi-arm.csv", -#' package = "rpact" -#' ) -#' if (dataFileSurvivalMultiArm != "") { -#' datasetSurvivalMultiArm <- readDataset(dataFileSurvivalMultiArm) -#' datasetSurvivalMultiArm -#' } -#' } -#' -#' @export -#' -readDataset <- function(file, ..., header = TRUE, sep = ",", quote = "\"", - dec = ".", fill = TRUE, comment.char = "", fileEncoding = "UTF-8") { - if (!file.exists(file)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the file '", file, "' does not exist") - } - - data <- utils::read.table( - file = file, header = header, sep = sep, - quote = quote, dec = dec, fill = fill, fileEncoding = fileEncoding, ... - ) - dataWide <- stats::reshape(data = data, direction = "wide", idvar = "stages", timevar = "groups") - colnames(dataWide) <- gsub("\\.", "", colnames(dataWide)) - return(getDataset(dataWide)) -} - -#' @title -#' Write Dataset -#' -#' @description -#' Writes a dataset to a CSV file. -#' -#' @param dataset A dataset. -#' @param file The target CSV file. -#' @param append Logical. Only relevant if file is a character string. -#' If \code{TRUE}, the output is appended to the file. If \code{FALSE}, any existing file of the name is destroyed. -#' @param sep The field separator character. Values on each line of the file are separated -#' by this character. If sep = "," (the default for \code{writeDataset}) the separator is a comma. -#' @param quote The set of quoting characters. To disable quoting altogether, use -#' quote = "". See scan for the behavior on quotes embedded in quotes. Quoting is only -#' considered for columns read as character, which is all of them unless \code{colClasses} is specified. -#' @param dec The character used in the file for decimal points. -#' @param eol The character(s) to print at the end of each line (row). -#' @param na The string to use for missing values in the data. -#' @param row.names Either a logical value indicating whether the row names of \code{dataset} are -#' to be written along with \code{dataset}, or a character vector of row names to be written. -#' @param col.names Either a logical value indicating whether the column names of \code{dataset} are -#' to be written along with \code{dataset}, or a character vector of column names to be written. -#' See the section on 'CSV files' for the meaning of \code{col.names = NA}. -#' @param qmethod A character string specifying how to deal with embedded double quote characters -#' when quoting strings. Must be one of "double" (default in \code{writeDataset}) or "escape". -#' @param fileEncoding Character string: if non-empty declares the encoding used on a file -#' (not a connection) so the character data can be re-encoded. -#' See the 'Encoding' section of the help for file, the 'R Data Import/Export Manual' and 'Note'. -#' @param ... Further arguments to be passed to \code{\link[utils]{write.table}}. -#' -#' @details -#' \code{\link[=writeDataset]{writeDataset()}} is a wrapper function that coerces the dataset to a data frame and uses \cr -#' \code{\link[utils]{write.table}} to write it to a CSV file. -#' -#' @seealso -#' \itemize{ -#' \item \code{\link[=writeDatasets]{writeDatasets()}} for writing multiple datasets, -#' \item \code{\link[=readDataset]{readDataset()}} for reading a single dataset, -#' \item \code{\link[=readDatasets]{readDatasets()}} for reading multiple datasets. -#' } -#' -#' @examples -#' \dontrun{ -#' datasetOfRates <- getDataset( -#' n1 = c(11, 13, 12, 13), -#' n2 = c(8, 10, 9, 11), -#' events1 = c(10, 10, 12, 12), -#' events2 = c(3, 5, 5, 6) -#' ) -#' writeDataset(datasetOfRates, "dataset_rates.csv") -#' } -#' -#' @export -#' -writeDataset <- function(dataset, file, ..., append = FALSE, quote = TRUE, sep = ",", - eol = "\n", na = "NA", dec = ".", row.names = TRUE, - col.names = NA, qmethod = "double", - fileEncoding = "UTF-8") { - .assertIsDataset(dataset) - - x <- as.data.frame(dataset, niceColumnNamesEnabled = FALSE) - - utils::write.table( - x = x, file = file, append = append, quote = quote, sep = sep, - eol = eol, na = na, dec = dec, row.names = FALSE, - col.names = TRUE, qmethod = qmethod, - fileEncoding = fileEncoding - ) -} - -#' @title -#' Read Multiple Datasets -#' -#' @description -#' Reads a data file and returns it as a list of dataset objects. -#' -#' @param file A CSV file (see \code{\link[utils]{read.table}}). -#' @param header A logical value indicating whether the file contains the names of -#' the variables as its first line. -#' @param sep The field separator character. Values on each line of the file are separated -#' by this character. If sep = "," (the default for \code{readDatasets}) the separator is a comma. -#' @param quote The set of quoting characters. To disable quoting altogether, use -#' quote = "". See scan for the behavior on quotes embedded in quotes. Quoting is only -#' considered for columns read as character, which is all of them unless \code{colClasses} is specified. -#' @param dec The character used in the file for decimal points. -#' @param fill logical. If \code{TRUE} then in case the rows have unequal length, blank fields -#' are implicitly added. -#' @param comment.char character: a character vector of length one containing a single character -#' or an empty string. Use "" to turn off the interpretation of comments altogether. -#' @param fileEncoding character string: if non-empty declares the encoding used on a file -#' (not a connection) so the character data can be re-encoded. -#' See the 'Encoding' section of the help for file, the 'R Data Import/Export Manual' and 'Note'. -#' @param ... Further arguments to be passed to \code{\link[utils]{read.table}}. -#' -#' @details -#' Reads a file that was written by \code{\link[=writeDatasets]{writeDatasets()}} before. -#' -#' @return Returns a \code{\link[base]{list}} of \code{\link{Dataset}} objects. -#' -#' @seealso -#' \itemize{ -#' \item \code{\link[=readDataset]{readDataset()}} for reading a single dataset, -#' \item \code{\link[=writeDatasets]{writeDatasets()}} for writing multiple datasets, -#' \item \code{\link[=writeDataset]{writeDataset()}} for writing a single dataset. -#' } -#' -#' @examples -#' dataFile <- system.file("extdata", "datasets_rates.csv", package = "rpact") -#' if (dataFile != "") { -#' datasets <- readDatasets(dataFile) -#' datasets -#' } -#' @export -#' -readDatasets <- function(file, ..., header = TRUE, sep = ",", quote = "\"", - dec = ".", fill = TRUE, comment.char = "", fileEncoding = "UTF-8") { - if (!file.exists(file)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the file '", file, "' does not exist") - } - - data <- utils::read.table( - file = file, header = header, sep = sep, - quote = quote, dec = dec, fill = fill, fileEncoding = fileEncoding, ... - ) - - if (is.null(data[["datasetId"]])) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "data file must contain the column 'datasetId'") - } - - datasets <- list() - for (datasetId in unique(data$datasetId)) { - subData <- data[data$datasetId == datasetId, ] - dataFrame <- subset(subData, select = -datasetId) - description <- NA_character_ - if (!is.null(dataFrame[["description"]])) { - description <- as.character(dataFrame$description[1]) - dataFrame <- subset(dataFrame, select = -description) - } - if (length(unique(subData$groups)) == 2) { - dataWide <- stats::reshape(dataFrame, direction = "wide", idvar = "stages", timevar = "groups") - colnames(dataWide) <- gsub("\\.", "", colnames(dataWide)) - dataset <- getDataset(dataWide) - } else { - dataset <- getDataset(dataFrame) - } - dataset$setDescription(description) - datasets <- c(datasets, dataset) - } - return(datasets) -} - -#' @title -#' Write Multiple Datasets -#' -#' @description -#' Writes a list of datasets to a CSV file. -#' -#' @param datasets A list of datasets. -#' @param file The target CSV file. -#' @param append Logical. Only relevant if file is a character string. -#' If \code{TRUE}, the output is appended to the file. If FALSE, any existing file of the name is destroyed. -#' @param sep The field separator character. Values on each line of the file are separated -#' by this character. If sep = "," (the default for \code{writeDatasets}) the separator is a comma. -#' @param quote The set of quoting characters. To disable quoting altogether, use -#' quote = "". See scan for the behavior on quotes embedded in quotes. Quoting is only -#' considered for columns read as character, which is all of them unless \code{colClasses} is specified. -#' @param dec The character used in the file for decimal points. -#' @param eol The character(s) to print at the end of each line (row). -#' @param na The string to use for missing values in the data. -#' @param row.names Either a logical value indicating whether the row names of \code{dataset} are -#' to be written along with \code{dataset}, or a character vector of row names to be written. -#' @param col.names Either a logical value indicating whether the column names of \code{dataset} are -#' to be written along with \code{dataset}, or a character vector of column names to be written. -#' See the section on 'CSV files' for the meaning of \code{col.names = NA}. -#' @param qmethod A character string specifying how to deal with embedded double quote characters -#' when quoting strings. Must be one of "double" (default in \code{writeDatasets}) or "escape". -#' @param fileEncoding Character string: if non-empty declares the encoding used on a file -#' (not a connection) so the character data can be re-encoded. -#' See the 'Encoding' section of the help for file, the 'R Data Import/Export Manual' and 'Note'. -#' @param ... Further arguments to be passed to \code{\link[utils]{write.table}}. -#' -#' @details -#' The format of the CSV file is optimized for usage of \code{\link[=readDatasets]{readDatasets()}}. -#' -#' @seealso -#' \itemize{ -#' \item \code{\link[=writeDataset]{writeDataset()}} for writing a single dataset, -#' \item \code{\link[=readDatasets]{readDatasets()}} for reading multiple datasets, -#' \item \code{\link[=readDataset]{readDataset()}} for reading a single dataset. -#' } -#' -#' @examples -#' \dontrun{ -#' d1 <- getDataset( -#' n1 = c(11, 13, 12, 13), -#' n2 = c(8, 10, 9, 11), -#' events1 = c(10, 10, 12, 12), -#' events2 = c(3, 5, 5, 6) -#' ) -#' d2 <- getDataset( -#' n1 = c(9, 13, 12, 13), -#' n2 = c(6, 10, 9, 11), -#' events1 = c(10, 10, 12, 12), -#' events2 = c(4, 5, 5, 6) -#' ) -#' datasets <- list(d1, d2) -#' writeDatasets(datasets, "datasets_rates.csv") -#' } -#' -#' @export -#' -writeDatasets <- function(datasets, file, ..., append = FALSE, quote = TRUE, sep = ",", - eol = "\n", na = "NA", dec = ".", row.names = TRUE, - col.names = NA, qmethod = "double", - fileEncoding = "UTF-8") { - if (!is.list(datasets)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'datasets' must be a list of datasets") - } - - if (length(datasets) == 0) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'datasets' is empty") - } - - datasetType <- NA_character_ - dataFrames <- NULL - for (i in 1:length(datasets)) { - dataset <- datasets[[i]] - .assertIsDataset(dataset) - if (is.na(datasetType)) { - datasetType <- .getClassName(dataset) - } else if (.getClassName(dataset) != datasetType) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all datasets must have the same type") - } - - data <- as.data.frame(dataset, niceColumnNamesEnabled = FALSE) - datasetId <- ifelse(!is.null(dataset$getId()) && !is.na(dataset$getId()), dataset$getId(), i) - data <- cbind(rep(datasetId, nrow(data)), data) - colnames(data)[1] <- "datasetId" - - if (!is.null(dataset$getDescription()) && !is.na(dataset$getDescription())) { - data <- cbind(data, rep(dataset$getDescription(), nrow(data))) - colnames(data)[ncol(data)] <- "description" - } - - if (is.null(dataFrames)) { - dataFrames <- data - } else { - dataFrames <- rbind(dataFrames, data) - } - } - - if (is.null(dataFrames)) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to bind datasets") - } - - utils::write.table( - x = dataFrames, file = file, append = append, quote = quote, sep = sep, - eol = eol, na = na, dec = dec, row.names = FALSE, - col.names = TRUE, qmethod = qmethod, - fileEncoding = fileEncoding - ) -} - -.getDataset <- function(..., floatingPointNumbersEnabled = FALSE) { - args <- list(...) - if (length(args) == 0) { - stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "data.frame, data vectors, or datasets expected") - } - - if (.optionalArgsContainsDatasets(...)) { - if (length(args) == 1) { - return(args[[1]]) - } - - design <- .getDesignFromArgs(...) - if (length(args) == 2 && !is.null(design)) { - dataset <- .getDatasetFromArgs(...) - if (!is.null(dataset)) { - dataset <- dataset$clone(deep = TRUE) #TODO was $copy shallow - dataset$.design <- design - return(dataset) - } - } - - return(.getEnrichmentDatasetFromArgs(...)) - } - - exampleType <- args[["example"]] - if (!is.null(exampleType) && exampleType %in% c("means", "rates", "survival")) { - return(.getDatasetExample(exampleType = exampleType)) - } - - if (length(args) == 1 && !is.null(args[[1]]) && is.list(args[[1]]) && !is.data.frame(args[[1]])) { - return(.getDatasetMeansFromModelsByStage(emmeansResults = args[[1]])) - } - - emmeansResults <- .getDatasetMeansModelObjectsList(args) - if (!is.null(emmeansResults) && length(emmeansResults) > 0) { - return(.getDatasetMeansFromModelsByStage(emmeansResults = emmeansResults)) - } - - dataFrame <- .getDataFrameFromArgs(...) - - design <- .getDesignFromArgs(...) - - if (is.null(dataFrame)) { - args <- .removeDesignFromArgs(args) - - paramNames <- names(args) - paramNames <- paramNames[paramNames != ""] - - numberOfParameters <- length(args) - if (numberOfParameters > 0 && names(args)[1] == "" && .isTrialDesign(args[[1]])) { - numberOfParameters <- numberOfParameters - 1 - } - - if (length(paramNames) != numberOfParameters) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all parameters must be named") - } - - if (length(paramNames) != length(unique(paramNames))) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the parameter names must be unique") - } - - dataFrame <- .createDataFrame(...) - } - - enrichmentEnabled <- .isDataObjectEnrichment(...) - - if (.isDataObjectMeans(...)) { - return(DatasetMeansR6$new( - dataFrame = dataFrame, - floatingPointNumbersEnabled = floatingPointNumbersEnabled, - enrichmentEnabled = enrichmentEnabled, - .design = design - )) - } - - if (.isDataObjectRates(...)) { - return(DatasetRatesR6$new( - dataFrame = dataFrame, - floatingPointNumbersEnabled = floatingPointNumbersEnabled, - enrichmentEnabled = enrichmentEnabled, - .design = design - )) - } - - if (.isDataObjectNonStratifiedEnrichmentSurvival(...)) { - return(DatasetEnrichmentSurvivalR6$new( - dataFrame = dataFrame, - floatingPointNumbersEnabled = floatingPointNumbersEnabled, - enrichmentEnabled = enrichmentEnabled, - .design = design - )) - } - - if (.isDataObjectSurvival(...)) { - return(DatasetSurvivalR6$new( - dataFrame = dataFrame, - floatingPointNumbersEnabled = floatingPointNumbersEnabled, - enrichmentEnabled = enrichmentEnabled, - .design = design - )) - } - - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "failed to identify dataset type") -} - -#' @title -#' Get Dataset -#' -#' @description -#' Creates a dataset object and returns it. -#' -#' @param ... A \code{data.frame} or some data vectors defining the dataset. -#' @param floatingPointNumbersEnabled If \code{TRUE}, -#' sample sizes and event numbers can be specified as floating-point numbers -#' (this make sense, e.g., for theoretical comparisons); \cr -#' by default \code{floatingPointNumbersEnabled = FALSE}, i.e., -#' samples sizes and event numbers defined as floating-point numbers will be truncated. -#' -#' @details -#' The different dataset types \code{DatasetMeans}, of \code{DatasetRates}, or -#' \code{DatasetSurvival} can be created as follows: -#' \itemize{ -#' \item An element of \code{\link{DatasetMeans}} for one sample is created by \cr -#' \code{getDataset(sampleSizes =, means =, stDevs =)} where \cr -#' \code{sampleSizes}, \code{means}, \code{stDevs} are vectors with stage-wise sample sizes, -#' means and standard deviations of length given by the number of available stages. -#' \item An element of \code{\link{DatasetMeans}} for two samples is created by \cr -#' \code{getDataset(sampleSizes1 =, sampleSizes2 =, means1 =, means2 =, } \cr -#' \code{stDevs1 =, stDevs2 =)} where -#' \code{sampleSizes1}, \code{sampleSizes2}, \code{means1}, \code{means2}, -#' \code{stDevs1}, \code{stDevs2} are vectors with -#' stage-wise sample sizes, means and standard deviations for the two treatment groups -#' of length given by the number of available stages. -#' \item An element of \code{\link{DatasetRates}} for one sample is created by \cr -#' \code{getDataset(sampleSizes =, events =)} where \code{sampleSizes}, \code{events} are vectors -#' with stage-wise sample sizes and events of length given by the number of available stages. -#' \item An element of \code{\link{DatasetRates}} for two samples is created by \cr -#' \code{getDataset(sampleSizes1 =, sampleSizes2 =, events1 =, events2 =)} where -#' \code{sampleSizes1}, \code{sampleSizes2}, \code{events1}, \code{events2} -#' are vectors with stage-wise sample sizes -#' and events for the two treatment groups of length given by the number of available stages. -#' \item An element of \code{\link{DatasetSurvival}} is created by \cr -#' \code{getDataset(events =, logRanks =, allocationRatios =)} where -#' \code{events}, \code{logRanks}, and \code{allocation ratios} are the stage-wise events, -#' (one-sided) logrank statistics, and allocation ratios. -#' \item An element of \code{\link{DatasetMeans}}, \code{\link{DatasetRates}}, and \code{\link{DatasetSurvival}} -#' for more than one comparison is created by adding subsequent digits to the variable names. -#' The system can analyze these data in a multi-arm many-to-one comparison setting where the -#' group with the highest index represents the control group. -#' } -#' Prefix \code{overall[Capital case of first letter of variable name]...} for the variable -#' names enables entering the overall (cumulative) results and calculates stage-wise statistics. -#' Since rpact version 3.2, the prefix \code{cumulative[Capital case of first letter of variable name]...} or -#' \code{cum[Capital case of first letter of variable name]...} can alternatively be used for this. -#' -#' \code{n} can be used in place of \code{samplesizes}. -#' -#' Note that in survival design usually the overall (cumulative) events and logrank test statistics are provided -#' in the output, so \cr -#' \code{getDataset(cumulativeEvents=, cumulativeLogRanks =, cumulativeAllocationRatios =)} \cr -#' is the usual command for entering survival data. Note also that for \code{cumulativeLogranks} also the -#' z scores from a Cox regression can be used. -#' -#' For multi-arm designs, the index refers to the considered comparison. For example,\cr -#' \code{ -#' getDataset(events1=c(13, 33), logRanks1 = c(1.23, 1.55), events2 = c(16, NA), logRanks2 = c(1.55, NA)) -#' } \cr -#' refers to the case where one active arm (1) is considered at both stages whereas active arm 2 -#' was dropped at interim. Number of events and logrank statistics are entered for the corresponding -#' comparison to control (see Examples). -#' -#' For enrichment designs, the comparison of two samples is provided for an unstratified -#' (sub-population wise) or stratified data input.\cr -#' For unstratified (sub-population wise) data input the data sets are defined for the sub-populations -#' S1, S2, ..., F, where F refers to the full populations. Use of \code{getDataset(S1 = , S2, ..., F = )} -#' defines the data set to be used in \code{\link[=getAnalysisResults]{getAnalysisResults()}} (see examples)\cr -#' For stratified data input the data sets are defined for the strata S1, S12, S2, ..., R, where R -#' refers to the remainder of the strata such that the union of all sets is the full population. -#' Use of \code{getDataset(S1 = , S12 = , S2, ..., R = )} defines the data set to be used in -#' \code{\link[=getAnalysisResults]{getAnalysisResults()}} (see examples)\cr -#' For survival data, for enrichment designs the log-rank statistics should be entered as stratified -#' log-rank statistics in order to provide strong control of Type I error rate. For stratified data input, -#' the variables to be specified in \code{getDataset()} are \code{events}, \code{expectedEvents}, -#' \code{varianceEvents}, and \code{allocationRatios} or \code{overallEvents}, \code{overallExpectedEvents}, -#' \code{overallVarianceEvents}, and \code{overallAllocationRatios}. From this, (stratified) log-rank tests are -#' calculated. -#' -#' @template return_object_dataset -#' -#' @template examples_get_dataset -#' -#' @include f_analysis_base.R -#' @include f_analysis_utilities.R -#' -#' @export -#' -getDataset <- function(..., floatingPointNumbersEnabled = FALSE) { - dataset <- .getDataset(floatingPointNumbersEnabled = floatingPointNumbersEnabled, ...) - if (dataset$.enrichmentEnabled && dataset$getNumberOfGroups() != 2) { - warning("Only population enrichment data with 2 groups can be analyzed but ", - dataset$getNumberOfGroups(), " group", - ifelse(dataset$getNumberOfGroups() == 1, " is", "s are"), " defined", - call. = FALSE - ) - } - return(dataset) -} - -#' @rdname getDataset -#' @export -getDataSet <- function(..., floatingPointNumbersEnabled = FALSE) { - return(getDataset(floatingPointNumbersEnabled = floatingPointNumbersEnabled, ...)) -} - -.getDatasetMeansModelObjectsList <- function(args) { - if (is.null(args) || length(args) == 0 || !is.list(args)) { - return(NULL) - } - - emmeansResults <- list() - for (arg in args) { - if (inherits(arg, "emmGrid")) { - emmeansResults[[length(emmeansResults) + 1]] <- arg - } - } - if (length(emmeansResults) == 0) { - return(NULL) - } - - argNames <- names(args) - for (i in 1:length(args)) { - arg <- args[[i]] - if (!inherits(arg, "emmGrid")) { - argName <- argNames[i] - argInfo <- "" - if (length(argName) == 1 && argName != "") { - argInfo <- paste0(sQuote(argName), " ") - } - argInfo <- paste0(argInfo, "(", .arrayToString(arg), ")") - warning("Argument ", argInfo, " will be ignored because only 'emmGrid' objects will be respected") - } - } - - return(emmeansResults) -} - -.getStandardDeviationFromStandardError <- function(sampleSize, standardError, ..., - dfValue = NA_real_, alpha = 0.05, lmEnabled = TRUE, stDevCalcMode = "auto") { - qtCalcEnablbled <- length(stDevCalcMode) == 1 && !is.na(stDevCalcMode) && stDevCalcMode == "t" - if ((qtCalcEnablbled || !lmEnabled) && !is.na(dfValue) && !is.infinite(dfValue) && dfValue > 0) { - qValue <- stats::qt(1 - alpha / 2, df = dfValue) - stDev <- standardError * 2 / qValue * sqrt(sampleSize) - } else { - stDev <- standardError * sqrt(sampleSize) - } - - return(stDev) -} - -.getDatasetMeansFromModelsByStage <- function(emmeansResults, correctGroupOrder = TRUE) { - if (is.null(emmeansResults)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(emmeansResults), " must be a non-empty list") - } - if (!is.list(emmeansResults)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(emmeansResults), " must be a list") - } - if (length(emmeansResults) == 0) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(emmeansResults), " must be not empty") - } - - for (stage in 1:length(emmeansResults)) { - if (!inherits(emmeansResults[[stage]], "emmGrid")) { - stop(sprintf( - paste0( - "%s%s must contain %s objects created by emmeans(x), ", - "where x is a linear model result (one object per stage; class is %s at stage %s)" - ), - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("emmeansResults"), sQuote("emmGrid"), - .getClassName(emmeansResults[[stage]]), stage - )) - } - } - - stages <- integer(0) - groups <- integer(0) - means <- numeric(0) - stDevs <- numeric(0) - sampleSizes <- numeric(0) - - lmEnabled <- TRUE - tryCatch( - { - modelCall <- emmeansResults[[1]]@model.info$call - modelFunction <- as.character(modelCall)[1] - lmEnabled <- modelFunction == "lm" - if (!grepl(paste0("::", modelFunction), modelFunction)) { - packageName <- .getPackageName(modelFunction) - if (!is.na(packageName)) { - modelFunction <- paste0(packageName, "::", modelFunction) - } - } - - if (lmEnabled) { - warning("When using ", modelFunction, "() ", - "the estimated marginal means and standard deviations can be inaccurate ", - "and analysis results based on this values may be imprecise", - call. = FALSE - ) - } else { - warning("Using ", modelFunction, " emmeans result objects as ", - "arguments of getDataset() is experminental in this rpact version and not fully validated", - call. = FALSE - ) - } - }, - error = function(e) { - warning("Using emmeans result objects as ", - "arguments of getDataset() is experminental in this rpact version and not fully validated", - call. = FALSE - ) - } - ) - - stDevCalcMode <- getOption("rpact.dataset.stdev.calc.mode", "auto") # auto, sigma, norm, t - for (stage in 1:length(emmeansResults)) { - emmeansResult <- emmeansResults[[stage]] - emmeansResultsSummary <- summary(emmeansResult) - emmeansResultsList <- as.list(emmeansResult) - - if (is.null(emmeansResultsSummary[["emmean"]])) { - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, - "the objects in summary(emmeansResults) must contain the field 'emmean'" - ) - } - for (expectedField in c("sigma", "extras")) { - if (is.null(emmeansResultsList[[expectedField]])) { - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, - "the objects in as.list(emmeansResults) must contain the field ", sQuote(expectedField) - ) - } - } - - numberOfGroups <- length(emmeansResultsSummary$emmean) - rpactGroupNumbers <- 1:numberOfGroups - if (correctGroupOrder) { - rpactGroupNumbers <- 1 - if (numberOfGroups > 1) { - rpactGroupNumbers <- c(2:numberOfGroups, rpactGroupNumbers) - } - } - for (group in 1:length(emmeansResultsSummary$emmean)) { - stages <- c(stages, stage) - groups <- c(groups, group) - rpactGroupNumber <- rpactGroupNumbers[group] - - standardError <- emmeansResultsSummary$SE[rpactGroupNumber] - - sampleSize <- emmeansResultsList$extras[rpactGroupNumber, ] - meanValue <- emmeansResultsSummary$emmean[rpactGroupNumber] - dfValue <- emmeansResultsSummary$df[rpactGroupNumber] - if (length(stDevCalcMode) == 1 && !is.na(stDevCalcMode) && stDevCalcMode == "sigma") { - # pooled standard deviation from emmeans - stDev <- emmeansResultsList$sigma - } else { - stDev <- .getStandardDeviationFromStandardError(sampleSize, standardError, - dfValue = dfValue, lmEnabled = lmEnabled, stDevCalcMode = stDevCalcMode - ) - } - - means <- c(means, meanValue) - stDevs <- c(stDevs, stDev) - sampleSizes <- c(sampleSizes, sampleSize) - } - } - - data <- data.frame( - stages = stages, - groups = groups, - means = means, - stDevs = stDevs, - sampleSizes = sampleSizes - ) - data <- data[order(data$stages, data$groups), ] - dataWide <- stats::reshape(data = data, direction = "wide", idvar = "stages", timevar = "groups") - colnames(dataWide) <- gsub("\\.", "", colnames(dataWide)) - return(getDataset(dataWide)) -} - -.optionalArgsContainsDatasets <- function(...) { - args <- list(...) - if (length(args) == 0) { - return(FALSE) - } - - for (arg in args) { - if (inherits(arg, "Dataset") || inherits(arg, "DatasetR6")) { - return(TRUE) - } - } - return(FALSE) -} - -.getSubsetsFromArgs <- function(...) { - args <- list(...) - if (length(args) == 0) { - stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "one or more subset datasets expected") - } - - subsetNames <- names(args) - if (is.null(subsetNames)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all subsets must be named") - } - - if (!("R" %in% subsetNames) && !("F" %in% subsetNames)) { - stop( - C_EXCEPTION_TYPE_MISSING_ARGUMENT, - '"R" (stratified analysis)" or "F" (non-stratified analysis) must be defined as subset' - ) - } - - subsetNumbers <- gsub("\\D", "", subsetNames) - subsetNumbers <- subsetNumbers[subsetNumbers != ""] # & nchar(subsetNumbers) == 1 - if (length(subsetNumbers) == 0) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all subset names (", - .arrayToString(subsetNames), ") must be \"S[n]\", \"R\", or \"F\", ", - "where [n] is a number with increasing digits (starting with 1)" - ) - } - - stratifiedInput <- "R" %in% subsetNames - - subsetNumbers <- paste0(subsetNumbers, collapse = "") - subsetNumbers <- strsplit(subsetNumbers, "")[[1]] - subsetNumbers <- as.integer(subsetNumbers) - gMax <- max(subsetNumbers) + 1 - validSubsetNames <- .createSubsetsByGMax(gMax, stratifiedInput = stratifiedInput, all = FALSE) - for (subsetName in subsetNames) { - if (subsetName == "") { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all subsets must be named") - } - - if (!(subsetName %in% validSubsetNames)) { - suffix <- ifelse(stratifiedInput, " (stratified analysis)", " (non-stratified analysis)") - if (length(validSubsetNames) < 10) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "invalid subset name (", subsetName, "); ", - "valid names are ", .arrayToString(validSubsetNames), suffix - ) - } else { - restFull <- ifelse(stratifiedInput, '"R"', '"F"') - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "invalid subset name (", subsetName, "): ", - "all subset names must be \"S[n]\" or ", restFull, ", ", - "where [n] is a number with increasing digits", suffix - ) - } - } - } - - subsets <- NULL - subsetType <- NA_character_ - emptySubsetNames <- validSubsetNames[!(validSubsetNames %in% subsetNames)] - for (subsetName in subsetNames) { - subset <- args[[subsetName]] - if (is.null(subset) || (!(isS4(subset) || is.R6(subset)) && is.na(subset))) { - emptySubsetNames <- c(emptySubsetNames, subsetName) - } else { - if (!.isDataset(subset)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "subset ", subsetName, " is not a dataset (is ", .getClassName(subset), ")" - ) - } - if (!is.na(subsetType) && subsetType != .getClassName(subset)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "all subsets must have the same type (found ", subsetType, " and ", .getClassName(subset), ")" - ) - } - subsetType <- .getClassName(subset) - if (is.null(subset[[".data"]])) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "subset ", subsetName, " does not contain field '.data'" - ) - } - subset <- subset$.data - subset$subset <- rep(subsetName, nrow(subset)) - if (is.null(subsets)) { - subsets <- subset - } else { - subsets <- rbind(subsets, subset) - } - } - } - - if (length(emptySubsetNames) > 0) { - emptySubsetNames <- unique(emptySubsetNames) - template <- subsets[subsets$subset == ifelse(stratifiedInput, "R", "F"), ] - colNames <- colnames(template) - colNames <- colNames[!(colNames %in% c("stage", "group", "subset"))] - for (colName in colNames) { - template[[colName]] <- rep(NA_real_, nrow(template)) - } - - for (subsetName in emptySubsetNames) { - template$subset <- rep(subsetName, nrow(template)) - subsets <- rbind(subsets, template) - } - - if (length(emptySubsetNames) == 1) { - warning("The undefined subset ", emptySubsetNames, - " was defined as empty subset", - call. = FALSE - ) - } else { - warning(gettextf( - "The %s undefined subsets %s were defined as empty subsets", - length(emptySubsetNames), .arrayToString(emptySubsetNames) - ), call. = FALSE) - } - } - - return(subsets) -} - -.validateEnrichmentDataFrameAtFirstStage <- function(dataFrame, params) { - dataFrameStage1 <- dataFrame[dataFrame$stage == 1, ] - for (param in params) { - paramValue <- dataFrameStage1[[param]] - if (any(is.null(paramValue) || any(is.infinite(paramValue)))) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - gettextf( - "all %s values (%s) at first stage must be valid", - sQuote(param), .arrayToString(paramValue, maxLength = 10) - ) - ) - } - if (any(is.na(paramValue))) { - subsets <- unique(dataFrame$subset) - for (s in subsets) { - subData <- dataFrame[dataFrame$subset == s, ] - subsetParamValues <- subData[[param]] - if (!all(is.na(subsetParamValues)) && any(is.na(subsetParamValues[subData$stage == 1]))) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - gettextf( - "all %s values (%s) at first stage must be valid (NA is not allowed)", - sQuote(param), .arrayToString(paramValue, maxLength = 10) - ) - ) - } - } - } - } -} - -.getEndpointSpecificDataFrameParameterNames <- function(dataFrame) { - paramNames <- colnames(dataFrame) - paramNames <- paramNames[!(paramNames %in% c("stage", "group", "subset"))] - return(paramNames) -} - -.validateEnrichmentDataFrameDeselection <- function(dataFrame) { - paramNames <- .getEndpointSpecificDataFrameParameterNames(dataFrame) - for (i in 1:nrow(dataFrame)) { - row <- dataFrame[i, paramNames] - if (any(is.na(row)) && !all(is.na(row))) { - stop( - C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, - gettextf( - paste0( - "inconsistent deselection in group %s at stage %s (", - "%s: all or none must be NA)" - ), - dataFrame$group[i], dataFrame$stage[i], .arrayToString(paramNames, maxCharacters = 40) - ) - ) - } - } - - subsets <- unique(dataFrame$subset) - for (s in subsets) { - deselectedStage <- 0 - for (stage in unique(dataFrame$stage)) { - subData <- dataFrame[dataFrame$subset == s & dataFrame$stage == stage, paramNames] - - if (deselectedStage > 0 && !all(is.na(subData))) { - stop( - C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, - gettextf(paste0( - "%s was deselected at stage %s ", - "and therefore must be also deselected in the following stages, ", - "but is no longer deselected in stage %s" - ), s, deselectedStage, stage) - ) - } - - if (any(is.na(subData))) { - deselectedStage <- stage - } - } - } -} - -.validateEnrichmentDataFrameMeans <- function(dataFrame) { - if (any(na.omit(dataFrame$stDev) <= 0) || any(na.omit(dataFrame$overallStDev) <= 0)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all standard deviations must be > 0") - } - if (any(na.omit(dataFrame$sampleSize) <= 0) || any(na.omit(dataFrame$overallSampleSize) <= 0)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all sample sizes must be > 0") - } - - .validateEnrichmentDataFrameAtFirstStage(dataFrame, - params = c("sampleSize", "overallSampleSize", "mean", "overallMean", "stDev", "overallStDev") - ) - - .validateEnrichmentDataFrameDeselection(dataFrame) - - subsets <- unique(dataFrame$subset) - if ("F" %in% subsets) { - subsets <- subsets[subsets != "F"] - fullData <- dataFrame[dataFrame$subset == "F", ] - for (s in subsets) { - for (stage in unique(dataFrame$stage)) { - for (group in unique(dataFrame$group)) { - subData <- dataFrame[dataFrame$subset == s & dataFrame$stage == stage & dataFrame$group == group, ] - - stDevFull <- na.omit(fullData$stDev[fullData$stage == stage & fullData$group == group]) - stDevSubset <- na.omit(subData$stDev) - if (length(stDevFull) > 0 && length(stDevSubset) > 0 && any(stDevFull <= stDevSubset)) { - stop( - C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, - gettextf( - "'stDev' F (%s) must be > 'stDev' %s (%s) in group %s at stage %s", - .arrayToString(stDevFull), s, - .arrayToString(stDevSubset), group, stage - ) - ) - } - - sampleSizeFull <- na.omit(fullData$sampleSize[fullData$stage == stage & fullData$group == group]) - sampleSizeSubset <- na.omit(subData$sampleSize) - if (length(sampleSizeFull) > 0 && length(sampleSizeSubset) > 0 && any(sampleSizeFull < sampleSizeSubset)) { - stop( - C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, - gettextf( - "'sampleSize' F (%s) must be >= 'sampleSize' %s (%s) in group %s at stage %s", - .arrayToString(sampleSizeFull), s, - .arrayToString(sampleSizeSubset), group, stage - ) - ) - } - } - } - } - } -} - -.validateEnrichmentDataFrameSurvival <- function(dataFrame) { - if (any(na.omit(dataFrame$event) < 0) || any(na.omit(dataFrame$overallEvent) < 0)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all events must be >= 0") - } - - .validateEnrichmentDataFrameAtFirstStage(dataFrame, - params = c("event", "overallEvent") - ) - - .validateEnrichmentDataFrameDeselection(dataFrame) - - subsets <- unique(dataFrame$subset) - if ("F" %in% subsets) { - subsets <- subsets[subsets != "F"] - fullData <- dataFrame[dataFrame$subset == "F", ] - for (s in subsets) { - for (stage in unique(dataFrame$stage)) { - for (group in unique(dataFrame$group)) { - subData <- dataFrame[dataFrame$subset == s & dataFrame$stage == stage & dataFrame$group == group, ] - - eventFull <- na.omit(fullData$event[fullData$stage == stage & fullData$group == group]) - eventSubset <- na.omit(subData$event) - if (length(eventFull) > 0 && length(eventSubset) > 0 && any(eventFull < eventSubset)) { - stop( - C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, - gettextf( - "'event' F (%s) must be >= 'event' %s (%s) in group %s at stage %s", - .arrayToString(eventFull), s, - .arrayToString(eventSubset), group, stage - ) - ) - } - } - } - } - } -} - -.validateEnrichmentDataFrameRates <- function(dataFrame) { - if (any(na.omit(dataFrame$sampleSize) <= 0) || any(na.omit(dataFrame$overallSampleSize) <= 0)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all sample sizes must be > 0") - } - - .validateEnrichmentDataFrameAtFirstStage(dataFrame, - params = c("sampleSize", "overallSampleSize") - ) - - .validateEnrichmentDataFrameDeselection(dataFrame) - - subsets <- unique(dataFrame$subset) - if ("F" %in% subsets) { - subsets <- subsets[subsets != "F"] - fullData <- dataFrame[dataFrame$subset == "F", ] - for (s in subsets) { - for (stage in unique(dataFrame$stage)) { - for (group in unique(dataFrame$group)) { - subData <- dataFrame[dataFrame$subset == s & dataFrame$stage == stage & dataFrame$group == group, ] - - sampleSizeFull <- na.omit(fullData$sampleSize[fullData$stage == stage & fullData$group == group]) - sampleSizeSubset <- na.omit(subData$sampleSize) - if (length(sampleSizeFull) > 0 && length(sampleSizeSubset) > 0 && any(sampleSizeFull < sampleSizeSubset)) { - stop( - C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, - gettextf( - "'sampleSize' F (%s) must be >= 'sampleSize' %s (%s) in group %s at stage %s", - .arrayToString(sampleSizeFull), s, - .arrayToString(sampleSizeSubset), group, stage - ) - ) - } - } - } - } - } - - .validateEnrichmentDataFrameSurvival(dataFrame) -} - -.validateEnrichmentDataFrameHasConsistentNumberOfStages <- function(dataFrame) { - subsets <- unique(dataFrame$subset) - kMaxList <- list() - for (s in subsets) { - subsetStages <- as.integer(sort(unique(na.omit(as.character(dataFrame$stage[dataFrame$subset == s]))))) - kMax <- max(subsetStages) - if (!identical(1:kMax, subsetStages)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - gettextf("subset %s has incomplete stages (%s)", s, .arrayToString(subsetStages)) - ) - } - - kMaxList[[s]] <- kMax - } - - kMax <- unique(unlist(kMaxList)) - if (length(kMax) > 1) { - stop( - C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, - "all subsets must have the identical number of stages defined (kMax: ", .listToString(kMaxList), ")" - ) - } -} - -.validateEnrichmentDataFrame <- function(dataFrame) { - paramNames <- colnames(dataFrame) - if (any(grepl("(S|s)tDev", paramNames))) { - .validateEnrichmentDataFrameMeans(dataFrame) - } else if (any(grepl("(S|s)ampleSize", paramNames)) && any(grepl("(E|e)vent", paramNames))) { - .validateEnrichmentDataFrameRates(dataFrame) - } else if (any(grepl("(L|l)ogRank", paramNames)) || any(grepl("(E|e)xpectedEvent", paramNames))) { - .validateEnrichmentDataFrameSurvival(dataFrame) - } else { - print(paramNames) - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "could not identify the endpoint of the specified dataset") - } - - subsets <- unique(dataFrame$subset) - if ("R" %in% subsets) { - paramNames <- .getEndpointSpecificDataFrameParameterNames(dataFrame) - paramName <- paramNames[1] - subsets <- subsets[subsets != "R"] - subsets <- subsets[grepl("^S\\d$", subsets)] - if (length(subsets) > 0) { - restData <- dataFrame[dataFrame$subset == "R", ] - for (s in subsets) { - stages <- unique(dataFrame$stage) - stages <- stages[stages != 1] - if (length(stages) > 0) { - for (stage in stages) { - for (group in unique(dataFrame$group)) { - subData <- dataFrame[dataFrame$subset == s & dataFrame$stage == stage & dataFrame$group == group, ] - - paramValueRest <- restData[[paramName]][restData$stage == stage & restData$group == group] - paramValueSubset <- subData[[paramName]] - if (length(paramValueRest) > 0 && length(paramValueSubset) > 0 && - any(is.na(paramValueSubset)) && !all(is.na(paramValueRest))) { - stop( - C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, - gettextf( - paste0( - "if %s is deselected (NA) then R also must be deselected (NA) but, e.g., ", - "%s R is %s in group %s at stage %s" - ), - s, sQuote(paramName), .arrayToString(paramValueRest, vectorLookAndFeelEnabled = TRUE), - group, stage - ) - ) - } - } - } - } - } - } - } - - .validateEnrichmentDataFrameHasConsistentNumberOfStages(dataFrame) -} - -.getEnrichmentDataFrameFromArgs <- function(...) { - dataFrame <- .getSubsetsFromArgs(...) - - validColumns <- c() - for (j in 1:ncol(dataFrame)) { - if (!all(is.na(dataFrame[, j]))) { - validColumns <- c(validColumns, j) - } - } - if (length(validColumns) > 0) { - dataFrame <- dataFrame[, validColumns] - } - - return(dataFrame) -} - -.getEnrichmentDatasetFromArgs <- function(...) { - dataFrame <- .getEnrichmentDataFrameFromArgs(...) - .validateEnrichmentDataFrame(dataFrame) - dataFrame <- .getWideFormat(dataFrame) - return(.getDataset(dataFrame = dataFrame)) -} - -.getDatasetExample <- function(exampleType) { - if (exampleType == "means") { - return(getDataset( - n1 = c(13, 25), - n2 = c(15, NA), - n3 = c(14, 27), - n4 = c(12, 29), - means1 = c(24.2, 22.2), - means2 = c(18.8, NA), - means3 = c(26.7, 27.7), - means4 = c(9.2, 12.2), - stDevs1 = c(24.4, 22.1), - stDevs2 = c(21.2, NA), - stDevs3 = c(25.6, 23.2), - stDevs4 = c(21.5, 22.7) - )) - } else if (exampleType == "rates") { - return(getDataset( - n1 = c(23, 25), - n2 = c(25, NA), - n3 = c(24, 27), - n4 = c(22, 29), - events1 = c(15, 12), - events2 = c(19, NA), - events3 = c(18, 22), - events4 = c(12, 13) - )) - } else if (exampleType == "survival") { - return(getDataset( - events1 = c(25, 32), - events2 = c(18, NA), - events3 = c(22, 36), - logRanks1 = c(2.2, 1.8), - logRanks2 = c(1.99, NA), - logRanks3 = c(2.32, 2.11) - )) - } - - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'exampleType' (", exampleType, ") is not allowed") -} - -#' -#' @name Dataset -#' -#' @title -#' Dataset -#' -#' @description -#' Basic class for datasets. -#' -#' @template field_stages -#' @template field_groups -#' -#' @details -#' \code{Dataset} is the basic class for -#' \itemize{ -#' \item \code{\link{DatasetMeans}}, -#' \item \code{\link{DatasetRates}}, -#' \item \code{\link{DatasetSurvival}}, and -#' \item \code{\link{DatasetEnrichmentSurvival}}. -#' } -#' This basic class contains the fields \code{stages} and \code{groups} and several commonly used -#' functions. -#' -#' @include class_core_parameter_set.R -#' @include class_core_plot_settings.R -#' @include class_design.R -#' @include f_core_constants.R -#' @include f_core_assertions.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -DatasetR6 <- R6Class("DatasetR6", - inherit = ParameterSetR6, - public = list( - .data = NULL, - .plotSettings = NULL, - .id = NULL, - .description = NULL, - .floatingPointNumbersEnabled = NULL, - .kMax = NULL, - .enrichmentEnabled = NULL, - .inputType = NULL, - .design = NULL, - stages = NULL, - groups = NULL, - subsets = NULL, - initialize = function(dataFrame, ..., floatingPointNumbersEnabled = FALSE, enrichmentEnabled = FALSE) { - super$initialize() - - self$.floatingPointNumbersEnabled <- floatingPointNumbersEnabled - self$.enrichmentEnabled <- enrichmentEnabled - - self$.plotSettings <- PlotSettingsR6$new() - self$.parameterNames <- .getParameterNames(dataset = self) - self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS - - self$.id <- NA_integer_ - self$.description <- NA_character_ - self$.inputType <- NA_character_ - - if (!missing(dataFrame)) { - self$.initByDataFrame(dataFrame) - self$.kMax <- self$getNumberOfStages() - if (!self$.enrichmentEnabled) { - self$.validateDataset() - } - } - }, - getPlotSettings = function() { - return(self$.plotSettings) - }, - show = function(showType = 1, digits = NA_integer_) { - "Method for automatically printing dataset objects" - self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) - }, - .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { - self$.resetCat() - - if (!is.null(showType) && length(showType) == 1 && !is.na(showType) && - is.character(showType) && showType == "rcmd") { - s <- strsplit(getObjectRCode(self, stringWrapParagraphWidth = NULL), "), *")[[1]] - s[2:length(s)] <- paste0("\t", s[2:length(s)]) - s <- paste0(s, collapse = "),\n") - cat(s, "\n") - } else if (showType == 2) { - super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) - } else { - self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), - title = self$.toString(startWithUpperCase = TRUE), orderByParameterName = FALSE, - consoleOutputEnabled = consoleOutputEnabled - ) - - self$.showParametersOfOneGroup(self$.getGeneratedParameters(), - title = "Calculated data", orderByParameterName = FALSE, - consoleOutputEnabled = consoleOutputEnabled - ) - - self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - - if (!is.na(self$.description) && nchar(self$.description) > 0) { - self$.cat("Description: ", self$.description, "\n\n", - consoleOutputEnabled = consoleOutputEnabled - ) - } - } - }, - .initByDataFrame = function(dataFrame) { - if (!is.data.frame(dataFrame)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'dataFrame' must be a data.frame (is an instance of class ", .getClassName(dataFrame), ")" - ) - } - - if (!self$.paramExists(dataFrame, "stage") && !self$.paramExists(dataFrame, "stages")) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'dataFrame' must contain parameter 'stages' or 'stage'" - ) - } - - self$stages <- as.integer(self$.getValuesByParameterName(dataFrame, c("stages", "stage"))) - if (!self$.enrichmentEnabled && length(unique(self$stages)) < length(self$stages)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'stages' (", .arrayToString(self$stages), - ") must be a unique vector of stage numbers" - ) - } - self$groups <- rep(1L, length(self$stages)) - - self$.setParameterType("groups", C_PARAM_USER_DEFINED) - self$.setParameterType("stages", C_PARAM_USER_DEFINED) - - if (any(grepl("^subsets?\\d*$", colnames(dataFrame)))) { - numberOfTreatmentGroups <- self$.getNumberOfGroups(dataFrame, c(C_KEY_WORDS_SAMPLE_SIZES, C_KEY_WORDS_LOG_RANKS)) - self$subsets <- character(0) - for (group in 1:numberOfTreatmentGroups) { - suffix <- ifelse(any(grepl("^subsets?\\d+$", colnames(dataFrame))), group, "") - self$subsets <- c(self$subsets, self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_SUBSETS, suffix = suffix)) - } - self$.setParameterType("subsets", C_PARAM_USER_DEFINED) - } else { - self$subsets <- rep(NA_character_, length(self$stages)) - } - }, - .validateDataset = function() { - .assertIsValidKMax(kMax = self$getNumberOfStages()) - - for (var in names(self)) { - values <- self[[var]] - if (any(is.nan(values)) || any(is.infinite(values))) { - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'", var, "' (", .arrayToString(values), - ") contains illegal values, i.e., something went wrong" - ) - } - } - }, - .validateValues = function(values, name) { - if (self$.enrichmentEnabled) { - return(invisible()) - } - - l1 <- length(unique(self$stages)) - l2 <- length(values) - if (l1 != l2) { - stop( - C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, - "there ", ifelse(l1 == 1, paste("is", l1, "stage"), - paste("are", l1, "stages") - ), " defined", - " (", .arrayToString(unique(self$stages)), ") and '", name, "' has length ", l2 - ) - } - }, - .recreateDataFrame = function() { - self$.data <- data.frame( - stage = factor(self$stages), - group = factor(self$groups), - subset = factor(self$subsets) - ) - }, - .setDataToVariables = function() { - self$stages <- as.integer(self$.data$stage) - self$groups <- as.integer(self$.data$group) - self$subsets <- as.character(self$.data$subset) - }, - .fillWithNAs = function(kMax) { - numberOfStages <- self$getNumberOfStages() - self$.kMax <- numberOfStages - if (numberOfStages >= kMax) { - return(invisible()) - } - - numberOfGroups <- self$getNumberOfGroups(survivalCorrectionEnabled = FALSE) - if (self$.enrichmentEnabled) { - for (stage in (numberOfStages + 1):kMax) { - for (group in 1:numberOfGroups) { - for (subset in levels(self$.data$subset)) { - self$stages <- c(self$stages, stage) - self$groups <- c(self$groups, group) - self$subsets <- c(self$subsets, subset) - } - } - } - } else { - for (stage in (numberOfStages + 1):kMax) { - for (group in 1:numberOfGroups) { - self$stages <- c(self$stages, stage) - self$groups <- c(self$groups, group) - self$subsets <- c(self$subsets, NA_character_) - } - } - } - }, - .trim = function(kMax) { - if (is.na(kMax)) { - kMax <- self$.kMax - } - numberOfStages <- self$getNumberOfStages(FALSE) - if (numberOfStages <= kMax) { - return(invisible(numeric(0))) - } - - indices <- which(self$stages <= kMax) - - self$stages <- self$stages[indices] - self$groups <- self$groups[indices] - self$subsets <- self$subsets[indices] - - return(indices) - }, - .orderDataByStageAndGroup = function() { - if (self$.enrichmentEnabled) { - dat <- self$.data - dat$char <- gsub("\\d", "", as.character(self$.data$subset)) - dat$char[dat$char == "R"] <- "Z" - dat$char[dat$char == "F"] <- "Z" - dat$num <- as.integer(gsub("\\D", "", as.character(self$.data$subset))) - - self$.data <- self$.data[order(self$.data$stage, self$.data$group, dat$char, dat$num), ] - } else { - self$.data <- self$.data[order(self$.data$stage, self$.data$group), ] - } - }, - .getNumberOfNAsToAdd = function(kMax) { - n <- kMax - self$getNumberOfStages() - if (n <= 0) { - return(0) - } - - n <- n * self$getNumberOfGroups(survivalCorrectionEnabled = FALSE) - if (self$.enrichmentEnabled) { - n <- n * self$getNumberOfSubsets() - } - return(n) - }, - .paramExists = function(dataFrame, parameterName) { - for (p in parameterName) { - value <- dataFrame[[p]] - if (!is.null(value)) { - return(TRUE) - } - } - return(FALSE) - }, - .getValuesByParameterName = function(dataFrame, parameterNameVariants, ..., - defaultValues = NULL, suffix = "") { - for (parameterName in parameterNameVariants) { - key <- paste0(parameterName, suffix) - if (self$.paramExists(dataFrame, key)) { - return(dataFrame[[key]]) - } - } - - if (!is.null(defaultValues)) { - return(defaultValues) - } - - stop( - C_EXCEPTION_TYPE_MISSING_ARGUMENT, "parameter '", - paste0(parameterNameVariants[1], suffix), "' is missing or not correctly specified" - ) - }, - .getValueLevels = function(values) { - if (is.factor(values)) { - return(levels(values)) - } - - return(sort(unique(na.omit(values)))) - }, - .getValues = function(paramName, paramValues) { - values <- self$.data[[paramName]] - valueLevels <- self$.getValueLevels(values) - if (!all(paramValues %in% valueLevels)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", paramName, "' (", .arrayToString(paramValues), - ") out of range [", .arrayToString(valueLevels), "]" - ) - } - return(values) - }, - .getIndexValues = function(paramName, paramValues, subset = NA_character_) { - values <- self$.getValues(paramName, paramValues) - if (all(is.na(subset))) { - return(which(values %in% paramValues)) - } - - self$.assertIsValidSubset(subset) - return(which(values %in% paramValues & self$.data$subset %in% subset)) - }, - .assertIsValidSubset = function(subset) { - for (s in subset) { - if (!(s %in% levels(self$.data$subset))) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'subset' (", s, - ") is not a defined value [", .arrayToString(levels(self$.data$subset)), "]" - ) - } - } - }, - .getIndices = function(..., stage, group, subset = NA_character_) { - if (is.null(self$.data)) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'.data' must be defined") - } - - if (!is.null(stage) && !any(is.na(stage)) && all(stage < 0)) { - index <- 1:self$getNumberOfStages() - stage <- index[!(index %in% abs(stage))] - } - - if (!is.null(group) && !any(is.na(group)) && all(group < 0)) { - index <- 1:self$getNumberOfGroups(survivalCorrectionEnabled = FALSE) - group <- index[!(index %in% abs(group))] - } - - # stage only and optional subset - if (!is.null(group) && length(group) == 1 && is.na(group)) { - return(self$.getIndexValues("stage", stage, subset)) - } - - # group only and optional subset - if (!is.null(stage) && length(stage) == 1 && is.na(stage)) { - return(self$.getIndexValues("group", group, subset)) - } - - # stage and group and optional subset - stageValues <- self$.getValues("stage", stage) - groupValues <- self$.getValues("group", group) - if (all(is.na(subset))) { - return(which(stageValues %in% stage & groupValues %in% group)) - } - - self$.assertIsValidSubset(subset) - return(which(stageValues %in% stage & groupValues %in% group & self$.data$subset %in% subset)) - }, - .getValidatedFloatingPointNumbers = function(x, parameterName = "Sample sizes") { - if (self$.floatingPointNumbersEnabled) { - return(x) - } - - nToCheck <- stats::na.omit(x) - if (any(nToCheck != as.integer(nToCheck))) { - warning(parameterName, " specified as floating-point numbers were truncated", call. = FALSE) - } - - x[!is.na(x)] <- as.integer(x[!is.na(x)]) - return(x) - }, - .keyWordExists = function(dataFrame, keyWords, suffix = "") { - for (key in keyWords) { - if (self$.paramExists(dataFrame, paste0(key, suffix))) { - return(TRUE) - } - } - return(FALSE) - }, - .getNumberOfGroups = function(dataFrame, keyWords) { - for (group in 2:1000) { - if (!self$.keyWordExists(dataFrame, keyWords, group)) { - return(group - 1) - } - } - return(1) - }, - .getValidatedStage = function(stage = NA_integer_) { - if (all(is.na(stage))) { - stage <- c(1:self$getNumberOfStages()) - } - return(stage) - }, - getNumberOfGroups = function(survivalCorrectionEnabled = TRUE) { - data <- stats::na.omit(self$.data) - if (!survivalCorrectionEnabled) { - return(length(levels(data$group))) - } - return(length(levels(data$group)) + ifelse(inherits(self, "DatasetSurvival") || inherits(self, "DatasetSurvivalR6"), 1, 0)) - }, - getNumberOfStages = function(naOmitEnabled = TRUE) { - if (naOmitEnabled) { - colNames <- colnames(self$.data) - validColNames <- character(0) - for (colName in colNames) { - colValues <- self$.data[, colName] - if (length(colValues) > 0 && !all(is.na(colValues))) { - validColNames <- c(validColNames, colName) - } - } - subData <- stats::na.omit(self$.data[, validColNames]) - numberOfStages <- length(unique(as.character(subData$stage))) - if (numberOfStages == 0) { - print(self$.data[, validColNames]) - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, - ".data seems to contain an invalid column" - ) - } - return(numberOfStages) - } - return(length(levels(self$.data$stage))) - }, - getNumberOfSubsets = function() { - return(length(levels(self$.data$subset))) - }, - isDatasetMeans = function() { - return(inherits(self, "DatasetMeansR6")) - }, - isDatasetRates = function() { - return(inherits(self, "DatasetRatesR6")) - }, - isDatasetSurvival = function() { - return(inherits(self, "DatasetSurvivalR6")) - }, - isStratified = function() { - return(self$.enrichmentEnabled && "R" %in% levels(self$.data$subset)) - }, - setId = function(id) { - self$.id <- as.integer(id) - }, - getId = function() { - return(self$.id) - }, - setDescription = function(description) { - self$.description <- description - }, - getDescription = function() { - return(self$.description) - }, - .toString = function(startWithUpperCase = FALSE) { - s <- "dataset of " - if (self$.enrichmentEnabled) { - s <- paste0(s, "enrichment ") - } else if (self$getNumberOfGroups() > 2) { - s <- paste0(s, "multi-arm ") - } - - if (self$isDatasetMeans()) { - s <- paste0(s, "means") - } else if (self$isDatasetRates()) { - s <- paste0(s, "rates") - } else if (self$isDatasetSurvival()) { - s <- paste0(s, "survival data") - } else { - s <- paste0(s, "unknown endpoint") - } - return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) - } - ) -) - -#' -#' @name DatasetMeans -#' -#' @title -#' Dataset of Means -#' -#' @description -#' Class for a dataset of means. -#' -#' @template field_groups -#' @template field_stages -#' @template field_sampleSizes -#' @template field_means -#' @template field_stDevs -#' @template field_overallSampleSizes -#' @template field_overallMeans -#' @template field_overallStDevs -#' -#' @details -#' This object cannot be created directly; better use \code{\link{getDataset}} -#' with suitable arguments to create a dataset of means. -#' -#' @include class_core_parameter_set.R -#' @include class_core_plot_settings.R -#' @include f_core_constants.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -DatasetMeansR6 <- R6Class("DatasetMeansR6", - inherit = DatasetR6, - public = list( - sampleSizes = NULL, - means = NULL, - stDevs = NULL, - overallSampleSizes = NULL, - overallMeans = NULL, - overallStDevs = NULL, - getSampleSize = function(stage, group = 1, subset = NA_character_) { - return(self$.data$sampleSize[self$.getIndices(stage = stage, group = group, subset = subset)]) - }, - getMean = function(stage, group = 1, subset = NA_character_) { - return(self$.data$mean[self$.getIndices(stage = stage, group = group, subset = subset)]) - }, - getStDev = function(stage, group = 1, subset = NA_character_) { - return(self$.data$stDev[self$.getIndices(stage = stage, group = group, subset = subset)]) - }, - getSampleSizes = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(self$.data$sampleSize[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) - }, - getMeans = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(self$.data$mean[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) - }, - getStDevs = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(self$.data$stDev[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) - }, - getSampleSizesUpTo = function(to, group = 1, subset = NA_character_) { - return(self$.data$sampleSize[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) - }, - getMeansUpTo = function(to, group = 1, subset = NA_character_) { - return(self$.data$mean[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) - }, - getStDevsUpTo = function(to, group = 1, subset = NA_character_) { - return(self$.data$stDev[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) - }, - getOverallSampleSize = function(stage, group = 1, subset = NA_character_) { - return(self$.data$overallSampleSize[self$.getIndices(stage = stage, group = group, subset = subset)]) - }, - getOverallMean = function(stage, group = 1, subset = NA_character_) { - return(self$.data$overallMean[self$.getIndices(stage = stage, group = group, subset = subset)]) - }, - getOverallStDev = function(stage, group = 1, subset = NA_character_) { - return(self$.data$overallStDev[self$.getIndices(stage = stage, group = group, subset = subset)]) - }, - getOverallSampleSizes = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(self$.data$overallSampleSize[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) - }, - getOverallMeans = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(self$.data$overallMean[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) - }, - getOverallStDevs = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(self$.data$overallStDev[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) - }, - getOverallSampleSizesUpTo = function(to, group = 1, subset = NA_character_) { - return(self$.data$overallSampleSize[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) - }, - getOverallMeansUpTo = function(to, group = 1, subset = NA_character_) { - return(self$.data$overallMean[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) - }, - getOverallStDevsUpTo = function(to, group = 1, subset = NA_character_) { - return(self$.data$overallStDev[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) - }, - .initByDataFrame = function(dataFrame) { - super$.initByDataFrame(dataFrame) - - # case: one mean - stage wise - if (self$.paramExists(dataFrame, C_KEY_WORDS_SAMPLE_SIZES)) { - self$.inputType <- "stagewise" - self$sampleSizes <- self$.getValidatedFloatingPointNumbers(self$.getValuesByParameterName( - dataFrame, - C_KEY_WORDS_SAMPLE_SIZES - ), parameterName = "Sample sizes") - self$.validateValues(self$sampleSizes, "n") - if (any(stats::na.omit(self$sampleSizes) <= 0)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "all sample sizes must be > 0, but 'n' = ", - .arrayToString(self$sampleSizes, vectorLookAndFeelEnabled = TRUE) - ) - } - - self$means <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_MEANS) - self$.validateValues(self$means, "means") - - self$stDevs <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_ST_DEVS) - self$.validateValues(self$stDevs, "stDevs") - } - - # case: one mean - overall - else if (self$.paramExists(dataFrame, C_KEY_WORDS_OVERALL_SAMPLE_SIZES)) { - self$.inputType <- "overall" - self$overallSampleSizes <- self$.getValidatedFloatingPointNumbers(self$.getValuesByParameterName( - dataFrame, - C_KEY_WORDS_OVERALL_SAMPLE_SIZES - ), parameterName = "Cumulative sample sizes ") - self$.validateValues(self$overallSampleSizes, "overallSampleSizes") - - self$overallMeans <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_MEANS) - self$.validateValues(self$overallMeans, "overallMeans") - - self$overallStDevs <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_ST_DEVS) - self$.validateValues(self$overallStDevs, "overallStDevs") - } - - # case: two or more means - stage wise - else if (self$.paramExists(dataFrame, paste0(C_KEY_WORDS_SAMPLE_SIZES, 1)) && - self$.paramExists(dataFrame, paste0(C_KEY_WORDS_SAMPLE_SIZES, 2))) { - self$.inputType <- "stagewise" - numberOfTreatmentGroups <- self$.getNumberOfGroups(dataFrame, C_KEY_WORDS_SAMPLE_SIZES) - self$stages <- rep(self$stages, numberOfTreatmentGroups) - self$groups <- integer(0) - self$sampleSizes <- numeric(0) - self$means <- numeric(0) - self$stDevs <- numeric(0) - for (group in 1:numberOfTreatmentGroups) { - sampleSizesTemp <- self$.getValidatedFloatingPointNumbers(self$.getValuesByParameterName( - dataFrame, C_KEY_WORDS_SAMPLE_SIZES, - suffix = group - ), parameterName = "Sample sizes") - self$.validateValues(sampleSizesTemp, paste0("n", group)) - if (any(stats::na.omit(sampleSizesTemp) <= 0)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "all sample sizes must be > 0, but 'n", group, "' = ", - .arrayToString(sampleSizesTemp, vectorLookAndFeelEnabled = TRUE) - ) - } - self$sampleSizes <- c(self$sampleSizes, sampleSizesTemp) - - meansTemp <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_MEANS, suffix = group) - self$.validateValues(meansTemp, paste0("means", group)) - self$means <- c(self$means, meansTemp) - - stDevsTemp <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_ST_DEVS, suffix = group) - self$.validateValues(stDevsTemp, paste0("stDevs", group)) - self$stDevs <- c(self$stDevs, stDevsTemp) - - self$groups <- c(self$groups, rep(as.integer(group), length(sampleSizesTemp))) - } - } - - # case: two or more means - overall - else if (self$.paramExists(dataFrame, paste0(C_KEY_WORDS_OVERALL_SAMPLE_SIZES, 1)) && - self$.paramExists(dataFrame, paste0(C_KEY_WORDS_OVERALL_SAMPLE_SIZES, 2))) { - self$.inputType <- "overall" - numberOfTreatmentGroups <- self$.getNumberOfGroups(dataFrame, C_KEY_WORDS_OVERALL_SAMPLE_SIZES) - self$stages <- rep(self$stages, numberOfTreatmentGroups) - self$groups <- integer(0) - self$sampleSizes <- numeric(0) - self$means <- numeric(0) - self$stDevs <- numeric(0) - self$overallSampleSizes <- numeric(0) - self$overallMeans <- numeric(0) - self$overallStDevs <- numeric(0) - for (group in 1:numberOfTreatmentGroups) { - overallSampleSizesTemp <- self$.getValidatedFloatingPointNumbers(self$.getValuesByParameterName( - dataFrame, C_KEY_WORDS_OVERALL_SAMPLE_SIZES, - suffix = group - ), parameterName = "Cumulative sample sizes") - self$.validateValues(overallSampleSizesTemp, paste0("overallSampleSizes", group)) - self$overallSampleSizes <- c(self$overallSampleSizes, overallSampleSizesTemp) - - overallMeansTemp <- self$.getValuesByParameterName(dataFrame, - C_KEY_WORDS_OVERALL_MEANS, - suffix = group - ) - self$.validateValues(overallMeansTemp, paste0("overallMeans", group)) - self$overallMeans <- c(self$overallMeans, overallMeansTemp) - - overallStDevsTemp <- self$.getValuesByParameterName(dataFrame, - C_KEY_WORDS_OVERALL_ST_DEVS, - suffix = group - ) - self$.validateValues(overallStDevsTemp, paste0("overallStDevs", group)) - self$overallStDevs <- c(self$overallStDevs, overallStDevsTemp) - - self$groups <- c(self$groups, rep(as.integer(group), length(overallSampleSizesTemp))) - } - } else { - stop( - C_EXCEPTION_TYPE_MISSING_ARGUMENT, - "sample sizes are missing or not correctly specified" - ) - } - - if (self$.inputType == "stagewise") { - n <- length(self$sampleSizes) - self$overallSampleSizes <- rep(NA_real_, n) - self$overallMeans <- rep(NA_real_, n) - self$overallStDevs <- rep(NA_real_, n) - - self$.setParameterType("sampleSizes", C_PARAM_USER_DEFINED) - self$.setParameterType("means", C_PARAM_USER_DEFINED) - self$.setParameterType("stDevs", C_PARAM_USER_DEFINED) - - self$.setParameterType("overallSampleSizes", C_PARAM_GENERATED) - self$.setParameterType("overallMeans", C_PARAM_GENERATED) - self$.setParameterType("overallStDevs", C_PARAM_GENERATED) - - self$.recreateDataFrame() - self$.createOverallData() - } else { - n <- length(self$overallSampleSizes) - self$sampleSizes <- rep(NA_real_, n) - self$means <- rep(NA_real_, n) - self$stDevs <- rep(NA_real_, n) - - self$.setParameterType("sampleSizes", C_PARAM_GENERATED) - self$.setParameterType("means", C_PARAM_GENERATED) - self$.setParameterType("stDevs", C_PARAM_GENERATED) - - self$.setParameterType("overallSampleSizes", C_PARAM_USER_DEFINED) - self$.setParameterType("overallMeans", C_PARAM_USER_DEFINED) - self$.setParameterType("overallStDevs", C_PARAM_USER_DEFINED) - - self$.recreateDataFrame() - self$.createStageWiseData() - } - - if (sum(stats::na.omit(self$sampleSizes) < 0) > 0) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all sample sizes must be >= 0") - } - if (sum(stats::na.omit(self$stDevs) < 0) > 0) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all standard deviations must be >= 0") - } - }, - .recreateDataFrame = function() { - super$.recreateDataFrame() - self$.data <- cbind(self$.data, data.frame( - sampleSize = self$sampleSizes, - mean = self$means, - stDev = self$stDevs, - overallSampleSize = self$overallSampleSizes, - overallMean = self$overallMeans, - overallStDev = self$overallStDevs - )) - self$.orderDataByStageAndGroup() - self$.setDataToVariables() - }, - .setDataToVariables = function() { - super$.setDataToVariables() - self$sampleSizes <- self$.data$sampleSize - self$means <- self$.data$mean - self$stDevs <- self$.data$stDev - self$overallSampleSizes <- self$.data$overallSampleSize - self$overallMeans <- self$.data$overallMean - self$overallStDevs <- self$.data$overallStDev - }, - .fillWithNAs = function(kMax) { - super$.fillWithNAs(kMax) - n <- self$.getNumberOfNAsToAdd(kMax) - - naRealsToAdd <- rep(NA_real_, n) - - self$sampleSizes <- c(self$sampleSizes, naRealsToAdd) - self$means <- c(self$means, naRealsToAdd) - self$stDevs <- c(self$stDevs, naRealsToAdd) - - self$overallSampleSizes <- c(self$overallSampleSizes, naRealsToAdd) - self$overallMeans <- c(self$overallMeans, naRealsToAdd) - self$overallStDevs <- c(self$overallStDevs, naRealsToAdd) - - self$.recreateDataFrame() - }, - .trim = function(kMax = NA_integer_) { - indices <- super$.trim(kMax) - if (length(indices) == 0) { - return(invisible(FALSE)) - } - - self$sampleSizes <- self$sampleSizes[indices] - self$means <- self$means[indices] - self$stDevs <- self$stDevs[indices] - - self$overallSampleSizes <- self$overallSampleSizes[indices] - self$overallMeans <- self$overallMeans[indices] - self$overallStDevs <- self$overallStDevs[indices] - - self$.recreateDataFrame() - return(invisible(TRUE)) - }, - .getOverallMeans = function(sampleSizes, means) { - return(cumsum(sampleSizes * means) / cumsum(sampleSizes)) - }, - .getOverallStDevs = function(sampleSizes, means, stDevs, overallMeans) { - kMax <- length(sampleSizes) - overallStDev <- rep(NA_real_, kMax) - for (k in 1:kMax) { - overallStDev[k] <- sqrt((sum((sampleSizes[1:k] - 1) * stDevs[1:k]^2) + - sum(sampleSizes[1:k] * (means[1:k] - overallMeans[k])^2)) / - (sum(sampleSizes[1:k]) - 1)) - } - return(overallStDev) - }, - .createOverallData = function() { - self$.data$overallSampleSize <- rep(NA_real_, nrow(self$.data)) - self$.data$overallMean <- rep(NA_real_, nrow(self$.data)) - self$.data$overallStDev <- rep(NA_real_, nrow(self$.data)) - subsetLevels <- NA_character_ - if (self$.enrichmentEnabled) { - subsetLevels <- levels(self$.data$subset) - } - for (s in subsetLevels) { - for (g in levels(self$.data$group)) { - if (!is.na(s)) { - indices <- which(self$.data$subset == s & self$.data$group == g) - } else { - indices <- which(self$.data$group == g) - } - self$.data$overallSampleSize[indices] <- cumsum(self$.data$sampleSize[indices]) - self$.data$overallMean[indices] <- self$.getOverallMeans( - self$.data$sampleSize[indices], self$.data$mean[indices] - ) - self$.data$overallStDev[indices] <- self$.getOverallStDevs( - self$.data$sampleSize[indices], - self$.data$mean[indices], self$.data$stDev[indices], self$.data$overallMean[indices] - ) - } - } - self$.setDataToVariables() - }, - .getStageWiseSampleSizes = function(overallSampleSizes) { - result <- overallSampleSizes - if (length(overallSampleSizes) == 1) { - return(result) - } - - kMax <- length(overallSampleSizes) - result[2:kMax] <- overallSampleSizes[2:kMax] - overallSampleSizes[1:(kMax - 1)] - return(result) - }, - .getStageWiseMeans = function(sampleSizes, overallSampleSizes, overallMeans) { - result <- overallMeans - if (length(overallMeans) == 1) { - return(result) - } - - for (k in 2:length(overallMeans)) { - result[k] <- (overallSampleSizes[k] * overallMeans[k] - - overallSampleSizes[k - 1] * overallMeans[k - 1]) / sampleSizes[k] - } - return(result) - }, - .getStageWiseStDev = function(overallStDevs, sampleSizes, overallSampleSizes, means, overallMeans, k) { - numBeforeK <- (overallSampleSizes[k - 1] - 1) * overallStDevs[k - 1]^2 - numK <- (overallSampleSizes[k] - 1) * overallStDevs[k]^2 - numSumBeforeK <- sum(sampleSizes[1:(k - 1)] * (means[1:(k - 1)] - overallMeans[k - 1])^2) - numSumK <- sum(sampleSizes[1:k] * (means[1:k] - overallMeans[k])^2) - denom <- (sampleSizes[k] - 1) - value <- (numK - numBeforeK + numSumBeforeK - numSumK) / denom - if (is.null(value) || length(value) != 1 || is.na(value) || value < 0) { - warning("No calculation of stage-wise standard deviation from ", - "overall standard deviations possible at stage ", k, - call. = FALSE - ) - return(NA_real_) - } - - return(sqrt(value)) - }, - .getStageWiseStDevs = function(overallStDevs, sampleSizes, overallSampleSizes, means, overallMeans) { - result <- overallStDevs - if (length(overallStDevs) == 1) { - return(result) - } - - for (k in 2:length(overallStDevs)) { - result[k] <- self$.getStageWiseStDev(overallStDevs, sampleSizes, overallSampleSizes, means, overallMeans, k) - } - return(result) - }, - .createStageWiseData = function() { - "Calculates stage-wise means and standard deviation if cunulative data is available" - - self$.data$sampleSize <- rep(NA_real_, nrow(self$.data)) - self$.data$mean <- rep(NA_real_, nrow(self$.data)) - self$.data$stDev <- rep(NA_real_, nrow(self$.data)) - - subsetLevels <- NA_character_ - if (self$.enrichmentEnabled) { - subsetLevels <- levels(self$.data$subset) - } - - for (s in subsetLevels) { - for (g in levels(self$.data$group)) { - if (!is.na(s)) { - indices <- which(self$.data$subset == s & self$.data$group == g) - } else { - indices <- which(self$.data$group == g) - } - - .assertValuesAreStrictlyIncreasing(self$.data$overallSampleSize[indices], - paste0("overallSampleSizes", g), - endingNasAllowed = TRUE - ) - - self$.data$sampleSize[indices] <- self$.getStageWiseSampleSizes(self$.data$overallSampleSize[indices]) - self$.data$mean[indices] <- self$.getStageWiseMeans( - self$.data$sampleSize[indices], - self$.data$overallSampleSize[indices], self$.data$overallMean[indices] - ) - self$.data$stDev[indices] <- self$.getStageWiseStDevs( - self$.data$overallStDev[indices], self$.data$sampleSize[indices], - self$.data$overallSampleSize[indices], self$.data$mean[indices], self$.data$overallMean[indices] - ) - } - } - self$.setDataToVariables() - }, - getRandomData = function() { - return(self$.getRandomDataMeans(self)) - } - ) -) - -#' @examples -#' -#' datasetExample <- getDataset( -#' means1 = c(112.3, 105.1, 121.3), -#' means2 = c(98.1, 99.3, 100.1), -#' means3 = c(98.1, 99.3, 100.1), -#' stDevs1 = c(44.4, 42.9, 41.4), -#' stDevs2 = c(46.7, 41.1, 39.5), -#' stDevs3 = c(46.7, 41.1, 39.5), -#' n1 = c(84, 81, 82), -#' n2 = c(87, 83, 81), -#' n3 = c(87, 82, 84) -#' ) -#' .getRandomDataMeans(datasetExample, -#' randomDataParamName = "outcome", numberOfVisits = 3, -#' fixedCovariates = list(gender = c("f", "m"), bmi = c(17, 40)) -#' ) -#' -#' @noRd -#' -.getRandomDataMeans <- function(dataset, ..., - treatmentName = "Treatment group", - controlName = "Control group", - randomDataParamName = "randomData", - numberOfVisits = 1L, - fixedCovariates = NULL, - covariateEffects = NULL, - seed = NA_real_) { - if (!is.null(fixedCovariates)) { - if (!is.list(fixedCovariates)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("fixedCovariates"), " must be a named list") - } - } - if (!is.null(covariateEffects)) { - if (!is.list(covariateEffects)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("covariateEffects"), " must be a named list") - } - } - - .assertIsSingleCharacter(treatmentName, "treatmentName") - .assertIsSingleCharacter(controlName, "controlName") - .assertIsSingleCharacter(randomDataParamName, "randomDataParamName") - .assertIsSinglePositiveInteger(numberOfVisits, "numberOfVisits", validateType = FALSE) - .assertIsSingleNumber(seed, "seed", naAllowed = TRUE) - - seed <- .setSeed(seed) - - numberOfGroups <- dataset$getNumberOfGroups() - - sampleSize <- 0 - for (stage in 1:dataset$getNumberOfStages()) { - for (group in 1:numberOfGroups) { - if (dataset$.enrichmentEnabled) { - for (subset in levels(dataset$.data$subset)) { - n <- dataset$getSampleSize(stage = stage, group = group, subset = subset) - if (n > sampleSize) { - sampleSize <- n - } - } - } else { - n <- dataset$getSampleSize(stage = stage, group = group) - n <- round(n / numberOfVisits) - if (n > sampleSize) { - sampleSize <- n - } - } - } - } - - idFactor <- 10^nchar(as.character(sampleSize)) - - data <- NULL - for (stage in 1:dataset$getNumberOfStages()) { - for (group in 1:numberOfGroups) { - for (visit in 1:numberOfVisits) { - if (dataset$.enrichmentEnabled) { - for (subset in levels(dataset$.data$subset)) { - n <- dataset$getSampleSize(stage = stage, group = group, subset = subset) - randomData <- stats::rnorm( - n = n, - mean = dataset$getMean(stage = stage, group = group, subset = subset), - sd = dataset$getStDev(stage = stage, group = group, subset = subset) - ) - row <- data.frame( - subject = idFactor * group + c(1:n), - stage = rep(stage, n), - group = rep(group, n), - subset = rep(subset, n), - randomData = randomData - ) - if (is.null(data)) { - data <- row - } else { - data <- rbind(data, row) - } - } - } else { - n <- dataset$getSampleSize(stage = stage, group = group) - n <- floor(n / numberOfVisits) - randomData <- stats::rnorm( - n = sampleSize, - mean = dataset$getMean(stage = stage, group = group), - sd = dataset$getStDev(stage = stage, group = group) - ) - - subjectIds <- (idFactor * 10 * stage) + (idFactor * group) + c(1:sampleSize) - indices <- 1:sampleSize - randomDataBefore <- NULL - numberOfDropOutsBefore <- 0 - if (visit > 1 && !is.null(data)) { - randomDataBefore <- data$randomData[data$stage == visit - 1 & data$subject %in% subjectIds] - numberOfDropOutsBefore <- sum(is.na(randomDataBefore)) - indices <- which(!is.na(randomDataBefore)) - } - sampleSizeBefore <- sampleSize - numberOfDropOutsBefore - if (n < sampleSizeBefore) { - numberOfDropOuts <- sampleSizeBefore - n - dropOuts <- sample(c(rep(1, n - numberOfDropOuts), rep(0, numberOfDropOuts))) - randomData[indices[dropOuts == 0]] <- NA_real_ - if (!is.null(randomDataBefore)) { - randomData[is.na(randomDataBefore)] <- NA_real_ - } - } - - row <- data.frame( - subject = subjectIds, - stage = rep(stage, sampleSize), - group = rep(group, sampleSize), - visit = rep(visit - 1, sampleSize), - randomData = randomData - ) - - if (is.null(data)) { - data <- row - } else { - data <- rbind(data, row) - } - } - } - } - } - data$stage <- factor(data$stage) - groupLevels <- paste(treatmentName, c(1:numberOfGroups)) - if (numberOfGroups > 1) { - if (numberOfGroups == 2) { - groupLevels[1] <- treatmentName - } - groupLevels[numberOfGroups] <- controlName - } - - data$group <- factor(data$group, labels = groupLevels) - if (dataset$.enrichmentEnabled) { - data$subset <- factor(data$subset) - } - - if (!is.null(randomDataParamName) && length(randomDataParamName) == 1 && !is.na(randomDataParamName)) { - colNames <- colnames(data) - colNames[colNames == "randomData"] <- randomDataParamName - colnames(data) <- colNames - } - - if (!is.null(fixedCovariates)) { - fixedCovariateNames <- names(fixedCovariates) - if (is.null(fixedCovariateNames) || any(nchar(trimws(fixedCovariateNames)) == 0)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("fixedCovariates"), " must be a named list") - } - - subjects <- sort(unique(data$subject)) - for (fixedCovariateName in fixedCovariateNames) { - data[[fixedCovariateName]] <- rep(NA, nrow(data)) - values <- fixedCovariates[[fixedCovariateName]] - if (is.null(values) || length(values) < 2 || any(is.na(values))) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(paste0("fixedCovariates$", fixedCovariateName)), - " (", .arrayToString(values), ") must be a valid numeric or character vector with a minimum of 2 values" - ) - } - - if (is.character(values)) { - if (length(unique(values)) < length(values)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote(paste0("fixedCovariates$", fixedCovariateName)), - " (", .arrayToString(values, maxLength = 20), ") must be a unique vector" - ) - } - - fixedCovariateSample <- sample(values, length(subjects), replace = TRUE) - for (i in 1:length(subjects)) { - data[[fixedCovariateName]][data$subject == subjects[i]] <- fixedCovariateSample[i] - } - } else if (is.numeric(values)) { - if (length(values) == 2) { - minValue <- min(values) - maxValue <- max(values) - covMean <- runif(1, minValue, maxValue) - covSD <- covMean * 0.1 - showMessage <- TRUE - for (i in 1:length(subjects)) { - groupName <- as.character(data$group[data$subject == subjects[i]])[1] - covEffect <- 1 - if (groupName == controlName && !is.null(covariateEffects)) { - covEffect <- covariateEffects[[fixedCovariateName]] - if (is.null(covEffect)) { - covEffect <- 1 - } else { - .assertIsNumericVector(covEffect, paste0("covariateEffects$", fixedCovariateName)) - if (showMessage) { - message( - "Add effect ", covEffect, " to ", - sQuote(fixedCovariateName), " of ", sQuote(groupName) - ) - showMessage <- FALSE - } - } - } - continuesExample <- rnorm(sum(data$subject == subjects[i]), covMean * covEffect, covSD) - data[[fixedCovariateName]][data$subject == subjects[i]] <- continuesExample - } - } - } - } - } - - data$seed <- rep(seed, nrow(data)) - - return(data) -} - -#' -#' @title -#' Dataset Plotting -#' -#' @description -#' Plots a dataset. -#' -#' @param x The \code{\link{Dataset}} object to plot. -#' @param y Not available for this kind of plot (is only defined to be compatible -#' to the generic plot function). -#' @param main The main title, default is \code{"Dataset"}. -#' @param xlab The x-axis label, default is \code{"Stage"}. -#' @param ylab The y-axis label. -#' @param legendTitle The legend title, default is \code{"Group"}. -#' @inheritParams param_palette -#' @inheritParams param_showSource -#' @inheritParams param_plotSettings -#' @inheritParams param_three_dots_plot -#' -#' @details -#' Generic function to plot all kinds of datasets. -#' -#' @template return_object_ggplot -#' -#' @examples -#' # Plot a dataset of means -#' dataExample <- getDataset( -#' n1 = c(22, 11, 22, 11), -#' n2 = c(22, 13, 22, 13), -#' means1 = c(1, 1.1, 1, 1), -#' means2 = c(1.4, 1.5, 3, 2.5), -#' stDevs1 = c(1, 2, 2, 1.3), -#' stDevs2 = c(1, 2, 2, 1.3) -#' ) -#' \dontrun{ -#' if (require(ggplot2)) plot(dataExample, main = "Comparison of Means") -#' } -#' -#' # Plot a dataset of rates -#' dataExample <- getDataset( -#' n1 = c(8, 10, 9, 11), -#' n2 = c(11, 13, 12, 13), -#' events1 = c(3, 5, 5, 6), -#' events2 = c(8, 10, 12, 12) -#' ) -#' \dontrun{ -#' if (require(ggplot2)) plot(dataExample, main = "Comparison of Rates") -#' } -#' -#' @export -#' -plot.DatasetR6 <- function(x, y, ..., main = "Dataset", xlab = "Stage", ylab = NA_character_, - legendTitle = "Group", palette = "Set1", showSource = FALSE, plotSettings = NULL) { - if (x$.enrichmentEnabled) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "plot of enrichment data is not implemented yet") - } - - .assertGgplotIsInstalled() - - if (x$isDatasetMeans()) { - data <- x$getRandomData() - if (is.na(ylab)) { - ylab <- "Random data" - } - } else if (x$isDatasetRates()) { - data <- x$.data - if (is.na(ylab)) { - ylab <- "Frequency (Events and Sample Size)" - } - } else if (x$isDatasetSurvival()) { - # Open work: implement dataset plot of survival data - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "plot of survival data is not implemented yet") - } - - if (!is.logical(showSource) || isTRUE(showSource)) { - warning("'showSource' != FALSE is not implemented yet for class ", .getClassName(x)) - } - - if (is.null(plotSettings)) { - plotSettings <- x$getPlotSettings() - } - - if (x$getNumberOfGroups() == 1) { - if (x$isDatasetMeans()) { - p <- ggplot2::ggplot( - data = data, - ggplot2::aes(y = .data[["randomData"]], x = factor(.data[["stage"]])) - ) - p <- p + ggplot2::geom_boxplot(ggplot2::aes(fill = .data[["stage"]])) - p <- p + ggplot2::geom_point( - colour = "#0e414e", shape = 20, - position = ggplot2::position_jitter(width = .1), - size = plotSettings$pointSize - ) - p <- p + ggplot2::stat_summary( - fun = "mean", geom = "point", - shape = 21, position = ggplot2::position_dodge(.75), size = 4, fill = "white", - colour = "black", show.legend = FALSE - ) - } else if (x$isDatasetRates()) { - p <- ggplot2::ggplot(show.legend = FALSE) - - # plot sample size - p <- p + ggplot2::geom_bar( - data = data, - ggplot2::aes( - y = .data[["sampleSize"]], - x = factor(.data[["stage"]]), fill = factor(.data[["stage"]]) - ), - position = "dodge", stat = "identity", alpha = 0.4 - ) - - # plot events - p <- p + ggplot2::geom_bar( - data = data, - ggplot2::aes( - y = .data[["event"]], x = factor(.data[["stage"]]), - fill = factor(.data[["stage"]]) - ), - position = "dodge", stat = "identity" - ) - } else if (x$isDatasetSurvival()) { - # implement survival plot here - } - } else { - data$stageGroup <- interaction(data$stage, data$group) - - if (x$isDatasetMeans()) { - p <- ggplot2::ggplot(ggplot2::aes( - y = .data[["randomData"]], x = factor(.data[["stage"]]), - fill = factor(.data[["group"]]) - ), data = data) - p <- p + ggplot2::geom_point(ggplot2::aes(colour = .data[["group"]]), - shape = 20, - position = ggplot2::position_dodge(.75), - size = plotSettings$pointSize - ) - p <- p + ggplot2::geom_boxplot() - p <- p + ggplot2::stat_summary(ggplot2::aes(colour = .data[["group"]]), - fun = "mean", geom = "point", - shape = 21, position = ggplot2::position_dodge(.75), size = 4, fill = "white", - show.legend = FALSE - ) - } else if (x$isDatasetRates()) { - p <- ggplot2::ggplot(show.legend = FALSE) - - # plot sample size - p <- p + ggplot2::geom_bar( - ggplot2::aes( - y = .data[["sampleSize"]], - x = factor(.data[["stage"]]), fill = factor(.data[["group"]]) - ), - data = data, position = "dodge", stat = "identity", alpha = 0.4 - ) - - # plot events - p <- p + ggplot2::geom_bar( - data = data, - ggplot2::aes( - y = .data[["event"]], x = factor(.data[["stage"]]), - fill = factor(.data[["group"]]) - ), - position = "dodge", stat = "identity" - ) - } else if (x$isDatasetSurvival()) { - # implement survival plot here - } - } - - # hide second legend - if (x$getNumberOfGroups() == 1) { - p <- p + ggplot2::guides(fill = FALSE, colour = FALSE) - } else { - p <- p + ggplot2::guides(colour = FALSE) - } - - # set theme - p <- plotSettings$setTheme(p) - # p <- designSet$getPlotSettings()$hideGridLines(p) - - # set main title - p <- plotSettings$setMainTitle(p, main) - - # set axes labels - p <- plotSettings$setAxesLabels(p, xlab = xlab, ylab = ylab) - - # set legend - if (x$getNumberOfGroups() > 1) { - p <- plotSettings$setLegendPosition(p, legendPosition = C_POSITION_OUTSIDE_PLOT) - p <- plotSettings$setLegendBorder(p) - p <- plotSettings$setLegendTitle(p, legendTitle, mode = "fill") - p <- plotSettings$setLegendLabelSize(p) - } - - p <- plotSettings$setAxesAppearance(p) - p <- plotSettings$setColorPalette(p, palette, mode = "all") - p <- plotSettings$enlargeAxisTicks(p) - - companyAnnotationEnabled <- .getOptionalArgument("companyAnnotationEnabled", ...) - if (is.null(companyAnnotationEnabled) || !is.logical(companyAnnotationEnabled)) { - companyAnnotationEnabled <- FALSE - } - p <- plotSettings$addCompanyAnnotation(p, enabled = companyAnnotationEnabled) - - p -} - -#' -#' @name DatasetRates -#' -#' @title -#' Dataset of Rates -#' -#' @description -#' Class for a dataset of rates. -#' -#' @template field_groups -#' @template field_stages -#' @template field_sampleSizes -#' @template field_overallSampleSizes -#' @template field_events -#' @template field_overallEvents -#' -#' @details -#' This object cannot be created directly; better use \code{\link{getDataset}} -#' with suitable arguments to create a dataset of rates. -#' -#' @include class_core_parameter_set.R -#' @include class_core_plot_settings.R -#' @include f_core_constants.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -DatasetRatesR6 <- R6Class("DatasetRatesR6", - inherit = DatasetR6, - public = list( - sampleSizes = NULL, - events = NULL, - overallSampleSizes = NULL, - overallEvents = NULL, - getSampleSize = function(stage, group = 1, subset = NA_character_) { - return(self$.data$sampleSize[self$.getIndices(stage = stage, group = group, subset = subset)]) - }, - getSampleSizes = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(self$.data$sampleSize[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) - }, - getSampleSizesUpTo = function(to, group = 1, subset = NA_character_) { - return(self$.data$sampleSize[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) - }, - getEvent = function(stage, group = 1, subset = NA_character_) { - return(self$.data$event[self$.getIndices(stage = stage, group = group, subset = subset)]) - }, - getEvents = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(self$.data$event[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) - }, - getEventsUpTo = function(to, group = 1, subset = NA_character_) { - return(self$.data$event[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) - }, - getOverallSampleSize = function(stage, group = 1, subset = NA_character_) { - return(self$.data$overallSampleSize[self$.getIndices(stage = stage, group = group, subset = subset)]) - }, - getOverallSampleSizes = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(self$.data$overallSampleSize[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) - }, - getOverallSampleSizesUpTo = function(to, group = 1, subset = NA_character_) { - return(self$.data$overallSampleSize[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) - }, - getOverallEvent = function(stage, group = 1, subset = NA_character_) { - return(self$.data$overallEvent[self$.getIndices(stage = stage, group = group, subset = subset)]) - }, - getOverallEvents = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(self$.data$overallEvent[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) - }, - getOverallEventsUpTo = function(to, group = 1, subset = NA_character_) { - return(self$.data$overallEvent[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) - }, - .initByDataFrame = function(dataFrame) { - super$.initByDataFrame(dataFrame) - - # case: one rate - stage wise - if (self$.paramExists(dataFrame, C_KEY_WORDS_SAMPLE_SIZES)) { - self$.inputType <- "stagewise" - - self$sampleSizes <- self$.getValidatedFloatingPointNumbers( - self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_SAMPLE_SIZES), - parameterName = "Sample sizes" - ) - self$.validateValues(self$sampleSizes, "n") - if (any(stats::na.omit(self$sampleSizes) <= 0)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "all sample sizes must be > 0, but 'n' = ", - self$.arrayToString(self$sampleSizes, vectorLookAndFeelEnabled = TRUE) - ) - } - - self$events <- self$.getValidatedFloatingPointNumbers( - self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_EVENTS), - parameterName = "Events" - ) - self$.validateValues(self$events, "events") - if (any(stats::na.omit(self$events) < 0)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all events must be >= 0, but 'events' = ", - self$.arrayToString(self$events, vectorLookAndFeelEnabled = TRUE) - ) - } - - kMax <- length(self$sampleSizes) - stageNumber <- length(stats::na.omit(self$sampleSizes)) - dataInput <- data.frame( - sampleSizes = self$sampleSizes, - events = self$events - ) - dataInput <- self$.getOverallData(dataInput, kMax, stage = stageNumber) - self$overallSampleSizes <- dataInput$overallSampleSizes - self$overallEvents <- dataInput$overallEvents - - self$.setParameterType("sampleSizes", C_PARAM_USER_DEFINED) - self$.setParameterType("events", C_PARAM_USER_DEFINED) - - self$.setParameterType("overallSampleSizes", C_PARAM_GENERATED) - self$.setParameterType("overallEvents", C_PARAM_GENERATED) - } - - # case: one rate - overall - else if (self$.paramExists(dataFrame, C_KEY_WORDS_OVERALL_SAMPLE_SIZES)) { - self$.inputType <- "overall" - self$overallSampleSizes <- self$.getValidatedFloatingPointNumbers( - self$.getValuesByParameterName( - dataFrame, - C_KEY_WORDS_OVERALL_SAMPLE_SIZES - ), - parameterName = "Cumulative sample sizes" - ) - self$.validateValues(self$overallSampleSizes, "overallSampleSizes") - .assertValuesAreStrictlyIncreasing(self$overallSampleSizes, "overallSampleSizes", endingNasAllowed = TRUE) - - self$overallEvents <- self$.getValidatedFloatingPointNumbers( - self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_EVENTS), - parameterName = "Cumulative events" - ) - self$.validateValues(self$overallEvents, "overallEvents") - .assertValuesAreMonotoneIncreasing(self$overallEvents, "overallEvents", endingNasAllowed = TRUE) - - kMax <- length(self$overallSampleSizes) - stageNumber <- length(stats::na.omit(self$overallSampleSizes)) - stageWiseData <- self$.getStageWiseData(data.frame( - overallSampleSizes = self$overallSampleSizes, - overallEvents = self$overallEvents - ), kMax, stage = stageNumber) - self$sampleSizes <- stageWiseData$sampleSizes - self$events <- stageWiseData$events - - self$.setParameterType("sampleSizes", C_PARAM_GENERATED) - self$.setParameterType("events", C_PARAM_GENERATED) - - self$.setParameterType("overallSampleSizes", C_PARAM_USER_DEFINED) - self$.setParameterType("overallEvents", C_PARAM_USER_DEFINED) - } - - # case: two or more rates - stage wise - else if (self$.paramExists(dataFrame, paste0(C_KEY_WORDS_SAMPLE_SIZES, 1)) && - self$.paramExists(dataFrame, paste0(C_KEY_WORDS_SAMPLE_SIZES, 2))) { - self$.inputType <- "stagewise" - - numberOfTreatmentGroups <- self$.getNumberOfGroups(dataFrame, C_KEY_WORDS_SAMPLE_SIZES) - - self$stages <- rep(self$stages, numberOfTreatmentGroups) - - self$groups <- integer(0) - self$sampleSizes <- numeric(0) - self$events <- numeric(0) - self$overallSampleSizes <- numeric(0) - self$overallEvents <- numeric(0) - for (group in 1:numberOfTreatmentGroups) { - sampleSizesTemp <- self$.getValidatedFloatingPointNumbers( - self$.getValuesByParameterName( - dataFrame, C_KEY_WORDS_SAMPLE_SIZES, - suffix = group - ), - parameterName = "Sample sizes" - ) - self$.validateValues(sampleSizesTemp, paste0("n", group)) - if (any(stats::na.omit(sampleSizesTemp) <= 0)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "all sample sizes must be > 0, but 'n", group, "' = ", - self$.arrayToString(sampleSizesTemp, vectorLookAndFeelEnabled = TRUE) - ) - } - self$sampleSizes <- c(self$sampleSizes, sampleSizesTemp) - - eventsTemp <- self$.getValidatedFloatingPointNumbers( - self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_EVENTS, suffix = group), - parameterName = "Events" - ) - self$.validateValues(eventsTemp, paste0("events", group)) - if (any(stats::na.omit(eventsTemp) < 0)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all events must be >= 0, but 'events", group, "' = ", - self$.arrayToString(eventsTemp, vectorLookAndFeelEnabled = TRUE) - ) - } - self$events <- c(self$events, eventsTemp) - - self$groups <- c(self$groups, rep(as.integer(group), length(sampleSizesTemp))) - - kMax <- length(sampleSizesTemp) - numberOfValidStages <- length(stats::na.omit(sampleSizesTemp)) - overallData <- self$.getOverallData(data.frame( - sampleSizes = sampleSizesTemp, - events = eventsTemp - ), kMax, stage = numberOfValidStages) - - self$overallSampleSizes <- c(self$overallSampleSizes, overallData$overallSampleSizes) - self$overallEvents <- c(self$overallEvents, overallData$overallEvents) - } - if (sum(stats::na.omit(self$sampleSizes) < 0) > 0) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all sample sizes must be >= 0") - } - - self$.setParameterType("sampleSizes", C_PARAM_USER_DEFINED) - self$.setParameterType("events", C_PARAM_USER_DEFINED) - - self$.setParameterType("overallSampleSizes", C_PARAM_GENERATED) - self$.setParameterType("overallEvents", C_PARAM_GENERATED) - } - - # case: two or more rates - overall - else if (self$.paramExists(dataFrame, paste0(C_KEY_WORDS_OVERALL_SAMPLE_SIZES, 1)) && - self$.paramExists(dataFrame, paste0(C_KEY_WORDS_OVERALL_SAMPLE_SIZES, 2))) { - self$.inputType <- "overall" - - numberOfTreatmentGroups <- self$.getNumberOfGroups(dataFrame, C_KEY_WORDS_OVERALL_SAMPLE_SIZES) - - self$stages <- rep(self$stages, numberOfTreatmentGroups) - - self$groups <- integer(0) - self$sampleSizes <- numeric(0) - self$events <- numeric(0) - self$overallSampleSizes <- numeric(0) - self$overallEvents <- numeric(0) - for (group in 1:numberOfTreatmentGroups) { - overallSampleSizesTemp <- self$.getValidatedFloatingPointNumbers( - self$.getValuesByParameterName( - dataFrame, C_KEY_WORDS_OVERALL_SAMPLE_SIZES, - suffix = group - ), - parameterName = "Cumulative sample sizes" - ) - self$.validateValues(overallSampleSizesTemp, paste0("overallSampleSizes", group)) - .assertValuesAreStrictlyIncreasing(overallSampleSizesTemp, - paste0("overallSampleSizes", group), - endingNasAllowed = TRUE - ) - self$overallSampleSizes <- c(self$overallSampleSizes, overallSampleSizesTemp) - - overallEventsTemp <- self$.getValidatedFloatingPointNumbers( - self$.getValuesByParameterName(dataFrame, - C_KEY_WORDS_OVERALL_EVENTS, - suffix = group - ), - parameterName = "Cumulative events" - ) - self$.validateValues(overallEventsTemp, paste0("overallEvents", group)) - .assertValuesAreMonotoneIncreasing(overallEventsTemp, - paste0("overallEvents", group), - endingNasAllowed = TRUE - ) - self$overallEvents <- c(self$overallEvents, overallEventsTemp) - - self$groups <- c(self$groups, rep(as.integer(group), length(overallSampleSizesTemp))) - - kMax <- length(overallSampleSizesTemp) - numberOfValidStages <- length(stats::na.omit(overallSampleSizesTemp)) - stageWiseData <- self$.getStageWiseData(data.frame( - overallSampleSizes = overallSampleSizesTemp, - overallEvents = overallEventsTemp - ), kMax, stage = numberOfValidStages) - - validatedSampleSizes <- stageWiseData$sampleSizes - self$.validateValues(validatedSampleSizes, paste0("n", group)) - self$sampleSizes <- c(self$sampleSizes, validatedSampleSizes) - self$events <- c(self$events, stageWiseData$events) - - if (sum(stats::na.omit(self$sampleSizes) < 0) > 0) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all sample sizes must be >= 0") - } - } - - self$.setParameterType("sampleSizes", C_PARAM_GENERATED) - self$.setParameterType("events", C_PARAM_GENERATED) - - self$.setParameterType("overallSampleSizes", C_PARAM_USER_DEFINED) - self$.setParameterType("overallEvents", C_PARAM_USER_DEFINED) - } else { - stop( - C_EXCEPTION_TYPE_MISSING_ARGUMENT, - "sample sizes are missing or not correctly specified" - ) - } - - if (sum(stats::na.omit(self$events) < 0) > 0) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all events must be >= 0") - } - - self$.recreateDataFrame() - if (self$.enrichmentEnabled) { - self$.createOverallDataEnrichment() - } - }, - .recreateDataFrame = function() { - super$.recreateDataFrame() - self$.data <- cbind(self$.data, data.frame( - sampleSize = self$sampleSizes, - event = self$events, - overallSampleSize = self$overallSampleSizes, - overallEvent = self$overallEvents - )) - self$.orderDataByStageAndGroup() - self$.setDataToVariables() - }, - .setDataToVariables = function() { - super$.setDataToVariables() - self$sampleSizes <- self$.data$sampleSize - self$events <- self$.data$event - self$overallSampleSizes <- self$.data$overallSampleSize - self$overallEvents <- self$.data$overallEvent - }, - .fillWithNAs = function(kMax) { - super$.fillWithNAs(kMax) - n <- self$.getNumberOfNAsToAdd(kMax) - - self$sampleSizes <- c(self$sampleSizes, rep(NA_real_, n)) - self$events <- c(self$events, rep(NA_real_, n)) - - self$overallSampleSizes <- c(self$overallSampleSizes, rep(NA_real_, n)) - self$overallEvents <- c(self$overallEvents, rep(NA_real_, n)) - - self$.recreateDataFrame() - }, - .trim = function(kMax = NA_integer_) { - indices <- super$.trim(kMax) - if (length(indices) == 0) { - return(invisible(FALSE)) - } - - self$sampleSizes <- self$sampleSizes[indices] - self$events <- self$events[indices] - - self$overallSampleSizes <- self$overallSampleSizes[indices] - self$overallEvents <- self$overallEvents[indices] - - self$.recreateDataFrame() - - return(invisible(TRUE)) - }, - getRandomData = function() { - data <- NULL - for (stage in 1:self$getNumberOfStages()) { - for (group in 1:self$getNumberOfGroups()) { - if (self$.enrichmentEnabled) { - for (subset in levels(self$.data$subset)) { - n <- self$getSampleSize(stage = stage, group = group, subset = subset) - numberOfEvents <- self$getEvent(stage = stage, group = group, subset = subset) - randomIndices <- sample(x = c(1:n), size = numberOfEvents, replace = FALSE) - randomData <- rep(0, n) - randomData[randomIndices] <- 1#TODO indices -> indizes - - row <- data.frame( - stage = stage, - group = group, - subset = subset, - randomData = randomData - ) - if (is.null(data)) { - data <- row - } else { - data <- rbind(data, row) - } - } - } else { - n <- self$getSampleSize(stage = stage, group = group) - numberOfEvents <- self$getEvent(stage = stage, group = group) - randomIndices <- sample(x = c(1:n), size = numberOfEvents, replace = FALSE) - randomData <- rep(0, n) - randomData[randomIndices] <- 1 - - row <- data.frame( - stage = stage, - group = group, - randomData = randomData - ) - if (is.null(data)) { - data <- row - } else { - data <- rbind(data, row) - } - } - } - } - data$stage <- factor(data$stage) - data$group <- factor(data$group, label = paste("Group", c(1:self$getNumberOfGroups()))) - return(data) - }, - .createOverallDataEnrichment = function() { - if (!self$.enrichmentEnabled) { - return(invisible()) - } - - self$.data$overallSampleSize <- rep(NA_real_, nrow(self$.data)) - self$.data$overallEvent <- rep(NA_real_, nrow(self$.data)) - for (s in levels(self$.data$subset)) { - for (g in levels(self$.data$group)) { - indices <- which(self$.data$subset == s & self$.data$group == g) - self$.data$overallSampleSize[indices] <- cumsum(self$.data$sampleSize[indices]) - self$.data$overallEvent[indices] <- cumsum(self$.data$event[indices]) - } - } - - self$.setDataToVariables() - }, - .getOverallData = function(dataInput, kMax, stage) { - "Calculates cumulative values if stage-wise data is available" - if (is.null(dataInput[["sampleSizes"]])) { - stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "data input must contain variable 'sampleSizes'") - } - if (is.null(dataInput[["events"]])) { - stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "data input must contain variable 'events'") - } - - dataInput$overallSampleSizes <- c( - cumsum(dataInput$sampleSizes[1:stage]), - rep(NA_real_, kMax - stage) - ) - - dataInput$overallEvents <- c( - cumsum(dataInput$events[1:stage]), - rep(NA_real_, kMax - stage) - ) - - return(dataInput) - }, - .getStageWiseData = function(dataInput, kMax, stage) { - "Calculates stage-wise values if cumulative data is available" - if (is.null(dataInput[["overallSampleSizes"]])) { - stop( - C_EXCEPTION_TYPE_MISSING_ARGUMENT, - "data input must contain variable 'overallSampleSizes'" - ) - } - if (is.null(dataInput[["overallEvents"]])) { - stop( - C_EXCEPTION_TYPE_MISSING_ARGUMENT, - "data input must contain variable 'overallEvents'" - ) - } - - dataInput$sampleSizes <- c(dataInput$overallSampleSizes[1:stage], rep(NA_real_, kMax - stage)) - if (stage > 1) { - dataInput$sampleSizes[2:stage] <- dataInput$overallSampleSizes[2:stage] - - dataInput$overallSampleSizes[1:(stage - 1)] - } - - dataInput$events <- c(dataInput$overallEvents[1:stage], rep(NA_real_, kMax - stage)) - if (stage > 1) { - dataInput$events[2:stage] <- dataInput$overallEvents[2:stage] - - dataInput$overallEvents[1:(stage - 1)] - } - - return(dataInput) - } - ) -) - -#' -#' @name DatasetSurvival -#' -#' @title -#' Dataset of Survival Data -#' -#' @description -#' Class for a dataset of survival data. -#' -#' @template field_groups -#' @template field_stages -#' @template field_events -#' @template field_overallEvents -#' @template field_allocationRatios -#' @template field_overallAllocationRatios -#' @template field_logRanks -#' @template field_overallLogRanks -#' -#' -#' @details -#' This object cannot be created directly; better use \code{\link{getDataset}} -#' with suitable arguments to create a dataset of survival data. -#' -#' @include class_core_parameter_set.R -#' @include class_core_plot_settings.R -#' @include f_core_constants.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -DatasetSurvivalR6 <- R6Class("DatasetSurvivalR6", - inherit = DatasetR6, - public = list( - overallEvents = NULL, - overallAllocationRatios = NULL, - overallLogRanks = NULL, - events = NULL, - allocationRatios = NULL, - logRanks = NULL, - getEvent = function(stage, group = 1, subset = NA_character_) { - return(self$.data$event[self$.getIndices(stage = stage, group = group, subset = subset)]) - }, - getEvents = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(self$.data$event[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) - }, - getEventsUpTo = function(to, group = 1, subset = NA_character_) { - return(self$.data$event[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) - }, - getAllocationRatio = function(stage, group = 1, subset = NA_character_) { - return(self$.data$allocationRatio[self$.getIndices(stage = stage, group = group, subset = subset)]) - }, - getAllocationRatios = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(self$.data$allocationRatio[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) - }, - getAllocationRatiosUpTo = function(to, group = 1, subset = NA_character_) { - return(self$.data$allocationRatio[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) - }, - getLogRank = function(stage, group = 1, subset = NA_character_) { - return(self$.data$logRank[self$.getIndices(stage = stage, group = group, subset = subset)]) - }, - getLogRanks = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(self$.data$logRank[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) - }, - getLogRanksUpTo = function(to, group = 1, subset = NA_character_) { - return(self$.data$logRank[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) - }, - getOverallEvent = function(stage, group = 1, subset = NA_character_) { - return(self$.data$overallEvent[self$.getIndices(stage = stage, group = group, subset = subset)]) - }, - getOverallEvents = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(self$.data$overallEvent[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) - }, - getOverallEventsUpTo = function(to, group = 1, subset = NA_character_) { - return(self$.data$overallEvent[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) - }, - getOverallAllocationRatio = function(stage, group = 1, subset = NA_character_) { - return(self$.data$overallAllocationRatio[self$.getIndices(stage = stage, group = group, subset = subset)]) - }, - getOverallAllocationRatios = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(self$.data$overallAllocationRatio[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) - }, - getOverallAllocationRatiosUpTo = function(to, group = 1, subset = NA_character_) { - return(self$.data$overallAllocationRatio[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) - }, - getOverallLogRank = function(stage, group = 1, subset = NA_character_) { - return(self$.data$overallLogRank[self$.getIndices(stage = stage, group = group, subset = subset)]) - }, - getOverallLogRanks = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(self$.data$overallLogRank[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) - }, - getOverallLogRanksUpTo = function(to, group = 1, subset = NA_character_) { - return(self$.data$overallLogRank[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) - }, - .getAllocationRatioDefaultValues = function(stages, events, logRanks) { - allocationRatioDefaultValues <- rep(C_ALLOCATION_RATIO_DEFAULT, length(stages)) - indices <- which(is.na(events) | is.na(logRanks)) - allocationRatioDefaultValues[indices] <- NA_real_ - return(allocationRatioDefaultValues) - }, - .initByDataFrame = function(dataFrame) { - super$.initByDataFrame(dataFrame) - - if (inherits(self, "DatasetEnrichmentSurvivalR6")) { - if (self$.paramExists(dataFrame, C_KEY_WORDS_EXPECTED_EVENTS) || - self$.paramExists(dataFrame, C_KEY_WORDS_VARIANCE_EVENTS)) { - self$.inputType <- "stagewise" - - self$events <- self$.getValidatedFloatingPointNumbers( - self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_EVENTS), - parameterName = "Events" - ) - self$.validateValues(self$events, "events") - - self$allocationRatios <- self$.getValuesByParameterName( - dataFrame, C_KEY_WORDS_ALLOCATION_RATIOS, - defaultValues = .getAllocationRatioDefaultValues(self$stages, self$events, self$expectedEvents) - ) - self$.validateValues(self$allocationRatios, "allocationRatios") - } else if (self$.paramExists(dataFrame, C_KEY_WORDS_OVERALL_EXPECTED_EVENTS) || - self$.paramExists(dataFrame, C_KEY_WORDS_OVERALL_VARIANCE_EVENTS)) { - self$.inputType <- "overall" - - self$overallEvents <- self$.getValidatedFloatingPointNumbers( - self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_EVENTS), - parameterName = "Cumulative events" - ) - self$.validateValues(self$overallEvents, "overallEvents") - - self$overallAllocationRatios <- self$.getValuesByParameterName( - dataFrame, - parameterNameVariants = C_KEY_WORDS_OVERALL_ALLOCATION_RATIOS, - defaultValues = self$.getAllocationRatioDefaultValues(self$stages, self$overallEvents, self$overallExpectedEvents) - ) - self$.validateValues(self$overallAllocationRatios, "overallAllocationRatios") - } - - # stratified enrichment: do nothing more here - } - - # case: survival, two groups - overall - else if (self$.paramExists(dataFrame, C_KEY_WORDS_OVERALL_LOG_RANKS)) { - self$.inputType <- "overall" - self$overallEvents <- self$.getValidatedFloatingPointNumbers( - self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_EVENTS), - parameterName = "Cumulative events" - ) - self$.validateValues(self$overallEvents, "overallEvents") - if (!self$.enrichmentEnabled) { - .assertValuesAreStrictlyIncreasing(self$overallEvents, "overallEvents", endingNasAllowed = TRUE) - } - - self$overallLogRanks <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_LOG_RANKS) - self$.validateValues(self$overallLogRanks, "overallLogRanks") - - self$overallAllocationRatios <- self$.getValuesByParameterName( - dataFrame, - parameterNameVariants = C_KEY_WORDS_OVERALL_ALLOCATION_RATIOS, - defaultValues = self$.getAllocationRatioDefaultValues(self$stages, self$overallEvents, self$overallLogRanks) - ) - self$.validateValues(self$overallAllocationRatios, "overallAllocationRatios") - - self$.setParameterType("groups", C_PARAM_NOT_APPLICABLE) - } - - # case: survival, two groups - stage wise - else if (self$.paramExists(dataFrame, C_KEY_WORDS_LOG_RANKS)) { - self$.inputType <- "stagewise" - self$events <- self$.getValidatedFloatingPointNumbers(self$.getValuesByParameterName( - dataFrame, C_KEY_WORDS_EVENTS - ), parameterName = "Events") - self$.validateValues(self$events, "events") - if (any(stats::na.omit(self$events) < 0)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all events must be >= 0") - } - - self$logRanks <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_LOG_RANKS) - self$.validateValues(self$logRanks, "logRanks") - - self$allocationRatios <- self$.getValuesByParameterName( - dataFrame, C_KEY_WORDS_ALLOCATION_RATIOS, - defaultValues = self$.getAllocationRatioDefaultValues(self$stages, self$events, self$logRanks) - ) - self$.validateValues(self$allocationRatios, "allocationRatios") - - self$.setParameterType("groups", C_PARAM_NOT_APPLICABLE) - } - - # case: survival, three ore more groups - overall - else if (self$.paramExists(dataFrame, paste0(C_KEY_WORDS_OVERALL_LOG_RANKS, 1)) && - self$.paramExists(dataFrame, paste0(C_KEY_WORDS_OVERALL_LOG_RANKS, 2))) { - self$.inputType <- "overall" - - numberOfTreatmentGroups <- self$.getNumberOfGroups(dataFrame, C_KEY_WORDS_OVERALL_LOG_RANKS) - - self$stages <- rep(self$stages, numberOfTreatmentGroups) - - self$groups <- integer(0) - self$overallEvents <- numeric(0) - self$overallAllocationRatios <- numeric(0) - self$overallLogRanks <- numeric(0) - for (group in 1:numberOfTreatmentGroups) { - overallEventsTemp <- self$.getValuesByParameterName(dataFrame, - C_KEY_WORDS_OVERALL_EVENTS, - suffix = group - ) - self$.validateValues(overallEventsTemp, paste0("overallEvents", group)) - if (is.null(dataFrame[["subset"]]) || length(unique(dataFrame[["subset"]])) <= 1) { - .assertValuesAreStrictlyIncreasing(overallEventsTemp, - paste0("overallEvents", group), - endingNasAllowed = TRUE - ) - } - self$overallEvents <- c(self$overallEvents, overallEventsTemp) - - overallLogRanksTemp <- self$.getValuesByParameterName( - dataFrame, C_KEY_WORDS_OVERALL_LOG_RANKS, - suffix = group - ) - self$.validateValues(overallLogRanksTemp, paste0("overallLogRanks", group)) - self$overallLogRanks <- c(self$overallLogRanks, overallLogRanksTemp) - - overallAllocationRatiosTemp <- self$.getValuesByParameterName( - dataFrame, C_KEY_WORDS_OVERALL_ALLOCATION_RATIOS, - suffix = group, - defaultValues = self$.getAllocationRatioDefaultValues( - overallEventsTemp, - overallEventsTemp, overallLogRanksTemp - ) - ) - self$.validateValues(overallAllocationRatiosTemp, paste0("overallAllocationRatios", group)) - self$overallAllocationRatios <- c(self$overallAllocationRatios, overallAllocationRatiosTemp) - - self$groups <- c(self$groups, rep(as.integer(group), length(overallLogRanksTemp))) - } - } - - # case: survival, three ore more groups - stage wise - else if (self$.paramExists(dataFrame, paste0(C_KEY_WORDS_LOG_RANKS, 1)) && - self$.paramExists(dataFrame, paste0(C_KEY_WORDS_LOG_RANKS, 2))) { - self$.inputType <- "stagewise" - numberOfTreatmentGroups <- self$.getNumberOfGroups(dataFrame, C_KEY_WORDS_LOG_RANKS) - - self$stages <- rep(self$stages, numberOfTreatmentGroups) - - self$groups <- integer(0) - self$events <- numeric(0) - self$allocationRatios <- numeric(0) - self$logRanks <- numeric(0) - for (group in 1:numberOfTreatmentGroups) { - eventsTemp <- self$.getValidatedFloatingPointNumbers(self$.getValuesByParameterName( - dataFrame, C_KEY_WORDS_EVENTS, - suffix = group - ), parameterName = "Events") - if (any(stats::na.omit(eventsTemp) < 0)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all events must be >= 0, but 'events", group, "' = ", - self$.arrayToString(eventsTemp, vectorLookAndFeelEnabled = TRUE) - ) - } - self$events <- c(self$events, eventsTemp) - - logRanksTemp <- self$.getValuesByParameterName( - dataFrame, C_KEY_WORDS_LOG_RANKS, - suffix = group - ) - self$.validateValues(logRanksTemp, paste0("n", group)) - self$logRanks <- c(self$logRanks, logRanksTemp) - - allocationRatiosTemp <- self$.getValuesByParameterName( - dataFrame, C_KEY_WORDS_ALLOCATION_RATIOS, - suffix = group, - defaultValues = self$.getAllocationRatioDefaultValues( - eventsTemp, - eventsTemp, logRanksTemp - ) - ) - self$.validateValues(allocationRatiosTemp, paste0("allocationRatios", group)) - self$allocationRatios <- c(self$allocationRatios, allocationRatiosTemp) - - self$groups <- c(self$groups, rep(as.integer(group), length(eventsTemp))) - } - } else { - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, "unable to identify case for ", .getClassName(self), " and columns ", - self$.arrayToString(colnames(dataFrame)) - ) - } - - if (self$.inputType == "stagewise") { - n <- length(self$events) - self$overallEvents <- rep(NA_real_, n) - self$overallAllocationRatios <- rep(NA_real_, n) - self$overallLogRanks <- rep(NA_real_, n) - - self$.setParameterType("events", C_PARAM_USER_DEFINED) - self$.setParameterType("allocationRatios", C_PARAM_USER_DEFINED) - if (!inherits(self, "DatasetEnrichmentSurvivalR6")) { - self$.setParameterType("logRanks", C_PARAM_USER_DEFINED) - } - - self$.setParameterType("overallEvents", C_PARAM_GENERATED) - self$.setParameterType("overallAllocationRatios", C_PARAM_GENERATED) - if (!inherits(self, "DatasetEnrichmentSurvivalR6")) { - self$.setParameterType("overallLogRanks", C_PARAM_GENERATED) - } - - if (!inherits(self, "DatasetEnrichmentSurvivalR6")) { - self$.recreateDataFrame() - self$.createOverallData() - } - } else { - n <- length(self$overallEvents) - self$events <- rep(NA_real_, n) - self$allocationRatios <- rep(NA_real_, n) - self$logRanks <- rep(NA_real_, n) - - self$.setParameterType("events", C_PARAM_GENERATED) - self$.setParameterType("allocationRatios", C_PARAM_GENERATED) - if (!inherits(self, "DatasetEnrichmentSurvivalR6")) { - self$.setParameterType("logRanks", C_PARAM_GENERATED) - } - - self$.setParameterType("overallEvents", C_PARAM_USER_DEFINED) - self$.setParameterType("overallAllocationRatios", C_PARAM_USER_DEFINED) - if (!inherits(self, "DatasetEnrichmentSurvivalR6")) { - self$.setParameterType("overallLogRanks", C_PARAM_USER_DEFINED) - } - - if (!inherits(self, "DatasetEnrichmentSurvivalR6")) { - self$.recreateDataFrame() - self$.createStageWiseData() - } - } - }, - .recreateDataFrame = function() { - super$.recreateDataFrame() - - if (inherits(self, "DatasetEnrichmentSurvivalR6")) { - self$.data <- cbind(self$.data, data.frame( - overallEvent = self$overallEvents, - overallExpectedEvent = self$overallExpectedEvents, - overallVarianceEvent = self$overallVarianceEvents, - overallAllocationRatio = self$overallAllocationRatios, - event = self$events, - expectedEvent = self$expectedEvents, - # varianceEvent = varianceEvents, # maybe implemented later - allocationRatio = self$allocationRatios - )) - } else { - self$.data <- cbind(self$.data, data.frame( - overallEvent = self$overallEvents, - overallAllocationRatio = self$overallAllocationRatios, - overallLogRank = self$overallLogRanks, - event = self$events, - allocationRatio = self$allocationRatios, - logRank = self$logRanks - )) - } - self$.orderDataByStageAndGroup() - self$.setDataToVariables() - }, - .setDataToVariables = function() { - super$.setDataToVariables() - self$overallEvents <- self$.data$overallEvent - self$overallAllocationRatios <- self$.data$overallAllocationRatio - self$events <- self$.data$event - self$allocationRatios <- self$.data$allocationRatio - if (!inherits(self, "DatasetEnrichmentSurvivalR6")) { - self$overallLogRanks <- self$.data$overallLogRank - self$logRanks <- self$.data$logRank - } - }, - .fillWithNAs = function(kMax) { - super$.fillWithNAs(kMax) - n <- self$.getNumberOfNAsToAdd(kMax) - - self$overallEvents <- c(self$overallEvents, rep(NA_real_, n)) - self$overallAllocationRatios <- c(self$overallAllocationRatios, rep(NA_real_, n)) - self$overallLogRanks <- c(self$overallLogRanks, rep(NA_real_, n)) - - self$events <- c(self$events, rep(NA_real_, n)) - self$allocationRatios <- c(self$allocationRatios, rep(NA_real_, n)) - self$logRanks <- c(self$logRanks, rep(NA_real_, n)) - - self$.recreateDataFrame() - }, - .trim = function(kMax = NA_integer_) { - indices <- super$.trim(kMax) - if (length(indices) == 0) { - return(invisible(FALSE)) - } - - self$events <- self$events[indices] - self$allocationRatios <- self$allocationRatios[indices] - self$logRanks <- self$logRanks[indices] - - self$overallEvents <- self$overallEvents[indices] - self$overallAllocationRatios <- self$overallAllocationRatios[indices] - self$overallLogRanks <- self$overallLogRanks[indices] - - self$.recreateDataFrame() - - return(invisible(TRUE)) - }, - getRandomData = function() { - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, - "the function 'DatasetSurvival.getRandomData()' is not implemented yet" - ) - }, - .getOverallLogRanks = function(logRanks, events, overallEvents, - kMax = length(logRanks), stage = length(logRanks)) { - result <- c(logRanks[1:stage], rep(NA_real_, kMax - stage)) - if (stage == 1) { - return(result) - } - for (k in 2:stage) { - result[k] <- - (sqrt(events[k]) * logRanks[k] + - sqrt(overallEvents[k - 1]) * - result[k - 1]) / sqrt(overallEvents[k]) - } - return(result) - }, - .getOverallAllocationRatios = function(allocationRatios, events, overallEvents, - kMax = length(allocationRatios), stage = length(allocationRatios)) { - result <- c( - allocationRatios[1:stage], - rep(NA_real_, kMax - stage) - ) - if (stage == 1) { - return(result) - } - for (k in 2:stage) { - result[k] <- (events[k] * - allocationRatios[k] + overallEvents[k - 1] * - result[k - 1]) / overallEvents[k] - } - return(result) - }, - .createOverallData = function() { - self$.data$overallEvent <- rep(NA_real_, nrow(self$.data)) - if (inherits(self, "DatasetEnrichmentSurvivalR6")) { - self$.data$overallExpectedEvent <- rep(NA_real_, nrow(self$.data)) - self$.data$overallVarianceEvent <- rep(NA_real_, nrow(self$.data)) - } else { - self$.data$overallLogRank <- rep(NA_real_, nrow(self$.data)) - } - self$.data$overallAllocationRatio <- rep(NA_real_, nrow(self$.data)) - subsetLevels <- NA_character_ - if (self$.enrichmentEnabled) { - subsetLevels <- levels(self$.data$subset) - } - for (s in subsetLevels) { - for (g in levels(self$.data$group)) { - if (!is.na(s)) { - indices <- which(self$.data$subset == s & self$.data$group == g) - } else { - indices <- which(self$.data$group == g) - } - self$.data$overallEvent[indices] <- cumsum(self$.data$event[indices]) - self$.data$overallExpectedEvent[indices] <- cumsum(self$.data$expectedEvent[indices]) - # .data$overallVarianceEvent[indices] <<- # maybe implemented later - self$.data$overallLogRank[indices] <- self$.getOverallLogRanks( - self$.data$logRank[indices], self$.data$event[indices], self$.data$overallEvent[indices] - ) - self$.data$overallAllocationRatio[indices] <- self$.getOverallAllocationRatios( - self$.data$allocationRatio[indices], self$.data$event[indices], self$.data$overallEvent[indices] - ) - } - } - self$.setDataToVariables() - }, - .getStageWiseEvents = function(overallEvents) { - result <- overallEvents - if (length(result) == 1) { - return(result) - } - - kMax <- length(result) - result[2:kMax] <- overallEvents[2:kMax] - overallEvents[1:(kMax - 1)] - return(result) - }, - .getStageWiseLogRanks = function(overallLogRanks, overallEvents) { - result <- overallLogRanks - if (length(result) == 1) { - return(result) - } - - kMax <- length(result) - result[2:kMax] <- (sqrt(overallEvents[2:kMax]) * - overallLogRanks[2:kMax] - - sqrt(overallEvents[1:(kMax - 1)]) * - overallLogRanks[1:(kMax - 1)]) / - sqrt(overallEvents[2:kMax] - overallEvents[1:(kMax - 1)]) - return(result) - }, - .getStageWiseAllocationRatios = function(overallAllocationRatios, events, overallEvents) { - result <- overallAllocationRatios - if (length(result) == 1) { - return(result) - } - - kMax <- length(result) - result[2:kMax] <- ( - overallAllocationRatios[2:kMax] - - overallAllocationRatios[1:(kMax - 1)] * - overallEvents[1:(kMax - 1)] / overallEvents[2:kMax] - ) / (events[2:kMax] / overallEvents[2:kMax]) - if (any(stats::na.omit(result) <= 0)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "overall allocation ratios not correctly specified: ", - "one or more calculated stage-wise allocation ratios <= 0" - ) - } - return(result) - }, - .createStageWiseData = function() { - "Calculates stage-wise logrank statistics, events, and allocation ratios if cumulative data is available" - - self$.data$event <- rep(NA_real_, nrow(self$.data)) - if (inherits(self, "DatasetEnrichmentSurvivalR6")) { - self$.data$expectedEvent <- rep(NA_real_, nrow(self$.data)) - self$.data$varianceEvent <- rep(NA_real_, nrow(self$.data)) - } else { - self$.data$logRank <- rep(NA_real_, nrow(self$.data)) - } - self$.data$allocationRatio <- rep(NA_real_, nrow(self$.data)) - - subsetLevels <- NA_character_ - if (self$.enrichmentEnabled) { - subsetLevels <- levels(self$.data$subset) - } - - for (s in subsetLevels) { - for (g in levels(self$.data$group)) { - if (!is.na(s)) { - indices <- which(self$.data$subset == s & self$.data$group == g) - } else { - indices <- which(self$.data$group == g) - } - - groupNumber <- ifelse(levels(self$.data$group) > 1, g, "") - if (self$.enrichmentEnabled) { - .assertValuesAreStrictlyIncreasing(self$.data$overallEvent[indices], - paste0("overallEvents", groupNumber, "[subset == \"", s, "\"]"), - endingNasAllowed = TRUE - ) - } else { - .assertValuesAreStrictlyIncreasing(self$.data$overallEvent[indices], - paste0("overallEvents", groupNumber), - endingNasAllowed = TRUE - ) - } - - self$.data$event[indices] <- self$.getStageWiseEvents(self$.data$overallEvent[indices]) - if (inherits(self, "DatasetEnrichmentSurvivalR6")) { - self$.data$expectedEvent[indices] <- self$.getStageWiseEvents(self$.data$overallExpectedEvent[indices]) - # .data$varianceEvent[indices] <<- # maybe implemented later - } else { - self$.data$logRank[indices] <- self$.getStageWiseLogRanks( - self$.data$overallLogRank[indices], self$.data$overallEvent[indices] - ) - } - self$.data$allocationRatio[indices] <- self$.getStageWiseAllocationRatios( - self$.data$overallAllocationRatio[indices], - self$.data$event[indices], self$.data$overallEvent[indices] - ) - } - } - self$.setDataToVariables() - } - ) -) - -#' -#' @rdname DatasetSurvival -#' -#' @keywords internal -#' -DatasetEnrichmentSurvivalR6 <- R6Class("DatasetEnrichmentSurvivalR6", - inherit = DatasetSurvivalR6, - public = list( - expectedEvents = NULL, - varianceEvents = NULL, - overallExpectedEvents = NULL, - overallVarianceEvents = NULL, - .initByDataFrame = function(dataFrame) { - super$.initByDataFrame(dataFrame) - - if (self$.paramExists(dataFrame, C_KEY_WORDS_OVERALL_EXPECTED_EVENTS) || - self$.paramExists(dataFrame, C_KEY_WORDS_OVERALL_VARIANCE_EVENTS)) { - if (!self$.paramExists(dataFrame, C_KEY_WORDS_OVERALL_EXPECTED_EVENTS)) { - stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'overallExpectedEvents' is missing") - } - if (!self$.paramExists(dataFrame, C_KEY_WORDS_OVERALL_VARIANCE_EVENTS)) { - stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'overallVarianceEvents' is missing") - } - - self$.inputType <- "overall" - - self$overallEvents <- self$.getValidatedFloatingPointNumbers( - self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_EVENTS), - parameterName = "Cumulative events" - ) - self$.validateValues(self$overallEvents, "overallEvents") - - self$overallExpectedEvents <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_EXPECTED_EVENTS) - self$.validateValues(self$overallExpectedEvents, "overallExpectedEvents") - - self$overallVarianceEvents <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_OVERALL_VARIANCE_EVENTS) - self$.validateValues(self$overallVarianceEvents, "overallVarianceEvents") - - self$overallAllocationRatios <- self$.getValuesByParameterName( - dataFrame, - parameterNameVariants = C_KEY_WORDS_OVERALL_ALLOCATION_RATIOS, - defaultValues = self$.getAllocationRatioDefaultValues(self$stages, self$overallEvents, self$overallExpectedEvents) - ) - self$.validateValues(self$overallAllocationRatios, "overallAllocationRatios") - } else if (self$.paramExists(dataFrame, C_KEY_WORDS_EXPECTED_EVENTS) || - self$.paramExists(dataFrame, C_KEY_WORDS_VARIANCE_EVENTS)) { - if (!self$.paramExists(dataFrame, C_KEY_WORDS_EXPECTED_EVENTS)) { - stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'expectedEvents' is missing") - } - if (!self$.paramExists(dataFrame, C_KEY_WORDS_VARIANCE_EVENTS)) { - stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'varianceEvents' is missing") - } - - self$.inputType <- "stagewise" - - self$events <- self$.getValidatedFloatingPointNumbers( - self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_EVENTS), - parameterName = "Events" - ) - self$.validateValues(self$events, "events") - - self$expectedEvents <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_EXPECTED_EVENTS) - self$.validateValues(self$expectedEvents, "expectedEvents") - - self$varianceEvents <- self$.getValuesByParameterName(dataFrame, C_KEY_WORDS_VARIANCE_EVENTS) - self$.validateValues(varianceEvents, "varianceEvents") - - self$allocationRatios <- self$.getValuesByParameterName( - dataFrame, - parameterNameVariants = C_KEY_WORDS_ALLOCATION_RATIOS, - defaultValues = self$.getAllocationRatioDefaultValues(self$stages, self$events, self$expectedEvents) - ) - self$.validateValues(self$allocationRatios, "allocationRatios") - } - - self$.setParameterType("groups", C_PARAM_NOT_APPLICABLE) - - if (self$.inputType == "stagewise") { - n <- length(self$events) - self$overallExpectedEvents <- rep(NA_real_, n) - self$overallVarianceEvents <- rep(NA_real_, n) - - self$.setParameterType("events", C_PARAM_USER_DEFINED) - self$.setParameterType("allocationRatios", C_PARAM_USER_DEFINED) - self$.setParameterType("expectedEvents", C_PARAM_USER_DEFINED) - self$.setParameterType("varianceEvents", C_PARAM_USER_DEFINED) - - self$.setParameterType("overallEvents", C_PARAM_GENERATED) - self$.setParameterType("overallAllocationRatios", C_PARAM_GENERATED) - self$.setParameterType("overallExpectedEvents", C_PARAM_GENERATED) - self$.setParameterType("overallVarianceEvents", C_PARAM_GENERATED) - - self$.recreateDataFrame() - self$.createOverallData() - } else { - n <- length(self$overallEvents) - self$expectedEvents <- rep(NA_real_, n) - self$varianceEvents <- rep(NA_real_, n) - - self$.setParameterType("events", C_PARAM_GENERATED) - self$.setParameterType("allocationRatios", C_PARAM_GENERATED) - self$.setParameterType("expectedEvents", C_PARAM_GENERATED) - self$.setParameterType("varianceEvents", C_PARAM_GENERATED) - - self$.setParameterType("overallEvents", C_PARAM_USER_DEFINED) - self$.setParameterType("overallAllocationRatios", C_PARAM_USER_DEFINED) - self$.setParameterType("overallExpectedEvents", C_PARAM_USER_DEFINED) - self$.setParameterType("overallVarianceEvents", C_PARAM_USER_DEFINED) - - self$.recreateDataFrame() - self$.createStageWiseData() - } - }, - .getVisibleFieldNames = function() { - visibleFieldNames <- super$.getVisibleFieldNames() - visibleFieldNames <- visibleFieldNames[!(visibleFieldNames %in% c("logRanks", "overallLogRanks"))] - return(visibleFieldNames) - }, - .setDataToVariables = function() { - super$.setDataToVariables() - self$overallExpectedEvents <- self$.data$overallExpectedEvent - self$overallVarianceEvents <- self$.data$overallVarianceEvent - self$expectedEvents <- self$.data$expectedEvent - }, - getOverallExpectedEvent = function(stage, group = 1, subset = NA_character_) { - return(self$.data$overallExpectedEvent[self$.getIndices(stage = stage, group = group, subset = subset)]) - }, - getOverallExpectedEvents = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(self$.data$overallExpectedEvent[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) - }, - getOverallExpectedEventsUpTo = function(to, group = 1, subset = NA_character_) { - return(self$.data$overallExpectedEvent[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) - }, - getOverallVarianceEvent = function(stage, group = 1, subset = NA_character_) { - return(self$.data$overallVarianceEvent[self$.getIndices(stage = stage, group = group, subset = subset)]) - }, - getOverallVarianceEvents = function(..., stage = NA_integer_, group = NA_integer_, subset = NA_character_) { - return(self$.data$overallVarianceEvent[self$.getIndices(stage = self$.getValidatedStage(stage), group = group, subset = subset)]) - }, - getOverallVarianceEventsUpTo = function(to, group = 1, subset = NA_character_) { - return(self$.data$overallVarianceEvent[self$.getIndices(stage = c(1:to), group = group, subset = subset)]) - } - ) -) - -.isFloatingPointSampleSize <- function(object, param) { - values <- object[[param]] - if (is.null(values)) { - return(FALSE) - } - - values <- na.omit(values) - if (length(values) == 0) { - return(FALSE) - } - - if (any(floor(values) != values)) { - return(TRUE) - } - - return(FALSE) -} - -.getMaxDigits <- function(values) { - values <- na.omit(values) - if (length(values) == 0) { - return(0) - } - - values <- trimws(format(values, scientific = FALSE, digits = 15)) - values <- gsub("^\\d*\\.", "", values) - values <- gsub("\\D", "", values) - max(nchar(values)) -} - - -#' -#' @title -#' Dataset Summary -#' -#' @description -#' Displays a summary of \code{\link{Dataset}} object. -#' -#' @param object A \code{\link{Dataset}} object. -#' @inheritParams param_digits -#' @inheritParams param_three_dots -#' -#' @details -#' Summarizes the parameters and results of a dataset. -#' -#' @template details_summary -#' -#' @template return_object_summary -#' @template how_to_get_help_for_generics -#' -#' @export -#' -#' @keywords internal -#' -summary.DatasetR6 <- function(object, ..., type = 1, digits = NA_integer_) { - .warnInCaseOfUnknownArguments(functionName = "summary", ...) - - if (type == 1 && inherits(object, "SummaryFactoryR6")) { - return(object) - } - - if (type != 1) { - return(summary.ParameterSet(object, type = type, digits = digits, ...)) - } - - intervalFormat <- getOption("rpact.summary.intervalFormat", "[%s; %s]") - .assertIsValidSummaryIntervalFormat(intervalFormat) - - summaryFactory <- SummaryFactoryR6$new(object = object, intervalFormat = intervalFormat) - - s <- object$.toString() - - kMax <- object$getNumberOfStages() - summaryFactory$title <- .firstCharacterToUpperCase(s) - - numberOfGroups <- object$getNumberOfGroups() - - if (numberOfGroups == 1) { - groups <- "one sample" - } else if (numberOfGroups == 2) { - groups <- c("one treatment", "one control group") - if (object$isDatasetSurvival()) { - groups <- paste0(groups, c(" (1)", " (2)")) - } - } else { - groups <- c(paste0( - .integerToWrittenNumber(numberOfGroups - 1), - " treatment groups" - ), "one control group") - if (object$isDatasetSurvival()) { - groups <- paste0(groups, c( - paste0(" (", .arrayToString(1:(numberOfGroups - 1)), ")"), - paste0(" (", numberOfGroups, ")") - )) - } - } - - prefix <- "" - if (object$isDatasetMeans()) { - prefix <- "the sample sizes, means, and standard deviations of " - } else if (object$isDatasetRates()) { - prefix <- "the sample sizes and events of " - } else if (object$isDatasetSurvival()) { - prefix <- "the events and log rank statistics of the comparison of " - } - if (numberOfGroups > 1) { - prefix <- paste0(prefix, "\n") - } - header <- paste0( - "The dataset contains ", prefix, - paste0(groups, collapse = ifelse(object$isDatasetSurvival(), " with ", " and ")) - ) - if (object$.enrichmentEnabled) { - header <- paste0(header, ". The data will be analyzed ", ifelse(object$isStratified(), "", "non-"), "stratified") - } - if (kMax > 1) { - header <- paste0( - header, ".\nThe total number of looks is ", .integerToWrittenNumber(kMax), - "; stage-wise and cumulative data are included" - ) - } - header <- paste0(header, ".") - summaryFactory$header <- header - - digitSettings <- .getSummaryDigits(digits) - digits <- digitSettings$digits - digitsSampleSize <- 0 - digitsGeneral <- digitSettings$digitsGeneral - digitsProbabilities <- digitSettings$digitsProbabilities - - paramsToCheck <- character(0) - if (object$isDatasetMeans() || object$isDatasetRates()) { - paramsToCheck <- c(paramsToCheck, "sampleSizes") - if (kMax > 1) { - paramsToCheck <- c(paramsToCheck, "overallSampleSizes") - } - } else if (object$isDatasetRates() || object$isDatasetSurvival()) { - paramsToCheck <- c(paramsToCheck, "events") - if (kMax > 1) { - paramsToCheck <- c(paramsToCheck, "overallEvents") - } - } - if (length(paramsToCheck) > 0) { - for (param in paramsToCheck) { - if (.isFloatingPointSampleSize(object, param)) { - digitsSampleSize <- max(digitsSampleSize, .getMaxDigits(object[[param]])) - } - } - digitsSampleSize <- min(digitsSampleSize, digits) - } - - summaryFactory$addItem("Stage", object$stages) - - if (numberOfGroups > 1) { - groupNumbers <- object$groups - if (object$isDatasetSurvival()) { - groupNumbers <- paste0(object$groups, " vs ", numberOfGroups) - summaryFactory$addItem("Comparison", groupNumbers) - } else { - summaryFactory$addItem("Group", groupNumbers) - } - } - - if (object$.enrichmentEnabled) { - summaryFactory$addItem("Subset", object$subsets) - } - - parameterCaptionPrefix <- ifelse(kMax == 1, "", "Stage-wise ") - - if (object$isDatasetMeans() || object$isDatasetRates()) { - summaryFactory$addParameter(object, - parameterName = "sampleSizes", - parameterCaption = .firstCharacterToUpperCase(parameterCaptionPrefix, "sample size"), - roundDigits = digitsSampleSize - ) - if (kMax > 1) { - summaryFactory$addParameter(object, - parameterName = "overallSampleSizes", - parameterCaption = "Cumulative sample size", roundDigits = digitsSampleSize - ) - } - } - - if (object$isDatasetMeans()) { - summaryFactory$addParameter(object, - parameterName = "means", - parameterCaption = .firstCharacterToUpperCase(parameterCaptionPrefix, "mean"), - roundDigits = digitsGeneral - ) - if (kMax > 1) { - summaryFactory$addParameter(object, - parameterName = "overallMeans", - parameterCaption = "Cumulative mean", roundDigits = digitsGeneral - ) - } - summaryFactory$addParameter(object, - parameterName = "stDevs", - parameterCaption = .firstCharacterToUpperCase(parameterCaptionPrefix, "standard deviation"), - roundDigits = digitsGeneral - ) - if (kMax > 1) { - summaryFactory$addParameter(object, - parameterName = "overallStDevs", - parameterCaption = "Cumulative standard deviation", roundDigits = digitsGeneral - ) - } - } else if (object$isDatasetRates()) { - summaryFactory$addParameter(object, - parameterName = "events", - parameterCaption = .firstCharacterToUpperCase(parameterCaptionPrefix, "number of events"), - roundDigits = digitsSampleSize - ) - if (kMax > 1) { - summaryFactory$addParameter(object, - parameterName = "overallEvents", - parameterCaption = "Cumulative number of events", roundDigits = digitsSampleSize - ) - } - } else if (object$isDatasetSurvival()) { - summaryFactory$addParameter(object, - parameterName = "events", - parameterCaption = .firstCharacterToUpperCase(parameterCaptionPrefix, "number of events"), - roundDigits = digitsSampleSize - ) - if (kMax > 1) { - summaryFactory$addParameter(object, - parameterName = "overallEvents", - parameterCaption = "Cumulative number of events", roundDigits = digitsSampleSize - ) - } - summaryFactory$addParameter(object, - parameterName = "logRanks", - parameterCaption = .firstCharacterToUpperCase(parameterCaptionPrefix, "log rank statistic"), - roundDigits = digitsGeneral - ) - if (kMax > 1) { - summaryFactory$addParameter(object, - parameterName = "overallLogRanks", - parameterCaption = "Cumulative log rank statistic", roundDigits = digitsGeneral - ) - } - if (!any(is.na(object$allocationRatios)) && any(object$allocationRatios != 1)) { - summaryFactory$addParameter(object, - parameterName = "allocationRatios", - parameterCaption = .firstCharacterToUpperCase(parameterCaptionPrefix, "allocation ratio"), - roundDigits = digitsGeneral - ) - if (kMax > 1) { - summaryFactory$addParameter(object, - parameterName = "overallAllocationRatios", - parameterCaption = "Cumulative allocation ratio", roundDigits = digitsGeneral - ) - } - } - } - - return(summaryFactory) -} - -.getDatasetArgumentsRCodeLines <- function(x, complete = FALSE, digits = 4) { - m <- getWideFormat(x) - lines <- character(0) - paramNames <- colnames(m) - if (!complete) { - if (x$.inputType == "stagewise") { - paramNames <- paramNames[!grepl("^overall", paramNames)] - } else { - paramNames <- paramNames[grepl("^(stage|group|subset|overall)", paramNames)] - } - } - - for (paramName in paramNames) { - encapsulate <- grepl("^subset", paramName) - if (!encapsulate || isTRUE(x$.enrichmentEnabled)) { - values <- m[[paramName]] - if (!encapsulate && is.numeric(values) && !is.null(digits) && length(digits) == 1 && !is.na(digits)) { - values <- round(values, digits = digits) - } - lines <- c(lines, paste0(paramName, " = ", .arrayToString(values, - vectorLookAndFeelEnabled = TRUE, encapsulate = encapsulate, digits = NA_integer_ - ))) - } - } - - return(lines) -} - -#' -#' @title -#' Print Dataset Values -#' -#' @description -#' \code{print} prints its \code{\link{Dataset}} argument and returns it invisibly (via \code{invisible(x)}). -#' -#' @param x A \code{\link{Dataset}} object. -#' @param markdown If \code{TRUE}, the output will be created in Markdown. -#' @param output A character defining the output type, default is "list". -#' @inheritParams param_three_dots -#' -#' @details -#' Prints the dataset. -#' -#' @export -#' -#' @keywords internal -#' -print.DatasetR6 <- function(x, ..., markdown = FALSE, output = c("list", "long", "wide", "r", "rComplete")) { - fCall <- match.call(expand.dots = FALSE) - datasetName <- deparse(fCall$x) - - output <- match.arg(output) - - if (markdown) { - if (output != "list") { - warning("'output' (\"", output, "\") will be ignored ", - "because only \"list\" is supported yet if markdown is enabled", - call. = FALSE - ) - } - - x$.catMarkdownText() - return(invisible(x)) - } - - if (output == "long") { - m <- getLongFormat(x) - m <- prmatrix(m, rowlab = rep("", nrow(m))) - print(m, quote = FALSE, right = FALSE) - return(invisible(x)) - } else if (output == "wide") { - m <- getWideFormat(x) - m <- prmatrix(m, rowlab = rep("", nrow(m))) - print(m, quote = FALSE, right = FALSE) - return(invisible(x)) - } else if (output %in% c("r", "rComplete")) { - lines <- .getDatasetArgumentsRCodeLines(x, complete = (output == "rComplete")) - lines <- paste0("\t", lines) - - if (is.null(datasetName) || length(datasetName) != 1 || is.na(datasetName)) { - datasetName <- "dataInput" - } - - cat(datasetName, " <- getDataset(\n", sep = "") - cat(paste0(lines, collapse = ",\n"), "\n") - cat(")\n") - return(invisible(x)) - } - - x$show() - return(invisible(x)) -} diff --git a/R/class_analysis_results.R b/R/class_analysis_results.R index ee651680..244d5c1e 100644 --- a/R/class_analysis_results.R +++ b/R/class_analysis_results.R @@ -1,3 +1,4 @@ +library("R6") ## | ## | *Analysis result classes* ## | @@ -13,8 +14,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7126 $ -## | Last changed: $Date: 2023-06-23 14:26:39 +0200 (Fr, 23 Jun 2023) $ +## | File version: $Revision: 6909 $ +## | Last changed: $Date: 2023-03-31 14:33:51 +0200 (Fr, 31 Mrz 2023) $ ## | Last changed by: $Author: pahlke $ ## | @@ -26,8 +27,8 @@ #' #' @description #' Class for conditional power calculations -#' -#' @template field_nPlanned +#' +#' @template field_nPlanned #' @template field_allocationRatioPlanned #' @template field_iterations #' @template field_seed @@ -44,82 +45,89 @@ #' #' @importFrom methods new #' -ConditionalPowerResults <- setRefClass("ConditionalPowerResults", - contains = "ParameterSet", - fields = list( - .plotSettings = "ANY", - .design = "TrialDesign", - .stageResults = "StageResults", - .plotData = "list", - nPlanned = "numeric", - allocationRatioPlanned = "numeric", - iterations = "integer", - seed = "numeric", - simulated = "logical" - ), - methods = list( - initialize = function(...) { - callSuper(...) - - .plotSettings <<- PlotSettingsR6$new() - .parameterNames <<- C_PARAMETER_NAMES - .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS - - if (!is.null(.stageResults) && is.null(.design)) { - .design <<- .stageResults$.design - } - - if (is.null(simulated) || length(simulated) == 0 || is.na(simulated)) { - .self$simulated <<- FALSE - } - - if (!is.null(.design) && length(.design$kMax) == 1 && .design$kMax == 1L) { - .setParameterType("nPlanned", C_PARAM_NOT_APPLICABLE) - .setParameterType("allocationRatioPlanned", C_PARAM_NOT_APPLICABLE) - .setParameterType("conditionalPower", C_PARAM_NOT_APPLICABLE) - } else { - .setParameterType("nPlanned", C_PARAM_GENERATED) - .setParameterType("allocationRatioPlanned", C_PARAM_USER_DEFINED) - .setParameterType("conditionalPower", C_PARAM_GENERATED) - } - .setParameterType("simulated", C_PARAM_NOT_APPLICABLE) - }, - show = function(showType = 1, digits = NA_integer_) { - .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) - }, - .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { - "Method for automatically printing conditional power result objects" - .resetCat() - if (showType == 2) { - callSuper(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) - } else { - if (!is.null(.design) && length(.design$kMax) == 1 && .design$kMax == 1) { - .cat(.toString(), ": not applicable for fixed design (kMax = 1)\n", - heading = 1, - consoleOutputEnabled = consoleOutputEnabled - ) - } else { - .cat(.toString(), ":\n\n", - heading = 1, - consoleOutputEnabled = consoleOutputEnabled - ) - } - .showParametersOfOneGroup(.getUserDefinedParameters(), "User defined parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - .showParametersOfOneGroup(.getDefaultParameters(), "Default parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - .showParametersOfOneGroup(.getGeneratedParameters(), "Output", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - .showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - } - }, - .toString = function(startWithUpperCase = FALSE) { - return("Conditional power results") - } - ) +ConditionalPowerResultsR6 <- R6Class("ConditionalPowerResultsR6", + inherit = ParameterSetR6, + public = list( + .plotSettings = NULL, + .design = NULL, + .stageResults = NULL, + .plotData = NULL, + nPlanned = NULL, + allocationRatioPlanned = NULL, + iterations = NULL, + seed = NULL, + simulated = NULL, + initialize = function(..., .design = NULL, .stageResults = NULL, .plotData = NULL, nPlanned = NULL, allocationRatioPlanned = NULL, iterations = NULL, seed = NULL, simulated = NULL) { + self$.design <- .design + self$.stageResults <- .stageResults + self$.plotData <- .plotData + self$nPlanned <- nPlanned + self$allocationRatioPlanned <- allocationRatioPlanned + self$iterations <- iterations + self$seed <- seed + self$simulated <- simulated + + super$initialize(...) + + self$.plotSettings <- PlotSettingsR6$new() + self$.parameterNames <- C_PARAMETER_NAMES + self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS + + if (!is.null(self$.stageResults) && is.null(self$.design)) { + self$.design <- self$.stageResults$.design + } + + if (is.null(self$simulated) || length(self$simulated) == 0 || is.na(self$simulated)) { + self$simulated <- FALSE + } + + if (!is.null(self$.design) && length(self$.design$kMax) == 1 && self$.design$kMax == 1L) { + self$.setParameterType("nPlanned", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("allocationRatioPlanned", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("conditionalPower", C_PARAM_NOT_APPLICABLE) + } else { + self$.setParameterType("nPlanned", C_PARAM_GENERATED) + self$.setParameterType("allocationRatioPlanned", C_PARAM_USER_DEFINED) + self$.setParameterType("conditionalPower", C_PARAM_GENERATED) + } + self$.setParameterType("simulated", C_PARAM_NOT_APPLICABLE) + }, + show = function(showType = 1, digits = NA_integer_) { + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + }, + .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { + "Method for automatically printing conditional power result objects" + self$.resetCat() + if (showType == 2) { + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + } else { + if (!is.null(self$.design) && length(self$.design$kMax) == 1 && self$.design$kMax == 1) { + self$.cat(self$.toString(), ": not applicable for fixed design (kMax = 1)\n", + heading = 1, + consoleOutputEnabled = consoleOutputEnabled + ) + } else { + self$.cat(self$.toString(), ":\n\n", + heading = 1, + consoleOutputEnabled = consoleOutputEnabled + ) + } + self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Output", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + } + }, + .toString = function(startWithUpperCase = FALSE) { + return("Conditional power results") + } + ) ) #' @@ -127,11 +135,11 @@ ConditionalPowerResults <- setRefClass("ConditionalPowerResults", #' #' @title #' Conditional Power Results Means -#' +#' #' @description #' Class for conditional power calculations of means data -#' -#' @template field_nPlanned +#' +#' @template field_nPlanned #' @template field_allocationRatioPlanned #' @template field_iterations #' @template field_seed @@ -148,110 +156,111 @@ ConditionalPowerResults <- setRefClass("ConditionalPowerResults", #' #' @importFrom methods new #' -ConditionalPowerResultsMeans <- setRefClass("ConditionalPowerResultsMeans", - contains = "ConditionalPowerResults", - fields = list( - conditionalPower = "numeric", - thetaH1 = "numeric", - assumedStDev = "numeric" - ), - methods = list( - initialize = function(...) { - callSuper(...) - - if ((is.null(conditionalPower) || length(conditionalPower) == 0) && - !is.null(.design) && !is.null(.design$kMax) && length(.design$kMax) > 0) { - conditionalPower <<- rep(NA_real_, .design$kMax) - } - - if (is.null(thetaH1) || length(thetaH1) == 0 || all(is.na(thetaH1))) { - thetaH1 <<- NA_real_ - } - if (is.null(assumedStDev) || length(assumedStDev) == 0 || all(is.na(assumedStDev))) { - assumedStDev <<- NA_real_ - } - }, - .toString = function(startWithUpperCase = FALSE) { - return("Conditional power results means") - } - ) +ConditionalPowerResultsMeansR6 <- R6Class("ConditionalPowerResultsMeansR6", + inherit = ConditionalPowerResultsR6, + public = list( + conditionalPower = NULL, + thetaH1 = NULL, + assumedStDev = NULL, + initialize = function(..., conditionalPower = NULL, thetaH1 = NULL, assumedStDev = NULL) { + self$conditionalPower<- conditionalPower + self$thetaH1<- thetaH1 + self$assumedStDev<- assumedStDev + + super$initialize(...) + + if ((is.null(self$conditionalPower) || length(self$conditionalPower) == 0) && + !is.null(self$.design) && !is.null(self$.design$kMax) && length(self$.design$kMax) > 0) { + self$conditionalPower <- rep(NA_real_, self$.design$kMax) + } + + if (is.null(self$thetaH1) || length(self$thetaH1) == 0 || all(is.na(self$thetaH1))) { + self$thetaH1 <- NA_real_ + } + if (is.null(self$assumedStDev) || length(self$assumedStDev) == 0 || all(is.na(self$assumedStDev))) { + self$assumedStDev <- NA_real_ + } + }, + .toString = function(startWithUpperCase = FALSE) { + return("Conditional power results means") + } + ) ) -ConditionalPowerResultsMultiHypotheses <- setRefClass("ConditionalPowerResultsMultiHypotheses", - contains = "ConditionalPowerResults", - fields = list( - conditionalPower = "matrix" - ), - methods = list( - initialize = function(...) { - callSuper(...) - - if (.readyForInitialization()) { - gMax <- getGMax() - kMax <- .design$kMax - if (is.null(conditionalPower) || (nrow(conditionalPower) == 0 && ncol(conditionalPower) == 0)) { - conditionalPower <<- matrix(rep(NA_real_, gMax * kMax), nrow = gMax, ncol = kMax) - } - } - }, - .toString = function(startWithUpperCase = FALSE) { - s <- "Conditional power results" - s <- paste0(s, " ", ifelse(grepl("Enrichment", .getClassName(.stageResults)), "enrichment", "multi-arm")) - if (grepl("Means", .getClassName(.self))) { - s <- paste0(s, " means") - } else if (grepl("Rates", .getClassName(.self))) { - s <- paste0(s, " rates") - } else if (grepl("Survival", .getClassName(.self))) { - s <- paste0(s, " survival") - } - return(s) - }, - getGMax = function() { - return(.stageResults$getGMax()) - }, - .readyForInitialization = function() { - if (is.null(.design)) { - return(FALSE) - } - - if (length(.design$kMax) != 1) { - return(FALSE) - } - - if (is.null(.stageResults)) { - return(FALSE) - } - - if (is.null(.stageResults$testStatistics)) { - return(FALSE) - } - - return(TRUE) - } - ) +ConditionalPowerResultsMultiHypothesesR6 <- R6Class("ConditionalPowerResultsMultiHypothesesR6", + inherit = ConditionalPowerResultsR6, + public = list( + conditionalPower = NULL, + initialize = function(..., conditionalPower = NULL) { + self$conditionalPower <- conditionalPower + super$initialize(...) + + if (self$.readyForInitialization()) { + gMax <- self$getGMax() + kMax <- self$.design$kMax + if (is.null(self$conditionalPower) || (nrow(self$conditionalPower) == 0 && ncol(self$conditionalPower) == 0)) { + self$conditionalPower <- matrix(rep(NA_real_, gMax * kMax), nrow = gMax, ncol = kMax) + } + } + }, + .toString = function(startWithUpperCase = FALSE) { + s <- "Conditional power results" + s <- paste0(s, " ", ifelse(grepl("Enrichment", .getClassName(self$.stageResults)), "enrichment", "multi-arm")) + if (grepl("Means", .getClassName(self))) { + s <- paste0(s, " means") + } else if (grepl("Rates", .getClassName(self))) { + s <- paste0(s, " rates") + } else if (grepl("Survival", .getClassName(self))) { + s <- paste0(s, " survival") + } + return(s) + }, + getGMax = function() { + return(self$.stageResults$getGMax()) + }, + .readyForInitialization = function() { + if (is.null(self$.design)) { + return(FALSE) + } + + if (length(self$.design$kMax) != 1) { + return(FALSE) + } + + if (is.null(self$.stageResults)) { + return(FALSE) + } + + if (is.null(self$.stageResults$testStatistics)) { + return(FALSE) + } + + return(TRUE) + } + ) ) -ConditionalPowerResultsMultiArmMeans <- setRefClass("ConditionalPowerResultsMultiArmMeans", - contains = "ConditionalPowerResultsMultiHypotheses", - fields = list( - thetaH1 = "numeric", - assumedStDevs = "numeric" - ), - methods = list( - initialize = function(...) { - callSuper(...) - - if (.readyForInitialization()) { - gMax <- getGMax() - if (is.null(thetaH1) || length(thetaH1) == 0 || all(is.na(thetaH1))) { - thetaH1 <<- rep(NA_real_, gMax) - } - if (is.null(assumedStDevs) || length(assumedStDevs) == 0 || all(is.na(assumedStDevs))) { - assumedStDevs <<- rep(NA_real_, gMax) - } - } - } - ) +ConditionalPowerResultsMultiArmMeansR6 <- R6Class("ConditionalPowerResultsMultiArmMeansR6", + inherit = ConditionalPowerResultsMultiHypothesesR6, + public = list( + thetaH1 = NULL, + assumedStDevs = NULL, + initialize = function(..., thetaH1 = NULL, assumedStDevs = NULL) { + self$thetaH1 <- thetaH1 + self$assumedStDevs <- assumedStDevs + super$initialize(...) + + if (self$.readyForInitialization()) { + gMax <- self$getGMax() + if (is.null(self$thetaH1) || length(self$thetaH1) == 0 || all(is.na(self$thetaH1))) { + self$thetaH1 <- rep(NA_real_, gMax) + } + if (is.null(self$assumedStDevs) || length(self$assumedStDevs) == 0 || all(is.na(self$assumedStDevs))) { + self$assumedStDevs <- rep(NA_real_, gMax) + } + } + } + ) ) #' @@ -259,11 +268,11 @@ ConditionalPowerResultsMultiArmMeans <- setRefClass("ConditionalPowerResultsMult #' #' @title #' Conditional Power Results Rates -#' +#' #' @description #' Class for conditional power calculations of rates data -#' -#' @template field_nPlanned +#' +#' @template field_nPlanned #' @template field_allocationRatioPlanned #' @template field_iterations #' @template field_seed @@ -280,56 +289,60 @@ ConditionalPowerResultsMultiArmMeans <- setRefClass("ConditionalPowerResultsMult #' #' @importFrom methods new #' -ConditionalPowerResultsRates <- setRefClass("ConditionalPowerResultsRates", - contains = "ConditionalPowerResults", - fields = list( - conditionalPower = "numeric", - pi1 = "numeric", - pi2 = "numeric" - ), - methods = list( - initialize = function(...) { - callSuper(...) - - if ((is.null(conditionalPower) || length(conditionalPower) == 0) && - !is.null(.design) && !is.null(.design$kMax) && length(.design$kMax) > 0) { - conditionalPower <<- rep(NA_real_, .design$kMax) - } - - if (is.null(pi1) || length(pi1) == 0 || all(is.na(pi1))) { - pi1 <<- NA_real_ - } - if (is.null(pi2) || length(pi2) == 0 || all(is.na(pi2))) { - pi2 <<- NA_real_ - } - }, - .toString = function(startWithUpperCase = FALSE) { - return("Conditional power results rates") - } - ) +ConditionalPowerResultsRatesR6 <- R6Class("ConditionalPowerResultsRatesR6", + inherit = ConditionalPowerResultsR6, + public = list( + conditionalPower = NULL, + pi1 = NULL, + pi2 = NULL, + initialize = function(..., conditionalPower = NULL, + pi1 = NULL, + pi2 = NULL) { + self$conditionalPower <- conditionalPower + self$pi1 <- pi1 + self$pi2 <- pi2 + + super$initialize(...) + + if ((is.null(self$conditionalPower) || length(self$conditionalPower) == 0) && + !is.null(self$.design) && !is.null(self$.design$kMax) && length(self$.design$kMax) > 0) { + self$conditionalPower <- rep(NA_real_, self$.design$kMax) + } + + if (is.null(self$pi1) || length(self$pi1) == 0 || all(is.na(self$pi1))) { + self$pi1 <- NA_real_ + } + if (is.null(self$pi2) || length(self$pi2) == 0 || all(is.na(self$pi2))) { + self$pi2 <- NA_real_ + } + }, + .toString = function(startWithUpperCase = FALSE) { + return("Conditional power results rates") + } + ) ) -ConditionalPowerResultsMultiArmRates <- setRefClass("ConditionalPowerResultsMultiArmRates", - contains = "ConditionalPowerResultsMultiHypotheses", - fields = list( - piTreatments = "numeric", - piControl = "numeric" - ), - methods = list( - initialize = function(...) { - callSuper(...) - - if (.readyForInitialization()) { - gMax <- getGMax() - if (is.null(piControl) || length(piControl) == 0 || all(is.na(piControl))) { - piControl <<- NA_real_ - } - if (is.null(piTreatments) || length(piTreatments) == 0 || all(is.na(piTreatments))) { - piTreatments <<- rep(NA_real_, gMax) - } - } - } - ) +ConditionalPowerResultsMultiArmRatesR6 <- R6Class("ConditionalPowerResultsMultiArmRatesR6", + inherit = ConditionalPowerResultsMultiHypothesesR6, + public = list( + piTreatments = NULL, + piControl = NULL, + initialize = function(..., piTreatments = NULL, piControl = NULL) { + self$piTreatments <- piTreatments + self$piControl <- piControl + super$initialize(...) + + if (self$.readyForInitialization()) { + gMax <- self$getGMax() + if (is.null(self$piControl) || length(self$piControl) == 0 || all(is.na(self$piControl))) { + self$piControl <- NA_real_ + } + if (is.null(self$piTreatments) || length(self$piTreatments) == 0 || all(is.na(self$piTreatments))) { + self$piTreatments <- rep(NA_real_, gMax) + } + } + } + ) ) #' @@ -337,11 +350,11 @@ ConditionalPowerResultsMultiArmRates <- setRefClass("ConditionalPowerResultsMult #' #' @title #' Conditional Power Results Survival -#' +#' #' @description #' Class for conditional power calculations of survival data -#' -#' @template field_nPlanned +#' +#' @template field_nPlanned #' @template field_allocationRatioPlanned #' @template field_iterations #' @template field_seed @@ -357,48 +370,47 @@ ConditionalPowerResultsMultiArmRates <- setRefClass("ConditionalPowerResultsMult #' #' @importFrom methods new #' -ConditionalPowerResultsSurvival <- setRefClass("ConditionalPowerResultsSurvival", - contains = "ConditionalPowerResults", - fields = list( - conditionalPower = "numeric", - thetaH1 = "numeric" - ), - methods = list( - initialize = function(...) { - callSuper(...) - - if ((is.null(conditionalPower) || length(conditionalPower) == 0) && - !is.null(.design) && !is.null(.design$kMax) && length(.design$kMax) > 0) { - conditionalPower <<- rep(NA_real_, .design$kMax) - } - - if (is.null(thetaH1) || length(thetaH1) == 0 || all(is.na(thetaH1))) { - thetaH1 <<- NA_real_ - } - }, - .toString = function(startWithUpperCase = FALSE) { - return("Conditional power results survival") - } - ) +ConditionalPowerResultsSurvivalR6 <- R6Class("ConditionalPowerResultsSurvivalR6", + inherit = ConditionalPowerResultsR6, + public = list( + conditionalPower = NULL, + thetaH1 = NULL, + initialize = function(..., conditionalPower = NULL, thetaH1 = NULL) { + self$conditionalPower <- conditionalPower + self$thetaH1 <- thetaH1 + super$initialize(...) + + if ((is.null(self$conditionalPower) || length(self$conditionalPower) == 0) && + !is.null(self$.design) && !is.null(self$.design$kMax) && length(self$.design$kMax) > 0) { + self$conditionalPower <- rep(NA_real_, self$.design$kMax) + } + + if (is.null(self$thetaH1) || length(self$thetaH1) == 0 || all(is.na(self$thetaH1))) { + self$thetaH1 <- NA_real_ + } + }, + .toString = function(startWithUpperCase = FALSE) { + return("Conditional power results survival") + } + ) ) -ConditionalPowerResultsMultiArmSurvival <- setRefClass("ConditionalPowerResultsMultiArmSurvival", - contains = "ConditionalPowerResultsMultiHypotheses", - fields = list( - thetaH1 = "numeric" - ), - methods = list( - initialize = function(...) { - callSuper(...) - - if (.readyForInitialization()) { - gMax <- getGMax() - if (is.null(thetaH1) || length(thetaH1) == 0 || all(is.na(thetaH1))) { - thetaH1 <<- rep(NA_real_, gMax) - } - } - } - ) +ConditionalPowerResultsMultiArmSurvivalR6 <- R6Class("ConditionalPowerResultsMultiArmSurvivalR6", + inherit = ConditionalPowerResultsMultiHypothesesR6, + public = list( + thetaH1 = NULL, + initialize = function(..., thetaH1 = NULL) { + self$thetaH1 <- thetaH1 + super$initialize(...) + + if (self$.readyForInitialization()) { + gMax <- self$getGMax() + if (is.null(self$thetaH1) || length(self$thetaH1) == 0 || all(is.na(self$thetaH1))) { + self$thetaH1 <- rep(NA_real_, gMax) + } + } + } + ) ) #' @@ -406,11 +418,11 @@ ConditionalPowerResultsMultiArmSurvival <- setRefClass("ConditionalPowerResultsM #' #' @title #' Conditional Power Results Enrichment Means -#' +#' #' @description #' Class for conditional power calculations of enrichment means data -#' -#' @template field_nPlanned +#' +#' @template field_nPlanned #' @template field_allocationRatioPlanned #' @template field_iterations #' @template field_seed @@ -427,8 +439,8 @@ ConditionalPowerResultsMultiArmSurvival <- setRefClass("ConditionalPowerResultsM #' #' @importFrom methods new #' -ConditionalPowerResultsEnrichmentMeans <- setRefClass("ConditionalPowerResultsEnrichmentMeans", - contains = "ConditionalPowerResultsMultiArmMeans" +ConditionalPowerResultsEnrichmentMeansR6 <- R6Class("ConditionalPowerResultsEnrichmentMeansR6", + inherit = ConditionalPowerResultsMultiArmMeansR6 ) #' @@ -436,11 +448,11 @@ ConditionalPowerResultsEnrichmentMeans <- setRefClass("ConditionalPowerResultsEn #' #' @title #' Conditional Power Results Enrichment Rates -#' +#' #' @description #' Class for conditional power calculations of enrichment rates data -#' -#' @template field_nPlanned +#' +#' @template field_nPlanned #' @template field_allocationRatioPlanned #' @template field_iterations #' @template field_seed @@ -457,32 +469,32 @@ ConditionalPowerResultsEnrichmentMeans <- setRefClass("ConditionalPowerResultsEn #' #' @importFrom methods new #' -ConditionalPowerResultsEnrichmentRates <- setRefClass("ConditionalPowerResultsEnrichmentRates", - contains = "ConditionalPowerResultsMultiHypotheses", - fields = list( - piTreatments = "numeric", - piControls = "numeric" - ), - methods = list( - initialize = function(...) { - callSuper(...) - - if (.readyForInitialization()) { - gMax <- getGMax() - if (is.null(piControls) || length(piControls) == 0 || all(is.na(piControls))) { - piControls <<- rep(NA_real_, gMax) - } - if (is.null(piTreatments) || length(piTreatments) == 0 || all(is.na(piTreatments))) { - piTreatments <<- rep(NA_real_, gMax) - } - } - } - ) +ConditionalPowerResultsEnrichmentRatesR6 <- R6Class("ConditionalPowerResultsEnrichmentRatesR6", + inherit = ConditionalPowerResultsMultiHypothesesR6, + public = list( + piTreatments = NULL, + piControls = NULL, + initialize = function(..., piTreatments = NULL, piControls = NULL) { + self$piTreatments <- piTreatments + self$piControls <- piControls + super$initialize(...) + + if (self$.readyForInitialization()) { + gMax <- self$getGMax() + if (is.null(self$piControls) || length(self$piControls) == 0 || all(is.na(self$piControls))) { + self$piControls <- rep(NA_real_, gMax) + } + if (is.null(self$piTreatments) || length(self$piTreatments) == 0 || all(is.na(self$piTreatments))) { + self$piTreatments <- rep(NA_real_, gMax) + } + } + } + ) ) -ConditionalPowerResultsEnrichmentSurvival <- setRefClass("ConditionalPowerResultsEnrichmentSurvival", - contains = "ConditionalPowerResultsMultiArmSurvival" +ConditionalPowerResultsEnrichmentSurvivalR6 <- R6Class("ConditionalPowerResultsEnrichmentSurvivalR6", + inherit = ConditionalPowerResultsMultiArmSurvivalR6 ) #' @@ -503,7 +515,7 @@ ConditionalPowerResultsEnrichmentSurvival <- setRefClass("ConditionalPowerResult #' @template field_secondStagePValues #' @template field_rejected #' @template field_rejectedIntersections -#' +#' #' @details #' This object cannot be created directly; use \code{\link{getAnalysisResults}} #' with suitable arguments to create the multi-arm analysis results of a closed combination test design. @@ -512,152 +524,172 @@ ConditionalPowerResultsEnrichmentSurvival <- setRefClass("ConditionalPowerResult #' #' @importFrom methods new #' -ClosedCombinationTestResults <- setRefClass("ClosedCombinationTestResults", - contains = "ParameterSet", - fields = list( - .plotSettings = "ANY", - .design = "TrialDesign", - .enrichment = "logical", - intersectionTest = "character", - indices = "matrix", - adjustedStageWisePValues = "matrix", - overallAdjustedTestStatistics = "matrix", - separatePValues = "matrix", - conditionalErrorRate = "matrix", - secondStagePValues = "matrix", - rejected = "matrix", - rejectedIntersections = "matrix" - ), - methods = list( - initialize = function(...) { - callSuper(...) - - .plotSettings <<- PlotSettingsR6$new() - .parameterNames <<- C_PARAMETER_NAMES - .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS - - .setParameterType("intersectionTest", C_PARAM_USER_DEFINED) - - parametersGenerated <- c( - "indices", - "separatePValues", - "rejected", - "rejectedIntersections" - ) - if (inherits(.design, "TrialDesignConditionalDunnett")) { - parametersGenerated <- c( - parametersGenerated, - "conditionalErrorRate", - "secondStagePValues" - ) - } else { - parametersGenerated <- c( - parametersGenerated, - "adjustedStageWisePValues", - "overallAdjustedTestStatistics" - ) - } - for (param in parametersGenerated) { - .setParameterType(param, C_PARAM_GENERATED) - } - - if (!is.null(.design) && inherits(.design, C_CLASS_NAME_TRIAL_DESIGN_FISHER)) { - .parameterFormatFunctions$overallAdjustedTestStatistics <<- ".formatTestStatisticsFisher" - } - }, - show = function(showType = 1, digits = NA_integer_) { - .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) - }, - .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { - "Method for automatically printing closed combination test result objects" - .resetCat() - if (showType == 2) { - callSuper(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) - } else { - .cat(.toString(), ":\n\n", - heading = 1, - consoleOutputEnabled = consoleOutputEnabled - ) - - .showParametersOfOneGroup(.getUserDefinedParameters(), "User defined parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - - designParametersToShow <- c( - ".design$stages", - ".design$alpha" - ) - if (inherits(.design, "TrialDesignConditionalDunnett")) { - designParametersToShow <- c( - designParametersToShow, - ".design$informationAtInterim", - ".design$secondStageConditioning" - ) - } - .showParametersOfOneGroup(designParametersToShow, "Design parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - - .showParametersOfOneGroup(.getGeneratedParameters(), "Output", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - - .showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - - .cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) - if (isTRUE(.enrichment)) { - .cat(paste0(" S[i]: population i\n"), consoleOutputEnabled = consoleOutputEnabled) - .cat(paste0(" F: full population\n"), consoleOutputEnabled = consoleOutputEnabled) - } else { - .cat(paste0( - " (i): results of treatment arm i vs. control group ", - (nrow(separatePValues) + 1), "\n" - ), consoleOutputEnabled = consoleOutputEnabled) - .cat(" [i]: hypothesis number\n", - consoleOutputEnabled = consoleOutputEnabled - ) - } - } - }, - .toString = function(startWithUpperCase = FALSE) { - s <- "Closed combination test results" - if (inherits(.design, "TrialDesignConditionalDunnett")) { - s <- paste0(s, " (Conditional Dunnett)") - } - return(s) - }, - .getHypothesisTreatmentArms = function(number) { - result <- c() - for (i in 1:ncol(indices)) { - if (indices[number, i] == 1) { - result <- c(result, i) - } - } - return(result) - }, - .getHypothesisTreatmentArmVariants = function() { - result <- c() - for (number in 1:nrow(indices)) { - arms <- .getHypothesisTreatmentArms(number) - result <- c(result, paste0(arms, collapse = ", ")) - } - return(result) - }, - .getHypothesisPopulationVariants = function() { - result <- c() - gMax <- 1 - for (number in 1:nrow(indices)) { - arms <- .getHypothesisTreatmentArms(number) - if (number == 1) { - gMax <- length(arms) - } - arms <- paste0("S", arms) - arms[arms == paste0("S", gMax)] <- "F" - result <- c(result, paste0(arms, collapse = ", ")) - } - return(result) - } - ) +ClosedCombinationTestResultsR6 <- R6Class("ClosedCombinationTestResultsR6", + inherit = ParameterSetR6, + public = list( + .plotSettings = NULL, + .design = NULL, + .enrichment = NULL, + intersectionTest = NULL, + indices = NULL, + adjustedStageWisePValues = NULL, + overallAdjustedTestStatistics = NULL, + separatePValues = NULL, + conditionalErrorRate = NULL, + secondStagePValues = NULL, + rejected = NULL, + rejectedIntersections = NULL, + initialize = function(..., .design = NULL, + .enrichment = NULL, + intersectionTest = NULL, + indices = NULL, + adjustedStageWisePValues = NULL, + overallAdjustedTestStatistics = NULL, + separatePValues = NULL, + conditionalErrorRate = NULL, + secondStagePValues = NULL, + rejected = NULL, + rejectedIntersections = NULL) { + self$.design <- .design + self$.enrichment <- .enrichment + self$intersectionTest <- intersectionTest + self$indices <- indices + self$adjustedStageWisePValues <- adjustedStageWisePValues + self$overallAdjustedTestStatistics <- overallAdjustedTestStatistics + self$separatePValues <- separatePValues + self$conditionalErrorRate <- conditionalErrorRate + self$secondStagePValues <- secondStagePValues + self$rejected <- rejected + self$rejectedIntersections <- rejectedIntersections + + super$initialize(...) + + self$.plotSettings <- PlotSettingsR6$new() + self$.parameterNames <- C_PARAMETER_NAMES + self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS + + self$.setParameterType("intersectionTest", C_PARAM_USER_DEFINED) + + parametersGenerated <- c( + "indices", + "separatePValues", + "rejected", + "rejectedIntersections" + ) + if (inherits(self$.design, "TrialDesignConditionalDunnett")) { + parametersGenerated <- c( + parametersGenerated, + "conditionalErrorRate", + "secondStagePValues" + ) + } else { + parametersGenerated <- c( + parametersGenerated, + "adjustedStageWisePValues", + "overallAdjustedTestStatistics" + ) + } + for (param in parametersGenerated) { + self$.setParameterType(param, C_PARAM_GENERATED) + } + + if (!is.null(self$.design) && inherits(self$.design, C_CLASS_NAME_TRIAL_DESIGN_FISHER)) { + self$.parameterFormatFunctions$overallAdjustedTestStatistics <- ".formatTestStatisticsFisher" + } + }, + show = function(showType = 1, digits = NA_integer_) { + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + }, + .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { + "Method for automatically printing closed combination test result objects" + self$.resetCat() + if (showType == 2) { + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + } else { + self$.cat(self$.toString(), ":\n\n", + heading = 1, + consoleOutputEnabled = consoleOutputEnabled + ) + + self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + + designParametersToShow <- c( + ".design$stages", + ".design$alpha" + ) + if (inherits(self$.design, "TrialDesignConditionalDunnett")) { + designParametersToShow <- c( + designParametersToShow, + ".design$informationAtInterim", + ".design$secondStageConditioning" + ) + } + self$.showParametersOfOneGroup(designParametersToShow, "Design parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + + self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Output", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + + self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) + if (isTRUE(self$.enrichment)) { + self$.cat(paste0(" S[i]: population i\n"), consoleOutputEnabled = consoleOutputEnabled) + self$.cat(paste0(" F: full population\n"), consoleOutputEnabled = consoleOutputEnabled) + } else { + self$.cat(paste0( + " (i): results of treatment arm i vs. control group ", + (nrow(self$separatePValues) + 1), "\n" + ), consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" [i]: hypothesis number\n", + consoleOutputEnabled = consoleOutputEnabled + ) + } + } + }, + .toString = function(startWithUpperCase = FALSE) { + s <- "Closed combination test results" + if (inherits(self$.design, "TrialDesignConditionalDunnett")) { + s <- paste0(s, " (Conditional Dunnett)") + } + return(s) + }, + .getHypothesisTreatmentArms = function(number) { + result <- c() + for (i in 1:ncol(self$indices)) { + if (self$indices[number, i] == 1) { + result <- c(result, i) + } + } + return(result) + }, + .getHypothesisTreatmentArmVariants = function() { + result <- c() + for (number in 1:nrow(self$indices)) { + arms <- self$.getHypothesisTreatmentArms(number) + result <- c(result, paste0(arms, collapse = ", ")) + } + return(result) + }, + .getHypothesisPopulationVariants = function() { + result <- c() + gMax <- 1 + for (number in 1:nrow(self$indices)) { + arms <- self$.getHypothesisTreatmentArms(number) + if (number == 1) { + gMax <- length(arms) + } + arms <- paste0("S", arms) + arms[arms == paste0("S", gMax)] <- "F" + result <- c(result, paste0(arms, collapse = ", ")) + } + return(result) + } + ) ) #' @@ -693,262 +725,291 @@ ClosedCombinationTestResults <- setRefClass("ClosedCombinationTestResults", #' #' @importFrom methods new #' -AnalysisResults <- setRefClass("AnalysisResults", - contains = "ParameterSet", - fields = list( - .plotSettings = "ANY", - .design = "TrialDesign", - .dataInput = "Dataset", - .stageResults = "StageResults", - .conditionalPowerResults = "ConditionalPowerResults", - normalApproximation = "logical", - directionUpper = "logical", - thetaH0 = "numeric", - pi1 = "numeric", - pi2 = "numeric", - nPlanned = "numeric", - allocationRatioPlanned = "numeric" - ), - methods = list( - initialize = function(design, dataInput, ...) { - callSuper(.design = design, .dataInput = dataInput, ...) - - .plotSettings <<- PlotSettingsR6$new() - .parameterNames <<- .getParameterNames(design = design, analysisResults = .self) - .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS - }, - .setStageResults = function(stageResults) { - .stageResults <<- stageResults - .parameterNames <<- .getParameterNames(design = .design, stageResults = stageResults, analysisResults = .self) - }, - getPlotSettings = function() { - return(.plotSettings) - }, - show = function(showType = 1, digits = NA_integer_) { - .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) - }, - .getStageResultParametersToShow = function() { - stageResultParametersToShow <- c() - if (.design$kMax > 1) { - if (!grepl("Rates", .getClassName(.dataInput)) || .dataInput$getNumberOfGroups() > 1) { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$effectSizes") - } - - if (grepl("Means", .getClassName(.dataInput))) { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallStDevs") - } - if (grepl("Rates", .getClassName(.dataInput))) { - if (.isMultiArmAnalysisResults(.self)) { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPiTreatments") - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPiControl") - } else if (.isEnrichmentAnalysisResults(.self)) { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPisTreatment") - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPisControl") - } else { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPi1") - if (.dataInput$getNumberOfGroups() > 1) { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPi2") - } - } - } - } - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$testStatistics") - if (grepl("(MultiArm|Dunnett|Enrichment)", .getClassName(.self))) { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$separatePValues") - } else { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$pValues") - } - - if (.design$kMax == 1) { - # return(stageResultParametersToShow) - } - - # show combination test statistics - if (.isTrialDesignInverseNormal(.design)) { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$combInverseNormal") - } else if (.isTrialDesignGroupSequential(.design)) { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallTestStatistics") - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPValues") - } else if (.isTrialDesignFisher(.design)) { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$combFisher") - } - return(stageResultParametersToShow) - }, - .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { - "Method for automatically printing analysis result objects" - .resetCat() - if (showType == 2) { - callSuper(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) - } else { - .cat(.toString(startWithUpperCase = TRUE), ":\n\n", - heading = 1, - consoleOutputEnabled = consoleOutputEnabled - ) - - .showParametersOfOneGroup(.getDesignParametersToShow(.self), "Design parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - - .showParametersOfOneGroup(.getUserDefinedParameters(), "User defined parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - - .showParametersOfOneGroup(.getDefaultParameters(), "Default parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - - .showParametersOfOneGroup(.getStageResultParametersToShow(), "Stage results", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - - # show multi-arm parameters - if (grepl("(MultiArm|Dunnett|Enrichment)", .getClassName(.self))) { - if (.isTrialDesignConditionalDunnett(.design)) { - .showParametersOfOneGroup(".closedTestResults$conditionalErrorRate", - "Conditional error rate", - orderByParameterName = FALSE, - consoleOutputEnabled = consoleOutputEnabled - ) - .showParametersOfOneGroup(".closedTestResults$secondStagePValues", - "Second stage p-values", - orderByParameterName = FALSE, - consoleOutputEnabled = consoleOutputEnabled - ) - } else { - .showParametersOfOneGroup(".closedTestResults$adjustedStageWisePValues", - "Adjusted stage-wise p-values", - orderByParameterName = FALSE, - consoleOutputEnabled = consoleOutputEnabled - ) - .showParametersOfOneGroup(".closedTestResults$overallAdjustedTestStatistics", - "Overall adjusted test statistics", - orderByParameterName = FALSE, - consoleOutputEnabled = consoleOutputEnabled - ) - } - - .showParametersOfOneGroup(".closedTestResults$rejected", "Test actions", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - } - - generatedParams <- .getGeneratedParameters() - generatedParams <- generatedParams[!(generatedParams %in% - c("assumedStDevs", "thetaH1", "pi1", "pi2", "piTreatments", "piTreatments", "piControl", "piControls"))] - - if (grepl("(MultiArm|Dunnett|Enrichment)", .getClassName(.self))) { - if (all(c("conditionalPowerSimulated", "conditionalRejectionProbabilities") %in% generatedParams)) { - generatedParams <- .moveValue( - generatedParams, - "conditionalPowerSimulated", "conditionalRejectionProbabilities" - ) - } - - .showParametersOfOneGroup(generatedParams, "Further analysis results", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - } else { - .showParametersOfOneGroup(generatedParams, "Analysis results", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - } - - .showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - - if (grepl("(MultiArm|Dunnett)", .getClassName(.self))) { - .cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) - .cat( - paste0( - " (i): results of treatment arm i vs. control group ", - .dataInput$getNumberOfGroups(), "\n" - ), - consoleOutputEnabled = consoleOutputEnabled - ) - } else if (.isEnrichmentAnalysisResults(.self)) { - .cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) - .cat(paste0(" S[i]: population i\n"), consoleOutputEnabled = consoleOutputEnabled) - .cat(paste0(" F: full population\n"), consoleOutputEnabled = consoleOutputEnabled) - } else if (grepl("Rates", .getClassName(.dataInput)) && .dataInput$getNumberOfGroups() == 2) { - .cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) - .cat(" (i): values of treatment arm i\n", consoleOutputEnabled = consoleOutputEnabled) - } - } - }, - .toString = function(startWithUpperCase = FALSE) { - str <- "analysis results" - if (inherits(.self, "AnalysisResultsMultiArm")) { - str <- paste0("multi-arm ", str) - } else if (inherits(.self, "AnalysisResultsEnrichment")) { - str <- paste0("enrichment ", str) - } - if (startWithUpperCase) { - str <- .firstCharacterToUpperCase(str) - } - - numberOfGroups <- .dataInput$getNumberOfGroups() - str <- paste0(str, " (") - - str <- paste0(str, tolower(sub("Dataset(Enrichment)?", "", .getClassName(.dataInput)))) - if (grepl("Survival", .getClassName(.getClassName))) { - str <- paste0(str, " data") - } - - if (numberOfGroups == 1) { - str <- paste0(str, " of one group") - } else { - str <- paste0(str, " of ", numberOfGroups, " groups") - } - - if (.design$kMax > 1) { - if (grepl("GroupSequential", .getClassName(.self))) { - str <- paste0(str, ", group sequential design") - } else if (grepl("InverseNormal", .getClassName(.self))) { - str <- paste0(str, ", inverse normal combination test design") - } else if (grepl("Fisher", .getClassName(.self))) { - str <- paste0(str, ", Fisher's combination test design") - } else if (grepl("Dunnett", .getClassName(.self))) { - str <- paste0(str, ", conditional Dunnett design") - } - } else { - str <- paste0(str, ", fixed sample size design") - } - - str <- paste0(str, ")") - return(str) - }, - getNumberOfStages = function() { - return(.stageResults$getNumberOfStages()) - }, - getDataInput = function() { - return(.dataInput) - } - ) +AnalysisResultsR6 <- R6Class("AnalysisResultsR6", + inherit = ParameterSetR6, + public = list( + .plotSettings = NULL, + .design = NULL, + .dataInput = NULL, + .stageResults = NULL, + .conditionalPowerResults = NULL, + normalApproximation = NULL, + directionUpper = NULL, + thetaH0 = NULL, + pi1 = NULL, + pi2 = NULL, + nPlanned = NULL, + allocationRatioPlanned = NULL, + initialize = function(design, dataInput, ..., .stageResults = NULL, .conditionalPowerResults = NULL, directionUpper = NULL, thetaH0 = NULL) { + self$.design <- design + self$.dataInput <- dataInput + self$.stageResults <- .stageResults + self$.conditionalPowerResults <- .conditionalPowerResults + self$directionUpper <- directionUpper + self$thetaH0 <- thetaH0 + + super$initialize(...) + + self$.plotSettings <- PlotSettingsR6$new() + self$.parameterNames <- .getParameterNames(design = design, analysisResults = self) + self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS + }, + .setStageResults = function(stageResults) { + self$.stageResults <- stageResults + self$.parameterNames <- .getParameterNames(design = self$.design, stageResults = stageResults, analysisResults = self) + }, + getPlotSettings = function() { + return(self$.plotSettings) + }, + show = function(showType = 1, digits = NA_integer_) { + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + }, + .getStageResultParametersToShow = function() { + stageResultParametersToShow <- c() + if (self$.design$kMax > 1) { + if (!grepl("Rates", .getClassName(self$.dataInput)) || self$.dataInput$getNumberOfGroups() > 1) { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$effectSizes") + } + + if (grepl("Means", .getClassName(self$.dataInput))) { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallStDevs") + } + if (grepl("Rates", .getClassName(self$.dataInput))) { + if (.isMultiArmAnalysisResults(self)) { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPiTreatments") + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPiControl") + } else if (.isEnrichmentAnalysisResults(self)) { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPisTreatment") + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPisControl") + } else { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPi1") + if (self$.dataInput$getNumberOfGroups() > 1) { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPi2") + } + } + } + } + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$testStatistics") + if (grepl("(MultiArm|Dunnett|Enrichment)", .getClassName(self))) { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$separatePValues") + } else { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$pValues") + } + + if (self$.design$kMax == 1) { + # return(stageResultParametersToShow) + } + + # show combination test statistics + if (.isTrialDesignInverseNormal(self$.design)) { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$combInverseNormal") + } else if (.isTrialDesignGroupSequential(self$.design)) { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallTestStatistics") + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPValues") + } else if (.isTrialDesignFisher(self$.design)) { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$combFisher") + } + return(stageResultParametersToShow) + }, + .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { + "Method for automatically printing analysis result objects" + self$.resetCat() + if (showType == 2) { + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + } else { + self$.cat(self$.toString(startWithUpperCase = TRUE), ":\n\n", + heading = 1, + consoleOutputEnabled = consoleOutputEnabled + ) + + self$.showParametersOfOneGroup(.getDesignParametersToShow(self), "Design parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + + self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + + self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + + self$.showParametersOfOneGroup(self$.getStageResultParametersToShow(), "Stage results", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + + # show multi-arm parameters + if (grepl("(MultiArm|Dunnett|Enrichment)", .getClassName(self))) { + if (.isTrialDesignConditionalDunnett(self$.design)) { + self$.showParametersOfOneGroup(".closedTestResults$conditionalErrorRate", + "Conditional error rate", + orderByParameterName = FALSE, + consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(".closedTestResults$secondStagePValues", + "Second stage p-values", + orderByParameterName = FALSE, + consoleOutputEnabled = consoleOutputEnabled + ) + } else { + self$.showParametersOfOneGroup(".closedTestResults$adjustedStageWisePValues", + "Adjusted stage-wise p-values", + orderByParameterName = FALSE, + consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(".closedTestResults$overallAdjustedTestStatistics", + "Overall adjusted test statistics", + orderByParameterName = FALSE, + consoleOutputEnabled = consoleOutputEnabled + ) + } + + self$.showParametersOfOneGroup(".closedTestResults$rejected", "Test actions", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + } + + generatedParams <- self$.getGeneratedParameters() + generatedParams <- generatedParams[!(generatedParams %in% + c("assumedStDevs", "thetaH1", "pi1", "pi2", "piTreatments", "piTreatments", "piControl", "piControls"))] + + if (grepl("(MultiArm|Dunnett|Enrichment)", .getClassName(self))) { + + if (all(c("conditionalPowerSimulated", "conditionalRejectionProbabilities") %in% generatedParams)) { + generatedParams <- .moveValue(generatedParams, + "conditionalPowerSimulated", "conditionalRejectionProbabilities") + } + + self$.showParametersOfOneGroup(generatedParams, "Further analysis results", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + } else { + self$.showParametersOfOneGroup(generatedParams, "Analysis results", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + } + + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + + if (grepl("(MultiArm|Dunnett)", .getClassName(self))) { + self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(paste0( + " (i): results of treatment arm i vs. control group ", + self$.dataInput$getNumberOfGroups(), "\n" + ), + consoleOutputEnabled = consoleOutputEnabled + ) + } else if (.isEnrichmentAnalysisResults(self)) { + self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(paste0(" S[i]: population i\n"), consoleOutputEnabled = consoleOutputEnabled) + self$.cat(paste0(" F: full population\n"), consoleOutputEnabled = consoleOutputEnabled) + } else if (grepl("Rates", .getClassName(self$.dataInput)) && self$.dataInput$getNumberOfGroups() == 2) { + self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" (i): values of treatment arm i\n", consoleOutputEnabled = consoleOutputEnabled) + } + } + }, + .toString = function(startWithUpperCase = FALSE) { + str <- "analysis results" + if (inherits(self, "AnalysisResultsMultiArmR6")) { + str <- paste0("multi-arm ", str) + } else if (inherits(self, "AnalysisResultsEnrichmentR6")) { + str <- paste0("enrichment ", str) + } + if (startWithUpperCase) { + str <- .firstCharacterToUpperCase(str) + } + + numberOfGroups <- self$.dataInput$getNumberOfGroups() + str <- paste0(str, " (") + + str <- paste0(str, tolower(sub("Dataset(Enrichment)?", "", .getClassName(self$.dataInput)))) + if (grepl("Survival", .getClassName(.getClassName))) {#TODO BUG? + str <- paste0(str, " data") + } + + if (numberOfGroups == 1) { + str <- paste0(str, " of one group") + } else { + str <- paste0(str, " of ", numberOfGroups, " groups") + } + + if (self$.design$kMax > 1) { + if (grepl("GroupSequential", .getClassName(self))) { + str <- paste0(str, ", group sequential design") + } else if (grepl("InverseNormal", .getClassName(self))) { + str <- paste0(str, ", inverse normal combination test design") + } else if (grepl("Fisher", .getClassName(self))) { + str <- paste0(str, ", Fisher's combination test design") + } else if (grepl("Dunnett", .getClassName(self))) { + str <- paste0(str, ", conditional Dunnett design") + } + } else { + str <- paste0(str, ", fixed sample size design") + } + + str <- paste0(str, ")") + return(str) + }, + getNumberOfStages = function() { + return(self$.stageResults$getNumberOfStages()) + }, + getDataInput = function() { + return(self$.dataInput) + } + ) ) -AnalysisResultsBase <- setRefClass("AnalysisResultsBase", - contains = "AnalysisResults", - fields = list( - thetaH1 = "numeric", - assumedStDev = "numeric", - equalVariances = "logical", - testActions = "character", - conditionalRejectionProbabilities = "numeric", - conditionalPower = "numeric", - repeatedConfidenceIntervalLowerBounds = "numeric", - repeatedConfidenceIntervalUpperBounds = "numeric", - repeatedPValues = "numeric", - finalStage = "integer", - finalPValues = "numeric", - finalConfidenceIntervalLowerBounds = "numeric", - finalConfidenceIntervalUpperBounds = "numeric", - medianUnbiasedEstimates = "numeric" - ), - methods = list( - initialize = function(design, dataInput, ...) { - callSuper(design = design, dataInput = dataInput, ...) - finalStage <<- NA_integer_ - } - ) +AnalysisResultsBaseR6 <- R6Class("AnalysisResultsBaseR6", + inherit = AnalysisResultsR6, + public = list( + thetaH1 = NULL, + assumedStDev = NULL, + equalVariances = NULL, + testActions = NULL, + conditionalRejectionProbabilities = NULL, + conditionalPower = NULL, + repeatedConfidenceIntervalLowerBounds = NULL, + repeatedConfidenceIntervalUpperBounds = NULL, + repeatedPValues = NULL, + finalStage = NULL, + finalPValues = NULL, + finalConfidenceIntervalLowerBounds = NULL, + finalConfidenceIntervalUpperBounds = NULL, + medianUnbiasedEstimates = NULL, + initialize = function(design, dataInput, ..., thetaH1 = NULL, + assumedStDev = NULL, + equalVariances = NULL, + testActions = NULL, + conditionalRejectionProbabilities = NULL, + conditionalPower = NULL, + repeatedConfidenceIntervalLowerBounds = NULL, + repeatedConfidenceIntervalUpperBounds = NULL, + repeatedPValues = NULL, + finalStage = NULL, + finalPValues = NULL, + finalConfidenceIntervalLowerBounds = NULL, + finalConfidenceIntervalUpperBounds = NULL, + medianUnbiasedEstimates = NULL) { + self$thetaH1 <- thetaH1 + self$assumedStDev <- assumedStDev + self$equalVariances <- equalVariances + self$testActions <- testActions + self$conditionalRejectionProbabilities <- conditionalRejectionProbabilities + self$conditionalPower <- conditionalPower + self$repeatedConfidenceIntervalLowerBounds <- repeatedConfidenceIntervalLowerBounds + self$repeatedConfidenceIntervalUpperBounds <- repeatedConfidenceIntervalUpperBounds + self$repeatedPValues <- repeatedPValues + self$finalStage <- finalStage + self$finalPValues <- finalPValues + self$finalConfidenceIntervalLowerBounds <- finalConfidenceIntervalLowerBounds + self$finalConfidenceIntervalUpperBounds <- finalConfidenceIntervalUpperBounds + self$medianUnbiasedEstimates <- medianUnbiasedEstimates + + super$initialize(design = design, dataInput = dataInput, ...) + self$finalStage <- NA_integer_ + } + ) ) #' @@ -978,29 +1039,49 @@ AnalysisResultsBase <- setRefClass("AnalysisResultsBase", #' #' @importFrom methods new #' -AnalysisResultsMultiHypotheses <- setRefClass("AnalysisResultsMultiHypotheses", - contains = "AnalysisResults", - fields = list( - .closedTestResults = "ClosedCombinationTestResults", - thetaH1 = "matrix", # means only - assumedStDevs = "matrix", # means only - piTreatments = "matrix", # rates only - intersectionTest = "character", - varianceOption = "character", - conditionalRejectionProbabilities = "matrix", - conditionalPower = "matrix", - repeatedConfidenceIntervalLowerBounds = "matrix", - repeatedConfidenceIntervalUpperBounds = "matrix", - repeatedPValues = "matrix" - ), - methods = list( - initialize = function(design, dataInput, ...) { - callSuper(design = design, dataInput = dataInput, ...) - for (param in c("thetaH1", "assumedStDevs", "piTreatments")) { - .setParameterType(param, C_PARAM_NOT_APPLICABLE) - } - } - ) +AnalysisResultsMultiHypothesesR6 <- R6Class("AnalysisResultsMultiHypothesesR6", + inherit = AnalysisResultsR6, + public = list( + .closedTestResults = NULL, + thetaH1 = NULL, # means only + assumedStDevs = NULL, # means only + piTreatments = NULL, # rates only + intersectionTest = NULL, + varianceOption = NULL, + conditionalRejectionProbabilities = NULL, + conditionalPower = NULL, + repeatedConfidenceIntervalLowerBounds = NULL, + repeatedConfidenceIntervalUpperBounds = NULL, + repeatedPValues = NULL, + initialize = function(design, dataInput, ..., .closedTestResults = NULL, + thetaH1 = NULL, + assumedStDevs = NULL, + piTreatments = NULL, + intersectionTest = NULL, + varianceOption = NULL, + conditionalRejectionProbabilities = NULL, + conditionalPower = NULL, + repeatedConfidenceIntervalLowerBounds = NULL, + repeatedConfidenceIntervalUpperBounds = NULL, + repeatedPValues = NULL) { + self$.closedTestResults <- .closedTestResults + self$thetaH1 <- thetaH1 + self$assumedStDevs <- assumedStDevs + self$piTreatments <- piTreatments + self$intersectionTest <- intersectionTest + self$varianceOption <- varianceOption + self$conditionalRejectionProbabilities <- conditionalRejectionProbabilities + self$conditionalPower <- conditionalPower + self$repeatedConfidenceIntervalLowerBounds <- repeatedConfidenceIntervalLowerBounds + self$repeatedConfidenceIntervalUpperBounds <- repeatedConfidenceIntervalUpperBounds + self$repeatedPValues <- repeatedPValues + super$initialize(design = design, dataInput = dataInput, ...) + + for (param in c("thetaH1", "assumedStDevs", "piTreatments")) { + self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) + } + } + ) ) #' @@ -1031,31 +1112,30 @@ AnalysisResultsMultiHypotheses <- setRefClass("AnalysisResultsMultiHypotheses", #' #' @importFrom methods new #' -AnalysisResultsMultiArm <- setRefClass("AnalysisResultsMultiArm", - contains = "AnalysisResultsMultiHypotheses", - fields = list( - piControl = "matrix" # rates only - ), - methods = list( - initialize = function(design, dataInput, ...) { - callSuper(design = design, dataInput = dataInput, ...) - .setParameterType("piControl", C_PARAM_NOT_APPLICABLE) - }, - .getParametersToShow = function() { - parametersToShow <- .getVisibleFieldNames() - - if ("piTreatments" %in% parametersToShow && "piControl" %in% parametersToShow) { - index <- which(parametersToShow == "piTreatments") - parametersToShow <- parametersToShow[parametersToShow != "piControl"] - parametersToShow <- c( - parametersToShow[1:index], - "piControl", parametersToShow[(index + 1):length(parametersToShow)] - ) - } - - return(parametersToShow) - } - ) +AnalysisResultsMultiArmR6 <- R6Class("AnalysisResultsMultiArmR6", + inherit = AnalysisResultsMultiHypothesesR6, + public = list( + piControl = NULL, # rates only + initialize = function(design, dataInput, ..., piControl = NULL) { + self$piControl <- piControl + super$initialize(design = design, dataInput = dataInput, ...) + self$.setParameterType("piControl", C_PARAM_NOT_APPLICABLE) + }, + .getParametersToShow = function() { + parametersToShow <- self$.getVisibleFieldNames() + + if ("piTreatments" %in% parametersToShow && "piControl" %in% parametersToShow) { + index <- which(parametersToShow == "piTreatments") + parametersToShow <- parametersToShow[parametersToShow != "piControl"] + parametersToShow <- c( + parametersToShow[1:index], + "piControl", parametersToShow[(index + 1):length(parametersToShow)] + ) + } + + return(parametersToShow) + } + ) ) #' @@ -1085,17 +1165,16 @@ AnalysisResultsMultiArm <- setRefClass("AnalysisResultsMultiArm", #' #' @importFrom methods new #' -AnalysisResultsEnrichment <- setRefClass("AnalysisResultsEnrichment", - contains = "AnalysisResultsMultiHypotheses", - fields = list( - piControls = "matrix" # rates only - ), - methods = list( - initialize = function(design, dataInput, ...) { - callSuper(design = design, dataInput = dataInput, ...) - .setParameterType("piControls", C_PARAM_NOT_APPLICABLE) - } - ) +AnalysisResultsEnrichmentR6 <- R6Class("AnalysisResultsEnrichmentR6", + inherit = AnalysisResultsMultiHypothesesR6, + public = list( + piControls = NULL, # rates only + initialize = function(design, dataInput, ..., piControls = NULL) { + self$piControls <- piControls + super$initialize(design = design, dataInput = dataInput, ...) + self$.setParameterType("piControls", C_PARAM_NOT_APPLICABLE) + } + ) ) #' @@ -1121,8 +1200,8 @@ AnalysisResultsEnrichment <- setRefClass("AnalysisResultsEnrichment", #' #' @keywords internal #' -summary.AnalysisResults <- function(object, ..., type = 1, digits = NA_integer_) { - return(summary.ParameterSet(object = object, ..., type = type, digits = digits)) +summary.AnalysisResultsR6 <- function(object, ..., type = 1, digits = NA_integer_) { + return(summary.ParameterSetR6(object = object, ..., type = type, digits = digits)) } #' @@ -1145,26 +1224,27 @@ summary.AnalysisResults <- function(object, ..., type = 1, digits = NA_integer_) #' #' @keywords internal #' -as.data.frame.AnalysisResults <- function(x, row.names = NULL, optional = FALSE, ..., - niceColumnNamesEnabled = FALSE) { - parametersToShow <- .getDesignParametersToShow(x) - if (inherits(x, "AnalysisResultsMultiArm")) { - parametersToShow <- c(parametersToShow, ".closedTestResults$rejected") - } - parametersToShow <- c(parametersToShow, x$.getUserDefinedParameters()) - parametersToShow <- c(parametersToShow, x$.getDefaultParameters()) - parametersToShow <- c(parametersToShow, x$.getStageResultParametersToShow()) - parametersToShow <- c(parametersToShow, x$.getGeneratedParameters()) - - parametersToShow <- parametersToShow[!(parametersToShow %in% c( - "finalStage", "allocationRatioPlanned", "thetaH0", "thetaH1", "pi1", "pi2" - ))] - return(.getAsDataFrame( - parameterSet = x, - parameterNames = parametersToShow, - tableColumnNames = .getTableColumnNames(design = x$.design), - niceColumnNamesEnabled = niceColumnNamesEnabled - )) +as.data.frame.AnalysisResultsR6 <- function(x, row.names = NULL, optional = FALSE, ..., + niceColumnNamesEnabled = FALSE) { + + parametersToShow <- .getDesignParametersToShow(x) + if (inherits(x, "AnalysisResultsMultiArmR6")) { + parametersToShow <- c(parametersToShow, ".closedTestResults$rejected") + } + parametersToShow <- c(parametersToShow, x$.getUserDefinedParameters()) + parametersToShow <- c(parametersToShow, x$.getDefaultParameters()) + parametersToShow <- c(parametersToShow, x$.getStageResultParametersToShow()) + parametersToShow <- c(parametersToShow, x$.getGeneratedParameters()) + + parametersToShow <- parametersToShow[!(parametersToShow %in% c( + "finalStage", "allocationRatioPlanned", "thetaH0", "thetaH1", "pi1", "pi2" + ))] + return(.getAsDataFrame( + parameterSet = x, + parameterNames = parametersToShow, + tableColumnNames = .getTableColumnNames(design = x$.design), + niceColumnNamesEnabled = niceColumnNamesEnabled + )) } #' @@ -1185,13 +1265,13 @@ as.data.frame.AnalysisResults <- function(x, row.names = NULL, optional = FALSE, #' #' @keywords internal #' -names.AnalysisResults <- function(x) { - namesToShow <- c(".design", ".dataInput", ".stageResults", ".conditionalPowerResults") - if (.isMultiArmAnalysisResults(x)) { - namesToShow <- c(namesToShow, ".closedTestResults") - } - namesToShow <- c(namesToShow, x$.getVisibleFieldNames()) - return(namesToShow) +names.AnalysisResultsR6 <- function(x) { + namesToShow <- c(".design", ".dataInput", ".stageResults", ".conditionalPowerResults") + if (.isMultiArmAnalysisResults(x)) { + namesToShow <- c(namesToShow, ".closedTestResults") + } + namesToShow <- c(namesToShow, x$.getVisibleFieldNames()) + return(namesToShow) } #' @@ -1226,7 +1306,7 @@ names.AnalysisResults <- function(x) { #' @template field_medianUnbiasedEstimates #' @template field_maxInformation #' @template field_informationEpsilon -#' +#' #' @details #' This object cannot be created directly; use \code{\link{getAnalysisResults}} #' with suitable arguments to create the analysis results of a group sequential design. @@ -1241,19 +1321,21 @@ names.AnalysisResults <- function(x) { #' #' @importFrom methods new #' -AnalysisResultsGroupSequential <- setRefClass("AnalysisResultsGroupSequential", - contains = "AnalysisResultsBase", - fields = list( - maxInformation = "integer", - informationEpsilon = "numeric" - ), - methods = list( - initialize = function(design, dataInput, ...) { - callSuper(design = design, dataInput = dataInput, ...) - .setParameterType("maxInformation", C_PARAM_NOT_APPLICABLE) - .setParameterType("informationEpsilon", C_PARAM_NOT_APPLICABLE) - } - ) +AnalysisResultsGroupSequentialR6 <- R6Class("AnalysisResultsGroupSequentialR6", + inherit = AnalysisResultsBaseR6, + public = list( + maxInformation = NULL, + informationEpsilon = NULL, + initialize = function(design, dataInput, ..., maxInformation = NULL, informationEpsilon = NULL) { + self$maxInformation <- maxInformation + self$informationEpsilon <- informationEpsilon + + super$initialize(design = design, dataInput = dataInput, ...) + + self$.setParameterType("maxInformation", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("informationEpsilon", C_PARAM_NOT_APPLICABLE) + } + ) ) #' @@ -1286,7 +1368,7 @@ AnalysisResultsGroupSequential <- setRefClass("AnalysisResultsGroupSequential", #' @template field_finalConfidenceIntervalLowerBounds #' @template field_finalConfidenceIntervalUpperBounds #' @template field_medianUnbiasedEstimates -#' +#' #' @details #' This object cannot be created directly; use \code{\link{getAnalysisResults}} #' with suitable arguments to create the analysis results of a inverse normal design. @@ -1301,8 +1383,8 @@ AnalysisResultsGroupSequential <- setRefClass("AnalysisResultsGroupSequential", #' #' @importFrom methods new #' -AnalysisResultsInverseNormal <- setRefClass("AnalysisResultsInverseNormal", - contains = "AnalysisResultsBase" +AnalysisResultsInverseNormalR6 <- R6Class("AnalysisResultsInverseNormalR6", + inherit = AnalysisResultsBaseR6 ) #' @@ -1332,7 +1414,7 @@ AnalysisResultsInverseNormal <- setRefClass("AnalysisResultsInverseNormal", #' @template field_repeatedConfidenceIntervalUpperBounds #' @template field_repeatedPValues #' @template field_piControl -#' +#' #' @details #' This object cannot be created directly; use \code{\link{getAnalysisResults}} #' with suitable arguments to create the multi-arm analysis results of an inverse normal design. @@ -1347,8 +1429,8 @@ AnalysisResultsInverseNormal <- setRefClass("AnalysisResultsInverseNormal", #' #' @importFrom methods new #' -AnalysisResultsMultiArmInverseNormal <- setRefClass("AnalysisResultsMultiArmInverseNormal", - contains = "AnalysisResultsMultiArm" +AnalysisResultsMultiArmInverseNormalR6 <- R6Class("AnalysisResultsMultiArmInverseNormalR6", + inherit = AnalysisResultsMultiArmR6 ) #' @@ -1379,7 +1461,7 @@ AnalysisResultsMultiArmInverseNormal <- setRefClass("AnalysisResultsMultiArmInve #' @template field_repeatedPValues #' @template field_piControls #' @template field_stratifiedAnalysis -#' +#' #' @details #' This object cannot be created directly; use \code{\link{getAnalysisResults}} #' with suitable arguments to create the enrichment analysis results of an inverse normal design. @@ -1394,11 +1476,11 @@ AnalysisResultsMultiArmInverseNormal <- setRefClass("AnalysisResultsMultiArmInve #' #' @importFrom methods new #' -AnalysisResultsEnrichmentInverseNormal <- setRefClass("AnalysisResultsEnrichmentInverseNormal", - contains = "AnalysisResultsEnrichment", - fields = list( - stratifiedAnalysis = "logical" - ) +AnalysisResultsEnrichmentInverseNormalR6 <- R6Class("AnalysisResultsEnrichmentInverseNormalR6", + inherit = AnalysisResultsEnrichmentR6, + public = list( + stratifiedAnalysis = NULL + ) ) #' @@ -1434,7 +1516,7 @@ AnalysisResultsEnrichmentInverseNormal <- setRefClass("AnalysisResultsEnrichment #' @template field_conditionalPowerSimulated #' @template field_iterations #' @template field_seed -#' +#' #' @details #' This object cannot be created directly; use \code{\link{getAnalysisResults}} #' with suitable arguments to create the analysis results of a Fisher combination test design. @@ -1449,19 +1531,19 @@ AnalysisResultsEnrichmentInverseNormal <- setRefClass("AnalysisResultsEnrichment #' #' @importFrom methods new #' -AnalysisResultsFisher <- setRefClass("AnalysisResultsFisher", - contains = "AnalysisResultsBase", - fields = list( - conditionalPowerSimulated = "numeric", - iterations = "integer", - seed = "numeric" - ), - methods = list( - initialize = function(design, dataInput, ...) { - callSuper(design = design, dataInput = dataInput, ...) - conditionalPowerSimulated <<- -1 - } - ) +AnalysisResultsFisherR6 <- R6Class("AnalysisResultsFisherR6", + inherit = AnalysisResultsBaseR6, + public = list( + conditionalPowerSimulated = NULL, + iterations = NULL, + seed = NULL, + initialize = function(design, dataInput, ..., iterations = NULL, seed = NULL) { + self$iterations <- iterations + self$seed <- seed + super$initialize(design = design, dataInput = dataInput, ...) + self$conditionalPowerSimulated <- -1 + } + ) ) #' @@ -1492,7 +1574,7 @@ AnalysisResultsFisher <- setRefClass("AnalysisResultsFisher", #' @template field_conditionalPowerSimulated #' @template field_iterations #' @template field_seed -#' +#' #' @details #' This object cannot be created directly; use \code{\link{getAnalysisResults}} #' with suitable arguments to create the multi-arm analysis results of a Fisher combination test design. @@ -1507,13 +1589,13 @@ AnalysisResultsFisher <- setRefClass("AnalysisResultsFisher", #' #' @importFrom methods new #' -AnalysisResultsMultiArmFisher <- setRefClass("AnalysisResultsMultiArmFisher", - contains = "AnalysisResultsMultiArm", - fields = list( - conditionalPowerSimulated = "matrix", - iterations = "integer", - seed = "numeric" - ) +AnalysisResultsMultiArmFisherR6 <- R6Class("AnalysisResultsMultiArmFisherR6", + inherit = AnalysisResultsMultiArmR6, + public = list( + conditionalPowerSimulated = NULL, + iterations = NULL, + seed = NULL + ) ) #' @@ -1545,8 +1627,8 @@ AnalysisResultsMultiArmFisher <- setRefClass("AnalysisResultsMultiArmFisher", #' @template field_iterations #' @template field_seed #' @template field_stratifiedAnalysis -#' -#' +#' +#' #' @details #' This object cannot be created directly; use \code{\link{getAnalysisResults}} #' with suitable arguments to create the multi-arm analysis results of a Fisher combination test design. @@ -1561,14 +1643,14 @@ AnalysisResultsMultiArmFisher <- setRefClass("AnalysisResultsMultiArmFisher", #' #' @importFrom methods new #' -AnalysisResultsEnrichmentFisher <- setRefClass("AnalysisResultsEnrichmentFisher", - contains = "AnalysisResultsEnrichment", - fields = list( - conditionalPowerSimulated = "matrix", - iterations = "integer", - seed = "numeric", - stratifiedAnalysis = "logical" - ) +AnalysisResultsEnrichmentFisherR6 <- R6Class("AnalysisResultsEnrichmentFisherR6", + inherit = AnalysisResultsEnrichmentR6, + public = list( + conditionalPowerSimulated = NULL, + iterations = NULL, + seed = NULL, + stratifiedAnalysis = NULL + ) ) #' @@ -1598,7 +1680,7 @@ AnalysisResultsEnrichmentFisher <- setRefClass("AnalysisResultsEnrichmentFisher" #' @template field_repeatedConfidenceIntervalUpperBounds #' @template field_repeatedPValues #' @template field_piControl -#' +#' #' @details #' This object cannot be created directly; use \code{\link{getAnalysisResults}} #' with suitable arguments to create the multi-arm analysis results of a conditional Dunnett test design. @@ -1607,104 +1689,104 @@ AnalysisResultsEnrichmentFisher <- setRefClass("AnalysisResultsEnrichmentFisher" #' #' @importFrom methods new #' -AnalysisResultsConditionalDunnett <- setRefClass("AnalysisResultsConditionalDunnett", - contains = "AnalysisResultsMultiArm", - fields = list() +AnalysisResultsConditionalDunnettR6 <- R6Class("AnalysisResultsConditionalDunnettR6", + inherit = AnalysisResultsMultiArmR6, + public = list() ) .getAnalysisResultsPlotArguments <- function(x, - nPlanned = NA_real_, allocationRatioPlanned = NA_real_) { - if (all(is.na(nPlanned))) { - nPlanned <- stats::na.omit(x$nPlanned) - } - - if (is.na(allocationRatioPlanned) && length(x$allocationRatioPlanned) == 1) { - allocationRatioPlanned <- x$allocationRatioPlanned - } - - if (length(allocationRatioPlanned) != 1) { - allocationRatioPlanned <- NA_real_ - } - - if ((.isConditionalPowerEnabled(x$nPlanned) || .isConditionalPowerEnabled(nPlanned)) && is.na(allocationRatioPlanned)) { - allocationRatioPlanned <- 1 - } - - return(list( - stageResults = x$.stageResults, - nPlanned = nPlanned, - allocationRatioPlanned = allocationRatioPlanned - )) + nPlanned = NA_real_, allocationRatioPlanned = NA_real_) { + if (all(is.na(nPlanned))) { + nPlanned <- stats::na.omit(x$nPlanned) + } + + if (is.na(allocationRatioPlanned) && length(x$allocationRatioPlanned) == 1) { + allocationRatioPlanned <- x$allocationRatioPlanned + } + + if (length(allocationRatioPlanned) != 1) { + allocationRatioPlanned <- NA_real_ + } + + if ((.isConditionalPowerEnabled(x$nPlanned) || .isConditionalPowerEnabled(nPlanned)) && is.na(allocationRatioPlanned)) { + allocationRatioPlanned <- 1 + } + + return(list( + stageResults = x$.stageResults, + nPlanned = nPlanned, + allocationRatioPlanned = allocationRatioPlanned + )) } .getConfidenceIntervalPlotLegendLabels <- function(x, treatmentArmsToShow) { - if (.isEnrichmentAnalysisResults(x)) { - gMax <- x$.stageResults$getGMax() - labels <- paste0("S", treatmentArmsToShow) - labels[treatmentArmsToShow == gMax] <- "F" - labels <- factor(labels, levels = unique(labels)) - return(labels) - } - - return(paste0(treatmentArmsToShow, " vs control")) + if (.isEnrichmentAnalysisResults(x)) { + gMax <- x$.stageResults$getGMax() + labels <- paste0("S", treatmentArmsToShow) + labels[treatmentArmsToShow == gMax] <- "F" + labels <- factor(labels, levels = unique(labels)) + return(labels) + } + + return(paste0(treatmentArmsToShow, " vs control")) } .getConfidenceIntervalData <- function(x, treatmentArmsToShow = NULL) { - data <- .getConfidenceIntervalDataPerBound(x, "lower", treatmentArmsToShow) - data$upper <- .getConfidenceIntervalDataPerBound(x, "upper", treatmentArmsToShow)$upper - data$yValues <- (data$upper + data$lower) / 2 - data <- na.omit(data) - return(data) + data <- .getConfidenceIntervalDataPerBound(x, "lower", treatmentArmsToShow) + data$upper <- .getConfidenceIntervalDataPerBound(x, "upper", treatmentArmsToShow)$upper + data$yValues <- (data$upper + data$lower) / 2 + data <- na.omit(data) + return(data) } .getConfidenceIntervalDataPerBound <- function(x, ciName = c("lower", "upper"), treatmentArmsToShow = NULL) { - ciName <- match.arg(ciName) - paramName <- ifelse(ciName == "lower", "repeatedConfidenceIntervalLowerBounds", "repeatedConfidenceIntervalUpperBounds") - data <- x[[paramName]] - - if (is.matrix(data) && !is.null(treatmentArmsToShow) && - length(treatmentArmsToShow) > 0 && !any(is.na(treatmentArmsToShow))) { - data <- data[treatmentArmsToShow, ] - } - - if (is.matrix(data) && nrow(data) == 1) { - data <- as.numeric(data) - } - - if (is.matrix(data)) { - kMax <- ncol(data) - if (is.null(treatmentArmsToShow) || length(treatmentArmsToShow) == 0 || all(is.na(treatmentArmsToShow))) { - treatmentArmsToShow <- 1:nrow(data) - } - groups <- length(treatmentArmsToShow) - result <- data.frame(ci = data[, 1]) - colnames(result) <- ciName - result$xValues <- rep(1, groups) - result$categories <- .getConfidenceIntervalPlotLegendLabels(x, treatmentArmsToShow) - if (kMax == 1) { - return(result) - } - - for (stage in 2:kMax) { - resultPart <- data.frame(ci = data[, stage]) - colnames(resultPart) <- ciName - resultPart$xValues <- rep(stage, groups) - resultPart$categories <- .getConfidenceIntervalPlotLegendLabels(x, treatmentArmsToShow) - result <- rbind(result, resultPart) - } - return(result) - } - + ciName <- match.arg(ciName) + paramName <- ifelse(ciName == "lower", "repeatedConfidenceIntervalLowerBounds", "repeatedConfidenceIntervalUpperBounds") + data <- x[[paramName]] + + if (is.matrix(data) && !is.null(treatmentArmsToShow) && + length(treatmentArmsToShow) > 0 && !any(is.na(treatmentArmsToShow))) { + data <- data[treatmentArmsToShow, ] + } + + if (is.matrix(data) && nrow(data) == 1) { + data <- as.numeric(data) + } + + if (is.matrix(data)) { + kMax <- ncol(data) if (is.null(treatmentArmsToShow) || length(treatmentArmsToShow) == 0 || all(is.na(treatmentArmsToShow))) { - treatmentArmsToShow <- 1 + treatmentArmsToShow <- 1:nrow(data) } - - kMax <- length(data) - result <- data.frame(ci = data) + groups <- length(treatmentArmsToShow) + result <- data.frame(ci = data[, 1]) colnames(result) <- ciName - result$xValues <- 1:kMax - result$categories <- rep(.getConfidenceIntervalPlotLegendLabels(x, treatmentArmsToShow), kMax) + result$xValues <- rep(1, groups) + result$categories <- .getConfidenceIntervalPlotLegendLabels(x, treatmentArmsToShow) + if (kMax == 1) { + return(result) + } + + for (stage in 2:kMax) { + resultPart <- data.frame(ci = data[, stage]) + colnames(resultPart) <- ciName + resultPart$xValues <- rep(stage, groups) + resultPart$categories <- .getConfidenceIntervalPlotLegendLabels(x, treatmentArmsToShow) + result <- rbind(result, resultPart) + } return(result) + } + + if (is.null(treatmentArmsToShow) || length(treatmentArmsToShow) == 0 || all(is.na(treatmentArmsToShow))) { + treatmentArmsToShow <- 1 + } + + kMax <- length(data) + result <- data.frame(ci = data) + colnames(result) <- ciName + result$xValues <- 1:kMax + result$categories <- rep(.getConfidenceIntervalPlotLegendLabels(x, treatmentArmsToShow), kMax) + return(result) } #' @@ -1755,242 +1837,242 @@ AnalysisResultsConditionalDunnett <- setRefClass("AnalysisResultsConditionalDunn #' #' @export #' -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) { - .assertGgplotIsInstalled() - functionCall <- match.call(expand.dots = TRUE) - analysisResultsName <- as.character(functionCall$x)[1] - .assertIsSingleInteger(grid, "grid", validateType = FALSE) - typeNumbers <- .getPlotTypeNumber(type, x) - p <- NULL - plotList <- list() - for (typeNumber in typeNumbers) { - p <- .plotAnalysisResults( - x = x, y = y, type = typeNumber, - nPlanned = nPlanned, - allocationRatioPlanned = allocationRatioPlanned, - main = main, xlab = xlab, ylab = ylab, - legendTitle = legendTitle, palette = palette, legendPosition = legendPosition, - showSource = showSource, functionCall = functionCall, - analysisResultsName = analysisResultsName, plotSettings = plotSettings, ... - ) - .printPlotShowSourceSeparator(showSource, typeNumber, typeNumbers) - if (length(typeNumbers) > 1) { - caption <- .getPlotCaption(x, typeNumber, stopIfNotFound = TRUE) - plotList[[caption]] <- p - } - } - if (length(typeNumbers) == 1) { - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(p)) - } - - return(p) +plot.AnalysisResultsR6 <- 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) { + .assertGgplotIsInstalled() + functionCall <- match.call(expand.dots = TRUE) + analysisResultsName <- as.character(functionCall$x)[1] + .assertIsSingleInteger(grid, "grid", validateType = FALSE) + typeNumbers <- .getPlotTypeNumber(type, x) + p <- NULL + plotList <- list() + for (typeNumber in typeNumbers) { + p <- .plotAnalysisResults( + x = x, y = y, type = typeNumber, + nPlanned = nPlanned, + allocationRatioPlanned = allocationRatioPlanned, + main = main, xlab = xlab, ylab = ylab, + legendTitle = legendTitle, palette = palette, legendPosition = legendPosition, + showSource = showSource, functionCall = functionCall, + analysisResultsName = analysisResultsName, plotSettings = plotSettings, ... + ) + .printPlotShowSourceSeparator(showSource, typeNumber, typeNumbers) + if (length(typeNumbers) > 1) { + caption <- .getPlotCaption(x, typeNumber, stopIfNotFound = TRUE) + plotList[[caption]] <- p } - + } + if (length(typeNumbers) == 1) { if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(plotList)) + return(invisible(p)) } - - return(.createPlotResultObject(plotList, grid)) + + return(p) + } + + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(plotList)) + } + + return(.createPlotResultObject(plotList, grid)) } .plotAnalysisResultsRCI <- function(..., - x, y, nPlanned, allocationRatioPlanned, main, xlab, ylab, - legendTitle, palette, legendPosition, showSource, analysisResultsName, plotSettings = NULL) { - .assertIsAnalysisResults(x) - .warnInCaseOfUnknownArguments(functionName = "plot", ignore = c("treatmentArms", "populations"), ...) - - if (.isEnrichmentAnalysisResults(x)) { - gMax <- x$.stageResults$getGMax() - treatmentArmsToShow <- .getPopulationsToShow(x, gMax = gMax, ...) - } else { - treatmentArmsToShow <- .getTreatmentArmsToShow(x, ...) - } - - data <- .getConfidenceIntervalData(x, treatmentArmsToShow) - if (nrow(data) == 0) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "unable to create plot because no RCIs are available in the specified analysis result" - ) - } - - .warnInCaseOfUnusedArgument(nPlanned, "nPlanned", NA_real_, "plot") - .warnInCaseOfUnusedArgument(allocationRatioPlanned, "allocationRatioPlanned", NA_real_, "plot") - - plotData <- list( - main = "Repeated Confidence Intervals", - xlab = "Stage", - ylab = "RCI", - sub = NA_character_ # subtitle + x, y, nPlanned, allocationRatioPlanned, main, xlab, ylab, + legendTitle, palette, legendPosition, showSource, analysisResultsName, plotSettings = NULL) { + .assertIsAnalysisResults(x) + .warnInCaseOfUnknownArguments(functionName = "plot", ignore = c("treatmentArms", "populations"), ...) + + if (.isEnrichmentAnalysisResults(x)) { + gMax <- x$.stageResults$getGMax() + treatmentArmsToShow <- .getPopulationsToShow(x, gMax = gMax, ...) + } else { + treatmentArmsToShow <- .getTreatmentArmsToShow(x, ...) + } + + data <- .getConfidenceIntervalData(x, treatmentArmsToShow) + if (nrow(data) == 0) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "unable to create plot because no RCIs are available in the specified analysis result" ) - - if (is.na(legendPosition)) { - if (!.isMultiHypothesesAnalysisResults(x)) { - legendPosition <- ifelse(length(treatmentArmsToShow) == 1 && treatmentArmsToShow == 1, - -1, C_POSITION_RIGHT_CENTER - ) - } else { - legendPosition <- C_POSITION_RIGHT_TOP - } - } - - treatmentArmsToShowCmd <- "" - if (!is.null(treatmentArmsToShow) && !identical(sort(unique(treatmentArmsToShow)), 1:nrow(data))) { - treatmentArmsToShowCmd <- paste0(", ", .arrayToString(treatmentArmsToShow, mode = "vector")) + } + + .warnInCaseOfUnusedArgument(nPlanned, "nPlanned", NA_real_, "plot") + .warnInCaseOfUnusedArgument(allocationRatioPlanned, "allocationRatioPlanned", NA_real_, "plot") + + plotData <- list( + main = "Repeated Confidence Intervals", + xlab = "Stage", + ylab = "RCI", + sub = NA_character_ # subtitle + ) + + if (is.na(legendPosition)) { + if (!.isMultiHypothesesAnalysisResults(x)) { + legendPosition <- ifelse(length(treatmentArmsToShow) == 1 && treatmentArmsToShow == 1, + -1, C_POSITION_RIGHT_CENTER + ) + } else { + legendPosition <- C_POSITION_RIGHT_TOP } - dataCmd <- paste0("rpact:::.getConfidenceIntervalData(", analysisResultsName, treatmentArmsToShowCmd, ")") - srcCmd <- .showPlotSourceInformation( - objectName = analysisResultsName, - xParameterName = paste0(dataCmd, "$xValues"), - yParameterNames = c( - paste0(dataCmd, "$lower"), - paste0(dataCmd, "$yValues"), - paste0(dataCmd, "$upper") - ), - type = 2L, showSource = showSource, lineType = FALSE - ) - - p <- .createAnalysisResultsPlotObject(x, - data = data, plotData = plotData, main = main, xlab = xlab, ylab = ylab, - legendTitle = legendTitle, palette = palette, legendPosition = legendPosition, - kMax = x$.design$kMax, plotSettings = plotSettings - ) - p <- p + ggplot2::expand_limits(x = c(1, x$.design$kMax)) - return(p) + } + + treatmentArmsToShowCmd <- "" + if (!is.null(treatmentArmsToShow) && !identical(sort(unique(treatmentArmsToShow)), 1:nrow(data))) { + treatmentArmsToShowCmd <- paste0(", ", .arrayToString(treatmentArmsToShow, mode = "vector")) + } + dataCmd <- paste0("rpact:::.getConfidenceIntervalData(", analysisResultsName, treatmentArmsToShowCmd, ")") + srcCmd <- .showPlotSourceInformation( + objectName = analysisResultsName, + xParameterName = paste0(dataCmd, "$xValues"), + yParameterNames = c( + paste0(dataCmd, "$lower"), + paste0(dataCmd, "$yValues"), + paste0(dataCmd, "$upper") + ), + type = 2L, showSource = showSource, lineType = FALSE + ) + + p <- .createAnalysisResultsPlotObject(x, + data = data, plotData = plotData, main = main, xlab = xlab, ylab = ylab, + legendTitle = legendTitle, palette = palette, legendPosition = legendPosition, + kMax = x$.design$kMax, plotSettings = plotSettings + ) + p <- p + ggplot2::expand_limits(x = c(1, x$.design$kMax)) + return(p) } .plotAnalysisResults <- function(..., - x, y, type, nPlanned, allocationRatioPlanned, main, xlab, ylab, - legendTitle, palette, legendPosition, showSource, functionCall, - analysisResultsName, plotSettings = NULL) { - .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) - if (!(type %in% c(1, 2))) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is not allowed; must be 1 or 2") - } - - .assertIsAnalysisResults(x) - .assertIsValidLegendPosition(legendPosition = legendPosition) - - if (type == 2) { - return(.plotAnalysisResultsRCI( - x = x, y = y, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, - main = main, xlab = xlab, ylab = ylab, - legendTitle = legendTitle, palette = palette, - legendPosition = legendPosition, showSource = showSource, - analysisResultsName = analysisResultsName, - plotSettings = plotSettings, ... - )) - } - - if (!.isConditionalPowerEnabled(x$nPlanned) && !.isConditionalPowerEnabled(nPlanned)) { - stop("'nPlanned' must be defined to create conditional power plot") - } - - .warnInCaseOfUnknownArguments( - functionName = "plot", - ignore = c("thetaRange", "assumedStDev", "assumedStDevs", "treatmentArms", "populations", "pi2", "piTreatmentRange"), - ... - ) - - if (is.na(legendPosition)) { - legendPosition <- C_POSITION_RIGHT_CENTER + x, y, type, nPlanned, allocationRatioPlanned, main, xlab, ylab, + legendTitle, palette, legendPosition, showSource, functionCall, + analysisResultsName, plotSettings = NULL) { + .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) + if (!(type %in% c(1, 2))) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is not allowed; must be 1 or 2") + } + + .assertIsAnalysisResults(x) + .assertIsValidLegendPosition(legendPosition = legendPosition) + + if (type == 2) { + return(.plotAnalysisResultsRCI( + x = x, y = y, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, + main = main, xlab = xlab, ylab = ylab, + legendTitle = legendTitle, palette = palette, + legendPosition = legendPosition, showSource = showSource, + analysisResultsName = analysisResultsName, + plotSettings = plotSettings, ... + )) + } + + if (!.isConditionalPowerEnabled(x$nPlanned) && !.isConditionalPowerEnabled(nPlanned)) { + stop("'nPlanned' must be defined to create conditional power plot") + } + + .warnInCaseOfUnknownArguments( + functionName = "plot", + ignore = c("thetaRange", "assumedStDev", "assumedStDevs", "treatmentArms", "populations", "pi2", "piTreatmentRange"), + ... + ) + + if (is.na(legendPosition)) { + legendPosition <- C_POSITION_RIGHT_CENTER + } + + plotArgs <- .getAnalysisResultsPlotArguments( + x = x, nPlanned = nPlanned, + allocationRatioPlanned = allocationRatioPlanned + ) + + functionCall$x <- x$.stageResults + functionCall$y <- NULL + functionCall$stageResultsName <- paste0(analysisResultsName, "$.stageResults") + functionCall$nPlanned <- plotArgs$nPlanned + functionCall$main <- main + functionCall$xlab <- xlab + functionCall$ylab <- ylab + functionCall$legendTitle <- legendTitle + functionCall$palette <- palette + functionCall$legendPosition <- legendPosition + functionCall$type <- type + functionCall$plotSettings <- plotSettings + functionCall$allocationRatioPlanned <- plotArgs$allocationRatioPlanned + if (.isTrialDesignFisher(x$.design)) { + functionCall$iterations <- x$iterations + functionCall$seed <- x$seed + } + + if (x$getDataInput()$isDatasetMeans()) { + if (.isMultiHypothesesAnalysisResults(x)) { + assumedStDevs <- eval.parent(functionCall$assumedStDevs) + if (is.null(assumedStDevs)) { + assumedStDevs <- as.numeric(x$assumedStDevs) + } + + gMax <- x$.stageResults$getGMax() + .assertIsValidAssumedStDevs(assumedStDevs, gMax) + + functionCall$assumedStDevs <- assumedStDevs + } else { + assumedStDev <- eval.parent(functionCall$assumedStDev) + if (is.null(assumedStDev)) { + assumedStDev <- x$assumedStDev + } + functionCall$assumedStDev <- assumedStDev } - - plotArgs <- .getAnalysisResultsPlotArguments( - x = x, nPlanned = nPlanned, - allocationRatioPlanned = allocationRatioPlanned - ) - - functionCall$x <- x$.stageResults - functionCall$y <- NULL - functionCall$stageResultsName <- paste0(analysisResultsName, "$.stageResults") - functionCall$nPlanned <- plotArgs$nPlanned - functionCall$main <- main - functionCall$xlab <- xlab - functionCall$ylab <- ylab - functionCall$legendTitle <- legendTitle - functionCall$palette <- palette - functionCall$legendPosition <- legendPosition - functionCall$type <- type - functionCall$plotSettings <- plotSettings - functionCall$allocationRatioPlanned <- plotArgs$allocationRatioPlanned - if (.isTrialDesignFisher(x$.design)) { - functionCall$iterations <- x$iterations - functionCall$seed <- x$seed + } + + if (x$getDataInput()$isDatasetMeans() || x$getDataInput()$isDatasetSurvival()) { + thetaRange <- eval.parent(functionCall$thetaRange) + if (is.null(thetaRange)) { + thetaRangeMin <- min(x$thetaH0, min(na.omit(as.numeric(x$thetaH1)))) + thetaRangeMax <- 2 * max(x$thetaH0, max(na.omit(as.numeric(x$thetaH1)))) + thetaRange <- seq( + thetaRangeMin, thetaRangeMax, + (thetaRangeMax - thetaRangeMin) / C_THETA_RANGE_SEQUENCE_LENGTH_DEFAULT + ) + } else { + thetaRange <- .assertIsValidThetaRange( + thetaRange = thetaRange, + survivalDataEnabled = x$getDataInput()$isDatasetSurvival() + ) } - - if (x$getDataInput()$isDatasetMeans()) { - if (.isMultiHypothesesAnalysisResults(x)) { - assumedStDevs <- eval.parent(functionCall$assumedStDevs) - if (is.null(assumedStDevs)) { - assumedStDevs <- as.numeric(x$assumedStDevs) - } - - gMax <- x$.stageResults$getGMax() - .assertIsValidAssumedStDevs(assumedStDevs, gMax) - - functionCall$assumedStDevs <- assumedStDevs - } else { - assumedStDev <- eval.parent(functionCall$assumedStDev) - if (is.null(assumedStDev)) { - assumedStDev <- x$assumedStDev - } - functionCall$assumedStDev <- assumedStDev - } + functionCall$thetaRange <- thetaRange + } else if (x$getDataInput()$isDatasetRates()) { + if (.isMultiArmAnalysisResults(x)) { + piControl <- eval.parent(functionCall$piControl) + if (is.null(piControl)) { + piControl <- as.numeric(x$piControl) + } + functionCall$piControl <- piControl + } else if (.isEnrichmentAnalysisResults(x)) { + piControl <- eval.parent(functionCall$piControl) + if (is.null(piControl)) { + piControls <- as.numeric(x$piControls) + } + functionCall$piControls <- piControls + } else { + pi2 <- eval.parent(functionCall$pi2) + if (is.null(pi2)) { + pi2 <- x$pi2 + } + functionCall$pi2 <- pi2 } - - if (x$getDataInput()$isDatasetMeans() || x$getDataInput()$isDatasetSurvival()) { - thetaRange <- eval.parent(functionCall$thetaRange) - if (is.null(thetaRange)) { - thetaRangeMin <- min(x$thetaH0, min(na.omit(as.numeric(x$thetaH1)))) - thetaRangeMax <- 2 * max(x$thetaH0, max(na.omit(as.numeric(x$thetaH1)))) - thetaRange <- seq( - thetaRangeMin, thetaRangeMax, - (thetaRangeMax - thetaRangeMin) / C_THETA_RANGE_SEQUENCE_LENGTH_DEFAULT - ) - } else { - thetaRange <- .assertIsValidThetaRange( - thetaRange = thetaRange, - survivalDataEnabled = x$getDataInput()$isDatasetSurvival() - ) - } - functionCall$thetaRange <- thetaRange - } else if (x$getDataInput()$isDatasetRates()) { - if (.isMultiArmAnalysisResults(x)) { - piControl <- eval.parent(functionCall$piControl) - if (is.null(piControl)) { - piControl <- as.numeric(x$piControl) - } - functionCall$piControl <- piControl - } else if (.isEnrichmentAnalysisResults(x)) { - piControl <- eval.parent(functionCall$piControl) - if (is.null(piControl)) { - piControls <- as.numeric(x$piControls) - } - functionCall$piControls <- piControls - } else { - pi2 <- eval.parent(functionCall$pi2) - if (is.null(pi2)) { - pi2 <- x$pi2 - } - functionCall$pi2 <- pi2 - } - - piTreatmentRange <- eval.parent(functionCall$piTreatmentRange) - if (is.null(piTreatmentRange)) { - piTreatmentRange <- seq(0, 1, 1 / C_THETA_RANGE_SEQUENCE_LENGTH_DEFAULT) # default - } else { - piTreatmentRange <- .assertIsValidPiTreatmentRange(piTreatmentRange = piTreatmentRange) - } - functionCall$piTreatmentRange <- piTreatmentRange + + piTreatmentRange <- eval.parent(functionCall$piTreatmentRange) + if (is.null(piTreatmentRange)) { + piTreatmentRange <- seq(0, 1, 1 / C_THETA_RANGE_SEQUENCE_LENGTH_DEFAULT) # default + } else { + piTreatmentRange <- .assertIsValidPiTreatmentRange(piTreatmentRange = piTreatmentRange) } - - functionCall[[1L]] <- as.name("plot") - return(eval.parent(functionCall)) + functionCall$piTreatmentRange <- piTreatmentRange + } + + functionCall[[1L]] <- as.name("plot") + return(eval.parent(functionCall)) } diff --git a/R/class_analysis_results_r6.R b/R/class_analysis_results_r6.R deleted file mode 100644 index 244d5c1e..00000000 --- a/R/class_analysis_results_r6.R +++ /dev/null @@ -1,2078 +0,0 @@ -library("R6") -## | -## | *Analysis result classes* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | rpact package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File version: $Revision: 6909 $ -## | Last changed: $Date: 2023-03-31 14:33:51 +0200 (Fr, 31 Mrz 2023) $ -## | Last changed by: $Author: pahlke $ -## | - -#' -#' @name ConditionalPowerResults -#' -#' @title -#' Conditional Power Results -#' -#' @description -#' Class for conditional power calculations -#' -#' @template field_nPlanned -#' @template field_allocationRatioPlanned -#' @template field_iterations -#' @template field_seed -#' @template field_simulated -#' @template field_conditionalPower -#' @template field_thetaH1 -#' @template field_assumedStDev -#' -#' @details -#' This object cannot be created directly; use \code{\link[=getConditionalPower]{getConditionalPower()}} -#' with suitable arguments to create the results of a group sequential or a combination test design. -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -ConditionalPowerResultsR6 <- R6Class("ConditionalPowerResultsR6", - inherit = ParameterSetR6, - public = list( - .plotSettings = NULL, - .design = NULL, - .stageResults = NULL, - .plotData = NULL, - nPlanned = NULL, - allocationRatioPlanned = NULL, - iterations = NULL, - seed = NULL, - simulated = NULL, - initialize = function(..., .design = NULL, .stageResults = NULL, .plotData = NULL, nPlanned = NULL, allocationRatioPlanned = NULL, iterations = NULL, seed = NULL, simulated = NULL) { - self$.design <- .design - self$.stageResults <- .stageResults - self$.plotData <- .plotData - self$nPlanned <- nPlanned - self$allocationRatioPlanned <- allocationRatioPlanned - self$iterations <- iterations - self$seed <- seed - self$simulated <- simulated - - super$initialize(...) - - self$.plotSettings <- PlotSettingsR6$new() - self$.parameterNames <- C_PARAMETER_NAMES - self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS - - if (!is.null(self$.stageResults) && is.null(self$.design)) { - self$.design <- self$.stageResults$.design - } - - if (is.null(self$simulated) || length(self$simulated) == 0 || is.na(self$simulated)) { - self$simulated <- FALSE - } - - if (!is.null(self$.design) && length(self$.design$kMax) == 1 && self$.design$kMax == 1L) { - self$.setParameterType("nPlanned", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("allocationRatioPlanned", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("conditionalPower", C_PARAM_NOT_APPLICABLE) - } else { - self$.setParameterType("nPlanned", C_PARAM_GENERATED) - self$.setParameterType("allocationRatioPlanned", C_PARAM_USER_DEFINED) - self$.setParameterType("conditionalPower", C_PARAM_GENERATED) - } - self$.setParameterType("simulated", C_PARAM_NOT_APPLICABLE) - }, - show = function(showType = 1, digits = NA_integer_) { - self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) - }, - .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { - "Method for automatically printing conditional power result objects" - self$.resetCat() - if (showType == 2) { - super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) - } else { - if (!is.null(self$.design) && length(self$.design$kMax) == 1 && self$.design$kMax == 1) { - self$.cat(self$.toString(), ": not applicable for fixed design (kMax = 1)\n", - heading = 1, - consoleOutputEnabled = consoleOutputEnabled - ) - } else { - self$.cat(self$.toString(), ":\n\n", - heading = 1, - consoleOutputEnabled = consoleOutputEnabled - ) - } - self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Output", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - } - }, - .toString = function(startWithUpperCase = FALSE) { - return("Conditional power results") - } - ) -) - -#' -#' @name ConditionalPowerResultsMeans -#' -#' @title -#' Conditional Power Results Means -#' -#' @description -#' Class for conditional power calculations of means data -#' -#' @template field_nPlanned -#' @template field_allocationRatioPlanned -#' @template field_iterations -#' @template field_seed -#' @template field_simulated -#' @template field_conditionalPower -#' @template field_thetaH1 -#' @template field_assumedStDev -#' -#' @details -#' This object cannot be created directly; use \code{\link{getConditionalPower}} -#' with suitable arguments to create the results of a group sequential or a combination test design. -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -ConditionalPowerResultsMeansR6 <- R6Class("ConditionalPowerResultsMeansR6", - inherit = ConditionalPowerResultsR6, - public = list( - conditionalPower = NULL, - thetaH1 = NULL, - assumedStDev = NULL, - initialize = function(..., conditionalPower = NULL, thetaH1 = NULL, assumedStDev = NULL) { - self$conditionalPower<- conditionalPower - self$thetaH1<- thetaH1 - self$assumedStDev<- assumedStDev - - super$initialize(...) - - if ((is.null(self$conditionalPower) || length(self$conditionalPower) == 0) && - !is.null(self$.design) && !is.null(self$.design$kMax) && length(self$.design$kMax) > 0) { - self$conditionalPower <- rep(NA_real_, self$.design$kMax) - } - - if (is.null(self$thetaH1) || length(self$thetaH1) == 0 || all(is.na(self$thetaH1))) { - self$thetaH1 <- NA_real_ - } - if (is.null(self$assumedStDev) || length(self$assumedStDev) == 0 || all(is.na(self$assumedStDev))) { - self$assumedStDev <- NA_real_ - } - }, - .toString = function(startWithUpperCase = FALSE) { - return("Conditional power results means") - } - ) -) - -ConditionalPowerResultsMultiHypothesesR6 <- R6Class("ConditionalPowerResultsMultiHypothesesR6", - inherit = ConditionalPowerResultsR6, - public = list( - conditionalPower = NULL, - initialize = function(..., conditionalPower = NULL) { - self$conditionalPower <- conditionalPower - super$initialize(...) - - if (self$.readyForInitialization()) { - gMax <- self$getGMax() - kMax <- self$.design$kMax - if (is.null(self$conditionalPower) || (nrow(self$conditionalPower) == 0 && ncol(self$conditionalPower) == 0)) { - self$conditionalPower <- matrix(rep(NA_real_, gMax * kMax), nrow = gMax, ncol = kMax) - } - } - }, - .toString = function(startWithUpperCase = FALSE) { - s <- "Conditional power results" - s <- paste0(s, " ", ifelse(grepl("Enrichment", .getClassName(self$.stageResults)), "enrichment", "multi-arm")) - if (grepl("Means", .getClassName(self))) { - s <- paste0(s, " means") - } else if (grepl("Rates", .getClassName(self))) { - s <- paste0(s, " rates") - } else if (grepl("Survival", .getClassName(self))) { - s <- paste0(s, " survival") - } - return(s) - }, - getGMax = function() { - return(self$.stageResults$getGMax()) - }, - .readyForInitialization = function() { - if (is.null(self$.design)) { - return(FALSE) - } - - if (length(self$.design$kMax) != 1) { - return(FALSE) - } - - if (is.null(self$.stageResults)) { - return(FALSE) - } - - if (is.null(self$.stageResults$testStatistics)) { - return(FALSE) - } - - return(TRUE) - } - ) -) - -ConditionalPowerResultsMultiArmMeansR6 <- R6Class("ConditionalPowerResultsMultiArmMeansR6", - inherit = ConditionalPowerResultsMultiHypothesesR6, - public = list( - thetaH1 = NULL, - assumedStDevs = NULL, - initialize = function(..., thetaH1 = NULL, assumedStDevs = NULL) { - self$thetaH1 <- thetaH1 - self$assumedStDevs <- assumedStDevs - super$initialize(...) - - if (self$.readyForInitialization()) { - gMax <- self$getGMax() - if (is.null(self$thetaH1) || length(self$thetaH1) == 0 || all(is.na(self$thetaH1))) { - self$thetaH1 <- rep(NA_real_, gMax) - } - if (is.null(self$assumedStDevs) || length(self$assumedStDevs) == 0 || all(is.na(self$assumedStDevs))) { - self$assumedStDevs <- rep(NA_real_, gMax) - } - } - } - ) -) - -#' -#' @name ConditionalPowerResultsRates -#' -#' @title -#' Conditional Power Results Rates -#' -#' @description -#' Class for conditional power calculations of rates data -#' -#' @template field_nPlanned -#' @template field_allocationRatioPlanned -#' @template field_iterations -#' @template field_seed -#' @template field_simulated -#' @template field_conditionalPower -#' @template field_pi1 -#' @template field_pi2 -#' -#' @details -#' This object cannot be created directly; use \code{\link{getConditionalPower}} -#' with suitable arguments to create the results of a group sequential or a combination test design. -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -ConditionalPowerResultsRatesR6 <- R6Class("ConditionalPowerResultsRatesR6", - inherit = ConditionalPowerResultsR6, - public = list( - conditionalPower = NULL, - pi1 = NULL, - pi2 = NULL, - initialize = function(..., conditionalPower = NULL, - pi1 = NULL, - pi2 = NULL) { - self$conditionalPower <- conditionalPower - self$pi1 <- pi1 - self$pi2 <- pi2 - - super$initialize(...) - - if ((is.null(self$conditionalPower) || length(self$conditionalPower) == 0) && - !is.null(self$.design) && !is.null(self$.design$kMax) && length(self$.design$kMax) > 0) { - self$conditionalPower <- rep(NA_real_, self$.design$kMax) - } - - if (is.null(self$pi1) || length(self$pi1) == 0 || all(is.na(self$pi1))) { - self$pi1 <- NA_real_ - } - if (is.null(self$pi2) || length(self$pi2) == 0 || all(is.na(self$pi2))) { - self$pi2 <- NA_real_ - } - }, - .toString = function(startWithUpperCase = FALSE) { - return("Conditional power results rates") - } - ) -) - -ConditionalPowerResultsMultiArmRatesR6 <- R6Class("ConditionalPowerResultsMultiArmRatesR6", - inherit = ConditionalPowerResultsMultiHypothesesR6, - public = list( - piTreatments = NULL, - piControl = NULL, - initialize = function(..., piTreatments = NULL, piControl = NULL) { - self$piTreatments <- piTreatments - self$piControl <- piControl - super$initialize(...) - - if (self$.readyForInitialization()) { - gMax <- self$getGMax() - if (is.null(self$piControl) || length(self$piControl) == 0 || all(is.na(self$piControl))) { - self$piControl <- NA_real_ - } - if (is.null(self$piTreatments) || length(self$piTreatments) == 0 || all(is.na(self$piTreatments))) { - self$piTreatments <- rep(NA_real_, gMax) - } - } - } - ) -) - -#' -#' @name ConditionalPowerResultsSurvival -#' -#' @title -#' Conditional Power Results Survival -#' -#' @description -#' Class for conditional power calculations of survival data -#' -#' @template field_nPlanned -#' @template field_allocationRatioPlanned -#' @template field_iterations -#' @template field_seed -#' @template field_simulated -#' @template field_conditionalPower -#' @template field_thetaH1_survival -#' -#' @details -#' This object cannot be created directly; use \code{\link{getConditionalPower}} -#' with suitable arguments to create the results of a group sequential or a combination test design. -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -ConditionalPowerResultsSurvivalR6 <- R6Class("ConditionalPowerResultsSurvivalR6", - inherit = ConditionalPowerResultsR6, - public = list( - conditionalPower = NULL, - thetaH1 = NULL, - initialize = function(..., conditionalPower = NULL, thetaH1 = NULL) { - self$conditionalPower <- conditionalPower - self$thetaH1 <- thetaH1 - super$initialize(...) - - if ((is.null(self$conditionalPower) || length(self$conditionalPower) == 0) && - !is.null(self$.design) && !is.null(self$.design$kMax) && length(self$.design$kMax) > 0) { - self$conditionalPower <- rep(NA_real_, self$.design$kMax) - } - - if (is.null(self$thetaH1) || length(self$thetaH1) == 0 || all(is.na(self$thetaH1))) { - self$thetaH1 <- NA_real_ - } - }, - .toString = function(startWithUpperCase = FALSE) { - return("Conditional power results survival") - } - ) -) - -ConditionalPowerResultsMultiArmSurvivalR6 <- R6Class("ConditionalPowerResultsMultiArmSurvivalR6", - inherit = ConditionalPowerResultsMultiHypothesesR6, - public = list( - thetaH1 = NULL, - initialize = function(..., thetaH1 = NULL) { - self$thetaH1 <- thetaH1 - super$initialize(...) - - if (self$.readyForInitialization()) { - gMax <- self$getGMax() - if (is.null(self$thetaH1) || length(self$thetaH1) == 0 || all(is.na(self$thetaH1))) { - self$thetaH1 <- rep(NA_real_, gMax) - } - } - } - ) -) - -#' -#' @name ConditionalPowerResultsEnrichmentMeans -#' -#' @title -#' Conditional Power Results Enrichment Means -#' -#' @description -#' Class for conditional power calculations of enrichment means data -#' -#' @template field_nPlanned -#' @template field_allocationRatioPlanned -#' @template field_iterations -#' @template field_seed -#' @template field_simulated -#' @template field_conditionalPower -#' @template field_thetaH1 -#' @template field_assumedStDevs -#' -#' @details -#' This object cannot be created directly; use \code{\link{getConditionalPower}} -#' with suitable arguments to create the results of a group sequential or a combination test design. -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -ConditionalPowerResultsEnrichmentMeansR6 <- R6Class("ConditionalPowerResultsEnrichmentMeansR6", - inherit = ConditionalPowerResultsMultiArmMeansR6 -) - -#' -#' @name ConditionalPowerResultsEnrichmentRates -#' -#' @title -#' Conditional Power Results Enrichment Rates -#' -#' @description -#' Class for conditional power calculations of enrichment rates data -#' -#' @template field_nPlanned -#' @template field_allocationRatioPlanned -#' @template field_iterations -#' @template field_seed -#' @template field_simulated -#' @template field_conditionalPower -#' @template field_piTreatments -#' @template field_piControls -#' -#' @details -#' This object cannot be created directly; use \code{\link{getConditionalPower}} -#' with suitable arguments to create the results of a group sequential or a combination test design. -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -ConditionalPowerResultsEnrichmentRatesR6 <- R6Class("ConditionalPowerResultsEnrichmentRatesR6", - inherit = ConditionalPowerResultsMultiHypothesesR6, - public = list( - piTreatments = NULL, - piControls = NULL, - initialize = function(..., piTreatments = NULL, piControls = NULL) { - self$piTreatments <- piTreatments - self$piControls <- piControls - super$initialize(...) - - if (self$.readyForInitialization()) { - gMax <- self$getGMax() - if (is.null(self$piControls) || length(self$piControls) == 0 || all(is.na(self$piControls))) { - self$piControls <- rep(NA_real_, gMax) - } - if (is.null(self$piTreatments) || length(self$piTreatments) == 0 || all(is.na(self$piTreatments))) { - self$piTreatments <- rep(NA_real_, gMax) - } - } - } - ) -) - - -ConditionalPowerResultsEnrichmentSurvivalR6 <- R6Class("ConditionalPowerResultsEnrichmentSurvivalR6", - inherit = ConditionalPowerResultsMultiArmSurvivalR6 -) - -#' -#' @name ClosedCombinationTestResults -#' -#' @title -#' Analysis Results Closed Combination Test -#' -#' @description -#' Class for multi-arm analysis results based on a closed combination test. -#' -#' @template field_intersectionTest -#' @template field_indices -#' @template field_adjustedStageWisePValues -#' @template field_overallAdjustedTestStatistics -#' @template field_separatePValues -#' @template field_conditionalErrorRate -#' @template field_secondStagePValues -#' @template field_rejected -#' @template field_rejectedIntersections -#' -#' @details -#' This object cannot be created directly; use \code{\link{getAnalysisResults}} -#' with suitable arguments to create the multi-arm analysis results of a closed combination test design. -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -ClosedCombinationTestResultsR6 <- R6Class("ClosedCombinationTestResultsR6", - inherit = ParameterSetR6, - public = list( - .plotSettings = NULL, - .design = NULL, - .enrichment = NULL, - intersectionTest = NULL, - indices = NULL, - adjustedStageWisePValues = NULL, - overallAdjustedTestStatistics = NULL, - separatePValues = NULL, - conditionalErrorRate = NULL, - secondStagePValues = NULL, - rejected = NULL, - rejectedIntersections = NULL, - initialize = function(..., .design = NULL, - .enrichment = NULL, - intersectionTest = NULL, - indices = NULL, - adjustedStageWisePValues = NULL, - overallAdjustedTestStatistics = NULL, - separatePValues = NULL, - conditionalErrorRate = NULL, - secondStagePValues = NULL, - rejected = NULL, - rejectedIntersections = NULL) { - self$.design <- .design - self$.enrichment <- .enrichment - self$intersectionTest <- intersectionTest - self$indices <- indices - self$adjustedStageWisePValues <- adjustedStageWisePValues - self$overallAdjustedTestStatistics <- overallAdjustedTestStatistics - self$separatePValues <- separatePValues - self$conditionalErrorRate <- conditionalErrorRate - self$secondStagePValues <- secondStagePValues - self$rejected <- rejected - self$rejectedIntersections <- rejectedIntersections - - super$initialize(...) - - self$.plotSettings <- PlotSettingsR6$new() - self$.parameterNames <- C_PARAMETER_NAMES - self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS - - self$.setParameterType("intersectionTest", C_PARAM_USER_DEFINED) - - parametersGenerated <- c( - "indices", - "separatePValues", - "rejected", - "rejectedIntersections" - ) - if (inherits(self$.design, "TrialDesignConditionalDunnett")) { - parametersGenerated <- c( - parametersGenerated, - "conditionalErrorRate", - "secondStagePValues" - ) - } else { - parametersGenerated <- c( - parametersGenerated, - "adjustedStageWisePValues", - "overallAdjustedTestStatistics" - ) - } - for (param in parametersGenerated) { - self$.setParameterType(param, C_PARAM_GENERATED) - } - - if (!is.null(self$.design) && inherits(self$.design, C_CLASS_NAME_TRIAL_DESIGN_FISHER)) { - self$.parameterFormatFunctions$overallAdjustedTestStatistics <- ".formatTestStatisticsFisher" - } - }, - show = function(showType = 1, digits = NA_integer_) { - self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) - }, - .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { - "Method for automatically printing closed combination test result objects" - self$.resetCat() - if (showType == 2) { - super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) - } else { - self$.cat(self$.toString(), ":\n\n", - heading = 1, - consoleOutputEnabled = consoleOutputEnabled - ) - - self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - - designParametersToShow <- c( - ".design$stages", - ".design$alpha" - ) - if (inherits(self$.design, "TrialDesignConditionalDunnett")) { - designParametersToShow <- c( - designParametersToShow, - ".design$informationAtInterim", - ".design$secondStageConditioning" - ) - } - self$.showParametersOfOneGroup(designParametersToShow, "Design parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - - self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Output", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - - self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - - self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) - if (isTRUE(self$.enrichment)) { - self$.cat(paste0(" S[i]: population i\n"), consoleOutputEnabled = consoleOutputEnabled) - self$.cat(paste0(" F: full population\n"), consoleOutputEnabled = consoleOutputEnabled) - } else { - self$.cat(paste0( - " (i): results of treatment arm i vs. control group ", - (nrow(self$separatePValues) + 1), "\n" - ), consoleOutputEnabled = consoleOutputEnabled) - self$.cat(" [i]: hypothesis number\n", - consoleOutputEnabled = consoleOutputEnabled - ) - } - } - }, - .toString = function(startWithUpperCase = FALSE) { - s <- "Closed combination test results" - if (inherits(self$.design, "TrialDesignConditionalDunnett")) { - s <- paste0(s, " (Conditional Dunnett)") - } - return(s) - }, - .getHypothesisTreatmentArms = function(number) { - result <- c() - for (i in 1:ncol(self$indices)) { - if (self$indices[number, i] == 1) { - result <- c(result, i) - } - } - return(result) - }, - .getHypothesisTreatmentArmVariants = function() { - result <- c() - for (number in 1:nrow(self$indices)) { - arms <- self$.getHypothesisTreatmentArms(number) - result <- c(result, paste0(arms, collapse = ", ")) - } - return(result) - }, - .getHypothesisPopulationVariants = function() { - result <- c() - gMax <- 1 - for (number in 1:nrow(self$indices)) { - arms <- self$.getHypothesisTreatmentArms(number) - if (number == 1) { - gMax <- length(arms) - } - arms <- paste0("S", arms) - arms[arms == paste0("S", gMax)] <- "F" - result <- c(result, paste0(arms, collapse = ", ")) - } - return(result) - } - ) -) - -#' -#' @name AnalysisResults -#' -#' @title -#' Basic Class for Analysis Results -#' -#' @description -#' A basic class for analysis results. -#' -#' @details -#' \code{AnalysisResults} is the basic class for -#' \itemize{ -#' \item \code{\link{AnalysisResultsFisher}}, -#' \item \code{\link{AnalysisResultsGroupSequential}}, -#' \item \code{\link{AnalysisResultsInverseNormal}}, -#' \item \code{\link{AnalysisResultsMultiArmFisher}}, -#' \item \code{\link{AnalysisResultsMultiArmInverseNormal}}, -#' \item \code{\link{AnalysisResultsConditionalDunnett}}, -#' \item \code{\link{AnalysisResultsEnrichmentFisher}}, -#' \item \code{\link{AnalysisResultsEnrichmentInverseNormal}}. -#' } -#' -#' @include class_core_parameter_set.R -#' @include class_core_plot_settings.R -#' @include class_analysis_dataset.R -#' @include class_design.R -#' @include f_core_constants.R -#' @include class_analysis_stage_results.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -AnalysisResultsR6 <- R6Class("AnalysisResultsR6", - inherit = ParameterSetR6, - public = list( - .plotSettings = NULL, - .design = NULL, - .dataInput = NULL, - .stageResults = NULL, - .conditionalPowerResults = NULL, - normalApproximation = NULL, - directionUpper = NULL, - thetaH0 = NULL, - pi1 = NULL, - pi2 = NULL, - nPlanned = NULL, - allocationRatioPlanned = NULL, - initialize = function(design, dataInput, ..., .stageResults = NULL, .conditionalPowerResults = NULL, directionUpper = NULL, thetaH0 = NULL) { - self$.design <- design - self$.dataInput <- dataInput - self$.stageResults <- .stageResults - self$.conditionalPowerResults <- .conditionalPowerResults - self$directionUpper <- directionUpper - self$thetaH0 <- thetaH0 - - super$initialize(...) - - self$.plotSettings <- PlotSettingsR6$new() - self$.parameterNames <- .getParameterNames(design = design, analysisResults = self) - self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS - }, - .setStageResults = function(stageResults) { - self$.stageResults <- stageResults - self$.parameterNames <- .getParameterNames(design = self$.design, stageResults = stageResults, analysisResults = self) - }, - getPlotSettings = function() { - return(self$.plotSettings) - }, - show = function(showType = 1, digits = NA_integer_) { - self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) - }, - .getStageResultParametersToShow = function() { - stageResultParametersToShow <- c() - if (self$.design$kMax > 1) { - if (!grepl("Rates", .getClassName(self$.dataInput)) || self$.dataInput$getNumberOfGroups() > 1) { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$effectSizes") - } - - if (grepl("Means", .getClassName(self$.dataInput))) { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallStDevs") - } - if (grepl("Rates", .getClassName(self$.dataInput))) { - if (.isMultiArmAnalysisResults(self)) { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPiTreatments") - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPiControl") - } else if (.isEnrichmentAnalysisResults(self)) { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPisTreatment") - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPisControl") - } else { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPi1") - if (self$.dataInput$getNumberOfGroups() > 1) { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPi2") - } - } - } - } - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$testStatistics") - if (grepl("(MultiArm|Dunnett|Enrichment)", .getClassName(self))) { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$separatePValues") - } else { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$pValues") - } - - if (self$.design$kMax == 1) { - # return(stageResultParametersToShow) - } - - # show combination test statistics - if (.isTrialDesignInverseNormal(self$.design)) { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$combInverseNormal") - } else if (.isTrialDesignGroupSequential(self$.design)) { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallTestStatistics") - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPValues") - } else if (.isTrialDesignFisher(self$.design)) { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$combFisher") - } - return(stageResultParametersToShow) - }, - .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { - "Method for automatically printing analysis result objects" - self$.resetCat() - if (showType == 2) { - super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) - } else { - self$.cat(self$.toString(startWithUpperCase = TRUE), ":\n\n", - heading = 1, - consoleOutputEnabled = consoleOutputEnabled - ) - - self$.showParametersOfOneGroup(.getDesignParametersToShow(self), "Design parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - - self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - - self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - - self$.showParametersOfOneGroup(self$.getStageResultParametersToShow(), "Stage results", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - - # show multi-arm parameters - if (grepl("(MultiArm|Dunnett|Enrichment)", .getClassName(self))) { - if (.isTrialDesignConditionalDunnett(self$.design)) { - self$.showParametersOfOneGroup(".closedTestResults$conditionalErrorRate", - "Conditional error rate", - orderByParameterName = FALSE, - consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(".closedTestResults$secondStagePValues", - "Second stage p-values", - orderByParameterName = FALSE, - consoleOutputEnabled = consoleOutputEnabled - ) - } else { - self$.showParametersOfOneGroup(".closedTestResults$adjustedStageWisePValues", - "Adjusted stage-wise p-values", - orderByParameterName = FALSE, - consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(".closedTestResults$overallAdjustedTestStatistics", - "Overall adjusted test statistics", - orderByParameterName = FALSE, - consoleOutputEnabled = consoleOutputEnabled - ) - } - - self$.showParametersOfOneGroup(".closedTestResults$rejected", "Test actions", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - } - - generatedParams <- self$.getGeneratedParameters() - generatedParams <- generatedParams[!(generatedParams %in% - c("assumedStDevs", "thetaH1", "pi1", "pi2", "piTreatments", "piTreatments", "piControl", "piControls"))] - - if (grepl("(MultiArm|Dunnett|Enrichment)", .getClassName(self))) { - - if (all(c("conditionalPowerSimulated", "conditionalRejectionProbabilities") %in% generatedParams)) { - generatedParams <- .moveValue(generatedParams, - "conditionalPowerSimulated", "conditionalRejectionProbabilities") - } - - self$.showParametersOfOneGroup(generatedParams, "Further analysis results", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - } else { - self$.showParametersOfOneGroup(generatedParams, "Analysis results", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - } - - self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - - if (grepl("(MultiArm|Dunnett)", .getClassName(self))) { - self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) - self$.cat(paste0( - " (i): results of treatment arm i vs. control group ", - self$.dataInput$getNumberOfGroups(), "\n" - ), - consoleOutputEnabled = consoleOutputEnabled - ) - } else if (.isEnrichmentAnalysisResults(self)) { - self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) - self$.cat(paste0(" S[i]: population i\n"), consoleOutputEnabled = consoleOutputEnabled) - self$.cat(paste0(" F: full population\n"), consoleOutputEnabled = consoleOutputEnabled) - } else if (grepl("Rates", .getClassName(self$.dataInput)) && self$.dataInput$getNumberOfGroups() == 2) { - self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) - self$.cat(" (i): values of treatment arm i\n", consoleOutputEnabled = consoleOutputEnabled) - } - } - }, - .toString = function(startWithUpperCase = FALSE) { - str <- "analysis results" - if (inherits(self, "AnalysisResultsMultiArmR6")) { - str <- paste0("multi-arm ", str) - } else if (inherits(self, "AnalysisResultsEnrichmentR6")) { - str <- paste0("enrichment ", str) - } - if (startWithUpperCase) { - str <- .firstCharacterToUpperCase(str) - } - - numberOfGroups <- self$.dataInput$getNumberOfGroups() - str <- paste0(str, " (") - - str <- paste0(str, tolower(sub("Dataset(Enrichment)?", "", .getClassName(self$.dataInput)))) - if (grepl("Survival", .getClassName(.getClassName))) {#TODO BUG? - str <- paste0(str, " data") - } - - if (numberOfGroups == 1) { - str <- paste0(str, " of one group") - } else { - str <- paste0(str, " of ", numberOfGroups, " groups") - } - - if (self$.design$kMax > 1) { - if (grepl("GroupSequential", .getClassName(self))) { - str <- paste0(str, ", group sequential design") - } else if (grepl("InverseNormal", .getClassName(self))) { - str <- paste0(str, ", inverse normal combination test design") - } else if (grepl("Fisher", .getClassName(self))) { - str <- paste0(str, ", Fisher's combination test design") - } else if (grepl("Dunnett", .getClassName(self))) { - str <- paste0(str, ", conditional Dunnett design") - } - } else { - str <- paste0(str, ", fixed sample size design") - } - - str <- paste0(str, ")") - return(str) - }, - getNumberOfStages = function() { - return(self$.stageResults$getNumberOfStages()) - }, - getDataInput = function() { - return(self$.dataInput) - } - ) -) - -AnalysisResultsBaseR6 <- R6Class("AnalysisResultsBaseR6", - inherit = AnalysisResultsR6, - public = list( - thetaH1 = NULL, - assumedStDev = NULL, - equalVariances = NULL, - testActions = NULL, - conditionalRejectionProbabilities = NULL, - conditionalPower = NULL, - repeatedConfidenceIntervalLowerBounds = NULL, - repeatedConfidenceIntervalUpperBounds = NULL, - repeatedPValues = NULL, - finalStage = NULL, - finalPValues = NULL, - finalConfidenceIntervalLowerBounds = NULL, - finalConfidenceIntervalUpperBounds = NULL, - medianUnbiasedEstimates = NULL, - initialize = function(design, dataInput, ..., thetaH1 = NULL, - assumedStDev = NULL, - equalVariances = NULL, - testActions = NULL, - conditionalRejectionProbabilities = NULL, - conditionalPower = NULL, - repeatedConfidenceIntervalLowerBounds = NULL, - repeatedConfidenceIntervalUpperBounds = NULL, - repeatedPValues = NULL, - finalStage = NULL, - finalPValues = NULL, - finalConfidenceIntervalLowerBounds = NULL, - finalConfidenceIntervalUpperBounds = NULL, - medianUnbiasedEstimates = NULL) { - self$thetaH1 <- thetaH1 - self$assumedStDev <- assumedStDev - self$equalVariances <- equalVariances - self$testActions <- testActions - self$conditionalRejectionProbabilities <- conditionalRejectionProbabilities - self$conditionalPower <- conditionalPower - self$repeatedConfidenceIntervalLowerBounds <- repeatedConfidenceIntervalLowerBounds - self$repeatedConfidenceIntervalUpperBounds <- repeatedConfidenceIntervalUpperBounds - self$repeatedPValues <- repeatedPValues - self$finalStage <- finalStage - self$finalPValues <- finalPValues - self$finalConfidenceIntervalLowerBounds <- finalConfidenceIntervalLowerBounds - self$finalConfidenceIntervalUpperBounds <- finalConfidenceIntervalUpperBounds - self$medianUnbiasedEstimates <- medianUnbiasedEstimates - - super$initialize(design = design, dataInput = dataInput, ...) - self$finalStage <- NA_integer_ - } - ) -) - -#' -#' @name AnalysisResultsMultiHypotheses -#' -#' @title -#' Basic Class for Analysis Results Multi-Hypotheses -#' -#' @description -#' A basic class for multi-hypotheses analysis results. -#' -#' @details -#' \code{AnalysisResultsMultiHypotheses} is the basic class for -#' \itemize{ -#' \item \code{\link{AnalysisResultsMultiArm}} and -#' \item \code{\link{AnalysisResultsEnrichment}}. -#' } -#' -#' @include class_core_parameter_set.R -#' @include class_core_plot_settings.R -#' @include class_analysis_dataset.R -#' @include class_design.R -#' @include f_core_constants.R -#' @include class_analysis_stage_results.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -AnalysisResultsMultiHypothesesR6 <- R6Class("AnalysisResultsMultiHypothesesR6", - inherit = AnalysisResultsR6, - public = list( - .closedTestResults = NULL, - thetaH1 = NULL, # means only - assumedStDevs = NULL, # means only - piTreatments = NULL, # rates only - intersectionTest = NULL, - varianceOption = NULL, - conditionalRejectionProbabilities = NULL, - conditionalPower = NULL, - repeatedConfidenceIntervalLowerBounds = NULL, - repeatedConfidenceIntervalUpperBounds = NULL, - repeatedPValues = NULL, - initialize = function(design, dataInput, ..., .closedTestResults = NULL, - thetaH1 = NULL, - assumedStDevs = NULL, - piTreatments = NULL, - intersectionTest = NULL, - varianceOption = NULL, - conditionalRejectionProbabilities = NULL, - conditionalPower = NULL, - repeatedConfidenceIntervalLowerBounds = NULL, - repeatedConfidenceIntervalUpperBounds = NULL, - repeatedPValues = NULL) { - self$.closedTestResults <- .closedTestResults - self$thetaH1 <- thetaH1 - self$assumedStDevs <- assumedStDevs - self$piTreatments <- piTreatments - self$intersectionTest <- intersectionTest - self$varianceOption <- varianceOption - self$conditionalRejectionProbabilities <- conditionalRejectionProbabilities - self$conditionalPower <- conditionalPower - self$repeatedConfidenceIntervalLowerBounds <- repeatedConfidenceIntervalLowerBounds - self$repeatedConfidenceIntervalUpperBounds <- repeatedConfidenceIntervalUpperBounds - self$repeatedPValues <- repeatedPValues - super$initialize(design = design, dataInput = dataInput, ...) - - for (param in c("thetaH1", "assumedStDevs", "piTreatments")) { - self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) - } - } - ) -) - -#' -#' @name AnalysisResultsMultiArm -#' -#' @title -#' Basic Class for Analysis Results Multi-Arm -#' -#' @description -#' A basic class for multi-arm analysis results. -#' -#' @details -#' \code{AnalysisResultsMultiArm} is the basic class for -#' \itemize{ -#' \item \code{\link{AnalysisResultsMultiArmFisher}}, -#' \item \code{\link{AnalysisResultsMultiArmInverseNormal}}, and -#' \item \code{\link{AnalysisResultsConditionalDunnett}}. -#' } -#' -#' @include class_core_parameter_set.R -#' @include class_core_plot_settings.R -#' @include class_analysis_dataset.R -#' @include class_design.R -#' @include f_core_constants.R -#' @include class_analysis_stage_results.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -AnalysisResultsMultiArmR6 <- R6Class("AnalysisResultsMultiArmR6", - inherit = AnalysisResultsMultiHypothesesR6, - public = list( - piControl = NULL, # rates only - initialize = function(design, dataInput, ..., piControl = NULL) { - self$piControl <- piControl - super$initialize(design = design, dataInput = dataInput, ...) - self$.setParameterType("piControl", C_PARAM_NOT_APPLICABLE) - }, - .getParametersToShow = function() { - parametersToShow <- self$.getVisibleFieldNames() - - if ("piTreatments" %in% parametersToShow && "piControl" %in% parametersToShow) { - index <- which(parametersToShow == "piTreatments") - parametersToShow <- parametersToShow[parametersToShow != "piControl"] - parametersToShow <- c( - parametersToShow[1:index], - "piControl", parametersToShow[(index + 1):length(parametersToShow)] - ) - } - - return(parametersToShow) - } - ) -) - -#' -#' @name AnalysisResultsEnrichment -#' -#' @title -#' Basic Class for Analysis Results Enrichment -#' -#' @description -#' A basic class for enrichment analysis results. -#' -#' @details -#' \code{AnalysisResultsEnrichment} is the basic class for -#' \itemize{ -#' \item \code{\link{AnalysisResultsEnrichmentFisher}} and -#' \item \code{\link{AnalysisResultsEnrichmentInverseNormal}}. -#' } -#' -#' @include class_core_parameter_set.R -#' @include class_core_plot_settings.R -#' @include class_analysis_dataset.R -#' @include class_design.R -#' @include f_core_constants.R -#' @include class_analysis_stage_results.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -AnalysisResultsEnrichmentR6 <- R6Class("AnalysisResultsEnrichmentR6", - inherit = AnalysisResultsMultiHypothesesR6, - public = list( - piControls = NULL, # rates only - initialize = function(design, dataInput, ..., piControls = NULL) { - self$piControls <- piControls - super$initialize(design = design, dataInput = dataInput, ...) - self$.setParameterType("piControls", C_PARAM_NOT_APPLICABLE) - } - ) -) - -#' -#' @title -#' Analysis Results Summary -#' -#' @description -#' Displays a summary of \code{\link{AnalysisResults}} object. -#' -#' @param object An \code{\link{AnalysisResults}} object. -#' @inheritParams param_digits -#' @inheritParams param_three_dots -#' -#' @details -#' Summarizes the parameters and results of an analysis results object. -#' -#' @template details_summary -#' -#' @template return_object_summary -#' @template how_to_get_help_for_generics -#' -#' @export -#' -#' @keywords internal -#' -summary.AnalysisResultsR6 <- function(object, ..., type = 1, digits = NA_integer_) { - return(summary.ParameterSetR6(object = object, ..., type = type, digits = digits)) -} - -#' -#' @title -#' Coerce AnalysisResults to a Data Frame -#' -#' @description -#' Returns the \code{\link{AnalysisResults}} object as data frame. -#' -#' @param x An \code{\link{AnalysisResults}} object created by \code{\link[=getAnalysisResults]{getAnalysisResults()}}. -#' @inheritParams param_niceColumnNamesEnabled -#' @inheritParams param_three_dots -#' -#' @details -#' Coerces the analysis results to a data frame. -#' -#' @template return_dataframe -#' -#' @export -#' -#' @keywords internal -#' -as.data.frame.AnalysisResultsR6 <- function(x, row.names = NULL, optional = FALSE, ..., - niceColumnNamesEnabled = FALSE) { - - parametersToShow <- .getDesignParametersToShow(x) - if (inherits(x, "AnalysisResultsMultiArmR6")) { - parametersToShow <- c(parametersToShow, ".closedTestResults$rejected") - } - parametersToShow <- c(parametersToShow, x$.getUserDefinedParameters()) - parametersToShow <- c(parametersToShow, x$.getDefaultParameters()) - parametersToShow <- c(parametersToShow, x$.getStageResultParametersToShow()) - parametersToShow <- c(parametersToShow, x$.getGeneratedParameters()) - - parametersToShow <- parametersToShow[!(parametersToShow %in% c( - "finalStage", "allocationRatioPlanned", "thetaH0", "thetaH1", "pi1", "pi2" - ))] - return(.getAsDataFrame( - parameterSet = x, - parameterNames = parametersToShow, - tableColumnNames = .getTableColumnNames(design = x$.design), - niceColumnNamesEnabled = niceColumnNamesEnabled - )) -} - -#' -#' @title -#' Names of a Analysis Results Object -#' -#' @description -#' Function to get the names of an \code{\link{AnalysisResults}} object. -#' -#' @param x An \code{\link{AnalysisResults}} object created by \code{\link[=getAnalysisResults]{getAnalysisResults()}}. -#' -#' @details -#' Returns the names of an analysis results that can be accessed by the user. -#' -#' @template return_names -#' -#' @export -#' -#' @keywords internal -#' -names.AnalysisResultsR6 <- function(x) { - namesToShow <- c(".design", ".dataInput", ".stageResults", ".conditionalPowerResults") - if (.isMultiArmAnalysisResults(x)) { - namesToShow <- c(namesToShow, ".closedTestResults") - } - namesToShow <- c(namesToShow, x$.getVisibleFieldNames()) - return(namesToShow) -} - -#' -#' @name AnalysisResultsGroupSequential -#' -#' @title -#' Analysis Results Group Sequential -#' -#' @description -#' Class for analysis results results based on a group sequential design. -#' -#' @template field_normalApproximation -#' @template field_directionUpper -#' @template field_thetaH0 -#' @template field_pi1 -#' @template field_pi2 -#' @template field_nPlanned -#' @template field_allocationRatioPlanned -#' @template field_thetaH1 -#' @template field_assumedStDev -#' @template field_equalVariances -#' @template field_testActions -#' @template field_conditionalRejectionProbabilities -#' @template field_conditionalPower -#' @template field_repeatedConfidenceIntervalLowerBounds -#' @template field_repeatedConfidenceIntervalUpperBounds -#' @template field_repeatedPValues -#' @template field_finalStage -#' @template field_finalPValues -#' @template field_finalConfidenceIntervalLowerBounds -#' @template field_finalConfidenceIntervalUpperBounds -#' @template field_medianUnbiasedEstimates -#' @template field_maxInformation -#' @template field_informationEpsilon -#' -#' @details -#' This object cannot be created directly; use \code{\link{getAnalysisResults}} -#' with suitable arguments to create the analysis results of a group sequential design. -#' -#' @include class_core_parameter_set.R -#' @include class_core_plot_settings.R -#' @include class_analysis_dataset.R -#' @include class_design.R -#' @include f_core_constants.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -AnalysisResultsGroupSequentialR6 <- R6Class("AnalysisResultsGroupSequentialR6", - inherit = AnalysisResultsBaseR6, - public = list( - maxInformation = NULL, - informationEpsilon = NULL, - initialize = function(design, dataInput, ..., maxInformation = NULL, informationEpsilon = NULL) { - self$maxInformation <- maxInformation - self$informationEpsilon <- informationEpsilon - - super$initialize(design = design, dataInput = dataInput, ...) - - self$.setParameterType("maxInformation", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("informationEpsilon", C_PARAM_NOT_APPLICABLE) - } - ) -) - -#' -#' @name AnalysisResultsInverseNormal -#' -#' @title -#' Analysis Results Inverse Normal -#' -#' @description -#' Class for analysis results results based on an inverse normal design. -#' -#' @template field_normalApproximation -#' @template field_directionUpper -#' @template field_thetaH0 -#' @template field_pi1 -#' @template field_pi2 -#' @template field_nPlanned -#' @template field_allocationRatioPlanned -#' @template field_thetaH1 -#' @template field_assumedStDev -#' @template field_equalVariances -#' @template field_testActions -#' @template field_conditionalRejectionProbabilities -#' @template field_conditionalPower -#' @template field_repeatedConfidenceIntervalLowerBounds -#' @template field_repeatedConfidenceIntervalUpperBounds -#' @template field_repeatedPValues -#' @template field_finalStage -#' @template field_finalPValues -#' @template field_finalConfidenceIntervalLowerBounds -#' @template field_finalConfidenceIntervalUpperBounds -#' @template field_medianUnbiasedEstimates -#' -#' @details -#' This object cannot be created directly; use \code{\link{getAnalysisResults}} -#' with suitable arguments to create the analysis results of a inverse normal design. -#' -#' @include class_core_parameter_set.R -#' @include class_core_plot_settings.R -#' @include class_analysis_dataset.R -#' @include class_design.R -#' @include f_core_constants.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -AnalysisResultsInverseNormalR6 <- R6Class("AnalysisResultsInverseNormalR6", - inherit = AnalysisResultsBaseR6 -) - -#' -#' @name AnalysisResultsMultiArmInverseNormal -#' -#' @title -#' Analysis Results Multi-Arm Inverse Normal -#' -#' @description -#' Class for multi-arm analysis results based on a inverse normal design. -#' -#' @template field_normalApproximation -#' @template field_directionUpper -#' @template field_thetaH0 -#' @template field_pi1 -#' @template field_pi2 -#' @template field_nPlanned -#' @template field_allocationRatioPlanned -#' @template field_thetaH1 -#' @template field_assumedStDevs -#' @template field_piTreatments -#' @template field_intersectionTest -#' @template field_varianceOption -#' @template field_conditionalRejectionProbabilities -#' @template field_conditionalPower -#' @template field_repeatedConfidenceIntervalLowerBounds -#' @template field_repeatedConfidenceIntervalUpperBounds -#' @template field_repeatedPValues -#' @template field_piControl -#' -#' @details -#' This object cannot be created directly; use \code{\link{getAnalysisResults}} -#' with suitable arguments to create the multi-arm analysis results of an inverse normal design. -#' -#' @include class_core_parameter_set.R -#' @include class_core_plot_settings.R -#' @include class_analysis_dataset.R -#' @include class_design.R -#' @include f_core_constants.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -AnalysisResultsMultiArmInverseNormalR6 <- R6Class("AnalysisResultsMultiArmInverseNormalR6", - inherit = AnalysisResultsMultiArmR6 -) - -#' -#' @name AnalysisResultsEnrichmentInverseNormal -#' -#' @title -#' Analysis Results Enrichment Inverse Normal -#' -#' @description -#' Class for enrichment analysis results based on a inverse normal design. -#' -#' @template field_normalApproximation -#' @template field_directionUpper -#' @template field_thetaH0 -#' @template field_pi1 -#' @template field_pi2 -#' @template field_nPlanned -#' @template field_allocationRatioPlanned -#' @template field_thetaH1 -#' @template field_assumedStDevs -#' @template field_piTreatments -#' @template field_intersectionTest -#' @template field_varianceOption -#' @template field_conditionalRejectionProbabilities -#' @template field_conditionalPower -#' @template field_repeatedConfidenceIntervalLowerBounds -#' @template field_repeatedConfidenceIntervalUpperBounds -#' @template field_repeatedPValues -#' @template field_piControls -#' @template field_stratifiedAnalysis -#' -#' @details -#' This object cannot be created directly; use \code{\link{getAnalysisResults}} -#' with suitable arguments to create the enrichment analysis results of an inverse normal design. -#' -#' @include class_core_parameter_set.R -#' @include class_core_plot_settings.R -#' @include class_analysis_dataset.R -#' @include class_design.R -#' @include f_core_constants.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -AnalysisResultsEnrichmentInverseNormalR6 <- R6Class("AnalysisResultsEnrichmentInverseNormalR6", - inherit = AnalysisResultsEnrichmentR6, - public = list( - stratifiedAnalysis = NULL - ) -) - -#' -#' @name AnalysisResultsFisher -#' -#' @title -#' Analysis Results Fisher -#' -#' @description -#' Class for analysis results based on a Fisher combination test design. -#' -#' @template field_normalApproximation -#' @template field_directionUpper -#' @template field_thetaH0 -#' @template field_pi1 -#' @template field_pi2 -#' @template field_nPlanned -#' @template field_allocationRatioPlanned -#' @template field_thetaH1 -#' @template field_assumedStDev -#' @template field_equalVariances -#' @template field_testActions -#' @template field_conditionalRejectionProbabilities -#' @template field_conditionalPower -#' @template field_repeatedConfidenceIntervalLowerBounds -#' @template field_repeatedConfidenceIntervalUpperBounds -#' @template field_repeatedPValues -#' @template field_finalStage -#' @template field_finalPValues -#' @template field_finalConfidenceIntervalLowerBounds -#' @template field_finalConfidenceIntervalUpperBounds -#' @template field_medianUnbiasedEstimates -#' @template field_conditionalPowerSimulated -#' @template field_iterations -#' @template field_seed -#' -#' @details -#' This object cannot be created directly; use \code{\link{getAnalysisResults}} -#' with suitable arguments to create the analysis results of a Fisher combination test design. -#' -#' @include class_core_parameter_set.R -#' @include class_core_plot_settings.R -#' @include class_analysis_dataset.R -#' @include class_design.R -#' @include f_core_constants.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -AnalysisResultsFisherR6 <- R6Class("AnalysisResultsFisherR6", - inherit = AnalysisResultsBaseR6, - public = list( - conditionalPowerSimulated = NULL, - iterations = NULL, - seed = NULL, - initialize = function(design, dataInput, ..., iterations = NULL, seed = NULL) { - self$iterations <- iterations - self$seed <- seed - super$initialize(design = design, dataInput = dataInput, ...) - self$conditionalPowerSimulated <- -1 - } - ) -) - -#' -#' @title -#' Analysis Results Multi-Arm Fisher -#' -#' @description -#' Class for multi-arm analysis results based on a Fisher combination test design. -#' -#' @template field_normalApproximation -#' @template field_directionUpper -#' @template field_thetaH0 -#' @template field_pi1 -#' @template field_pi2 -#' @template field_nPlanned -#' @template field_allocationRatioPlanned -#' @template field_thetaH1 -#' @template field_assumedStDevs -#' @template field_piTreatments -#' @template field_intersectionTest -#' @template field_varianceOption -#' @template field_conditionalRejectionProbabilities -#' @template field_conditionalPower -#' @template field_repeatedConfidenceIntervalLowerBounds -#' @template field_repeatedConfidenceIntervalUpperBounds -#' @template field_repeatedPValues -#' @template field_piControl -#' @template field_conditionalPowerSimulated -#' @template field_iterations -#' @template field_seed -#' -#' @details -#' This object cannot be created directly; use \code{\link{getAnalysisResults}} -#' with suitable arguments to create the multi-arm analysis results of a Fisher combination test design. -#' -#' @include class_core_parameter_set.R -#' @include class_core_plot_settings.R -#' @include class_analysis_dataset.R -#' @include class_design.R -#' @include f_core_constants.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -AnalysisResultsMultiArmFisherR6 <- R6Class("AnalysisResultsMultiArmFisherR6", - inherit = AnalysisResultsMultiArmR6, - public = list( - conditionalPowerSimulated = NULL, - iterations = NULL, - seed = NULL - ) -) - -#' -#' @name AnalysisResultsEnrichmentFisher -#' -#' @title -#' Analysis Results Enrichment Fisher -#' -#' @description -#' Class for enrichment analysis results based on a Fisher combination test design. -#' -#' @template field_normalApproximation -#' @template field_directionUpper -#' @template field_thetaH0 -#' @template field_pi1 -#' @template field_pi2 -#' @template field_nPlanned -#' @template field_thetaH1 -#' @template field_assumedStDevs -#' @template field_piTreatments -#' @template field_intersectionTest -#' @template field_varianceOption -#' @template field_conditionalRejectionProbabilities -#' @template field_repeatedConfidenceIntervalLowerBounds -#' @template field_repeatedConfidenceIntervalUpperBounds -#' @template field_repeatedPValues -#' @template field_piControls -#' @template field_conditionalPowerSimulated -#' @template field_iterations -#' @template field_seed -#' @template field_stratifiedAnalysis -#' -#' -#' @details -#' This object cannot be created directly; use \code{\link{getAnalysisResults}} -#' with suitable arguments to create the multi-arm analysis results of a Fisher combination test design. -#' -#' @include class_core_parameter_set.R -#' @include class_core_plot_settings.R -#' @include class_analysis_dataset.R -#' @include class_design.R -#' @include f_core_constants.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -AnalysisResultsEnrichmentFisherR6 <- R6Class("AnalysisResultsEnrichmentFisherR6", - inherit = AnalysisResultsEnrichmentR6, - public = list( - conditionalPowerSimulated = NULL, - iterations = NULL, - seed = NULL, - stratifiedAnalysis = NULL - ) -) - -#' -#' @name AnalysisResultsConditionalDunnett -#' -#' @title -#' Analysis Results Multi-Arm Conditional Dunnett -#' -#' @description -#' Class for multi-arm analysis results based on a conditional Dunnett test design. -#' -#' @template field_normalApproximation -#' @template field_directionUpper -#' @template field_thetaH0 -#' @template field_pi1 -#' @template field_pi2 -#' @template field_nPlanned -#' @template field_allocationRatioPlanned -#' @template field_thetaH1 -#' @template field_assumedStDevs -#' @template field_piTreatments -#' @template field_intersectionTest -#' @template field_varianceOption -#' @template field_conditionalRejectionProbabilities -#' @template field_conditionalPower -#' @template field_repeatedConfidenceIntervalLowerBounds -#' @template field_repeatedConfidenceIntervalUpperBounds -#' @template field_repeatedPValues -#' @template field_piControl -#' -#' @details -#' This object cannot be created directly; use \code{\link{getAnalysisResults}} -#' with suitable arguments to create the multi-arm analysis results of a conditional Dunnett test design. -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -AnalysisResultsConditionalDunnettR6 <- R6Class("AnalysisResultsConditionalDunnettR6", - inherit = AnalysisResultsMultiArmR6, - public = list() -) - -.getAnalysisResultsPlotArguments <- function(x, - nPlanned = NA_real_, allocationRatioPlanned = NA_real_) { - if (all(is.na(nPlanned))) { - nPlanned <- stats::na.omit(x$nPlanned) - } - - if (is.na(allocationRatioPlanned) && length(x$allocationRatioPlanned) == 1) { - allocationRatioPlanned <- x$allocationRatioPlanned - } - - if (length(allocationRatioPlanned) != 1) { - allocationRatioPlanned <- NA_real_ - } - - if ((.isConditionalPowerEnabled(x$nPlanned) || .isConditionalPowerEnabled(nPlanned)) && is.na(allocationRatioPlanned)) { - allocationRatioPlanned <- 1 - } - - return(list( - stageResults = x$.stageResults, - nPlanned = nPlanned, - allocationRatioPlanned = allocationRatioPlanned - )) -} - -.getConfidenceIntervalPlotLegendLabels <- function(x, treatmentArmsToShow) { - if (.isEnrichmentAnalysisResults(x)) { - gMax <- x$.stageResults$getGMax() - labels <- paste0("S", treatmentArmsToShow) - labels[treatmentArmsToShow == gMax] <- "F" - labels <- factor(labels, levels = unique(labels)) - return(labels) - } - - return(paste0(treatmentArmsToShow, " vs control")) -} - -.getConfidenceIntervalData <- function(x, treatmentArmsToShow = NULL) { - data <- .getConfidenceIntervalDataPerBound(x, "lower", treatmentArmsToShow) - data$upper <- .getConfidenceIntervalDataPerBound(x, "upper", treatmentArmsToShow)$upper - data$yValues <- (data$upper + data$lower) / 2 - data <- na.omit(data) - return(data) -} - -.getConfidenceIntervalDataPerBound <- function(x, ciName = c("lower", "upper"), treatmentArmsToShow = NULL) { - ciName <- match.arg(ciName) - paramName <- ifelse(ciName == "lower", "repeatedConfidenceIntervalLowerBounds", "repeatedConfidenceIntervalUpperBounds") - data <- x[[paramName]] - - if (is.matrix(data) && !is.null(treatmentArmsToShow) && - length(treatmentArmsToShow) > 0 && !any(is.na(treatmentArmsToShow))) { - data <- data[treatmentArmsToShow, ] - } - - if (is.matrix(data) && nrow(data) == 1) { - data <- as.numeric(data) - } - - if (is.matrix(data)) { - kMax <- ncol(data) - if (is.null(treatmentArmsToShow) || length(treatmentArmsToShow) == 0 || all(is.na(treatmentArmsToShow))) { - treatmentArmsToShow <- 1:nrow(data) - } - groups <- length(treatmentArmsToShow) - result <- data.frame(ci = data[, 1]) - colnames(result) <- ciName - result$xValues <- rep(1, groups) - result$categories <- .getConfidenceIntervalPlotLegendLabels(x, treatmentArmsToShow) - if (kMax == 1) { - return(result) - } - - for (stage in 2:kMax) { - resultPart <- data.frame(ci = data[, stage]) - colnames(resultPart) <- ciName - resultPart$xValues <- rep(stage, groups) - resultPart$categories <- .getConfidenceIntervalPlotLegendLabels(x, treatmentArmsToShow) - result <- rbind(result, resultPart) - } - return(result) - } - - if (is.null(treatmentArmsToShow) || length(treatmentArmsToShow) == 0 || all(is.na(treatmentArmsToShow))) { - treatmentArmsToShow <- 1 - } - - kMax <- length(data) - result <- data.frame(ci = data) - colnames(result) <- ciName - result$xValues <- 1:kMax - result$categories <- rep(.getConfidenceIntervalPlotLegendLabels(x, treatmentArmsToShow), kMax) - return(result) -} - -#' -#' @title -#' Analysis Results Plotting -#' -#' @description -#' Plots the conditional power together with the likelihood function. -#' -#' @param x The analysis results at given stage, obtained from \code{\link[=getAnalysisResults]{getAnalysisResults()}}. -#' @param y Not available for this kind of plot (is only defined to be compatible to the generic plot function). -#' @inheritParams param_nPlanned -#' @inheritParams param_stage -#' @inheritParams param_allocationRatioPlanned -#' @param main The main title, default is \code{"Dataset"}. -#' @param xlab The x-axis label, default is \code{"Stage"}. -#' @param ylab The y-axis label. -#' @param legendTitle The legend title, default is \code{""}. -#' @inheritParams param_palette -#' @inheritParams param_showSource -#' @inheritParams param_plotSettings -#' @inheritParams param_legendPosition -#' @inheritParams param_grid -#' @param type The plot type (default = 1). Note that at the moment only one type (the conditional power plot) is available. -#' @param ... Optional \link[=param_three_dots_plot]{plot arguments}. Furthermore the following arguments can be defined: -#' \itemize{ -#' \item \code{thetaRange}: A range of assumed effect sizes if testing means or a survival design was specified. -#' Additionally, if testing means was selected, \code{assumedStDev} (assumed standard deviation) -#' can be specified (default is \code{1}). -#' \item \code{piTreatmentRange}: A range of assumed rates pi1 to calculate the conditional power. -#' Additionally, if a two-sample comparison was selected, \code{pi2} can be specified (default is the value from -#' \code{\link[=getAnalysisResults]{getAnalysisResults()}}). -#' \item \code{directionUpper}: Specifies the direction of the alternative, -#' only applicable for one-sided testing; default is \code{TRUE} -#' which means that larger values of the test statistics yield smaller p-values. -#' \item \code{\link[=param_thetaH0]{thetaH0}}: The null hypothesis value, default is \code{0} for -#' the normal and the binary case, it is \code{1} for the survival case. -#' For testing a rate in one sample, a value thetaH0 in (0, 1) has to be specified for -#' defining the null hypothesis H0: \code{pi = thetaH0}. -#' } -#' -#' @details -#' The conditional power is calculated only if effect size and sample size is specified. -#' -#' @template return_object_ggplot -#' -#' @template examples_plot_analysis_results -#' -#' @export -#' -plot.AnalysisResultsR6 <- 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) { - .assertGgplotIsInstalled() - functionCall <- match.call(expand.dots = TRUE) - analysisResultsName <- as.character(functionCall$x)[1] - .assertIsSingleInteger(grid, "grid", validateType = FALSE) - typeNumbers <- .getPlotTypeNumber(type, x) - p <- NULL - plotList <- list() - for (typeNumber in typeNumbers) { - p <- .plotAnalysisResults( - x = x, y = y, type = typeNumber, - nPlanned = nPlanned, - allocationRatioPlanned = allocationRatioPlanned, - main = main, xlab = xlab, ylab = ylab, - legendTitle = legendTitle, palette = palette, legendPosition = legendPosition, - showSource = showSource, functionCall = functionCall, - analysisResultsName = analysisResultsName, plotSettings = plotSettings, ... - ) - .printPlotShowSourceSeparator(showSource, typeNumber, typeNumbers) - if (length(typeNumbers) > 1) { - caption <- .getPlotCaption(x, typeNumber, stopIfNotFound = TRUE) - plotList[[caption]] <- p - } - } - if (length(typeNumbers) == 1) { - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(p)) - } - - return(p) - } - - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(plotList)) - } - - return(.createPlotResultObject(plotList, grid)) -} - -.plotAnalysisResultsRCI <- function(..., - x, y, nPlanned, allocationRatioPlanned, main, xlab, ylab, - legendTitle, palette, legendPosition, showSource, analysisResultsName, plotSettings = NULL) { - .assertIsAnalysisResults(x) - .warnInCaseOfUnknownArguments(functionName = "plot", ignore = c("treatmentArms", "populations"), ...) - - if (.isEnrichmentAnalysisResults(x)) { - gMax <- x$.stageResults$getGMax() - treatmentArmsToShow <- .getPopulationsToShow(x, gMax = gMax, ...) - } else { - treatmentArmsToShow <- .getTreatmentArmsToShow(x, ...) - } - - data <- .getConfidenceIntervalData(x, treatmentArmsToShow) - if (nrow(data) == 0) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "unable to create plot because no RCIs are available in the specified analysis result" - ) - } - - .warnInCaseOfUnusedArgument(nPlanned, "nPlanned", NA_real_, "plot") - .warnInCaseOfUnusedArgument(allocationRatioPlanned, "allocationRatioPlanned", NA_real_, "plot") - - plotData <- list( - main = "Repeated Confidence Intervals", - xlab = "Stage", - ylab = "RCI", - sub = NA_character_ # subtitle - ) - - if (is.na(legendPosition)) { - if (!.isMultiHypothesesAnalysisResults(x)) { - legendPosition <- ifelse(length(treatmentArmsToShow) == 1 && treatmentArmsToShow == 1, - -1, C_POSITION_RIGHT_CENTER - ) - } else { - legendPosition <- C_POSITION_RIGHT_TOP - } - } - - treatmentArmsToShowCmd <- "" - if (!is.null(treatmentArmsToShow) && !identical(sort(unique(treatmentArmsToShow)), 1:nrow(data))) { - treatmentArmsToShowCmd <- paste0(", ", .arrayToString(treatmentArmsToShow, mode = "vector")) - } - dataCmd <- paste0("rpact:::.getConfidenceIntervalData(", analysisResultsName, treatmentArmsToShowCmd, ")") - srcCmd <- .showPlotSourceInformation( - objectName = analysisResultsName, - xParameterName = paste0(dataCmd, "$xValues"), - yParameterNames = c( - paste0(dataCmd, "$lower"), - paste0(dataCmd, "$yValues"), - paste0(dataCmd, "$upper") - ), - type = 2L, showSource = showSource, lineType = FALSE - ) - - p <- .createAnalysisResultsPlotObject(x, - data = data, plotData = plotData, main = main, xlab = xlab, ylab = ylab, - legendTitle = legendTitle, palette = palette, legendPosition = legendPosition, - kMax = x$.design$kMax, plotSettings = plotSettings - ) - p <- p + ggplot2::expand_limits(x = c(1, x$.design$kMax)) - return(p) -} - -.plotAnalysisResults <- function(..., - x, y, type, nPlanned, allocationRatioPlanned, main, xlab, ylab, - legendTitle, palette, legendPosition, showSource, functionCall, - analysisResultsName, plotSettings = NULL) { - .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) - if (!(type %in% c(1, 2))) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is not allowed; must be 1 or 2") - } - - .assertIsAnalysisResults(x) - .assertIsValidLegendPosition(legendPosition = legendPosition) - - if (type == 2) { - return(.plotAnalysisResultsRCI( - x = x, y = y, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, - main = main, xlab = xlab, ylab = ylab, - legendTitle = legendTitle, palette = palette, - legendPosition = legendPosition, showSource = showSource, - analysisResultsName = analysisResultsName, - plotSettings = plotSettings, ... - )) - } - - if (!.isConditionalPowerEnabled(x$nPlanned) && !.isConditionalPowerEnabled(nPlanned)) { - stop("'nPlanned' must be defined to create conditional power plot") - } - - .warnInCaseOfUnknownArguments( - functionName = "plot", - ignore = c("thetaRange", "assumedStDev", "assumedStDevs", "treatmentArms", "populations", "pi2", "piTreatmentRange"), - ... - ) - - if (is.na(legendPosition)) { - legendPosition <- C_POSITION_RIGHT_CENTER - } - - plotArgs <- .getAnalysisResultsPlotArguments( - x = x, nPlanned = nPlanned, - allocationRatioPlanned = allocationRatioPlanned - ) - - functionCall$x <- x$.stageResults - functionCall$y <- NULL - functionCall$stageResultsName <- paste0(analysisResultsName, "$.stageResults") - functionCall$nPlanned <- plotArgs$nPlanned - functionCall$main <- main - functionCall$xlab <- xlab - functionCall$ylab <- ylab - functionCall$legendTitle <- legendTitle - functionCall$palette <- palette - functionCall$legendPosition <- legendPosition - functionCall$type <- type - functionCall$plotSettings <- plotSettings - functionCall$allocationRatioPlanned <- plotArgs$allocationRatioPlanned - if (.isTrialDesignFisher(x$.design)) { - functionCall$iterations <- x$iterations - functionCall$seed <- x$seed - } - - if (x$getDataInput()$isDatasetMeans()) { - if (.isMultiHypothesesAnalysisResults(x)) { - assumedStDevs <- eval.parent(functionCall$assumedStDevs) - if (is.null(assumedStDevs)) { - assumedStDevs <- as.numeric(x$assumedStDevs) - } - - gMax <- x$.stageResults$getGMax() - .assertIsValidAssumedStDevs(assumedStDevs, gMax) - - functionCall$assumedStDevs <- assumedStDevs - } else { - assumedStDev <- eval.parent(functionCall$assumedStDev) - if (is.null(assumedStDev)) { - assumedStDev <- x$assumedStDev - } - functionCall$assumedStDev <- assumedStDev - } - } - - if (x$getDataInput()$isDatasetMeans() || x$getDataInput()$isDatasetSurvival()) { - thetaRange <- eval.parent(functionCall$thetaRange) - if (is.null(thetaRange)) { - thetaRangeMin <- min(x$thetaH0, min(na.omit(as.numeric(x$thetaH1)))) - thetaRangeMax <- 2 * max(x$thetaH0, max(na.omit(as.numeric(x$thetaH1)))) - thetaRange <- seq( - thetaRangeMin, thetaRangeMax, - (thetaRangeMax - thetaRangeMin) / C_THETA_RANGE_SEQUENCE_LENGTH_DEFAULT - ) - } else { - thetaRange <- .assertIsValidThetaRange( - thetaRange = thetaRange, - survivalDataEnabled = x$getDataInput()$isDatasetSurvival() - ) - } - functionCall$thetaRange <- thetaRange - } else if (x$getDataInput()$isDatasetRates()) { - if (.isMultiArmAnalysisResults(x)) { - piControl <- eval.parent(functionCall$piControl) - if (is.null(piControl)) { - piControl <- as.numeric(x$piControl) - } - functionCall$piControl <- piControl - } else if (.isEnrichmentAnalysisResults(x)) { - piControl <- eval.parent(functionCall$piControl) - if (is.null(piControl)) { - piControls <- as.numeric(x$piControls) - } - functionCall$piControls <- piControls - } else { - pi2 <- eval.parent(functionCall$pi2) - if (is.null(pi2)) { - pi2 <- x$pi2 - } - functionCall$pi2 <- pi2 - } - - piTreatmentRange <- eval.parent(functionCall$piTreatmentRange) - if (is.null(piTreatmentRange)) { - piTreatmentRange <- seq(0, 1, 1 / C_THETA_RANGE_SEQUENCE_LENGTH_DEFAULT) # default - } else { - piTreatmentRange <- .assertIsValidPiTreatmentRange(piTreatmentRange = piTreatmentRange) - } - functionCall$piTreatmentRange <- piTreatmentRange - } - - functionCall[[1L]] <- as.name("plot") - return(eval.parent(functionCall)) -} diff --git a/R/class_analysis_stage_results.R b/R/class_analysis_stage_results.R index b9071261..8edb30d0 100644 --- a/R/class_analysis_stage_results.R +++ b/R/class_analysis_stage_results.R @@ -1,3 +1,4 @@ +library("R6") ## | ## | *Stage results classes* ## | @@ -13,8 +14,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7403 $ -## | Last changed: $Date: 2023-11-08 16:12:00 +0100 (Mi, 08 Nov 2023) $ +## | File version: $Revision: 6943 $ +## | Last changed: $Date: 2023-04-24 09:47:00 +0200 (Mo, 24 Apr 2023) $ ## | Last changed by: $Author: pahlke $ ## | @@ -29,7 +30,7 @@ #' #' @template field_stages #' @template field_testStatistics -#' @template field_pValues +#' @template field_pValues #' @template field_combInverseNormal #' @template field_combFisher #' @template field_effectSizes @@ -62,188 +63,192 @@ #' #' @importFrom methods new #' -StageResults <- setRefClass("StageResults", - contains = "ParameterSet", - fields = list( - .plotSettings = "ANY", - .design = "TrialDesign", - .dataInput = "Dataset", - stage = "integer", - stages = "integer", - pValues = "numeric", - weightsFisher = "numeric", - weightsInverseNormal = "numeric", - thetaH0 = "numeric", - direction = "character" - ), - methods = list( - initialize = function(...) { - callSuper(...) - }, - init = function(design, dataInput) { - .design <<- design - .dataInput <<- dataInput - - .plotSettings <<- PlotSettingsR6$new() - if (!missing(design)) { - stages <<- c(1:design$kMax) - if (design$kMax == C_KMAX_DEFAULT) { - .setParameterType("stages", C_PARAM_DEFAULT_VALUE) - } else { - .setParameterType("stages", C_PARAM_USER_DEFINED) - } - .parameterNames <<- .getParameterNames(design = design) - } - .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS - - .setParameterType("stage", C_PARAM_NOT_APPLICABLE) - - .setParameterType("pValues", ifelse( - .isMultiArm(), C_PARAM_NOT_APPLICABLE, C_PARAM_GENERATED - )) - .setParameterType("thetaH0", ifelse( - identical(thetaH0, C_THETA_H0_MEANS_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - .setParameterType("direction", ifelse( - identical(direction, C_DIRECTION_UPPER), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - }, - getPlotSettings = function() { - return(.plotSettings) - }, - show = function(showType = 1, digits = NA_integer_) { - .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) - }, - .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { - "Method for automatically printing stage results" - .resetCat() - if (showType == 2) { - callSuper(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) - } else { - .cat(.toString(startWithUpperCase = TRUE), ":\n\n", - heading = 1, - consoleOutputEnabled = consoleOutputEnabled - ) - .showParametersOfOneGroup(.getUserDefinedParameters(), "User defined parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - .showParametersOfOneGroup(.getDefaultParameters(), "Default parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - .showParametersOfOneGroup(.getGeneratedParameters(), "Output", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - .showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - - if (grepl("Enrichment", .getClassName(.self))) { - .cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) - .cat(paste0(" S[i]: population i\n"), consoleOutputEnabled = consoleOutputEnabled) - .cat(paste0(" F: full population\n"), consoleOutputEnabled = consoleOutputEnabled) - } else if (grepl("MultiArm", .getClassName(.self))) { - .cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) - .cat( - paste0( - " (i): results of treatment arm i vs. control group ", - .dataInput$getNumberOfGroups(), "\n" - ), - consoleOutputEnabled = consoleOutputEnabled - ) - } else if (.dataInput$getNumberOfGroups(survivalCorrectionEnabled = FALSE) >= 2) { - .cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) - .cat(" (i): values of treatment arm i\n", consoleOutputEnabled = consoleOutputEnabled) - } - } - }, - isDirectionUpper = function() { - return(direction == C_DIRECTION_UPPER) - }, - .isMultiArm = function() { - return(grepl("multi", tolower(.getClassName(.self)))) - }, - .isEnrichment = function() { - return(grepl("enrichment", tolower(.getClassName(.self)))) - }, - getGMax = function() { - if (!is.matrix(testStatistics)) { - return(1L) - } - - gMax <- nrow(testStatistics) - if (is.null(gMax) || gMax == 0) { - gMax <- 1L - } - return(gMax) - }, - .getParametersToShow = function() { - return(c("stages")) - }, - .toString = function(startWithUpperCase = FALSE) { - s <- "stage results of" - - if (grepl("MultiArm", .getClassName(.self))) { - s <- paste(s, "multi-arm") - } else if (grepl("Enrichment", .getClassName(.self))) { - s <- paste(s, "enrichment") - } - - if (grepl("Means", .getClassName(.self))) { - s <- paste(s, "means") - } - - if (grepl("Rates", .getClassName(.self))) { - s <- paste(s, "rates") - } - - if (grepl("Survival", .getClassName(.self))) { - s <- paste(s, "survival data") - } - - if (startWithUpperCase) { - s <- .firstCharacterToUpperCase(s) - } - - return(s) - }, - getDataInput = function() { - return(.dataInput) - }, - getNumberOfGroups = function() { - return(.dataInput$getNumberOfGroups()) - }, - isOneSampleDataset = function() { - return(getNumberOfGroups() == 1) - }, - isTwoSampleDataset = function() { - return(getNumberOfGroups() == 2) - }, - isDatasetMeans = function() { - return(.dataInput$isDatasetMeans()) - }, - isDatasetRates = function() { - return(.dataInput$isDatasetRates()) - }, - isDatasetSurvival = function() { - return(.dataInput$isDatasetSurvival()) - }, - getNumberOfStages = function() { - if (.isMultiArm()) { - if (inherits(.self, "StageResultsMultiArmRates")) { - return(max( - ncol(stats::na.omit(testStatistics)), - ncol(stats::na.omit(separatePValues)) - )) - } - return(max( - ncol(stats::na.omit(effectSizes)), - ncol(stats::na.omit(separatePValues)) - )) - } - return(max( - length(stats::na.omit(effectSizes)), - length(stats::na.omit(pValues)) - )) - } - ) +StageResultsR6 <- R6Class("StageResultsR6", + inherit = ParameterSetR6, + public = list( + .plotSettings = NULL, + .design = NULL, + .dataInput = NULL, + stage = NULL, + stages = NULL, + pValues = NULL, + weightsFisher = NULL, + weightsInverseNormal = NULL, + thetaH0 = NULL, + direction = NULL, + initialize = function(..., stage = NULL, stages = NULL, pValues = NULL, weightsFisher = NULL, weightsInverseNormal = NULL, thetaH0 = NULL, direction = NULL) { + self$stage <- stage + self$stages <- stages + self$pValues <- pValues + self$weightsFisher <- weightsFisher + self$weightsInverseNormal <- weightsInverseNormal + self$thetaH0 <- thetaH0 + self$direction <- direction + super$initialize(...) + }, + init = function(design, dataInput) { + self$.design <- design + self$.dataInput <- dataInput + + self$.plotSettings <- PlotSettingsR6$new() + if (!missing(design)) { + self$stages <- c(1:design$kMax) + if (design$kMax == C_KMAX_DEFAULT) { + self$.setParameterType("stages", C_PARAM_DEFAULT_VALUE) + } else { + self$.setParameterType("stages", C_PARAM_USER_DEFINED) + } + self$.parameterNames <- .getParameterNames(design = design) + } + self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS + + self$.setParameterType("stage", C_PARAM_NOT_APPLICABLE) + + self$.setParameterType("pValues", ifelse( + self$.isMultiArm(), C_PARAM_NOT_APPLICABLE, C_PARAM_GENERATED + )) + self$.setParameterType("thetaH0", ifelse( + identical(self$thetaH0, C_THETA_H0_MEANS_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + self$.setParameterType("direction", ifelse( + identical(self$direction, C_DIRECTION_UPPER), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + }, + getPlotSettings = function() { + return(self$.plotSettings) + }, + show = function(showType = 1, digits = NA_integer_) { + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + }, + .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { + "Method for automatically printing stage results" + self$.resetCat() + if (showType == 2) { + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + } else { + self$.cat(self$.toString(startWithUpperCase = TRUE), ":\n\n", + heading = 1, + consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Output", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + + if (grepl("Enrichment", .getClassName(self))) { + self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(paste0(" S[i]: population i\n"), consoleOutputEnabled = consoleOutputEnabled) + self$.cat(paste0(" F: full population\n"), consoleOutputEnabled = consoleOutputEnabled) + } else if (grepl("MultiArm", .getClassName(self))) { + self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(paste0( + " (i): results of treatment arm i vs. control group ", + self$.dataInput$getNumberOfGroups(), "\n" + ), + consoleOutputEnabled = consoleOutputEnabled + ) + } else if (self$.dataInput$getNumberOfGroups(survivalCorrectionEnabled = FALSE) >= 2) { + self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" (i): values of treatment arm i\n", consoleOutputEnabled = consoleOutputEnabled) + } + } + }, + isDirectionUpper = function() { + return(self$direction == C_DIRECTION_UPPER) + }, + .isMultiArm = function() { + return(grepl("multi", tolower(.getClassName(self)))) + }, + .isEnrichment = function() { + return(grepl("enrichment", tolower(.getClassName(self)))) + }, + getGMax = function() { + if (!is.matrix(self$testStatistics)) { + return(1L) + } + + gMax <- nrow(self$testStatistics) + if (is.null(gMax) || gMax == 0) { + gMax <- 1L + } + return(gMax) + }, + .getParametersToShow = function() { + return(c("stages")) + }, + .toString = function(startWithUpperCase = FALSE) { + s <- "stage results of" + + if (grepl("MultiArm", .getClassName(self))) { + s <- paste(s, "multi-arm") + } else if (grepl("Enrichment", .getClassName(self))) { + s <- paste(s, "enrichment") + } + + if (grepl("Means", .getClassName(self))) { + s <- paste(s, "means") + } + + if (grepl("Rates", .getClassName(self))) { + s <- paste(s, "rates") + } + + if (grepl("Survival", .getClassName(self))) { + s <- paste(s, "survival data") + } + + if (startWithUpperCase) { + s <- .firstCharacterToUpperCase(s) + } + + return(s) + }, + getDataInput = function() { + return(self$.dataInput) + }, + getNumberOfGroups = function() { + return(self$.dataInput$getNumberOfGroups()) + }, + isOneSampleDataset = function() { + return(self$getNumberOfGroups() == 1) + }, + isTwoSampleDataset = function() { + return(self$getNumberOfGroups() == 2) + }, + isDatasetMeans = function() { + return(self$.dataInput$isDatasetMeans()) + }, + isDatasetRates = function() { + return(self$.dataInput$isDatasetRates()) + }, + isDatasetSurvival = function() { + return(self$.dataInput$isDatasetSurvival()) + }, + getNumberOfStages = function() { + if (self$.isMultiArm()) { + if (inherits(self, "StageResultsMultiArmRatesR6")) { + return(max( + ncol(stats::na.omit(self$testStatistics)), + ncol(stats::na.omit(self$separatePValues)) + )) + } + return(max( + ncol(stats::na.omit(self$effectSizes)), + ncol(stats::na.omit(self$separatePValues)) + )) + } + return(max( + length(stats::na.omit(self$effectSizes)), + length(stats::na.omit(self$pValues)) + )) + } + ) ) #' @@ -270,7 +275,7 @@ StageResults <- setRefClass("StageResults", #' @template field_combInverseNormal #' @template field_weightsInverseNormal #' @field ... Names of \code{dataInput}. -#' +#' #' @details #' This object cannot be created directly; use \code{getStageResults} #' with suitable arguments to create the stage results of a dataset of means. @@ -284,115 +289,146 @@ StageResults <- setRefClass("StageResults", #' #' @importFrom methods new #' -StageResultsMeans <- setRefClass("StageResultsMeans", - contains = "StageResults", - fields = list( - combInverseNormal = "numeric", - combFisher = "numeric", - overallTestStatistics = "numeric", - overallPValues = "numeric", - effectSizes = "numeric", - testStatistics = "numeric", - overallMeans = "numeric", - overallMeans1 = "numeric", - overallMeans2 = "numeric", - overallStDevs = "numeric", - overallStDevs1 = "numeric", - overallStDevs2 = "numeric", - overallSampleSizes = "numeric", - overallSampleSizes1 = "numeric", - overallSampleSizes2 = "numeric", - equalVariances = "logical", - normalApproximation = "logical" - ), - methods = list( - initialize = function(design, dataInput, ..., equalVariances = TRUE, normalApproximation = FALSE) { - callSuper( - .design = design, .dataInput = dataInput, ..., - equalVariances = equalVariances, normalApproximation = normalApproximation - ) - init(design = design, dataInput = dataInput) - - for (param in c( - "weightsFisher", - "weightsInverseNormal", - "combFisher", - "combInverseNormal" - )) { - .setParameterType(param, C_PARAM_NOT_APPLICABLE) - } - - for (param in .getParametersToShow()) { - if (.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { - .setParameterType(param, C_PARAM_GENERATED) - } - } - - .setParameterType("equalVariances", ifelse( - identical(equalVariances, TRUE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - .setParameterType("normalApproximation", ifelse( - identical(normalApproximation, FALSE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - }, - .getParametersToShow = function() { - parametersToShow <- c( - "stages", - "overallTestStatistics", - "overallPValues" - ) - if (.dataInput$getNumberOfGroups() == 1) { - parametersToShow <- c( - parametersToShow, - "overallMeans", - "overallStDevs", - "overallSampleSizes" - ) - } else if (.dataInput$getNumberOfGroups() == 2) { - parametersToShow <- c( - parametersToShow, - "overallMeans1", - "overallMeans2", - "overallStDevs1", - "overallStDevs2", - "overallSampleSizes1", - "overallSampleSizes2" - ) - } - parametersToShow <- c( - parametersToShow, - "testStatistics", - "pValues", - "effectSizes" - ) - if (.isTrialDesignInverseNormal(.design)) { - parametersToShow <- c( - parametersToShow, - "combInverseNormal", - "weightsInverseNormal" - ) - } else if (.isTrialDesignFisher(.design)) { - parametersToShow <- c( - parametersToShow, - "combFisher", - "weightsFisher" - ) - } - parametersToShow <- c( - parametersToShow, - "thetaH0", - "direction", - "normalApproximation" - ) - if (.dataInput$getNumberOfGroups() == 2) { - parametersToShow <- c( - parametersToShow, - "equalVariances" - ) - } - return(parametersToShow) - } - ) +StageResultsMeansR6 <- R6Class("StageResultsMeansR6", + inherit = StageResultsR6, + public = list( + combInverseNormal = NULL, + combFisher = NULL, + overallTestStatistics = NULL, + overallPValues = NULL, + effectSizes = NULL, + testStatistics = NULL, + overallMeans = NULL, + overallMeans1 = NULL, + overallMeans2 = NULL, + overallStDevs = NULL, + overallStDevs1 = NULL, + overallStDevs2 = NULL, + overallSampleSizes = NULL, + overallSampleSizes1 = NULL, + overallSampleSizes2 = NULL, + equalVariances = NULL, + normalApproximation = NULL, + initialize = function(design, dataInput, ..., + combInverseNormal = NULL, + combFisher = NULL, + overallTestStatistics = NULL, + overallPValues = NULL, + effectSizes = NULL, + testStatistics = NULL, + overallMeans = NULL, + overallMeans1 = NULL, + overallMeans2 = NULL, + overallStDevs = NULL, + overallStDevs1 = NULL, + overallStDevs2 = NULL, + overallSampleSizes = NULL, + overallSampleSizes1 = NULL, + overallSampleSizes2 = NULL, + equalVariances = TRUE, normalApproximation = FALSE) { + super$initialize(.design = design, .dataInput = dataInput, ...)#TODO + + self$combInverseNormal <- combInverseNormal + self$combFisher <- combFisher + self$overallTestStatistics <- overallTestStatistics + self$overallPValues <- overallPValues + self$effectSizes <- effectSizes + self$testStatistics <- testStatistics + self$overallMeans <- overallMeans + self$overallMeans1 <- overallMeans1 + self$overallMeans2 <- overallMeans2 + self$overallStDevs <- overallStDevs + self$overallStDevs1 <- overallStDevs1 + self$overallStDevs2 <- overallStDevs2 + self$overallSampleSizes <- overallSampleSizes + self$overallSampleSizes1 <- overallSampleSizes1 + self$overallSampleSizes2 <- overallSampleSizes2 + + self$equalVariances <- equalVariances + self$normalApproximation <- normalApproximation + + self$init(design = design, dataInput = dataInput) + + for (param in c( + "weightsFisher", + "weightsInverseNormal", + "combFisher", + "combInverseNormal" + )) { + self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) + } + + for (param in self$.getParametersToShow()) { + if (self$.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { + self$.setParameterType(param, C_PARAM_GENERATED) + } + } + + self$.setParameterType("equalVariances", ifelse( + identical(self$equalVariances, TRUE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + self$.setParameterType("normalApproximation", ifelse( + identical(self$normalApproximation, FALSE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + }, + .getParametersToShow = function() { + parametersToShow <- c( + "stages", + "overallTestStatistics", + "overallPValues" + ) + if (self$.dataInput$getNumberOfGroups() == 1) { + parametersToShow <- c( + parametersToShow, + "overallMeans", + "overallStDevs", + "overallSampleSizes" + ) + } else if (self$.dataInput$getNumberOfGroups() == 2) { + parametersToShow <- c( + parametersToShow, + "overallMeans1", + "overallMeans2", + "overallStDevs1", + "overallStDevs2", + "overallSampleSizes1", + "overallSampleSizes2" + ) + } + parametersToShow <- c( + parametersToShow, + "testStatistics", + "pValues", + "effectSizes" + ) + if (.isTrialDesignInverseNormal(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combInverseNormal", + "weightsInverseNormal" + ) + } else if (.isTrialDesignFisher(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combFisher", + "weightsFisher" + ) + } + parametersToShow <- c( + parametersToShow, + "thetaH0", + "direction", + "normalApproximation" + ) + if (self$.dataInput$getNumberOfGroups() == 2) { + parametersToShow <- c( + parametersToShow, + "equalVariances" + ) + } + return(parametersToShow) + } + ) ) #' @name StageResultsMultiArmMeans @@ -405,7 +441,7 @@ StageResultsMeans <- setRefClass("StageResultsMeans", #' #' @template field_stages #' @template field_testStatistics -#' @template field_pValues +#' @template field_pValues #' @template field_combInverseNormal #' @template field_combFisher #' @template field_effectSizes @@ -430,7 +466,7 @@ StageResultsMeans <- setRefClass("StageResultsMeans", #' @details #' This object cannot be created directly; use \code{getStageResults} #' with suitable arguments to create the stage results of a dataset of multi arm means. -#' +#' #' @include class_core_parameter_set.R #' @include class_design.R #' @include class_analysis_dataset.R @@ -440,94 +476,114 @@ StageResultsMeans <- setRefClass("StageResultsMeans", #' #' @importFrom methods new #' -StageResultsMultiArmMeans <- setRefClass("StageResultsMultiArmMeans", - contains = "StageResults", - fields = list( - stage = "integer", - combInverseNormal = "matrix", - combFisher = "matrix", - overallTestStatistics = "matrix", - overallStDevs = "matrix", - overallPooledStDevs = "matrix", - overallPValues = "matrix", - testStatistics = "matrix", - separatePValues = "matrix", - effectSizes = "matrix", - singleStepAdjustedPValues = "matrix", - intersectionTest = "character", - varianceOption = "character", - normalApproximation = "logical", - directionUpper = "logical" - ), - methods = list( - initialize = function(design, dataInput, ..., varianceOption = C_VARIANCE_OPTION_MULTIARMED_DEFAULT, - normalApproximation = FALSE) { - callSuper( - .design = design, .dataInput = dataInput, ..., - varianceOption = varianceOption, normalApproximation = normalApproximation - ) - init(design = design, dataInput = dataInput) - - for (param in c( - "singleStepAdjustedPValues", - "weightsFisher", - "weightsInverseNormal", - "combFisher", - "combInverseNormal" - )) { - .setParameterType(param, C_PARAM_NOT_APPLICABLE) - } - - for (param in .getParametersToShow()) { - if (.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { - .setParameterType(param, C_PARAM_GENERATED) - } - } - - .setParameterType("varianceOption", ifelse( - identical(varianceOption, C_VARIANCE_OPTION_MULTIARMED_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - .setParameterType("normalApproximation", ifelse( - identical(normalApproximation, FALSE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - .setParameterType("directionUpper", ifelse( - identical(directionUpper, C_DIRECTION_UPPER_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - }, - .getParametersToShow = function() { - parametersToShow <- c( - "stages", - "thetaH0", - "direction", - "normalApproximation", - "directionUpper", - "varianceOption", - "intersectionTest", - "overallTestStatistics", - "overallPValues", - "overallStDevs", - "overallPooledStDevs", - "testStatistics", - "separatePValues", - "effectSizes", - "singleStepAdjustedPValues" - ) - if (.isTrialDesignInverseNormal(.design)) { - parametersToShow <- c( - parametersToShow, - "combInverseNormal", - "weightsInverseNormal" - ) - } else if (.isTrialDesignFisher(.design)) { - parametersToShow <- c( - parametersToShow, - "combFisher", - "weightsFisher" - ) - } - return(parametersToShow) - } - ) +StageResultsMultiArmMeansR6 <- R6Class("StageResultsMultiArmMeansR6", + inherit = StageResultsR6, + public = list( + combInverseNormal = NULL, + combFisher = NULL, + overallTestStatistics = NULL, + overallStDevs = NULL, + overallPooledStDevs = NULL, + overallPValues = NULL, + testStatistics = NULL, + separatePValues = NULL, + effectSizes = NULL, + singleStepAdjustedPValues = NULL, + intersectionTest = NULL, + varianceOption = NULL, + normalApproximation = NULL, + directionUpper = NULL, + initialize = function(design, dataInput, ..., + combInverseNormal = NULL, + combFisher = NULL, + overallTestStatistics = NULL, + overallStDevs = NULL, + overallPooledStDevs = NULL, + overallPValues = NULL, + testStatistics = NULL, + separatePValues = NULL, + effectSizes = NULL, + singleStepAdjustedPValues = NULL, + intersectionTest = NULL,varianceOption = C_VARIANCE_OPTION_MULTIARMED_DEFAULT, + normalApproximation = FALSE, directionUpper = NULL) { + super$initialize(...) + self$combInverseNormal <- combInverseNormal + self$combFisher <- combFisher + self$overallTestStatistics <- overallTestStatistics + self$overallStDevs <- overallStDevs + self$overallPooledStDevs <- overallPooledStDevs + self$overallPValues <- overallPValues + self$testStatistics <- testStatistics + self$separatePValues <- separatePValues + self$effectSizes <- effectSizes + self$singleStepAdjustedPValues <- singleStepAdjustedPValues + self$varianceOption <- varianceOption + self$normalApproximation <- normalApproximation + self$directionUpper <- directionUpper + + + self$init(design = design, dataInput = dataInput) + + for (param in c( + "singleStepAdjustedPValues", + "weightsFisher", + "weightsInverseNormal", + "combFisher", + "combInverseNormal" + )) { + self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) + } + + for (param in self$.getParametersToShow()) { + if (self$.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { + self$.setParameterType(param, C_PARAM_GENERATED) + } + } + + self$.setParameterType("varianceOption", ifelse( + identical(self$varianceOption, C_VARIANCE_OPTION_MULTIARMED_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + self$.setParameterType("normalApproximation", ifelse( + identical(self$normalApproximation, FALSE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + self$.setParameterType("directionUpper", ifelse( + identical(self$directionUpper, C_DIRECTION_UPPER_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + }, + .getParametersToShow = function() { + parametersToShow <- c( + "stages", + "thetaH0", + "direction", + "normalApproximation", + "directionUpper", + "varianceOption", + "intersectionTest", + "overallTestStatistics", + "overallPValues", + "overallStDevs", + "overallPooledStDevs", + "testStatistics", + "separatePValues", + "effectSizes", + "singleStepAdjustedPValues" + ) + if (.isTrialDesignInverseNormal(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combInverseNormal", + "weightsInverseNormal" + ) + } else if (.isTrialDesignFisher(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combFisher", + "weightsFisher" + ) + } + return(parametersToShow) + } + ) ) #' @@ -538,7 +594,7 @@ StageResultsMultiArmMeans <- setRefClass("StageResultsMultiArmMeans", #' #' @description #' Class for stage results of rates. -#' +#' #' @template field_stages #' @template field_testStatistics #' @template field_overallTestStatistics @@ -568,107 +624,135 @@ StageResultsMultiArmMeans <- setRefClass("StageResultsMultiArmMeans", #' #' @importFrom methods new #' -StageResultsRates <- setRefClass("StageResultsRates", - contains = "StageResults", - fields = list( - combInverseNormal = "numeric", - combFisher = "numeric", - overallTestStatistics = "numeric", - overallPValues = "numeric", - effectSizes = "numeric", - testStatistics = "numeric", - overallPi1 = "numeric", - overallPi2 = "numeric", - overallEvents = "numeric", - overallEvents1 = "numeric", - overallEvents2 = "numeric", - overallSampleSizes = "numeric", - overallSampleSizes1 = "numeric", - overallSampleSizes2 = "numeric", - normalApproximation = "logical" - ), - methods = list( - initialize = function(design, dataInput, ..., normalApproximation = TRUE) { - callSuper( - .design = design, .dataInput = dataInput, ..., - normalApproximation = normalApproximation - ) - init(design = design, dataInput = dataInput) - - for (param in c( - "weightsFisher", - "weightsInverseNormal", - "combFisher", - "combInverseNormal" - )) { - .setParameterType(param, C_PARAM_NOT_APPLICABLE) - } - - for (param in .getParametersToShow()) { - if (.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { - .setParameterType(param, C_PARAM_GENERATED) - } - } - - .setParameterType("normalApproximation", ifelse( - identical(normalApproximation, TRUE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - }, - .getParametersToShow = function() { - parametersToShow <- c( - "stages", - "overallTestStatistics", - "overallPValues" - ) - if (.dataInput$getNumberOfGroups() == 1) { - parametersToShow <- c( - parametersToShow, - "overallEvents", - "overallSampleSizes", - "overallPi1" - ) - } else if (.dataInput$getNumberOfGroups() == 2) { - parametersToShow <- c( - parametersToShow, - "overallEvents1", - "overallEvents2", - "overallSampleSizes1", - "overallSampleSizes2", - "overallPi1", - "overallPi2" - ) - } - parametersToShow <- c( - parametersToShow, - "testStatistics", - "pValues" - ) - if (.dataInput$getNumberOfGroups() > 1) { - parametersToShow <- c(parametersToShow, "effectSizes") - } - - if (.isTrialDesignInverseNormal(.design)) { - parametersToShow <- c( - parametersToShow, - "combInverseNormal", - "weightsInverseNormal" - ) - } else if (.isTrialDesignFisher(.design)) { - parametersToShow <- c( - parametersToShow, - "combFisher", - "weightsFisher" - ) - } - parametersToShow <- c( - parametersToShow, - "thetaH0", - "direction", - "normalApproximation" - ) - return(parametersToShow) - } - ) +StageResultsRatesR6 <- R6Class("StageResultsRatesR6", + inherit = StageResultsR6, + public = list( + combInverseNormal = NULL, + combFisher = NULL, + overallTestStatistics = NULL, + overallPValues = NULL, + effectSizes = NULL, + testStatistics = NULL, + overallPi1 = NULL, + overallPi2 = NULL, + overallEvents = NULL, + overallEvents1 = NULL, + overallEvents2 = NULL, + overallSampleSizes = NULL, + overallSampleSizes1 = NULL, + overallSampleSizes2 = NULL, + normalApproximation = NULL, + initialize = function(design, dataInput, ..., + combInverseNormal = NULL, + combFisher = NULL, + overallTestStatistics = NULL, + overallPValues = NULL, + effectSizes = NULL, + testStatistics = NULL, + overallPi1 = NULL, + overallPi2 = NULL, + overallEvents = NULL, + overallEvents1 = NULL, + overallEvents2 = NULL, + overallSampleSizes = NULL, + overallSampleSizes1 = NULL, + overallSampleSizes2 = NULL, + normalApproximation = TRUE) { + super$initialize(.design = design, .dataInput = dataInput, ...)#TODO + + self$combInverseNormal <- combInverseNormal + self$combFisher <- combFisher + self$overallTestStatistics <- overallTestStatistics + self$overallPValues <- overallPValues + self$effectSizes <- effectSizes + self$testStatistics <- testStatistics + self$overallPi1 <- overallPi1 + self$overallPi2 <- overallPi2 + self$overallEvents <- overallEvents + self$overallEvents1 <- overallEvents1 + self$overallEvents2 <- overallEvents2 + self$overallSampleSizes <- overallSampleSizes + self$overallSampleSizes1 <- overallSampleSizes1 + self$overallSampleSizes2 <- overallSampleSizes2 + + self$normalApproximation <- normalApproximation + + self$init(design = design, dataInput = dataInput) + + for (param in c( + "weightsFisher", + "weightsInverseNormal", + "combFisher", + "combInverseNormal" + )) { + self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) + } + + for (param in self$.getParametersToShow()) { + if (self$.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { + self$.setParameterType(param, C_PARAM_GENERATED) + } + } + + self$.setParameterType("normalApproximation", ifelse( + identical(self$normalApproximation, TRUE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + }, + .getParametersToShow = function() { + parametersToShow <- c( + "stages", + "overallTestStatistics", + "overallPValues" + ) + if (self$.dataInput$getNumberOfGroups() == 1) { + parametersToShow <- c( + parametersToShow, + "overallEvents", + "overallSampleSizes", + "overallPi1" + ) + } else if (self$.dataInput$getNumberOfGroups() == 2) { + parametersToShow <- c( + parametersToShow, + "overallEvents1", + "overallEvents2", + "overallSampleSizes1", + "overallSampleSizes2", + "overallPi1", + "overallPi2" + ) + } + parametersToShow <- c( + parametersToShow, + "testStatistics", + "pValues" + ) + if (self$.dataInput$getNumberOfGroups() > 1) { + parametersToShow <- c(parametersToShow, "effectSizes") + } + + if (.isTrialDesignInverseNormal(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combInverseNormal", + "weightsInverseNormal" + ) + } else if (.isTrialDesignFisher(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combFisher", + "weightsFisher" + ) + } + parametersToShow <- c( + parametersToShow, + "thetaH0", + "direction", + "normalApproximation" + ) + return(parametersToShow) + } + ) ) #' @name StageResultsMultiArmRates @@ -681,7 +765,7 @@ StageResultsRates <- setRefClass("StageResultsRates", #' #' @template field_stages #' @template field_testStatistics -#' @template field_pValues +#' @template field_pValues #' @template field_combInverseNormal #' @template field_combFisher #' @template field_effectSizes @@ -703,7 +787,7 @@ StageResultsRates <- setRefClass("StageResultsRates", #' @details #' This object cannot be created directly; use \code{getStageResults} #' with suitable arguments to create the stage results of a dataset of multi arm rates. -#' +#' #' @include class_core_parameter_set.R #' @include class_design.R #' @include class_analysis_dataset.R @@ -713,88 +797,110 @@ StageResultsRates <- setRefClass("StageResultsRates", #' #' @importFrom methods new #' -StageResultsMultiArmRates <- setRefClass("StageResultsMultiArmRates", - contains = "StageResults", - fields = list( - stage = "integer", - overallPiTreatments = "matrix", - overallPiControl = "matrix", - combInverseNormal = "matrix", - combFisher = "matrix", - overallTestStatistics = "matrix", - overallPValues = "matrix", - testStatistics = "matrix", - separatePValues = "matrix", - effectSizes = "matrix", - singleStepAdjustedPValues = "matrix", - intersectionTest = "character", - normalApproximation = "logical", - directionUpper = "logical" - ), - methods = list( - initialize = function(design, dataInput, ..., - normalApproximation = FALSE) { - callSuper( - .design = design, .dataInput = dataInput, ..., - normalApproximation = normalApproximation - ) - init(design = design, dataInput = dataInput) - - for (param in c( - "singleStepAdjustedPValues", - "weightsFisher", - "weightsInverseNormal", - "combFisher", - "combInverseNormal" - )) { - .setParameterType(param, C_PARAM_NOT_APPLICABLE) - } - - for (param in .getParametersToShow()) { - if (.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { - .setParameterType(param, C_PARAM_GENERATED) - } - } - - .setParameterType("normalApproximation", ifelse( - identical(normalApproximation, FALSE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - .setParameterType("directionUpper", ifelse( - identical(directionUpper, C_DIRECTION_UPPER_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - }, - .getParametersToShow = function() { - parametersToShow <- c( - "stages", - "thetaH0", - "direction", - "normalApproximation", - "directionUpper", - "overallPiControl", - "overallPiTreatments", - "intersectionTest", - "overallTestStatistics", - "overallPValues", - "testStatistics", - "separatePValues", - "singleStepAdjustedPValues" - ) - if (.isTrialDesignInverseNormal(.design)) { - parametersToShow <- c( - parametersToShow, - "combInverseNormal", - "weightsInverseNormal" - ) - } else if (.isTrialDesignFisher(.design)) { - parametersToShow <- c( - parametersToShow, - "combFisher", - "weightsFisher" - ) - } - return(parametersToShow) - } - ) +StageResultsMultiArmRatesR6 <- R6Class("StageResultsMultiArmRatesR6", + inherit = StageResultsR6, + public = list( + stage = NULL, + overallPiTreatments = NULL, + overallPiControl = NULL, + combInverseNormal = NULL, + combFisher = NULL, + overallTestStatistics = NULL, + overallPValues = NULL, + testStatistics = NULL, + separatePValues = NULL, + effectSizes = NULL, + singleStepAdjustedPValues = NULL, + intersectionTest = NULL, + normalApproximation = NULL, + directionUpper = NULL, + initialize = function(design, dataInput, ..., + overallPiTreatments = NULL, + overallPiControl = NULL, + combInverseNormal = NULL, + combFisher = NULL, + overallTestStatistics = NULL, + overallPValues = NULL, + testStatistics = NULL, + separatePValues = NULL, + effectSizes = NULL, + singleStepAdjustedPValues = NULL, + intersectionTest = NULL, + normalApproximation = FALSE, + directionUpper = NULL) { + super$initialize(.design = design, .dataInput = dataInput, ...)#TODO + + self$overallPiTreatments <- overallPiTreatments + self$overallPiControl <- overallPiControl + self$combInverseNormal <- combInverseNormal + self$combFisher <- combFisher + self$overallTestStatistics <- overallTestStatistics + self$overallPValues <- overallPValues + self$testStatistics <- testStatistics + self$separatePValues <- separatePValues + self$effectSizes <- effectSizes + self$singleStepAdjustedPValues <- singleStepAdjustedPValues + self$intersectionTest <- intersectionTest + self$normalApproximation <- normalApproximation + self$directionUpper <- directionUpper + + self$init(design = design, dataInput = dataInput) + + for (param in c( + "singleStepAdjustedPValues", + "weightsFisher", + "weightsInverseNormal", + "combFisher", + "combInverseNormal" + )) { + self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) + } + + for (param in self$.getParametersToShow()) { + if (self$.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { + self$.setParameterType(param, C_PARAM_GENERATED) + } + } + + self$.setParameterType("normalApproximation", ifelse( + identical(self$normalApproximation, FALSE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + self$.setParameterType("directionUpper", ifelse( + identical(self$directionUpper, C_DIRECTION_UPPER_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + }, + .getParametersToShow = function() { + parametersToShow <- c( + "stages", + "thetaH0", + "direction", + "normalApproximation", + "directionUpper", + "overallPiControl", + "overallPiTreatments", + "intersectionTest", + "overallTestStatistics", + "overallPValues", + "testStatistics", + "separatePValues", + "singleStepAdjustedPValues" + ) + if (.isTrialDesignInverseNormal(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combInverseNormal", + "weightsInverseNormal" + ) + } else if (.isTrialDesignFisher(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combFisher", + "weightsFisher" + ) + } + return(parametersToShow) + } + ) ) #' @@ -805,7 +911,7 @@ StageResultsMultiArmRates <- setRefClass("StageResultsMultiArmRates", #' #' @description #' Class for stage results survival data. -#' +#' #' @template field_stages #' @template field_testStatistics #' @template field_overallTestStatistics @@ -838,75 +944,95 @@ StageResultsMultiArmRates <- setRefClass("StageResultsMultiArmRates", #' #' @importFrom methods new #' -StageResultsSurvival <- setRefClass("StageResultsSurvival", - contains = "StageResults", - fields = list( - combInverseNormal = "numeric", - combFisher = "numeric", - overallPValues = "numeric", - effectSizes = "numeric", - overallTestStatistics = "numeric", - overallEvents = "numeric", - overallAllocationRatios = "numeric", - events = "numeric", - allocationRatios = "numeric", - testStatistics = "numeric" - ), - methods = list( - initialize = function(design, dataInput, ...) { - callSuper(.design = design, .dataInput = dataInput, ...) - init(design = design, dataInput = dataInput) - - for (param in c( - "weightsFisher", - "weightsInverseNormal", - "combFisher", - "combInverseNormal" - )) { - .setParameterType(param, C_PARAM_NOT_APPLICABLE) - } - - for (param in .getParametersToShow()) { - if (.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { - .setParameterType(param, C_PARAM_GENERATED) - } - } - }, - .getParametersToShow = function() { - parametersToShow <- c( - "stages", - "overallTestStatistics", - "overallPValues", - "overallEvents", - "overallAllocationRatios", - "events", - "allocationRatios", - "testStatistics", - "pValues", - "overallPValues", - "effectSizes" - ) - if (.isTrialDesignInverseNormal(.design)) { - parametersToShow <- c( - parametersToShow, - "combInverseNormal", - "weightsInverseNormal" - ) - } else if (.isTrialDesignFisher(.design)) { - parametersToShow <- c( - parametersToShow, - "combFisher", - "weightsFisher" - ) - } - parametersToShow <- c( - parametersToShow, - "thetaH0", - "direction" - ) - return(parametersToShow) - } - ) +StageResultsSurvivalR6 <- R6Class("StageResultsSurvivalR6", + inherit = StageResultsR6, + public = list( + combInverseNormal = NULL, + combFisher = NULL, + overallPValues = NULL, + effectSizes = NULL, + overallTestStatistics = NULL, + overallEvents = NULL, + overallAllocationRatios = NULL, + events = NULL, + allocationRatios = NULL, + testStatistics = NULL, + initialize = function(design, dataInput, ..., + combInverseNormal = NULL, + combFisher = NULL, + overallPValues = NULL, + effectSizes = NULL, + overallTestStatistics = NULL, + overallEvents = NULL, + overallAllocationRatios = NULL, + events = NULL, + allocationRatios = NULL, + testStatistics = NULL) { + super$initialize(.design = design, .dataInput = dataInput, ...)#TODO + + self$combInverseNormal <- combInverseNormal + self$combFisher <- combFisher + self$overallPValues <- overallPValues + self$effectSizes <- effectSizes + self$overallTestStatistics <- overallTestStatistics + self$overallEvents <- overallEvents + self$overallAllocationRatios <- overallAllocationRatios + self$events <- events + self$allocationRatios <- allocationRatios + self$testStatistics <- testStatistics + + self$init(design = design, dataInput = dataInput) + + for (param in c( + "weightsFisher", + "weightsInverseNormal", + "combFisher", + "combInverseNormal" + )) { + self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) + } + + for (param in self$.getParametersToShow()) { + if (self$.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { + self$.setParameterType(param, C_PARAM_GENERATED) + } + } + }, + .getParametersToShow = function() { + parametersToShow <- c( + "stages", + "overallTestStatistics", + "overallPValues", + "overallEvents", + "overallAllocationRatios", + "events", + "allocationRatios", + "testStatistics", + "pValues", + "overallPValues", + "effectSizes" + ) + if (.isTrialDesignInverseNormal(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combInverseNormal", + "weightsInverseNormal" + ) + } else if (.isTrialDesignFisher(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combFisher", + "weightsFisher" + ) + } + parametersToShow <- c( + parametersToShow, + "thetaH0", + "direction" + ) + return(parametersToShow) + } + ) ) #' @name StageResultsMultiArmSurvival @@ -919,7 +1045,7 @@ StageResultsSurvival <- setRefClass("StageResultsSurvival", #' #' @template field_stages #' @template field_testStatistics -#' @template field_pValues +#' @template field_pValues #' @template field_combInverseNormal #' @template field_combFisher #' @template field_effectSizes @@ -940,7 +1066,7 @@ StageResultsSurvival <- setRefClass("StageResultsSurvival", #' @details #' This object cannot be created directly; use \code{getStageResults} #' with suitable arguments to create the stage results of a dataset of multi arm survival. -#' +#' #' @include class_core_parameter_set.R #' @include class_design.R #' @include class_analysis_dataset.R @@ -950,76 +1076,96 @@ StageResultsSurvival <- setRefClass("StageResultsSurvival", #' #' @importFrom methods new #' -StageResultsMultiArmSurvival <- setRefClass("StageResultsMultiArmSurvival", - contains = "StageResults", - fields = list( - stage = "integer", - combInverseNormal = "matrix", - combFisher = "matrix", - overallTestStatistics = "matrix", - overallPValues = "matrix", - testStatistics = "matrix", - separatePValues = "matrix", - effectSizes = "matrix", - singleStepAdjustedPValues = "matrix", - intersectionTest = "character", - directionUpper = "logical" - ), - methods = list( - initialize = function(design, dataInput, ...) { - callSuper(.design = design, .dataInput = dataInput, ...) - init(design = design, dataInput = dataInput) - - for (param in c( - "singleStepAdjustedPValues", - "weightsFisher", - "weightsInverseNormal", - "combFisher", - "combInverseNormal" - )) { - .setParameterType(param, C_PARAM_NOT_APPLICABLE) - } - - for (param in .getParametersToShow()) { - if (.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { - .setParameterType(param, C_PARAM_GENERATED) - } - } - - .setParameterType("directionUpper", ifelse( - identical(directionUpper, C_DIRECTION_UPPER_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - }, - .getParametersToShow = function() { - parametersToShow <- c( - "stages", - "thetaH0", - "direction", - "directionUpper", - "intersectionTest", - "overallTestStatistics", - "overallPValues", - "testStatistics", - "separatePValues", - "effectSizes", - "singleStepAdjustedPValues" - ) - if (.isTrialDesignInverseNormal(.design)) { - parametersToShow <- c( - parametersToShow, - "combInverseNormal", - "weightsInverseNormal" - ) - } else if (.isTrialDesignFisher(.design)) { - parametersToShow <- c( - parametersToShow, - "combFisher", - "weightsFisher" - ) - } - return(parametersToShow) - } - ) +StageResultsMultiArmSurvivalR6 <- R6Class("StageResultsMultiArmSurvivalR6", + inherit = StageResultsR6, + public = list( + stage = NULL, + combInverseNormal = NULL, + combFisher = NULL, + overallTestStatistics = NULL, + overallPValues = NULL, + testStatistics = NULL, + separatePValues = NULL, + effectSizes = NULL, + singleStepAdjustedPValues = NULL, + intersectionTest = NULL, + directionUpper = NULL, + initialize = function(design, dataInput, ..., + combInverseNormal = NULL, + combFisher = NULL, + overallTestStatistics = NULL, + overallPValues = NULL, + testStatistics = NULL, + separatePValues = NULL, + effectSizes = NULL, + singleStepAdjustedPValues = NULL, + intersectionTest = NULL, + directionUpper = NULL) { + super$initialize(.design = design, .dataInput = dataInput, ...) #TODO + + self$combInverseNormal <- combInverseNormal + self$combFisher <- combFisher + self$overallTestStatistics <- overallTestStatistics + self$overallPValues <- overallPValues + self$testStatistics <- testStatistics + self$separatePValues <- separatePValues + self$effectSizes <- effectSizes + self$singleStepAdjustedPValues <- singleStepAdjustedPValues + self$intersectionTest <- intersectionTest + self$directionUpper <- directionUpper + + self$init(design = design, dataInput = dataInput) + + for (param in c( + "singleStepAdjustedPValues", + "weightsFisher", + "weightsInverseNormal", + "combFisher", + "combInverseNormal" + )) { + self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) + } + + for (param in self$.getParametersToShow()) { + if (self$.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { + self$.setParameterType(param, C_PARAM_GENERATED) + } + } + + self$.setParameterType("directionUpper", ifelse( + identical(self$directionUpper, C_DIRECTION_UPPER_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + }, + .getParametersToShow = function() { + parametersToShow <- c( + "stages", + "thetaH0", + "direction", + "directionUpper", + "intersectionTest", + "overallTestStatistics", + "overallPValues", + "testStatistics", + "separatePValues", + "effectSizes", + "singleStepAdjustedPValues" + ) + if (.isTrialDesignInverseNormal(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combInverseNormal", + "weightsInverseNormal" + ) + } else if (.isTrialDesignFisher(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combFisher", + "weightsFisher" + ) + } + return(parametersToShow) + } + ) ) #' @@ -1040,7 +1186,7 @@ StageResultsMultiArmSurvival <- setRefClass("StageResultsMultiArmSurvival", #' @template field_intersectionTest #' @template field_testStatistics #' @template field_overallTestStatistics -#' @template field_pValues +#' @template field_pValues #' @template field_overallPValues #' @template field_overallStDevs #' @template field_overallPooledStDevs @@ -1061,18 +1207,16 @@ StageResultsMultiArmSurvival <- setRefClass("StageResultsMultiArmSurvival", #' #' @importFrom methods new #' -StageResultsEnrichmentMeans <- setRefClass("StageResultsEnrichmentMeans", - contains = "StageResultsMultiArmMeans", - fields = list( - .overallSampleSizes1 = "matrix", - .overallSampleSizes2 = "matrix", - stratifiedAnalysis = "logical" - ), - methods = list( - .getParametersToShow = function() { - return(c(callSuper(), "stratifiedAnalysis")) - } - ) +StageResultsEnrichmentMeansR6 <- R6Class("StageResultsEnrichmentMeansR6", + inherit = StageResultsMultiArmMeansR6, + public = list( + .overallSampleSizes1 = NULL, + .overallSampleSizes2 = NULL, + stratifiedAnalysis = NULL, + .getParametersToShow = function() {#TODO init + return(c(super$.getParametersToShow(), "stratifiedAnalysis")) + } + ) ) #' @@ -1086,7 +1230,7 @@ StageResultsEnrichmentMeans <- setRefClass("StageResultsEnrichmentMeans", #' #' @template field_stages #' @template field_testStatistics -#' @template field_pValues +#' @template field_pValues #' @template field_combInverseNormal #' @template field_combFisher #' @template field_effectSizes @@ -1102,22 +1246,20 @@ StageResultsEnrichmentMeans <- setRefClass("StageResultsEnrichmentMeans", #' #' @importFrom methods new #' -StageResultsEnrichmentRates <- setRefClass("StageResultsEnrichmentRates", - contains = "StageResultsMultiArmRates", - fields = list( - .overallSampleSizes1 = "matrix", - .overallSampleSizes2 = "matrix", - overallPisTreatment = "matrix", - overallPisControl = "matrix", - stratifiedAnalysis = "logical" - ), - methods = list( - .getParametersToShow = function() { - parametersToShow <- callSuper() - parametersToShow <- parametersToShow[!(parametersToShow %in% c("overallPiTreatments", "overallPiControl"))] - return(c(parametersToShow, "stratifiedAnalysis", "overallPisTreatment", "overallPisControl")) - } - ) +StageResultsEnrichmentRatesR6 <- R6Class("StageResultsEnrichmentRatesR6", + inherit = StageResultsMultiArmRatesR6, + public = list( + .overallSampleSizes1 = NULL, + .overallSampleSizes2 = NULL, + overallPisTreatment = NULL, + overallPisControl = NULL, + stratifiedAnalysis = NULL, + .getParametersToShow = function() { + parametersToShow <- super$.getParametersToShow() + parametersToShow <- parametersToShow[!(parametersToShow %in% c("overallPiTreatments", "overallPiControl"))] + return(c(parametersToShow, "stratifiedAnalysis", "overallPisTreatment", "overallPisControl")) + } + ) ) #' @@ -1131,7 +1273,7 @@ StageResultsEnrichmentRates <- setRefClass("StageResultsEnrichmentRates", #' #' @template field_stages #' @template field_testStatistics -#' @template field_pValues +#' @template field_pValues #' @template field_combInverseNormal #' @template field_combFisher #' @template field_effectSizes @@ -1147,17 +1289,15 @@ StageResultsEnrichmentRates <- setRefClass("StageResultsEnrichmentRates", #' #' @importFrom methods new #' -StageResultsEnrichmentSurvival <- setRefClass("StageResultsEnrichmentSurvival", - contains = "StageResultsMultiArmSurvival", - fields = list( - stratifiedAnalysis = "logical", - .overallEvents = "matrix" - ), - methods = list( - .getParametersToShow = function() { - return(c(callSuper(), "stratifiedAnalysis")) - } - ) +StageResultsEnrichmentSurvivalR6 <- R6Class("StageResultsEnrichmentSurvivalR6", + inherit = StageResultsMultiArmSurvivalR6, + public = list( + stratifiedAnalysis = NULL, + .overallEvents = NULL, + .getParametersToShow = function() { + return(c(super$.getParametersToShow(), "stratifiedAnalysis")) + } + ) ) #' @@ -1178,8 +1318,8 @@ StageResultsEnrichmentSurvival <- setRefClass("StageResultsEnrichmentSurvival", #' #' @keywords internal #' -names.StageResults <- function(x) { - return(x$.getParametersToShow()) +names.StageResultsR6 <- function(x) { + return(x$.getParametersToShow()) } #' @@ -1203,44 +1343,113 @@ names.StageResults <- function(x) { #' #' @keywords internal #' -as.data.frame.StageResults <- function(x, row.names = NULL, - optional = FALSE, niceColumnNamesEnabled = FALSE, - includeAllParameters = FALSE, type = 1, ...) { - if (type == 1) { - parametersToShow <- x$.getParametersToShow() +as.data.frame.StageResultsR6 <- function(x, row.names = NULL, + optional = FALSE, niceColumnNamesEnabled = FALSE, + includeAllParameters = FALSE, type = 1, ...) { + if (type == 1) { + parametersToShow <- x$.getParametersToShow() + + return(.getAsDataFrame( + parameterSet = x, + parameterNames = parametersToShow, + niceColumnNamesEnabled = niceColumnNamesEnabled, + includeAllParameters = includeAllParameters, + tableColumnNames = .getTableColumnNames(design = x$.design) + )) + } + + kMax <- length(x$stages) + group1 <- rep(1, kMax) + group2 <- rep(2, kMax) + empty <- rep(NA_real_, kMax) + stageResults <- data.frame( + Stage = c(x$stages, x$stages), + Group = c(group1, group2), + "Cumulative Mean" = c(x$overallMeans1, x$overallMeans2), + "Cumulative stDev" = c(x$overallStDevs1, x$overallStDevs2), + "Cumulative test statistics" = c(x$overallTestStatistics, empty), + "Overall p-value" = c(x$overallPValues, empty), + "Cumulative stDev" = c(x$overallStDevs, empty), + "Stage-wise test statistic" = c(x$testStatistics, empty), + "Stage-wise p-value" = c(x$pValues, empty), + "Comb Inverse Normal" = c(x$combInverseNormal, empty), + "Comb Fisher" = c(x$combFisher, empty), + "Weights Fisher" = c(x$weightsFisher, empty), + "Weights Inverse Normal" = c(x$weightsInverseNormal, empty), + row.names = row.names, + ... + ) + stageResults <- stageResults[with(stageResults, order(Stage, Group)), ] + return(stageResults) +} - return(.getAsDataFrame( - parameterSet = x, - parameterNames = parametersToShow, - niceColumnNamesEnabled = niceColumnNamesEnabled, - includeAllParameters = includeAllParameters, - tableColumnNames = .getTableColumnNames(design = x$.design) - )) - } +.getTreatmentArmsToShow <- function(x, ...) { + dataInput <- x + if (!inherits(dataInput, "Dataset")) { + dataInput <- x[[".dataInput"]] + } + if (is.null(dataInput) || !inherits(dataInput, "Dataset")) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to get 'dataInput' from ", .getClassName(x)) + } + + numberOfTreatments <- dataInput$getNumberOfGroups() + if (numberOfTreatments > 1) { + validComparisons <- 1L:as.integer(numberOfTreatments - 1) + } else { + validComparisons <- 1L + } + + treatmentArmsToShow <- .getOptionalArgument("treatmentArms", ...) + if (!is.null(treatmentArmsToShow)) { + treatmentArmsToShow <- as.integer(na.omit(treatmentArmsToShow)) + } + if (is.null(treatmentArmsToShow) || length(treatmentArmsToShow) == 0 || + all(is.na(treatmentArmsToShow)) || !is.numeric(treatmentArmsToShow)) { + treatmentArmsToShow <- validComparisons + } else if (!all(treatmentArmsToShow %in% validComparisons)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'treatmentArms' (", + .arrayToString(treatmentArmsToShow), ") must be a vector ", + "containing one or more values of ", .arrayToString(validComparisons) + ) + } + treatmentArmsToShow <- sort(unique(treatmentArmsToShow)) + return(treatmentArmsToShow) +} - kMax <- length(x$stages) - group1 <- rep(1, kMax) - group2 <- rep(2, kMax) - empty <- rep(NA_real_, kMax) - stageResults <- data.frame( - Stage = c(x$stages, x$stages), - Group = c(group1, group2), - "Cumulative Mean" = c(x$overallMeans1, x$overallMeans2), - "Cumulative stDev" = c(x$overallStDevs1, x$overallStDevs2), - "Cumulative test statistics" = c(x$overallTestStatistics, empty), - "Overall p-value" = c(x$overallPValues, empty), - "Cumulative stDev" = c(x$overallStDevs, empty), - "Stage-wise test statistic" = c(x$testStatistics, empty), - "Stage-wise p-value" = c(x$pValues, empty), - "Comb Inverse Normal" = c(x$combInverseNormal, empty), - "Comb Fisher" = c(x$combFisher, empty), - "Weights Fisher" = c(x$weightsFisher, empty), - "Weights Inverse Normal" = c(x$weightsInverseNormal, empty), - row.names = row.names, - ... +.getPopulationsToShow <- function(x, ..., gMax) { + dataInput <- x + if (!inherits(dataInput, "Dataset")) { + dataInput <- x[[".dataInput"]] + } + if (is.null(dataInput) || !inherits(dataInput, "Dataset")) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to get 'dataInput' from ", .getClassName(x)) + } + + numberOfPopulations <- gMax + if (numberOfPopulations > 1) { + validComparisons <- 1L:as.integer(numberOfPopulations) + } else { + validComparisons <- 1L + } + + populationsToShow <- .getOptionalArgument("populations", ...) + + if (!is.null(populationsToShow)) { + populationsToShow <- as.integer(na.omit(populationsToShow)) + } + if (is.null(populationsToShow) || length(populationsToShow) == 0 || + all(is.na(populationsToShow)) || !is.numeric(populationsToShow)) { + populationsToShow <- validComparisons + } else if (!all(populationsToShow %in% validComparisons)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'populations' (", + .arrayToString(populationsToShow), ") must be a vector ", + "containing one or more values of ", .arrayToString(validComparisons) ) - stageResults <- stageResults[with(stageResults, order(Stage, Group)), ] - return(stageResults) + } + populationsToShow <- sort(unique(populationsToShow)) + return(populationsToShow) } #' @@ -1250,7 +1459,7 @@ as.data.frame.StageResults <- function(x, row.names = NULL, #' @description #' Plots the conditional power together with the likelihood function. #' -#' @param x The stage results at given stage, obtained from \code{\link[=getStageResults]{getStageResults()}} or +#' @param x The stage results at given stage, obtained from \code{\link[=getStageResults]{getStageResults()}} or #' \code{\link[=getAnalysisResults]{getAnalysisResults()}}. #' @param y Not available for this kind of plot (is only defined to be compatible to the generic plot function). #' @inheritParams param_stage @@ -1302,200 +1511,313 @@ as.data.frame.StageResults <- function(x, row.names = NULL, #' ) #' #' stageResults <- getStageResults(design, dataExample, thetaH0 = 20) -#' +#' #' \dontrun{ #' if (require(ggplot2)) plot(stageResults, nPlanned = c(30), thetaRange = c(0, 100)) #' } -#' +#' #' @export #' -plot.StageResults <- function(x, y, ..., type = 1L, - nPlanned, allocationRatioPlanned = 1, # C_ALLOCATION_RATIO_DEFAULT - main = NA_character_, xlab = NA_character_, ylab = NA_character_, - legendTitle = NA_character_, palette = "Set1", legendPosition = NA_integer_, - showSource = FALSE, plotSettings = NULL) { - fCall <- match.call(expand.dots = FALSE) - - .assertGgplotIsInstalled() - .assertIsStageResults(x) - .assertIsValidLegendPosition(legendPosition) - if (.isConditionalPowerEnabled(nPlanned)) { - .assertIsValidAllocationRatioPlanned(allocationRatioPlanned, x$.dataInput$getNumberOfGroups()) +plot.StageResultsR6 <- function(x, y, ..., type = 1L, + nPlanned, allocationRatioPlanned = 1, # C_ALLOCATION_RATIO_DEFAULT + main = NA_character_, xlab = NA_character_, ylab = NA_character_, + legendTitle = NA_character_, palette = "Set1", legendPosition = NA_integer_, + showSource = FALSE, plotSettings = NULL) { + fCall <- match.call(expand.dots = FALSE) + + .assertGgplotIsInstalled() + .assertIsStageResults(x) + .assertIsValidLegendPosition(legendPosition) + if (.isConditionalPowerEnabled(nPlanned)) { + .assertIsValidAllocationRatioPlanned(allocationRatioPlanned, x$.dataInput$getNumberOfGroups()) + } + .stopInCaseOfIllegalStageDefinition2(...) + + if (x$.design$kMax == 1) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "cannot plot stage results of a fixed design") + } + + if (!is.logical(showSource) || isTRUE(showSource)) { + stageResultsName <- .getOptionalArgument("stageResultsName", ...) + if (is.null(stageResultsName)) { + stageResultsName <- deparse(fCall$x) } - .stopInCaseOfIllegalStageDefinition2(...) - - if (x$.design$kMax == 1) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "cannot plot stage results of a fixed design") + cat("Source data of the plot:\n") + cat(" Use getConditionalPower(..., addPlotData = TRUE) to create the data.\n", sep = "") + cat("Simple plot command example:\n", sep = "") + + cmd <- paste0( + "condPow <- getConditionalPower(", stageResultsName, + ", nPlanned = ", .arrayToString(nPlanned, vectorLookAndFeelEnabled = TRUE) + ) + if (.isConditionalPowerEnabled(nPlanned) && allocationRatioPlanned != C_ALLOCATION_RATIO_DEFAULT) { + cmd <- paste0(cmd, ", allocationRatioPlanned = ", allocationRatioPlanned) } - - if (!is.logical(showSource) || isTRUE(showSource)) { - stageResultsName <- .getOptionalArgument("stageResultsName", ...) - if (is.null(stageResultsName)) { - stageResultsName <- deparse(fCall$x) - } - cat("Source data of the plot:\n") - cat(" Use getConditionalPower(..., addPlotData = TRUE) to create the data.\n", sep = "") - cat("Simple plot command example:\n", sep = "") - - cmd <- paste0( - "condPow <- getConditionalPower(", stageResultsName, - ", nPlanned = ", .arrayToString(nPlanned, vectorLookAndFeelEnabled = TRUE) - ) - if (.isConditionalPowerEnabled(nPlanned) && allocationRatioPlanned != C_ALLOCATION_RATIO_DEFAULT) { - cmd <- paste0(cmd, ", allocationRatioPlanned = ", allocationRatioPlanned) - } - if (grepl("Means|Survival", .getClassName(x))) { - cmd <- paste0(cmd, ", thetaRange = seq(0, 1, 0.1)") - } else if (grepl("Rates", .getClassName(x))) { - cmd <- paste0(cmd, ", piTreatmentRange = seq(0, 1, 0.1)") + if (grepl("Means|Survival", .getClassName(x))) { + cmd <- paste0(cmd, ", thetaRange = seq(0, 1, 0.1)") + } else if (grepl("Rates", .getClassName(x))) { + cmd <- paste0(cmd, ", piTreatmentRange = seq(0, 1, 0.1)") + } + cmd <- paste0(cmd, ", addPlotData = TRUE)") + + cat(" ", cmd, "\n", sep = "") + cat(" plotData <- condPow$.plotData # get plot data list\n", sep = "") + cat(" plotData # show plot data list\n", sep = "") + cat(" plot(plotData$xValues, plotData$condPowerValues)\n", sep = "") + cat(" plot(plotData$xValues, plotData$likelihoodValues)\n", sep = "") + } + + plotData <- .getConditionalPowerPlot( + stageResults = x, nPlanned = nPlanned, + allocationRatioPlanned = allocationRatioPlanned, ... + ) + + yParameterName1 <- "Conditional power" + yParameterName2 <- "Likelihood" + + if (.isMultiArmStageResults(x)) { + treatmentArmsToShow <- .getTreatmentArmsToShow(x, ...) + data <- data.frame( + xValues = numeric(0), + yValues = numeric(0), + categories = character(0), + treatmentArms = numeric(0) + ) + for (treatmentArm in treatmentArmsToShow) { + legend1 <- ifelse(length(treatmentArmsToShow) == 1, yParameterName1, + paste0(yParameterName1, " (", treatmentArm, " vs control)") + ) + legend2 <- ifelse(length(treatmentArmsToShow) == 1, yParameterName2, + paste0(yParameterName2, " (", treatmentArm, " vs control)") + ) + + treatmentArmIndices <- which(plotData$treatmentArms == treatmentArm) + + if (all(is.na(plotData$condPowerValues[treatmentArmIndices]))) { + if (!all(is.na(plotData$likelihoodValues[treatmentArmIndices]))) { + data <- rbind(data, data.frame( + xValues = plotData$xValues[treatmentArmIndices], + yValues = plotData$likelihoodValues[treatmentArmIndices], + categories = rep(legend2, length(plotData$xValues[treatmentArmIndices])), + treatmentArms = rep(treatmentArm, length(plotData$xValues[treatmentArmIndices])) + )) } - cmd <- paste0(cmd, ", addPlotData = TRUE)") - - cat(" ", cmd, "\n", sep = "") - cat(" plotData <- condPow$.plotData # get plot data list\n", sep = "") - cat(" plotData # show plot data list\n", sep = "") - cat(" plot(plotData$xValues, plotData$condPowerValues)\n", sep = "") - cat(" plot(plotData$xValues, plotData$likelihoodValues)\n", sep = "") + } else { + data <- rbind(data, data.frame( + xValues = c( + plotData$xValues[treatmentArmIndices], + plotData$xValues[treatmentArmIndices] + ), + yValues = c( + plotData$condPowerValues[treatmentArmIndices], + plotData$likelihoodValues[treatmentArmIndices] + ), + categories = c( + rep(legend1, length(plotData$xValues[treatmentArmIndices])), + rep(legend2, length(plotData$xValues[treatmentArmIndices])) + ), + treatmentArms = c( + rep(treatmentArm, length(plotData$xValues[treatmentArmIndices])), + rep(treatmentArm, length(plotData$xValues[treatmentArmIndices])) + ) + )) + } } - - plotData <- .getConditionalPowerPlot( - stageResults = x, nPlanned = nPlanned, - allocationRatioPlanned = allocationRatioPlanned, ... + } else if (.isEnrichmentStageResults(x)) { + gMax <- max(na.omit(plotData$populations)) + populationsToShow <- .getPopulationsToShow(x, ..., gMax = gMax) + data <- data.frame( + xValues = numeric(0), + yValues = numeric(0), + categories = character(0), + populations = numeric(0) ) - - yParameterName1 <- "Conditional power" - yParameterName2 <- "Likelihood" - - if (.isMultiArmStageResults(x)) { - treatmentArmsToShow <- .getTreatmentArmsToShow(x, ...) - data <- data.frame( - xValues = numeric(0), - yValues = numeric(0), - categories = character(0), - treatmentArms = numeric(0) - ) - for (treatmentArm in treatmentArmsToShow) { - legend1 <- ifelse(length(treatmentArmsToShow) == 1, yParameterName1, - paste0(yParameterName1, " (", treatmentArm, " vs control)") - ) - legend2 <- ifelse(length(treatmentArmsToShow) == 1, yParameterName2, - paste0(yParameterName2, " (", treatmentArm, " vs control)") - ) - - treatmentArmIndices <- which(plotData$treatmentArms == treatmentArm) - - if (all(is.na(plotData$condPowerValues[treatmentArmIndices]))) { - if (!all(is.na(plotData$likelihoodValues[treatmentArmIndices]))) { - data <- rbind(data, data.frame( - xValues = plotData$xValues[treatmentArmIndices], - yValues = plotData$likelihoodValues[treatmentArmIndices], - categories = rep(legend2, length(plotData$xValues[treatmentArmIndices])), - treatmentArms = rep(treatmentArm, length(plotData$xValues[treatmentArmIndices])) - )) - } - } else { - data <- rbind(data, data.frame( - xValues = c( - plotData$xValues[treatmentArmIndices], - plotData$xValues[treatmentArmIndices] - ), - yValues = c( - plotData$condPowerValues[treatmentArmIndices], - plotData$likelihoodValues[treatmentArmIndices] - ), - categories = c( - rep(legend1, length(plotData$xValues[treatmentArmIndices])), - rep(legend2, length(plotData$xValues[treatmentArmIndices])) - ), - treatmentArms = c( - rep(treatmentArm, length(plotData$xValues[treatmentArmIndices])), - rep(treatmentArm, length(plotData$xValues[treatmentArmIndices])) - ) - )) - } + for (population in populationsToShow) { + populationName <- ifelse(population == gMax, "F", paste0("S", population)) + legend1 <- ifelse(length(populationsToShow) == 1, yParameterName1, + paste0(yParameterName1, " (", populationName, ")") + ) + legend2 <- ifelse(length(populationsToShow) == 1, yParameterName2, + paste0(yParameterName2, " (", populationName, ")") + ) + + populationIndices <- which(plotData$populations == population) + + if (all(is.na(plotData$condPowerValues[populationIndices]))) { + if (!all(is.na(plotData$likelihoodValues[populationIndices]))) { + data <- rbind(data, data.frame( + xValues = plotData$xValues[populationIndices], + yValues = plotData$likelihoodValues[populationIndices], + categories = rep(legend2, length(plotData$xValues[populationIndices])), + populations = rep(population, length(plotData$xValues[populationIndices])) + )) } - } else if (.isEnrichmentStageResults(x)) { - gMax <- max(na.omit(plotData$populations)) - populationsToShow <- .getPopulationsToShow(x, ..., gMax = gMax) - data <- data.frame( - xValues = numeric(0), - yValues = numeric(0), - categories = character(0), - populations = numeric(0) + } else { + data <- rbind(data, data.frame( + xValues = c( + plotData$xValues[populationIndices], + plotData$xValues[populationIndices] + ), + yValues = c( + plotData$condPowerValues[populationIndices], + plotData$likelihoodValues[populationIndices] + ), + categories = c( + rep(legend1, length(plotData$xValues[populationIndices])), + rep(legend2, length(plotData$xValues[populationIndices])) + ), + populations = c( + rep(population, length(plotData$xValues[populationIndices])), + rep(population, length(plotData$xValues[populationIndices])) + ) + )) + } + } + } else { + if (all(is.na(plotData$condPowerValues))) { + legendPosition <- -1 + data <- data.frame( + xValues = plotData$xValues, + yValues = plotData$likelihoodValues, + categories = rep(yParameterName2, length(plotData$xValues)) + ) + } else { + data <- data.frame( + xValues = c(plotData$xValues, plotData$xValues), + yValues = c(plotData$condPowerValues, plotData$likelihoodValues), + categories = c( + rep(yParameterName1, length(plotData$xValues)), + rep(yParameterName2, length(plotData$xValues)) ) - for (population in populationsToShow) { - populationName <- ifelse(population == gMax, "F", paste0("S", population)) - legend1 <- ifelse(length(populationsToShow) == 1, yParameterName1, - paste0(yParameterName1, " (", populationName, ")") - ) - legend2 <- ifelse(length(populationsToShow) == 1, yParameterName2, - paste0(yParameterName2, " (", populationName, ")") - ) - - populationIndices <- which(plotData$populations == population) + ) + } + } + + data$categories <- factor(data$categories, levels = unique(data$categories)) + + main <- ifelse(is.na(main), C_PLOT_MAIN_CONDITIONAL_POWER_WITH_LIKELIHOOD, main) + ylab <- ifelse(is.na(ylab), C_PLOT_YLAB_CONDITIONAL_POWER_WITH_LIKELIHOOD, ylab) + + if (is.na(legendTitle)) { + legendTitle <- "Parameter" + } + + return(.createAnalysisResultsPlotObject(x, + data = data, plotData = plotData, main = main, xlab = xlab, ylab = ylab, + legendTitle = legendTitle, palette = palette, legendPosition = legendPosition, numberOfPairedLines = 2L, + plotSettings = plotSettings + )) +} - if (all(is.na(plotData$condPowerValues[populationIndices]))) { - if (!all(is.na(plotData$likelihoodValues[populationIndices]))) { - data <- rbind(data, data.frame( - xValues = plotData$xValues[populationIndices], - yValues = plotData$likelihoodValues[populationIndices], - categories = rep(legend2, length(plotData$xValues[populationIndices])), - populations = rep(population, length(plotData$xValues[populationIndices])) - )) - } - } else { - data <- rbind(data, data.frame( - xValues = c( - plotData$xValues[populationIndices], - plotData$xValues[populationIndices] - ), - yValues = c( - plotData$condPowerValues[populationIndices], - plotData$likelihoodValues[populationIndices] - ), - categories = c( - rep(legend1, length(plotData$xValues[populationIndices])), - rep(legend2, length(plotData$xValues[populationIndices])) - ), - populations = c( - rep(population, length(plotData$xValues[populationIndices])), - rep(population, length(plotData$xValues[populationIndices])) - ) - )) - } - } +.createAnalysisResultsPlotObject <- function(x, ..., data, plotData, + main = NA_character_, xlab = NA_character_, ylab = NA_character_, + legendTitle = NA_character_, palette = "Set1", legendPosition = NA_integer_, + numberOfPairedLines = NA_integer_, plotSettings = NULL) { + ciModeEnabled <- !is.null(data[["lower"]]) && !is.null(data[["upper"]]) + + if (!ciModeEnabled) { + p <- ggplot2::ggplot(data, ggplot2::aes( + x = .data[["xValues"]], y = .data[["yValues"]], + colour = factor(.data[["categories"]]), + linetype = factor(.data[["categories"]]) + )) + } else { + p <- ggplot2::ggplot(data, ggplot2::aes( + x = .data[["xValues"]], y = .data[["yValues"]], + colour = factor(.data[["categories"]]) + )) + } + + if (is.null(plotSettings)) { + plotSettings <- x$getPlotSettings() + } + + p <- plotSettings$setTheme(p) + p <- plotSettings$hideGridLines(p) + + # set main title + mainTitle <- ifelse(!is.call(main) && !isS4(main) && is.na(main), plotData$main, main) + p <- plotSettings$setMainTitle(p, mainTitle, subtitle = plotData$sub) + + # set legend + if (is.na(legendPosition)) { + legendPosition <- C_POSITION_LEFT_TOP + } + p <- plotSettings$setLegendPosition(p, legendPosition = legendPosition) + p <- plotSettings$setLegendBorder(p) + p <- plotSettings$setLegendTitle(p, legendTitle) + p <- plotSettings$setLegendLabelSize(p) + + # set axes labels + p <- plotSettings$setAxesLabels(p, + xAxisLabel = plotData$xlab, yAxisLabel1 = plotData$ylab, + xlab = xlab, ylab = ylab + ) + + # plot lines and points + if (!ciModeEnabled) { + if (is.na(numberOfPairedLines)) { + numberOfPairedLines <- 2 + if (x$.isMultiArm()) { + numberOfPairedLines <- length(unique(data$treatmentArms)) - 1 + } else if (x$.isEnrichment()) { + numberOfPairedLines <- length(unique(data$populations)) - 1 + } + } + + p <- plotSettings$plotValues(p, plotPointsEnabled = FALSE, pointBorder = 1) + n <- length(unique(data$categories)) / numberOfPairedLines + if (n > 1) { + lineTypeValues <- rep(1:numberOfPairedLines, n) + colorTypes <- sort(rep(1:n, numberOfPairedLines)) + for (i in c(1, 3)) { + colorTypes[colorTypes >= i] <- colorTypes[colorTypes >= i] + 1 + } + p <- p + ggplot2::scale_color_manual(name = legendTitle, values = colorTypes) + p <- p + ggplot2::scale_linetype_manual(name = legendTitle, values = lineTypeValues) } else { - if (all(is.na(plotData$condPowerValues))) { - legendPosition <- -1 - data <- data.frame( - xValues = plotData$xValues, - yValues = plotData$likelihoodValues, - categories = rep(yParameterName2, length(plotData$xValues)) - ) - } else { - data <- data.frame( - xValues = c(plotData$xValues, plotData$xValues), - yValues = c(plotData$condPowerValues, plotData$likelihoodValues), - categories = c( - rep(yParameterName1, length(plotData$xValues)), - rep(yParameterName2, length(plotData$xValues)) - ) - ) - } + colorValues <- c(2, 4) + if (!x$.isMultiArm()) { + colorValues <- c(2, 2) # use only one color + } + p <- p + ggplot2::scale_color_manual(name = legendTitle, values = colorValues) + p <- p + ggplot2::scale_linetype_manual(name = legendTitle, values = c(1, 2)) } - - data$categories <- factor(data$categories, levels = unique(data$categories)) - - main <- ifelse(is.na(main), C_PLOT_MAIN_CONDITIONAL_POWER_WITH_LIKELIHOOD, main) - ylab <- ifelse(is.na(ylab), C_PLOT_YLAB_CONDITIONAL_POWER_WITH_LIKELIHOOD, ylab) - - if (is.na(legendTitle)) { - legendTitle <- "Parameter" + } + + # plot confidence intervall + else { + pd <- ggplot2::position_dodge(0.15) + + p <- p + ggplot2::geom_errorbar( + data = data, + ggplot2::aes(ymin = .data[["lower"]], ymax = .data[["upper"]]), + width = 0.15, position = pd, size = 0.8 + ) + p <- p + ggplot2::geom_line(position = pd, linetype = "longdash") + p <- p + ggplot2::geom_point(position = pd, size = 2.0) + + + stage <- unique(data$xValues) + kMax <- list(...)[["kMax"]] + if (length(stage) == 1 && !is.null(kMax)) { + stages <- 1:kMax + p <- p + ggplot2::scale_x_continuous(breaks = stages) + } else if (length(stage) > 1 && all(stage %in% 1:10)) { + p <- p + ggplot2::scale_x_continuous(breaks = stage) } - - return(.createAnalysisResultsPlotObject(x, - data = data, plotData = plotData, main = main, xlab = xlab, ylab = ylab, - legendTitle = legendTitle, palette = palette, legendPosition = legendPosition, numberOfPairedLines = 2L, - plotSettings = plotSettings - )) -} \ No newline at end of file + } + + p <- plotSettings$setAxesAppearance(p) + p <- plotSettings$enlargeAxisTicks(p) + + companyAnnotationEnabled <- .getOptionalArgument("companyAnnotationEnabled", ...) + if (is.null(companyAnnotationEnabled) || !is.logical(companyAnnotationEnabled)) { + companyAnnotationEnabled <- FALSE + } + + p <- plotSettings$addCompanyAnnotation(p, enabled = companyAnnotationEnabled) + + # start plot generation + return(p) +} diff --git a/R/class_analysis_stage_results_r6.R b/R/class_analysis_stage_results_r6.R deleted file mode 100644 index 8edb30d0..00000000 --- a/R/class_analysis_stage_results_r6.R +++ /dev/null @@ -1,1823 +0,0 @@ -library("R6") -## | -## | *Stage results classes* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | rpact package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File version: $Revision: 6943 $ -## | Last changed: $Date: 2023-04-24 09:47:00 +0200 (Mo, 24 Apr 2023) $ -## | Last changed by: $Author: pahlke $ -## | - -#' -#' @name StageResults -#' -#' @title -#' Basic Stage Results -#' -#' @description -#' Basic class for stage results. -#' -#' @template field_stages -#' @template field_testStatistics -#' @template field_pValues -#' @template field_combInverseNormal -#' @template field_combFisher -#' @template field_effectSizes -#' @template field_testActions -#' @template field_weightsFisher -#' @template field_weightsInverseNormal -#' -#' @details -#' \code{StageResults} is the basic class for -#' \itemize{ -#' \item \code{\link{StageResultsMeans}}, -#' \item \code{\link{StageResultsRates}}, -#' \item \code{\link{StageResultsSurvival}}, -#' \item \code{\link{StageResultsMultiArmMeans}}, -#' \item \code{\link{StageResultsMultiArmRates}}, -#' \item \code{\link{StageResultsMultiArmSurvival}}, -#' \item \code{\link{StageResultsEnrichmentMeans}}, -#' \item \code{\link{StageResultsEnrichmentRates}}, and -#' \item \code{\link{StageResultsEnrichmentSurvival}}. -#' } -#' -#' @include f_core_utilities.R -#' @include class_core_parameter_set.R -#' @include class_design.R -#' @include class_analysis_dataset.R -#' @include f_core_constants.R -#' @include class_core_plot_settings.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -StageResultsR6 <- R6Class("StageResultsR6", - inherit = ParameterSetR6, - public = list( - .plotSettings = NULL, - .design = NULL, - .dataInput = NULL, - stage = NULL, - stages = NULL, - pValues = NULL, - weightsFisher = NULL, - weightsInverseNormal = NULL, - thetaH0 = NULL, - direction = NULL, - initialize = function(..., stage = NULL, stages = NULL, pValues = NULL, weightsFisher = NULL, weightsInverseNormal = NULL, thetaH0 = NULL, direction = NULL) { - self$stage <- stage - self$stages <- stages - self$pValues <- pValues - self$weightsFisher <- weightsFisher - self$weightsInverseNormal <- weightsInverseNormal - self$thetaH0 <- thetaH0 - self$direction <- direction - super$initialize(...) - }, - init = function(design, dataInput) { - self$.design <- design - self$.dataInput <- dataInput - - self$.plotSettings <- PlotSettingsR6$new() - if (!missing(design)) { - self$stages <- c(1:design$kMax) - if (design$kMax == C_KMAX_DEFAULT) { - self$.setParameterType("stages", C_PARAM_DEFAULT_VALUE) - } else { - self$.setParameterType("stages", C_PARAM_USER_DEFINED) - } - self$.parameterNames <- .getParameterNames(design = design) - } - self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS - - self$.setParameterType("stage", C_PARAM_NOT_APPLICABLE) - - self$.setParameterType("pValues", ifelse( - self$.isMultiArm(), C_PARAM_NOT_APPLICABLE, C_PARAM_GENERATED - )) - self$.setParameterType("thetaH0", ifelse( - identical(self$thetaH0, C_THETA_H0_MEANS_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - self$.setParameterType("direction", ifelse( - identical(self$direction, C_DIRECTION_UPPER), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - }, - getPlotSettings = function() { - return(self$.plotSettings) - }, - show = function(showType = 1, digits = NA_integer_) { - self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) - }, - .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { - "Method for automatically printing stage results" - self$.resetCat() - if (showType == 2) { - super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) - } else { - self$.cat(self$.toString(startWithUpperCase = TRUE), ":\n\n", - heading = 1, - consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Output", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - - if (grepl("Enrichment", .getClassName(self))) { - self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) - self$.cat(paste0(" S[i]: population i\n"), consoleOutputEnabled = consoleOutputEnabled) - self$.cat(paste0(" F: full population\n"), consoleOutputEnabled = consoleOutputEnabled) - } else if (grepl("MultiArm", .getClassName(self))) { - self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) - self$.cat(paste0( - " (i): results of treatment arm i vs. control group ", - self$.dataInput$getNumberOfGroups(), "\n" - ), - consoleOutputEnabled = consoleOutputEnabled - ) - } else if (self$.dataInput$getNumberOfGroups(survivalCorrectionEnabled = FALSE) >= 2) { - self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) - self$.cat(" (i): values of treatment arm i\n", consoleOutputEnabled = consoleOutputEnabled) - } - } - }, - isDirectionUpper = function() { - return(self$direction == C_DIRECTION_UPPER) - }, - .isMultiArm = function() { - return(grepl("multi", tolower(.getClassName(self)))) - }, - .isEnrichment = function() { - return(grepl("enrichment", tolower(.getClassName(self)))) - }, - getGMax = function() { - if (!is.matrix(self$testStatistics)) { - return(1L) - } - - gMax <- nrow(self$testStatistics) - if (is.null(gMax) || gMax == 0) { - gMax <- 1L - } - return(gMax) - }, - .getParametersToShow = function() { - return(c("stages")) - }, - .toString = function(startWithUpperCase = FALSE) { - s <- "stage results of" - - if (grepl("MultiArm", .getClassName(self))) { - s <- paste(s, "multi-arm") - } else if (grepl("Enrichment", .getClassName(self))) { - s <- paste(s, "enrichment") - } - - if (grepl("Means", .getClassName(self))) { - s <- paste(s, "means") - } - - if (grepl("Rates", .getClassName(self))) { - s <- paste(s, "rates") - } - - if (grepl("Survival", .getClassName(self))) { - s <- paste(s, "survival data") - } - - if (startWithUpperCase) { - s <- .firstCharacterToUpperCase(s) - } - - return(s) - }, - getDataInput = function() { - return(self$.dataInput) - }, - getNumberOfGroups = function() { - return(self$.dataInput$getNumberOfGroups()) - }, - isOneSampleDataset = function() { - return(self$getNumberOfGroups() == 1) - }, - isTwoSampleDataset = function() { - return(self$getNumberOfGroups() == 2) - }, - isDatasetMeans = function() { - return(self$.dataInput$isDatasetMeans()) - }, - isDatasetRates = function() { - return(self$.dataInput$isDatasetRates()) - }, - isDatasetSurvival = function() { - return(self$.dataInput$isDatasetSurvival()) - }, - getNumberOfStages = function() { - if (self$.isMultiArm()) { - if (inherits(self, "StageResultsMultiArmRatesR6")) { - return(max( - ncol(stats::na.omit(self$testStatistics)), - ncol(stats::na.omit(self$separatePValues)) - )) - } - return(max( - ncol(stats::na.omit(self$effectSizes)), - ncol(stats::na.omit(self$separatePValues)) - )) - } - return(max( - length(stats::na.omit(self$effectSizes)), - length(stats::na.omit(self$pValues)) - )) - } - ) -) - -#' -#' @name StageResultsMeans -#' -#' @title -#' Stage Results of Means -#' -#' @description -#' Class for stage results of means. -#' -#' @template field_stages -#' @template field_testStatistics -#' @template field_overallTestStatistics -#' @template field_pValues -#' @template field_overallPValues -#' @template field_effectSizes -#' @template field_testActions -#' @template field_direction -#' @template field_normalApproximation -#' @template field_equalVariances -#' @template field_combFisher -#' @template field_weightsFisher -#' @template field_combInverseNormal -#' @template field_weightsInverseNormal -#' @field ... Names of \code{dataInput}. -#' -#' @details -#' This object cannot be created directly; use \code{getStageResults} -#' with suitable arguments to create the stage results of a dataset of means. -#' -#' @include class_core_parameter_set.R -#' @include class_design.R -#' @include class_analysis_dataset.R -#' @include f_core_constants.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -StageResultsMeansR6 <- R6Class("StageResultsMeansR6", - inherit = StageResultsR6, - public = list( - combInverseNormal = NULL, - combFisher = NULL, - overallTestStatistics = NULL, - overallPValues = NULL, - effectSizes = NULL, - testStatistics = NULL, - overallMeans = NULL, - overallMeans1 = NULL, - overallMeans2 = NULL, - overallStDevs = NULL, - overallStDevs1 = NULL, - overallStDevs2 = NULL, - overallSampleSizes = NULL, - overallSampleSizes1 = NULL, - overallSampleSizes2 = NULL, - equalVariances = NULL, - normalApproximation = NULL, - initialize = function(design, dataInput, ..., - combInverseNormal = NULL, - combFisher = NULL, - overallTestStatistics = NULL, - overallPValues = NULL, - effectSizes = NULL, - testStatistics = NULL, - overallMeans = NULL, - overallMeans1 = NULL, - overallMeans2 = NULL, - overallStDevs = NULL, - overallStDevs1 = NULL, - overallStDevs2 = NULL, - overallSampleSizes = NULL, - overallSampleSizes1 = NULL, - overallSampleSizes2 = NULL, - equalVariances = TRUE, normalApproximation = FALSE) { - super$initialize(.design = design, .dataInput = dataInput, ...)#TODO - - self$combInverseNormal <- combInverseNormal - self$combFisher <- combFisher - self$overallTestStatistics <- overallTestStatistics - self$overallPValues <- overallPValues - self$effectSizes <- effectSizes - self$testStatistics <- testStatistics - self$overallMeans <- overallMeans - self$overallMeans1 <- overallMeans1 - self$overallMeans2 <- overallMeans2 - self$overallStDevs <- overallStDevs - self$overallStDevs1 <- overallStDevs1 - self$overallStDevs2 <- overallStDevs2 - self$overallSampleSizes <- overallSampleSizes - self$overallSampleSizes1 <- overallSampleSizes1 - self$overallSampleSizes2 <- overallSampleSizes2 - - self$equalVariances <- equalVariances - self$normalApproximation <- normalApproximation - - self$init(design = design, dataInput = dataInput) - - for (param in c( - "weightsFisher", - "weightsInverseNormal", - "combFisher", - "combInverseNormal" - )) { - self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) - } - - for (param in self$.getParametersToShow()) { - if (self$.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { - self$.setParameterType(param, C_PARAM_GENERATED) - } - } - - self$.setParameterType("equalVariances", ifelse( - identical(self$equalVariances, TRUE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - self$.setParameterType("normalApproximation", ifelse( - identical(self$normalApproximation, FALSE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - }, - .getParametersToShow = function() { - parametersToShow <- c( - "stages", - "overallTestStatistics", - "overallPValues" - ) - if (self$.dataInput$getNumberOfGroups() == 1) { - parametersToShow <- c( - parametersToShow, - "overallMeans", - "overallStDevs", - "overallSampleSizes" - ) - } else if (self$.dataInput$getNumberOfGroups() == 2) { - parametersToShow <- c( - parametersToShow, - "overallMeans1", - "overallMeans2", - "overallStDevs1", - "overallStDevs2", - "overallSampleSizes1", - "overallSampleSizes2" - ) - } - parametersToShow <- c( - parametersToShow, - "testStatistics", - "pValues", - "effectSizes" - ) - if (.isTrialDesignInverseNormal(self$.design)) { - parametersToShow <- c( - parametersToShow, - "combInverseNormal", - "weightsInverseNormal" - ) - } else if (.isTrialDesignFisher(self$.design)) { - parametersToShow <- c( - parametersToShow, - "combFisher", - "weightsFisher" - ) - } - parametersToShow <- c( - parametersToShow, - "thetaH0", - "direction", - "normalApproximation" - ) - if (self$.dataInput$getNumberOfGroups() == 2) { - parametersToShow <- c( - parametersToShow, - "equalVariances" - ) - } - return(parametersToShow) - } - ) -) - -#' @name StageResultsMultiArmMeans -#' -#' @title -#' Stage Results Multi Arm Means -#' -#' @description -#' Class for stage results of multi arm means data -#' -#' @template field_stages -#' @template field_testStatistics -#' @template field_pValues -#' @template field_combInverseNormal -#' @template field_combFisher -#' @template field_effectSizes -#' @template field_testActions -#' @template field_weightsFisher -#' @template field_weightsInverseNormal -#' @template field_combInverseNormal -#' @template field_combFisher -#' @template field_overallTestStatistics -#' @template field_overallStDevs -#' @template field_overallPooledStDevs -#' @template field_overallPValues -#' @template field_testStatistics -#' @template field_separatePValues -#' @template field_effectSizes -#' @template field_singleStepAdjustedPValues -#' @template field_intersectionTest -#' @template field_varianceOption -#' @template field_normalApproximation -#' @template field_directionUpper -#' -#' @details -#' This object cannot be created directly; use \code{getStageResults} -#' with suitable arguments to create the stage results of a dataset of multi arm means. -#' -#' @include class_core_parameter_set.R -#' @include class_design.R -#' @include class_analysis_dataset.R -#' @include f_core_constants.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -StageResultsMultiArmMeansR6 <- R6Class("StageResultsMultiArmMeansR6", - inherit = StageResultsR6, - public = list( - combInverseNormal = NULL, - combFisher = NULL, - overallTestStatistics = NULL, - overallStDevs = NULL, - overallPooledStDevs = NULL, - overallPValues = NULL, - testStatistics = NULL, - separatePValues = NULL, - effectSizes = NULL, - singleStepAdjustedPValues = NULL, - intersectionTest = NULL, - varianceOption = NULL, - normalApproximation = NULL, - directionUpper = NULL, - initialize = function(design, dataInput, ..., - combInverseNormal = NULL, - combFisher = NULL, - overallTestStatistics = NULL, - overallStDevs = NULL, - overallPooledStDevs = NULL, - overallPValues = NULL, - testStatistics = NULL, - separatePValues = NULL, - effectSizes = NULL, - singleStepAdjustedPValues = NULL, - intersectionTest = NULL,varianceOption = C_VARIANCE_OPTION_MULTIARMED_DEFAULT, - normalApproximation = FALSE, directionUpper = NULL) { - super$initialize(...) - self$combInverseNormal <- combInverseNormal - self$combFisher <- combFisher - self$overallTestStatistics <- overallTestStatistics - self$overallStDevs <- overallStDevs - self$overallPooledStDevs <- overallPooledStDevs - self$overallPValues <- overallPValues - self$testStatistics <- testStatistics - self$separatePValues <- separatePValues - self$effectSizes <- effectSizes - self$singleStepAdjustedPValues <- singleStepAdjustedPValues - self$varianceOption <- varianceOption - self$normalApproximation <- normalApproximation - self$directionUpper <- directionUpper - - - self$init(design = design, dataInput = dataInput) - - for (param in c( - "singleStepAdjustedPValues", - "weightsFisher", - "weightsInverseNormal", - "combFisher", - "combInverseNormal" - )) { - self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) - } - - for (param in self$.getParametersToShow()) { - if (self$.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { - self$.setParameterType(param, C_PARAM_GENERATED) - } - } - - self$.setParameterType("varianceOption", ifelse( - identical(self$varianceOption, C_VARIANCE_OPTION_MULTIARMED_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - self$.setParameterType("normalApproximation", ifelse( - identical(self$normalApproximation, FALSE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - self$.setParameterType("directionUpper", ifelse( - identical(self$directionUpper, C_DIRECTION_UPPER_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - }, - .getParametersToShow = function() { - parametersToShow <- c( - "stages", - "thetaH0", - "direction", - "normalApproximation", - "directionUpper", - "varianceOption", - "intersectionTest", - "overallTestStatistics", - "overallPValues", - "overallStDevs", - "overallPooledStDevs", - "testStatistics", - "separatePValues", - "effectSizes", - "singleStepAdjustedPValues" - ) - if (.isTrialDesignInverseNormal(self$.design)) { - parametersToShow <- c( - parametersToShow, - "combInverseNormal", - "weightsInverseNormal" - ) - } else if (.isTrialDesignFisher(self$.design)) { - parametersToShow <- c( - parametersToShow, - "combFisher", - "weightsFisher" - ) - } - return(parametersToShow) - } - ) -) - -#' -#' @name StageResultsRates -#' -#' @title -#' Stage Results of Rates -#' -#' @description -#' Class for stage results of rates. -#' -#' @template field_stages -#' @template field_testStatistics -#' @template field_overallTestStatistics -#' @template field_pValues -#' @template field_overallPValues -#' @template field_effectSizes -#' @template field_direction -#' @template field_testActions -#' @template field_thetaH0 -#' @template field_normalApproximation -#' @template field_weightsFisher -#' @template field_weightsInverseNormal -#' @template field_combInverseNormal -#' @template field_combFisher -#' @field ... Names of \code{dataInput}. -#' -#' @details -#' This object cannot be created directly; use \code{getStageResults} -#' with suitable arguments to create the stage results of a dataset of rates. -#' -#' @include class_core_parameter_set.R -#' @include class_design.R -#' @include class_analysis_dataset.R -#' @include f_core_constants.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -StageResultsRatesR6 <- R6Class("StageResultsRatesR6", - inherit = StageResultsR6, - public = list( - combInverseNormal = NULL, - combFisher = NULL, - overallTestStatistics = NULL, - overallPValues = NULL, - effectSizes = NULL, - testStatistics = NULL, - overallPi1 = NULL, - overallPi2 = NULL, - overallEvents = NULL, - overallEvents1 = NULL, - overallEvents2 = NULL, - overallSampleSizes = NULL, - overallSampleSizes1 = NULL, - overallSampleSizes2 = NULL, - normalApproximation = NULL, - initialize = function(design, dataInput, ..., - combInverseNormal = NULL, - combFisher = NULL, - overallTestStatistics = NULL, - overallPValues = NULL, - effectSizes = NULL, - testStatistics = NULL, - overallPi1 = NULL, - overallPi2 = NULL, - overallEvents = NULL, - overallEvents1 = NULL, - overallEvents2 = NULL, - overallSampleSizes = NULL, - overallSampleSizes1 = NULL, - overallSampleSizes2 = NULL, - normalApproximation = TRUE) { - super$initialize(.design = design, .dataInput = dataInput, ...)#TODO - - self$combInverseNormal <- combInverseNormal - self$combFisher <- combFisher - self$overallTestStatistics <- overallTestStatistics - self$overallPValues <- overallPValues - self$effectSizes <- effectSizes - self$testStatistics <- testStatistics - self$overallPi1 <- overallPi1 - self$overallPi2 <- overallPi2 - self$overallEvents <- overallEvents - self$overallEvents1 <- overallEvents1 - self$overallEvents2 <- overallEvents2 - self$overallSampleSizes <- overallSampleSizes - self$overallSampleSizes1 <- overallSampleSizes1 - self$overallSampleSizes2 <- overallSampleSizes2 - - self$normalApproximation <- normalApproximation - - self$init(design = design, dataInput = dataInput) - - for (param in c( - "weightsFisher", - "weightsInverseNormal", - "combFisher", - "combInverseNormal" - )) { - self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) - } - - for (param in self$.getParametersToShow()) { - if (self$.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { - self$.setParameterType(param, C_PARAM_GENERATED) - } - } - - self$.setParameterType("normalApproximation", ifelse( - identical(self$normalApproximation, TRUE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - }, - .getParametersToShow = function() { - parametersToShow <- c( - "stages", - "overallTestStatistics", - "overallPValues" - ) - if (self$.dataInput$getNumberOfGroups() == 1) { - parametersToShow <- c( - parametersToShow, - "overallEvents", - "overallSampleSizes", - "overallPi1" - ) - } else if (self$.dataInput$getNumberOfGroups() == 2) { - parametersToShow <- c( - parametersToShow, - "overallEvents1", - "overallEvents2", - "overallSampleSizes1", - "overallSampleSizes2", - "overallPi1", - "overallPi2" - ) - } - parametersToShow <- c( - parametersToShow, - "testStatistics", - "pValues" - ) - if (self$.dataInput$getNumberOfGroups() > 1) { - parametersToShow <- c(parametersToShow, "effectSizes") - } - - if (.isTrialDesignInverseNormal(self$.design)) { - parametersToShow <- c( - parametersToShow, - "combInverseNormal", - "weightsInverseNormal" - ) - } else if (.isTrialDesignFisher(self$.design)) { - parametersToShow <- c( - parametersToShow, - "combFisher", - "weightsFisher" - ) - } - parametersToShow <- c( - parametersToShow, - "thetaH0", - "direction", - "normalApproximation" - ) - return(parametersToShow) - } - ) -) - -#' @name StageResultsMultiArmRates -#' -#' @title -#' Stage Results Multi Arm Rates -#' -#' @description -#' Class for stage results of multi arm rates data -#' -#' @template field_stages -#' @template field_testStatistics -#' @template field_pValues -#' @template field_combInverseNormal -#' @template field_combFisher -#' @template field_effectSizes -#' @template field_testActions -#' @template field_weightsFisher -#' @template field_weightsInverseNormal -#' @template field_combInverseNormal -#' @template field_combFisher -#' @template field_overallTestStatistics -#' @template field_overallPValues -#' @template field_testStatistics -#' @template field_separatePValues -#' @template field_effectSizes -#' @template field_singleStepAdjustedPValues -#' @template field_intersectionTest -#' @template field_normalApproximation -#' @template field_directionUpper -#' -#' @details -#' This object cannot be created directly; use \code{getStageResults} -#' with suitable arguments to create the stage results of a dataset of multi arm rates. -#' -#' @include class_core_parameter_set.R -#' @include class_design.R -#' @include class_analysis_dataset.R -#' @include f_core_constants.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -StageResultsMultiArmRatesR6 <- R6Class("StageResultsMultiArmRatesR6", - inherit = StageResultsR6, - public = list( - stage = NULL, - overallPiTreatments = NULL, - overallPiControl = NULL, - combInverseNormal = NULL, - combFisher = NULL, - overallTestStatistics = NULL, - overallPValues = NULL, - testStatistics = NULL, - separatePValues = NULL, - effectSizes = NULL, - singleStepAdjustedPValues = NULL, - intersectionTest = NULL, - normalApproximation = NULL, - directionUpper = NULL, - initialize = function(design, dataInput, ..., - overallPiTreatments = NULL, - overallPiControl = NULL, - combInverseNormal = NULL, - combFisher = NULL, - overallTestStatistics = NULL, - overallPValues = NULL, - testStatistics = NULL, - separatePValues = NULL, - effectSizes = NULL, - singleStepAdjustedPValues = NULL, - intersectionTest = NULL, - normalApproximation = FALSE, - directionUpper = NULL) { - super$initialize(.design = design, .dataInput = dataInput, ...)#TODO - - self$overallPiTreatments <- overallPiTreatments - self$overallPiControl <- overallPiControl - self$combInverseNormal <- combInverseNormal - self$combFisher <- combFisher - self$overallTestStatistics <- overallTestStatistics - self$overallPValues <- overallPValues - self$testStatistics <- testStatistics - self$separatePValues <- separatePValues - self$effectSizes <- effectSizes - self$singleStepAdjustedPValues <- singleStepAdjustedPValues - self$intersectionTest <- intersectionTest - self$normalApproximation <- normalApproximation - self$directionUpper <- directionUpper - - self$init(design = design, dataInput = dataInput) - - for (param in c( - "singleStepAdjustedPValues", - "weightsFisher", - "weightsInverseNormal", - "combFisher", - "combInverseNormal" - )) { - self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) - } - - for (param in self$.getParametersToShow()) { - if (self$.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { - self$.setParameterType(param, C_PARAM_GENERATED) - } - } - - self$.setParameterType("normalApproximation", ifelse( - identical(self$normalApproximation, FALSE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - self$.setParameterType("directionUpper", ifelse( - identical(self$directionUpper, C_DIRECTION_UPPER_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - }, - .getParametersToShow = function() { - parametersToShow <- c( - "stages", - "thetaH0", - "direction", - "normalApproximation", - "directionUpper", - "overallPiControl", - "overallPiTreatments", - "intersectionTest", - "overallTestStatistics", - "overallPValues", - "testStatistics", - "separatePValues", - "singleStepAdjustedPValues" - ) - if (.isTrialDesignInverseNormal(self$.design)) { - parametersToShow <- c( - parametersToShow, - "combInverseNormal", - "weightsInverseNormal" - ) - } else if (.isTrialDesignFisher(self$.design)) { - parametersToShow <- c( - parametersToShow, - "combFisher", - "weightsFisher" - ) - } - return(parametersToShow) - } - ) -) - -#' -#' @name StageResultsSurvival -#' -#' @title -#' Stage Results of Survival Data -#' -#' @description -#' Class for stage results survival data. -#' -#' @template field_stages -#' @template field_testStatistics -#' @template field_overallTestStatistics -#' @template field_separatePValues -#' @template field_singleStepAdjustedPValues -#' @template field_overallPValues -#' @template field_direction -#' @template field_directionUpper -#' @template field_intersectionTest -#' @template field_combInverseNormal -#' @template field_combFisher -#' @template field_effectSizes -#' @template field_testActions -#' @template field_thetaH0 -#' @template field_weightsFisher -#' @template field_weightsInverseNormal -#' @template field_normalApproximation -#' @field ... Names of \code{dataInput}. -#' -#' @details -#' This object cannot be created directly; use \code{getStageResults} -#' with suitable arguments to create the stage results of a dataset of survival data. -#' -#' @include class_core_parameter_set.R -#' @include class_design.R -#' @include class_analysis_dataset.R -#' @include f_core_constants.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -StageResultsSurvivalR6 <- R6Class("StageResultsSurvivalR6", - inherit = StageResultsR6, - public = list( - combInverseNormal = NULL, - combFisher = NULL, - overallPValues = NULL, - effectSizes = NULL, - overallTestStatistics = NULL, - overallEvents = NULL, - overallAllocationRatios = NULL, - events = NULL, - allocationRatios = NULL, - testStatistics = NULL, - initialize = function(design, dataInput, ..., - combInverseNormal = NULL, - combFisher = NULL, - overallPValues = NULL, - effectSizes = NULL, - overallTestStatistics = NULL, - overallEvents = NULL, - overallAllocationRatios = NULL, - events = NULL, - allocationRatios = NULL, - testStatistics = NULL) { - super$initialize(.design = design, .dataInput = dataInput, ...)#TODO - - self$combInverseNormal <- combInverseNormal - self$combFisher <- combFisher - self$overallPValues <- overallPValues - self$effectSizes <- effectSizes - self$overallTestStatistics <- overallTestStatistics - self$overallEvents <- overallEvents - self$overallAllocationRatios <- overallAllocationRatios - self$events <- events - self$allocationRatios <- allocationRatios - self$testStatistics <- testStatistics - - self$init(design = design, dataInput = dataInput) - - for (param in c( - "weightsFisher", - "weightsInverseNormal", - "combFisher", - "combInverseNormal" - )) { - self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) - } - - for (param in self$.getParametersToShow()) { - if (self$.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { - self$.setParameterType(param, C_PARAM_GENERATED) - } - } - }, - .getParametersToShow = function() { - parametersToShow <- c( - "stages", - "overallTestStatistics", - "overallPValues", - "overallEvents", - "overallAllocationRatios", - "events", - "allocationRatios", - "testStatistics", - "pValues", - "overallPValues", - "effectSizes" - ) - if (.isTrialDesignInverseNormal(self$.design)) { - parametersToShow <- c( - parametersToShow, - "combInverseNormal", - "weightsInverseNormal" - ) - } else if (.isTrialDesignFisher(self$.design)) { - parametersToShow <- c( - parametersToShow, - "combFisher", - "weightsFisher" - ) - } - parametersToShow <- c( - parametersToShow, - "thetaH0", - "direction" - ) - return(parametersToShow) - } - ) -) - -#' @name StageResultsMultiArmSurvival -#' -#' @title -#' Stage Results Multi Arm Survival -#' -#' @description -#' Class for stage results of multi arm survival data -#' -#' @template field_stages -#' @template field_testStatistics -#' @template field_pValues -#' @template field_combInverseNormal -#' @template field_combFisher -#' @template field_effectSizes -#' @template field_testActions -#' @template field_weightsFisher -#' @template field_weightsInverseNormal -#' @template field_combInverseNormal -#' @template field_combFisher -#' @template field_overallTestStatistics -#' @template field_overallPValues -#' @template field_testStatistics -#' @template field_separatePValues -#' @template field_effectSizes -#' @template field_singleStepAdjustedPValues -#' @template field_intersectionTest -#' @template field_directionUpper -#' -#' @details -#' This object cannot be created directly; use \code{getStageResults} -#' with suitable arguments to create the stage results of a dataset of multi arm survival. -#' -#' @include class_core_parameter_set.R -#' @include class_design.R -#' @include class_analysis_dataset.R -#' @include f_core_constants.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -StageResultsMultiArmSurvivalR6 <- R6Class("StageResultsMultiArmSurvivalR6", - inherit = StageResultsR6, - public = list( - stage = NULL, - combInverseNormal = NULL, - combFisher = NULL, - overallTestStatistics = NULL, - overallPValues = NULL, - testStatistics = NULL, - separatePValues = NULL, - effectSizes = NULL, - singleStepAdjustedPValues = NULL, - intersectionTest = NULL, - directionUpper = NULL, - initialize = function(design, dataInput, ..., - combInverseNormal = NULL, - combFisher = NULL, - overallTestStatistics = NULL, - overallPValues = NULL, - testStatistics = NULL, - separatePValues = NULL, - effectSizes = NULL, - singleStepAdjustedPValues = NULL, - intersectionTest = NULL, - directionUpper = NULL) { - super$initialize(.design = design, .dataInput = dataInput, ...) #TODO - - self$combInverseNormal <- combInverseNormal - self$combFisher <- combFisher - self$overallTestStatistics <- overallTestStatistics - self$overallPValues <- overallPValues - self$testStatistics <- testStatistics - self$separatePValues <- separatePValues - self$effectSizes <- effectSizes - self$singleStepAdjustedPValues <- singleStepAdjustedPValues - self$intersectionTest <- intersectionTest - self$directionUpper <- directionUpper - - self$init(design = design, dataInput = dataInput) - - for (param in c( - "singleStepAdjustedPValues", - "weightsFisher", - "weightsInverseNormal", - "combFisher", - "combInverseNormal" - )) { - self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) - } - - for (param in self$.getParametersToShow()) { - if (self$.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { - self$.setParameterType(param, C_PARAM_GENERATED) - } - } - - self$.setParameterType("directionUpper", ifelse( - identical(self$directionUpper, C_DIRECTION_UPPER_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - }, - .getParametersToShow = function() { - parametersToShow <- c( - "stages", - "thetaH0", - "direction", - "directionUpper", - "intersectionTest", - "overallTestStatistics", - "overallPValues", - "testStatistics", - "separatePValues", - "effectSizes", - "singleStepAdjustedPValues" - ) - if (.isTrialDesignInverseNormal(self$.design)) { - parametersToShow <- c( - parametersToShow, - "combInverseNormal", - "weightsInverseNormal" - ) - } else if (.isTrialDesignFisher(self$.design)) { - parametersToShow <- c( - parametersToShow, - "combFisher", - "weightsFisher" - ) - } - return(parametersToShow) - } - ) -) - -#' -#' @name StageResultsEnrichmentMeans -#' -#' @title -#' Stage Results Enrichment Means -#' -#' @description -#' Class for stage results of enrichment means data -#' -#' @template field_stages -#' @template field_thetaH0 -#' @template field_direction -#' @template field_normalApproximation -#' @template field_directionUpper -#' @template field_varianceOption -#' @template field_intersectionTest -#' @template field_testStatistics -#' @template field_overallTestStatistics -#' @template field_pValues -#' @template field_overallPValues -#' @template field_overallStDevs -#' @template field_overallPooledStDevs -#' @template field_separatePValues -#' @template field_effectSizes -#' @template field_singleStepAdjustedPValues -#' @template field_stratifiedAnalysis -#' @template field_combInverseNormal -#' @template field_combFisher -#' @template field_weightsFisher -#' @template field_weightsInverseNormal -#' -#' @details -#' This object cannot be created directly; use \code{getStageResults} -#' with suitable arguments to create the stage results of a dataset of enrichment means. -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -StageResultsEnrichmentMeansR6 <- R6Class("StageResultsEnrichmentMeansR6", - inherit = StageResultsMultiArmMeansR6, - public = list( - .overallSampleSizes1 = NULL, - .overallSampleSizes2 = NULL, - stratifiedAnalysis = NULL, - .getParametersToShow = function() {#TODO init - return(c(super$.getParametersToShow(), "stratifiedAnalysis")) - } - ) -) - -#' -#' @name StageResultsEnrichmentRates -#' -#' @title -#' Stage Results Enrichment Rates -#' -#' @description -#' Class for stage results of enrichment rates data. -#' -#' @template field_stages -#' @template field_testStatistics -#' @template field_pValues -#' @template field_combInverseNormal -#' @template field_combFisher -#' @template field_effectSizes -#' @template field_testActions -#' @template field_weightsFisher -#' @template field_weightsInverseNormal -#' -#' @details -#' This object cannot be created directly; use \code{getStageResults} -#' with suitable arguments to create the stage results of a dataset of enrichment rates. -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -StageResultsEnrichmentRatesR6 <- R6Class("StageResultsEnrichmentRatesR6", - inherit = StageResultsMultiArmRatesR6, - public = list( - .overallSampleSizes1 = NULL, - .overallSampleSizes2 = NULL, - overallPisTreatment = NULL, - overallPisControl = NULL, - stratifiedAnalysis = NULL, - .getParametersToShow = function() { - parametersToShow <- super$.getParametersToShow() - parametersToShow <- parametersToShow[!(parametersToShow %in% c("overallPiTreatments", "overallPiControl"))] - return(c(parametersToShow, "stratifiedAnalysis", "overallPisTreatment", "overallPisControl")) - } - ) -) - -#' -#' @name StageResultsEnrichmentSurvival -#' -#' @title -#' Stage Results Enrichment Survival -#' -#' @description -#' Class for stage results of enrichment survival data. -#' -#' @template field_stages -#' @template field_testStatistics -#' @template field_pValues -#' @template field_combInverseNormal -#' @template field_combFisher -#' @template field_effectSizes -#' @template field_testActions -#' @template field_weightsFisher -#' @template field_weightsInverseNormal -#' -#' @details -#' This object cannot be created directly; use \code{getStageResults} -#' with suitable arguments to create the stage results of a dataset of enrichment survival. -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -StageResultsEnrichmentSurvivalR6 <- R6Class("StageResultsEnrichmentSurvivalR6", - inherit = StageResultsMultiArmSurvivalR6, - public = list( - stratifiedAnalysis = NULL, - .overallEvents = NULL, - .getParametersToShow = function() { - return(c(super$.getParametersToShow(), "stratifiedAnalysis")) - } - ) -) - -#' -#' @title -#' Names of a Stage Results Object -#' -#' @description -#' Function to get the names of a \code{\link{StageResults}} object. -#' -#' @param x A \code{\link{StageResults}} object. -#' -#' @details -#' Returns the names of stage results that can be accessed by the user. -#' -#' @template return_names -#' -#' @export -#' -#' @keywords internal -#' -names.StageResultsR6 <- function(x) { - return(x$.getParametersToShow()) -} - -#' -#' @title -#' Coerce Stage Results to a Data Frame -#' -#' @description -#' Returns the \code{StageResults} as data frame. -#' -#' @param x A \code{\link{StageResults}} object. -#' @inheritParams param_niceColumnNamesEnabled -#' @inheritParams param_includeAllParameters -#' @inheritParams param_three_dots -#' -#' @details -#' Coerces the stage results to a data frame. -#' -#' @template return_dataframe -#' -#' @export -#' -#' @keywords internal -#' -as.data.frame.StageResultsR6 <- function(x, row.names = NULL, - optional = FALSE, niceColumnNamesEnabled = FALSE, - includeAllParameters = FALSE, type = 1, ...) { - if (type == 1) { - parametersToShow <- x$.getParametersToShow() - - return(.getAsDataFrame( - parameterSet = x, - parameterNames = parametersToShow, - niceColumnNamesEnabled = niceColumnNamesEnabled, - includeAllParameters = includeAllParameters, - tableColumnNames = .getTableColumnNames(design = x$.design) - )) - } - - kMax <- length(x$stages) - group1 <- rep(1, kMax) - group2 <- rep(2, kMax) - empty <- rep(NA_real_, kMax) - stageResults <- data.frame( - Stage = c(x$stages, x$stages), - Group = c(group1, group2), - "Cumulative Mean" = c(x$overallMeans1, x$overallMeans2), - "Cumulative stDev" = c(x$overallStDevs1, x$overallStDevs2), - "Cumulative test statistics" = c(x$overallTestStatistics, empty), - "Overall p-value" = c(x$overallPValues, empty), - "Cumulative stDev" = c(x$overallStDevs, empty), - "Stage-wise test statistic" = c(x$testStatistics, empty), - "Stage-wise p-value" = c(x$pValues, empty), - "Comb Inverse Normal" = c(x$combInverseNormal, empty), - "Comb Fisher" = c(x$combFisher, empty), - "Weights Fisher" = c(x$weightsFisher, empty), - "Weights Inverse Normal" = c(x$weightsInverseNormal, empty), - row.names = row.names, - ... - ) - stageResults <- stageResults[with(stageResults, order(Stage, Group)), ] - return(stageResults) -} - -.getTreatmentArmsToShow <- function(x, ...) { - dataInput <- x - if (!inherits(dataInput, "Dataset")) { - dataInput <- x[[".dataInput"]] - } - if (is.null(dataInput) || !inherits(dataInput, "Dataset")) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to get 'dataInput' from ", .getClassName(x)) - } - - numberOfTreatments <- dataInput$getNumberOfGroups() - if (numberOfTreatments > 1) { - validComparisons <- 1L:as.integer(numberOfTreatments - 1) - } else { - validComparisons <- 1L - } - - treatmentArmsToShow <- .getOptionalArgument("treatmentArms", ...) - if (!is.null(treatmentArmsToShow)) { - treatmentArmsToShow <- as.integer(na.omit(treatmentArmsToShow)) - } - if (is.null(treatmentArmsToShow) || length(treatmentArmsToShow) == 0 || - all(is.na(treatmentArmsToShow)) || !is.numeric(treatmentArmsToShow)) { - treatmentArmsToShow <- validComparisons - } else if (!all(treatmentArmsToShow %in% validComparisons)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'treatmentArms' (", - .arrayToString(treatmentArmsToShow), ") must be a vector ", - "containing one or more values of ", .arrayToString(validComparisons) - ) - } - treatmentArmsToShow <- sort(unique(treatmentArmsToShow)) - return(treatmentArmsToShow) -} - -.getPopulationsToShow <- function(x, ..., gMax) { - dataInput <- x - if (!inherits(dataInput, "Dataset")) { - dataInput <- x[[".dataInput"]] - } - if (is.null(dataInput) || !inherits(dataInput, "Dataset")) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to get 'dataInput' from ", .getClassName(x)) - } - - numberOfPopulations <- gMax - if (numberOfPopulations > 1) { - validComparisons <- 1L:as.integer(numberOfPopulations) - } else { - validComparisons <- 1L - } - - populationsToShow <- .getOptionalArgument("populations", ...) - - if (!is.null(populationsToShow)) { - populationsToShow <- as.integer(na.omit(populationsToShow)) - } - if (is.null(populationsToShow) || length(populationsToShow) == 0 || - all(is.na(populationsToShow)) || !is.numeric(populationsToShow)) { - populationsToShow <- validComparisons - } else if (!all(populationsToShow %in% validComparisons)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'populations' (", - .arrayToString(populationsToShow), ") must be a vector ", - "containing one or more values of ", .arrayToString(validComparisons) - ) - } - populationsToShow <- sort(unique(populationsToShow)) - return(populationsToShow) -} - -#' -#' @title -#' Stage Results Plotting -#' -#' @description -#' Plots the conditional power together with the likelihood function. -#' -#' @param x The stage results at given stage, obtained from \code{\link[=getStageResults]{getStageResults()}} or -#' \code{\link[=getAnalysisResults]{getAnalysisResults()}}. -#' @param y Not available for this kind of plot (is only defined to be compatible to the generic plot function). -#' @inheritParams param_stage -#' @inheritParams param_nPlanned -#' @inheritParams param_allocationRatioPlanned -#' @param main The main title. -#' @param xlab The x-axis label. -#' @param ylab The y-axis label. -#' @param legendTitle The legend title. -#' @inheritParams param_palette -#' @inheritParams param_showSource -#' @inheritParams param_plotSettings -#' @inheritParams param_legendPosition -#' @param type The plot type (default = 1). Note that at the moment only one type -#' (the conditional power plot) is available. -#' @param ... Optional \link[=param_three_dots_plot]{plot arguments}. Furthermore the following arguments can be defined: -#' \itemize{ -#' \item \code{thetaRange}: A range of assumed effect sizes if testing means or a survival design was specified. -#' Additionally, if testing means was selected, an assumed standard deviation can be specified (default is 1). -#' \item \code{piTreatmentRange}: A range of assumed rates pi1 to calculate the conditional power. -#' Additionally, if a two-sample comparison was selected, pi2 can be specified (default is the value from -#' \code{\link[=getAnalysisResults]{getAnalysisResults()}}). -#' \item \code{directionUpper}: Specifies the direction of the alternative, -#' only applicable for one-sided testing; default is \code{TRUE} -#' which means that larger values of the test statistics yield smaller p-values. -#' \item \code{\link[=param_thetaH0]{thetaH0}}: The null hypothesis value, default is 0 for the normal and the binary case, -#' it is 1 for the survival case. -#' For testing a rate in one sample, a value thetaH0 in (0,1) has to be specified for -#' defining the null hypothesis H0: pi = thetaH0. -#' } -#' -#' @details -#' Generic function to plot all kinds of stage results. -#' The conditional power is calculated only if effect size and sample size is specified. -#' -#' @template return_object_ggplot -#' -#' @examples -#' design <- getDesignGroupSequential( -#' kMax = 4, alpha = 0.025, -#' informationRates = c(0.2, 0.5, 0.8, 1), -#' typeOfDesign = "WT", deltaWT = 0.25 -#' ) -#' -#' dataExample <- getDataset( -#' n = c(20, 30, 30), -#' means = c(50, 51, 55), -#' stDevs = c(130, 140, 120) -#' ) -#' -#' stageResults <- getStageResults(design, dataExample, thetaH0 = 20) -#' -#' \dontrun{ -#' if (require(ggplot2)) plot(stageResults, nPlanned = c(30), thetaRange = c(0, 100)) -#' } -#' -#' @export -#' -plot.StageResultsR6 <- function(x, y, ..., type = 1L, - nPlanned, allocationRatioPlanned = 1, # C_ALLOCATION_RATIO_DEFAULT - main = NA_character_, xlab = NA_character_, ylab = NA_character_, - legendTitle = NA_character_, palette = "Set1", legendPosition = NA_integer_, - showSource = FALSE, plotSettings = NULL) { - fCall <- match.call(expand.dots = FALSE) - - .assertGgplotIsInstalled() - .assertIsStageResults(x) - .assertIsValidLegendPosition(legendPosition) - if (.isConditionalPowerEnabled(nPlanned)) { - .assertIsValidAllocationRatioPlanned(allocationRatioPlanned, x$.dataInput$getNumberOfGroups()) - } - .stopInCaseOfIllegalStageDefinition2(...) - - if (x$.design$kMax == 1) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "cannot plot stage results of a fixed design") - } - - if (!is.logical(showSource) || isTRUE(showSource)) { - stageResultsName <- .getOptionalArgument("stageResultsName", ...) - if (is.null(stageResultsName)) { - stageResultsName <- deparse(fCall$x) - } - cat("Source data of the plot:\n") - cat(" Use getConditionalPower(..., addPlotData = TRUE) to create the data.\n", sep = "") - cat("Simple plot command example:\n", sep = "") - - cmd <- paste0( - "condPow <- getConditionalPower(", stageResultsName, - ", nPlanned = ", .arrayToString(nPlanned, vectorLookAndFeelEnabled = TRUE) - ) - if (.isConditionalPowerEnabled(nPlanned) && allocationRatioPlanned != C_ALLOCATION_RATIO_DEFAULT) { - cmd <- paste0(cmd, ", allocationRatioPlanned = ", allocationRatioPlanned) - } - if (grepl("Means|Survival", .getClassName(x))) { - cmd <- paste0(cmd, ", thetaRange = seq(0, 1, 0.1)") - } else if (grepl("Rates", .getClassName(x))) { - cmd <- paste0(cmd, ", piTreatmentRange = seq(0, 1, 0.1)") - } - cmd <- paste0(cmd, ", addPlotData = TRUE)") - - cat(" ", cmd, "\n", sep = "") - cat(" plotData <- condPow$.plotData # get plot data list\n", sep = "") - cat(" plotData # show plot data list\n", sep = "") - cat(" plot(plotData$xValues, plotData$condPowerValues)\n", sep = "") - cat(" plot(plotData$xValues, plotData$likelihoodValues)\n", sep = "") - } - - plotData <- .getConditionalPowerPlot( - stageResults = x, nPlanned = nPlanned, - allocationRatioPlanned = allocationRatioPlanned, ... - ) - - yParameterName1 <- "Conditional power" - yParameterName2 <- "Likelihood" - - if (.isMultiArmStageResults(x)) { - treatmentArmsToShow <- .getTreatmentArmsToShow(x, ...) - data <- data.frame( - xValues = numeric(0), - yValues = numeric(0), - categories = character(0), - treatmentArms = numeric(0) - ) - for (treatmentArm in treatmentArmsToShow) { - legend1 <- ifelse(length(treatmentArmsToShow) == 1, yParameterName1, - paste0(yParameterName1, " (", treatmentArm, " vs control)") - ) - legend2 <- ifelse(length(treatmentArmsToShow) == 1, yParameterName2, - paste0(yParameterName2, " (", treatmentArm, " vs control)") - ) - - treatmentArmIndices <- which(plotData$treatmentArms == treatmentArm) - - if (all(is.na(plotData$condPowerValues[treatmentArmIndices]))) { - if (!all(is.na(plotData$likelihoodValues[treatmentArmIndices]))) { - data <- rbind(data, data.frame( - xValues = plotData$xValues[treatmentArmIndices], - yValues = plotData$likelihoodValues[treatmentArmIndices], - categories = rep(legend2, length(plotData$xValues[treatmentArmIndices])), - treatmentArms = rep(treatmentArm, length(plotData$xValues[treatmentArmIndices])) - )) - } - } else { - data <- rbind(data, data.frame( - xValues = c( - plotData$xValues[treatmentArmIndices], - plotData$xValues[treatmentArmIndices] - ), - yValues = c( - plotData$condPowerValues[treatmentArmIndices], - plotData$likelihoodValues[treatmentArmIndices] - ), - categories = c( - rep(legend1, length(plotData$xValues[treatmentArmIndices])), - rep(legend2, length(plotData$xValues[treatmentArmIndices])) - ), - treatmentArms = c( - rep(treatmentArm, length(plotData$xValues[treatmentArmIndices])), - rep(treatmentArm, length(plotData$xValues[treatmentArmIndices])) - ) - )) - } - } - } else if (.isEnrichmentStageResults(x)) { - gMax <- max(na.omit(plotData$populations)) - populationsToShow <- .getPopulationsToShow(x, ..., gMax = gMax) - data <- data.frame( - xValues = numeric(0), - yValues = numeric(0), - categories = character(0), - populations = numeric(0) - ) - for (population in populationsToShow) { - populationName <- ifelse(population == gMax, "F", paste0("S", population)) - legend1 <- ifelse(length(populationsToShow) == 1, yParameterName1, - paste0(yParameterName1, " (", populationName, ")") - ) - legend2 <- ifelse(length(populationsToShow) == 1, yParameterName2, - paste0(yParameterName2, " (", populationName, ")") - ) - - populationIndices <- which(plotData$populations == population) - - if (all(is.na(plotData$condPowerValues[populationIndices]))) { - if (!all(is.na(plotData$likelihoodValues[populationIndices]))) { - data <- rbind(data, data.frame( - xValues = plotData$xValues[populationIndices], - yValues = plotData$likelihoodValues[populationIndices], - categories = rep(legend2, length(plotData$xValues[populationIndices])), - populations = rep(population, length(plotData$xValues[populationIndices])) - )) - } - } else { - data <- rbind(data, data.frame( - xValues = c( - plotData$xValues[populationIndices], - plotData$xValues[populationIndices] - ), - yValues = c( - plotData$condPowerValues[populationIndices], - plotData$likelihoodValues[populationIndices] - ), - categories = c( - rep(legend1, length(plotData$xValues[populationIndices])), - rep(legend2, length(plotData$xValues[populationIndices])) - ), - populations = c( - rep(population, length(plotData$xValues[populationIndices])), - rep(population, length(plotData$xValues[populationIndices])) - ) - )) - } - } - } else { - if (all(is.na(plotData$condPowerValues))) { - legendPosition <- -1 - data <- data.frame( - xValues = plotData$xValues, - yValues = plotData$likelihoodValues, - categories = rep(yParameterName2, length(plotData$xValues)) - ) - } else { - data <- data.frame( - xValues = c(plotData$xValues, plotData$xValues), - yValues = c(plotData$condPowerValues, plotData$likelihoodValues), - categories = c( - rep(yParameterName1, length(plotData$xValues)), - rep(yParameterName2, length(plotData$xValues)) - ) - ) - } - } - - data$categories <- factor(data$categories, levels = unique(data$categories)) - - main <- ifelse(is.na(main), C_PLOT_MAIN_CONDITIONAL_POWER_WITH_LIKELIHOOD, main) - ylab <- ifelse(is.na(ylab), C_PLOT_YLAB_CONDITIONAL_POWER_WITH_LIKELIHOOD, ylab) - - if (is.na(legendTitle)) { - legendTitle <- "Parameter" - } - - return(.createAnalysisResultsPlotObject(x, - data = data, plotData = plotData, main = main, xlab = xlab, ylab = ylab, - legendTitle = legendTitle, palette = palette, legendPosition = legendPosition, numberOfPairedLines = 2L, - plotSettings = plotSettings - )) -} - -.createAnalysisResultsPlotObject <- function(x, ..., data, plotData, - main = NA_character_, xlab = NA_character_, ylab = NA_character_, - legendTitle = NA_character_, palette = "Set1", legendPosition = NA_integer_, - numberOfPairedLines = NA_integer_, plotSettings = NULL) { - ciModeEnabled <- !is.null(data[["lower"]]) && !is.null(data[["upper"]]) - - if (!ciModeEnabled) { - p <- ggplot2::ggplot(data, ggplot2::aes( - x = .data[["xValues"]], y = .data[["yValues"]], - colour = factor(.data[["categories"]]), - linetype = factor(.data[["categories"]]) - )) - } else { - p <- ggplot2::ggplot(data, ggplot2::aes( - x = .data[["xValues"]], y = .data[["yValues"]], - colour = factor(.data[["categories"]]) - )) - } - - if (is.null(plotSettings)) { - plotSettings <- x$getPlotSettings() - } - - p <- plotSettings$setTheme(p) - p <- plotSettings$hideGridLines(p) - - # set main title - mainTitle <- ifelse(!is.call(main) && !isS4(main) && is.na(main), plotData$main, main) - p <- plotSettings$setMainTitle(p, mainTitle, subtitle = plotData$sub) - - # set legend - if (is.na(legendPosition)) { - legendPosition <- C_POSITION_LEFT_TOP - } - p <- plotSettings$setLegendPosition(p, legendPosition = legendPosition) - p <- plotSettings$setLegendBorder(p) - p <- plotSettings$setLegendTitle(p, legendTitle) - p <- plotSettings$setLegendLabelSize(p) - - # set axes labels - p <- plotSettings$setAxesLabels(p, - xAxisLabel = plotData$xlab, yAxisLabel1 = plotData$ylab, - xlab = xlab, ylab = ylab - ) - - # plot lines and points - if (!ciModeEnabled) { - if (is.na(numberOfPairedLines)) { - numberOfPairedLines <- 2 - if (x$.isMultiArm()) { - numberOfPairedLines <- length(unique(data$treatmentArms)) - 1 - } else if (x$.isEnrichment()) { - numberOfPairedLines <- length(unique(data$populations)) - 1 - } - } - - p <- plotSettings$plotValues(p, plotPointsEnabled = FALSE, pointBorder = 1) - n <- length(unique(data$categories)) / numberOfPairedLines - if (n > 1) { - lineTypeValues <- rep(1:numberOfPairedLines, n) - colorTypes <- sort(rep(1:n, numberOfPairedLines)) - for (i in c(1, 3)) { - colorTypes[colorTypes >= i] <- colorTypes[colorTypes >= i] + 1 - } - p <- p + ggplot2::scale_color_manual(name = legendTitle, values = colorTypes) - p <- p + ggplot2::scale_linetype_manual(name = legendTitle, values = lineTypeValues) - } else { - colorValues <- c(2, 4) - if (!x$.isMultiArm()) { - colorValues <- c(2, 2) # use only one color - } - p <- p + ggplot2::scale_color_manual(name = legendTitle, values = colorValues) - p <- p + ggplot2::scale_linetype_manual(name = legendTitle, values = c(1, 2)) - } - } - - # plot confidence intervall - else { - pd <- ggplot2::position_dodge(0.15) - - p <- p + ggplot2::geom_errorbar( - data = data, - ggplot2::aes(ymin = .data[["lower"]], ymax = .data[["upper"]]), - width = 0.15, position = pd, size = 0.8 - ) - p <- p + ggplot2::geom_line(position = pd, linetype = "longdash") - p <- p + ggplot2::geom_point(position = pd, size = 2.0) - - - stage <- unique(data$xValues) - kMax <- list(...)[["kMax"]] - if (length(stage) == 1 && !is.null(kMax)) { - stages <- 1:kMax - p <- p + ggplot2::scale_x_continuous(breaks = stages) - } else if (length(stage) > 1 && all(stage %in% 1:10)) { - p <- p + ggplot2::scale_x_continuous(breaks = stage) - } - } - - p <- plotSettings$setAxesAppearance(p) - p <- plotSettings$enlargeAxisTicks(p) - - companyAnnotationEnabled <- .getOptionalArgument("companyAnnotationEnabled", ...) - if (is.null(companyAnnotationEnabled) || !is.logical(companyAnnotationEnabled)) { - companyAnnotationEnabled <- FALSE - } - - p <- plotSettings$addCompanyAnnotation(p, enabled = companyAnnotationEnabled) - - # start plot generation - return(p) -} diff --git a/R/class_core_parameter_set.R b/R/class_core_parameter_set.R index 6f211768..48691d31 100644 --- a/R/class_core_parameter_set.R +++ b/R/class_core_parameter_set.R @@ -1,3 +1,4 @@ +library("R6") ## | ## | *Parameter set classes* ## | @@ -13,8 +14,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7359 $ -## | Last changed: $Date: 2023-10-13 11:39:39 +0200 (Fri, 13 Oct 2023) $ +## | File version: $Revision: 6902 $ +## | Last changed: $Date: 2023-03-29 10:01:19 +0200 (Mi, 29 Mrz 2023) $ ## | Last changed by: $Author: pahlke $ ## | @@ -23,7 +24,7 @@ NULL #' -#' @name FieldSet +#' @name FieldSetR6 #' #' @title #' Field Set @@ -40,137 +41,135 @@ NULL #' #' @importFrom methods new #' -FieldSet <- setRefClass("FieldSet", - fields = list( - .parameterTypes = "list", - .parameterNames = "list", - .parameterFormatFunctions = "list", - .showParameterTypeEnabled = "logical", - .catLines = "character" - ), - methods = list( - .getFieldNames = function() { - return(names(.self$getRefClass()$fields())) - }, - .getVisibleFieldNames = function() { - fieldNames <- names(.self$getRefClass()$fields()) - fieldNames <- fieldNames[!startsWith(fieldNames, ".")] - return(fieldNames) - }, - .resetCat = function() { - .catLines <<- character(0) - }, - .cat = function(..., file = "", sep = "", fill = FALSE, labels = NULL, - append = FALSE, heading = 0, tableColumns = 0, consoleOutputEnabled = TRUE, - na = NA_character_) { - if (consoleOutputEnabled) { - cat(..., file = file, sep = sep, fill = fill, labels = labels, append = append) - return(invisible()) - } - - args <- list(...) - line <- "" - if (length(args) > 0) { - if (tableColumns > 0) { - values <- unlist(args, use.names = FALSE) - values <- values[values != "\n"] - for (i in 1:length(values)) { - values[i] <- gsub("\n", "", values[i]) - } - if (!is.null(na) && length(na) == 1 && !is.na(na)) { - len <- min(nchar(values)) - naStr <- paste0(trimws(na), " ") - while (nchar(naStr) < len) { - naStr <- paste0(" ", naStr) - } - values[is.na(values) | nchar(trimws(values)) == 0] <- naStr - } - line <- paste0(values, collapse = "| ") - if (trimws(line) != "" && !grepl("\\| *$", line)) { - line <- paste0(line, "|") - } - line <- paste0("| ", line) - extraCells <- tableColumns - length(values) - if (extraCells > 0 && trimws(line) != "") { - line <- paste0(line, paste0(rep(" |", extraCells), collapse = "")) - } - line <- paste0(line, "\n") - } else { - line <- paste0(args, collapse = sep) - listItemEnabled <- grepl("^ ", line) - - headingBaseNumber <- as.integer(getOption("rpact.print.heading.base.number", 0L)) - if (is.na(headingBaseNumber)) { - headingBaseNumber <- 0L - } - if (headingBaseNumber < -1) { - warning( - "Illegal option ", sQuote("rpact.print.heading.base.number"), - " (", headingBaseNumber, ") was set to 0" - ) - headingBaseNumber <- 0L - } - if (headingBaseNumber > 4) { - warning( - "Illgeal option ", sQuote("rpact.print.heading.base.number"), - " (", headingBaseNumber, ") was set to 4 becasue it was too large" - ) - headingBaseNumber <- 4L - } - - if (heading > 0) { - if (headingBaseNumber == -1) { - lineBreak <- "" - if (grepl("\n *$", line)) { - lineBreak <- "\n\n" +FieldSetR6 <- R6Class("FieldSetR6", + public = list( + .parameterTypes = NULL, + .parameterNames = NULL, + .parameterFormatFunctions = NULL, + .showParameterTypeEnabled = NULL, + .catLines = NULL, + .getFieldNames = function() { + return(unlist(lapply(class(self)[1:(length(class(self))-1)],function(x) {names(get(x)$public_fields)}))) + }, + .getVisibleFieldNames = function() { + fieldNames <- self$.getFieldNames() + fieldNames <- fieldNames[!startsWith(fieldNames, ".")] + return(fieldNames) + }, + .resetCat = function() { + self$.catLines <- character(0) + }, + .cat = function(..., file = "", sep = "", fill = FALSE, labels = NULL, + append = FALSE, heading = 0, tableColumns = 0, consoleOutputEnabled = TRUE, + na = NA_character_) { + if (consoleOutputEnabled) { + cat(..., file = file, sep = sep, fill = fill, labels = labels, append = append) + return(invisible()) #TODO self? } - line <- paste0("**", sub(": *", "", trimws(line)), "**", lineBreak) - } else { - headingCmd <- paste0(rep("#", heading + headingBaseNumber + 1), collapse = "") - lineBreak <- "" - if (grepl("\n *$", line)) { - lineBreak <- "\n\n" + + args <- list(...) + line <- "" + if (length(args) > 0) { + if (tableColumns > 0) { + values <- unlist(args, use.names = FALSE) + values <- values[values != "\n"] + for (i in 1:length(values)) { + values[i] <- gsub("\n", "", values[i]) + } + if (!is.null(na) && length(na) == 1 && !is.na(na)) { + len <- min(nchar(values)) + naStr <- paste0(trimws(na), " ") + while (nchar(naStr) < len) { + naStr <- paste0(" ", naStr) + } + values[is.na(values) | nchar(trimws(values)) == 0] <- naStr + } + line <- paste0(values, collapse = "| ") + if (trimws(line) != "" && !grepl("\\| *$", line)) { + line <- paste0(line, "|") + } + line <- paste0("| ", line) + extraCells <- tableColumns - length(values) + if (extraCells > 0 && trimws(line) != "") { + line <- paste0(line, paste0(rep(" |", extraCells), collapse = "")) + } + line <- paste0(line, "\n") + } else { + line <- paste0(args, collapse = sep) + listItemEnabled <- grepl("^ ", line) + + headingBaseNumber <- as.integer(getOption("rpact.print.heading.base.number", 0L)) + if (is.na(headingBaseNumber)) { + headingBaseNumber <- 0L + } + if (headingBaseNumber < -1) { + warning( + "Illegal option ", sQuote("rpact.print.heading.base.number"), + " (", headingBaseNumber, ") was set to 0" + ) + headingBaseNumber <- 0L + } + if (headingBaseNumber > 4) { + warning( + "Illgeal option ", sQuote("rpact.print.heading.base.number"), + " (", headingBaseNumber, ") was set to 4 becasue it was too large" + ) + headingBaseNumber <- 4L + } + + if (heading > 0) { + if (headingBaseNumber == -1) { + lineBreak <- "" + if (grepl("\n *$", line)) { + lineBreak <- "\n\n" + } + line <- paste0("**", sub(": *", "", trimws(line)), "**", lineBreak) + } else { + headingCmd <- paste0(rep("#", heading + headingBaseNumber + 1), collapse = "") + lineBreak <- "" + if (grepl("\n *$", line)) { + lineBreak <- "\n\n" + } + line <- paste0(headingCmd, " ", sub(": *", "", trimws(line)), lineBreak) + } + } else { + parts <- strsplit(line, " *: ")[[1]] + if (length(parts) == 2) { + line <- paste0("*", trimws(parts[1]), "*: ", parts[2]) + } + } + if (listItemEnabled) { + if (grepl("^ ", line)) { + line <- sub("^ ", "* ", line) + } else { + line <- paste0("* ", line) + } + } + } } - line <- paste0(headingCmd, " ", sub(": *", "", trimws(line)), lineBreak) - } - } else { - parts <- strsplit(line, " *: ")[[1]] - if (length(parts) == 2) { - line <- paste0("*", trimws(parts[1]), "*: ", parts[2]) - } - } - if (listItemEnabled) { - if (grepl("^ ", line)) { - line <- sub("^ ", "* ", line) - } else { - line <- paste0("* ", line) - } - } - } - } - if (length(.catLines) == 0) { - .catLines <<- line - } else { - .catLines <<- c(.catLines, line) - } - return(invisible()) - }, - .getFields = function(values) { - flds <- names(.self$getRefClass()$fields()) - if (!missing(values)) { - flds <- flds[flds %in% values] - } - result <- setNames(vector("list", length(flds)), flds) - for (fld in flds) { - result[[fld]] <- .self[[fld]] - } - return(result) - } - ) + if (length(self$.catLines) == 0) { + self$.catLines <- line + } else { + self$.catLines <- c(self$.catLines, line) + } + return(invisible()) + }, + .getFields = function(values) { + flds <- self$.getFieldNames() + if (!missing(values)) { + flds <- flds[flds %in% values] + } + result <- setNames(vector("list", length(flds)), flds) + for (fld in flds) { + result[[fld]] <- self[[fld]] + } + return(result) + } + ) ) #' -#' @name ParameterSet +#' @name ParameterSetR6 #' #' @title #' Parameter Set @@ -190,721 +189,1165 @@ FieldSet <- setRefClass("FieldSet", #' #' @importFrom methods new #' -ParameterSet <- setRefClass("ParameterSet", - contains = "FieldSet", - fields = list( - .parameterTypes = "list", - .parameterNames = "list", - .parameterFormatFunctions = "list", - .showParameterTypeEnabled = "logical", - .catLines = "character" - ), - methods = list( - initialize = function(..., - .showParameterTypeEnabled = TRUE) { - callSuper(..., - .showParameterTypeEnabled = .showParameterTypeEnabled - ) - .parameterTypes <<- list() - .parameterNames <<- list() - .parameterFormatFunctions <<- list() - .catLines <<- character(0) - }, - clone = function() { - paramNames <- names(.self$getRefClass()$fields()) - plotSettingsEnabled <- ".plotSettings" %in% paramNames - designEnabled <- ".design" %in% paramNames - paramNames <- paramNames[!grepl("^\\.|^stages$", paramNames)] - args <- list() - if (designEnabled) { - args$design <- .self$.design - } - for (paramName in paramNames) { - if (.self$.getParameterType(paramName) == C_PARAM_USER_DEFINED) { - args[[paramName]] <- .self[[paramName]] - } - } - what <- .getGeneratorFunctionName(.self) - result <- do.call(what = what, args = args) - if (plotSettingsEnabled && !is.null(.self$.plotSettings)) { - result$.plotSettings <- .self$.plotSettings$clone() - } - return(result) - }, - .toString = function(startWithUpperCase = FALSE) { - s <- .formatCamelCase(.getClassName(.self)) - return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) - }, - .initParameterTypes = function() { - for (parameterName in names(.parameterNames)) { - .parameterTypes[[parameterName]] <<- C_PARAM_TYPE_UNKNOWN - } - }, - .getParameterType = function(parameterName) { - if (is.null(parameterName) || length(parameterName) == 0 || is.na(parameterName)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'parameterName' must be a valid character with length > 0" - ) - } - - parameterType <- .parameterTypes[[parameterName]] - if (is.null(parameterType)) { - return(C_PARAM_TYPE_UNKNOWN) - } - - return(parameterType[1]) - }, - .getParametersToShow = function() { - return(.getVisibleFieldNames()) - }, - .setParameterType = function(parameterName, parameterType) { - if (is.null(parameterName) || length(parameterName) == 0 || is.na(parameterName)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'parameterName' must be a valid character with length > 0" - ) - } - - parameterType <- parameterType[1] - - if (!all(parameterType %in% c( - C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE, - C_PARAM_GENERATED, C_PARAM_DERIVED, C_PARAM_NOT_APPLICABLE - ))) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'parameterType' ('", parameterType, "') is invalid" - ) - } - - .parameterTypes[[parameterName]] <<- parameterType - - invisible(parameterType) - }, - isUserDefinedParameter = function(parameterName) { - return(.getParameterType(parameterName) == C_PARAM_USER_DEFINED) - }, - isDefaultParameter = function(parameterName) { - return(.getParameterType(parameterName) == C_PARAM_DEFAULT_VALUE) - }, - isGeneratedParameter = function(parameterName) { - return(.getParameterType(parameterName) == C_PARAM_GENERATED) - }, - isDerivedParameter = function(parameterName) { - return(.getParameterType(parameterName) == C_PARAM_DERIVED) - }, - isUndefinedParameter = function(parameterName) { - return(.getParameterType(parameterName) == C_PARAM_TYPE_UNKNOWN) - }, - .getInputParameters = function() { - params <- .getParametersOfOneGroup(c(C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE)) - return(params) - }, - .getUserDefinedParameters = function() { - return(.getParametersOfOneGroup(C_PARAM_USER_DEFINED)) - }, - .getDefaultParameters = function() { - return(.getParametersOfOneGroup(C_PARAM_DEFAULT_VALUE)) - }, - .getGeneratedParameters = function() { - return(.getParametersOfOneGroup(C_PARAM_GENERATED)) - }, - .getDerivedParameters = function() { - return(.getParametersOfOneGroup(C_PARAM_DERIVED)) - }, - .getUndefinedParameters = function() { - return(.getParametersOfOneGroup(C_PARAM_TYPE_UNKNOWN)) - }, - .getParameterValueIfUserDefinedOrDefault = function(parameterName) { - if (isUserDefinedParameter(parameterName) || isDefaultParameter(parameterName)) { - return(.self[[parameterName]]) - } - - parameterType <- .self$getRefClass()$fields()[[parameterName]] - if (parameterType == "numeric") { - return(NA_real_) - } - - if (parameterType == "integer") { - return(NA_integer_) - } - - if (parameterType == "character") { - return(NA_character_) - } - - return(NA) - }, - .getParametersOfOneGroup = function(parameterType) { - if (length(parameterType) == 1) { - parameterNames <- names(.parameterTypes[.parameterTypes == parameterType]) - } else { - parameterNames <- names(.parameterTypes[which(.parameterTypes %in% parameterType)]) - } - parametersToShow <- .getParametersToShow() - if (is.null(parametersToShow) || length(parametersToShow) == 0) { - return(parameterNames) - } - - return(parametersToShow[parametersToShow %in% parameterNames]) - }, - .showParameterType = function(parameterName) { - if (!.showParameterTypeEnabled) { - return(" ") - } - - return(paste0("[", .getParameterType(parameterName), "]")) - }, - .showAllParameters = function(consoleOutputEnabled = TRUE) { - parametersToShow <- .getVisibleFieldNamesOrdered() - for (parameter in parametersToShow) { - .showParameter(parameter, - showParameterType = TRUE, - consoleOutputEnabled = consoleOutputEnabled - ) - } - }, - .getVisibleFieldNamesOrdered = function() { - visibleFieldNames <- .getVisibleFieldNames() - - parametersToShowSorted <- .getParametersToShow() - if (is.null(parametersToShowSorted) || length(parametersToShowSorted) == 0) { - return(visibleFieldNames) - } - - visibleFieldNames <- visibleFieldNames[!(visibleFieldNames %in% parametersToShowSorted)] - visibleFieldNames <- c(parametersToShowSorted, visibleFieldNames) - return(visibleFieldNames) - }, - .show = function(..., consoleOutputEnabled = FALSE) { - showType <- .getOptionalArgument("showType", ...) - if (!is.null(showType) && showType == 2) { - .cat("Technical developer summary of the ", .self$.toString(), " object (", - methods::classLabel(class(.self)), "):\n\n", - sep = "", heading = 1, - consoleOutputEnabled = consoleOutputEnabled - ) - .showAllParameters(consoleOutputEnabled = consoleOutputEnabled) - .showParameterTypeDescription(consoleOutputEnabled = consoleOutputEnabled) - } else { - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, - "method '.show()' is not implemented in class '", .getClassName(.self), "'" - ) - } - }, - .catMarkdownText = function(...) { - .show(consoleOutputEnabled = FALSE, ...) - if (length(.catLines) == 0) { - return(invisible()) - } - - for (line in .catLines) { - cat(line) - } - }, - .showParametersOfOneGroup = function(parameters, title, - orderByParameterName = TRUE, consoleOutputEnabled = TRUE) { - output <- "" - if (is.null(parameters) || length(parameters) == 0 || all(is.na(parameters))) { - if (!missing(title) && !is.null(title) && !is.na(title) && consoleOutputEnabled) { - output <- paste0(title, ": not available\n\n") - .cat(output, heading = 2, consoleOutputEnabled = consoleOutputEnabled) - } - invisible(output) - } else { - if (orderByParameterName) { - parameters <- sort(parameters) - } - - if (!missing(title) && !is.null(title) && !is.na(title)) { - output <- paste0(title, ":\n") - .cat(output, heading = 2, consoleOutputEnabled = consoleOutputEnabled) - } - for (parameterName in parameters) { - output <- paste0(output, .showParameter(parameterName, - consoleOutputEnabled = consoleOutputEnabled - )) - } - .cat("\n", consoleOutputEnabled = consoleOutputEnabled) - output <- paste0(output, "\n") - invisible(output) - } - }, - .showParameter = function(parameterName, showParameterType = FALSE, consoleOutputEnabled = TRUE) { - tryCatch( - { - params <- .getParameterValueFormatted(obj = .self, parameterName = parameterName) - if (is.null(params) || !is.list(params)) { - return(invisible("")) - } - - if (!is.null(names(params)) && "paramValue" %in% names(params)) { - return(.showParameterSingle( - param = params, - parameterName = parameterName, - showParameterType = showParameterType, - consoleOutputEnabled = consoleOutputEnabled - )) - } - - output <- "" - for (i in 1:length(params)) { - param <- params[[i]] - category <- NULL - parts <- strsplit(param$paramName, "$", fixed = TRUE)[[1]] - if (length(parts) == 2) { - parameterName <- parts[1] - param$paramName <- parameterName - - category <- parts[2] - categoryCaption <- .parameterNames[[category]] - if (is.null(categoryCaption)) { - categoryCaption <- paste0("%", category, "%") - } - category <- categoryCaption - } - outputPart <- .showParameterSingle( - param = param, - parameterName = parameterName, - category = category, - showParameterType = showParameterType, - consoleOutputEnabled = consoleOutputEnabled - ) - if (nchar(output) > 0) { - output <- paste0(output, "\n", outputPart) - } else { - output <- outputPart - } - } - return(invisible(output)) - }, - error = function(e) { - if (consoleOutputEnabled) { - warning("Failed to show parameter '", parameterName, "': ", e$message) - } - } - ) - }, - .showParameterSingle = function(param, - parameterName, ..., - category = NULL, - showParameterType = FALSE, - consoleOutputEnabled = TRUE) { - if (is.null(param)) { - return(invisible("")) - } - - output <- "" - tryCatch( - { - if (param$type == "array" && length(dim(param$paramValue)) == 3) { - numberOfEntries <- dim(param$paramValue)[3] - numberOfRows <- dim(param$paramValue)[1] - if (numberOfEntries > 0 && numberOfRows > 0) { - index <- 1 - for (i in 1:numberOfEntries) { - for (j in 1:numberOfRows) { - output <- paste0(output, .showParameterFormatted( +ParameterSetR6 <- R6Class("ParameterSetR6", + inherit = FieldSetR6, + public = list( + initialize = function(..., .showParameterTypeEnabled = TRUE) { + self$.showParameterTypeEnabled <- .showParameterTypeEnabled + self$.parameterTypes <- list() + self$.parameterNames <- list() + self$.parameterFormatFunctions <- list() + self$.catLines <- character(0) + }, + .toString = function(startWithUpperCase = FALSE) { + s <- .formatCamelCase(.getClassName(self)) + return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) + }, + .initParameterTypes = function() { + for (parameterName in names(self$.parameterNames)) { + self$.parameterTypes[[parameterName]] <- C_PARAM_TYPE_UNKNOWN + } + }, + .getParameterType = function(parameterName) { + if (is.null(parameterName) || length(parameterName) == 0 || is.na(parameterName)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'parameterName' must be a valid character with length > 0" + ) + } + + parameterType <- self$.parameterTypes[[parameterName]] + if (is.null(parameterType)) { + return(C_PARAM_TYPE_UNKNOWN) + } + + return(parameterType[1]) + }, + .getParametersToShow = function() { + return(self$.getVisibleFieldNames()) + }, + .setParameterType = function(parameterName, parameterType) { + if (is.null(parameterName) || length(parameterName) == 0 || is.na(parameterName)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'parameterName' must be a valid character with length > 0" + ) + } + + parameterType <- parameterType[1] + + if (!all(parameterType %in% c( + C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE, + C_PARAM_GENERATED, C_PARAM_DERIVED, C_PARAM_NOT_APPLICABLE + ))) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'parameterType' ('", parameterType, "') is invalid" + ) + } + + self$.parameterTypes[[parameterName]] <- parameterType + + invisible(parameterType) #TODO return? + }, + isUserDefinedParameter = function(parameterName) { + return(self$.getParameterType(parameterName) == C_PARAM_USER_DEFINED) + }, + isDefaultParameter = function(parameterName) { + return(self$.getParameterType(parameterName) == C_PARAM_DEFAULT_VALUE) + }, + isGeneratedParameter = function(parameterName) { + return(self$.getParameterType(parameterName) == C_PARAM_GENERATED) + }, + isDerivedParameter = function(parameterName) { + return(self$.getParameterType(parameterName) == C_PARAM_DERIVED) + }, + isUndefinedParameter = function(parameterName) { + return(self$.getParameterType(parameterName) == C_PARAM_TYPE_UNKNOWN) + }, + .getInputParameters = function() { + params <- self$.getParametersOfOneGroup(c(C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE)) + return(params) + }, + .getUserDefinedParameters = function() { + return(self$.getParametersOfOneGroup(C_PARAM_USER_DEFINED)) + }, + .getDefaultParameters = function() { + return(self$.getParametersOfOneGroup(C_PARAM_DEFAULT_VALUE)) + }, + .getGeneratedParameters = function() { + return(self$.getParametersOfOneGroup(C_PARAM_GENERATED)) + }, + .getDerivedParameters = function() { + return(self$.getParametersOfOneGroup(C_PARAM_DERIVED)) + }, + .getUndefinedParameters = function() { + return(self$.getParametersOfOneGroup(C_PARAM_TYPE_UNKNOWN)) + }, + .getParameterValueIfUserDefinedOrDefault = function(parameterName) { + if (self$isUserDefinedParameter(parameterName) || self$isDefaultParameter(parameterName)) { + return(self[[parameterName]]) #TODO does this work? + } + + parameterType <- .self$getRefClass()$fields()[[parameterName]]#TODO + if (parameterType == "numeric") { + return(NA_real_) + } + + if (parameterType == "integer") { + return(NA_integer_) + } + + if (parameterType == "character") { + return(NA_character_) + } + + return(NA) + }, + .getParametersOfOneGroup = function(parameterType) { + if (length(parameterType) == 1) { + parameterNames <- names(self$.parameterTypes[self$.parameterTypes == parameterType]) + + } else { + parameterNames <- names(self$.parameterTypes[which(self$.parameterTypes %in% parameterType)]) + } + parametersToShow <- self$.getParametersToShow() + if (is.null(parametersToShow) || length(parametersToShow) == 0) { + return(parameterNames) + } + + return(parametersToShow[parametersToShow %in% parameterNames]) + }, + .showParameterType = function(parameterName) { + if (!self$.showParameterTypeEnabled) { + return(" ") + } + + return(paste0("[", self$.getParameterType(parameterName), "]")) + }, + .showAllParameters = function(consoleOutputEnabled = TRUE) { + parametersToShow <- self$.getVisibleFieldNamesOrdered() + for (parameter in parametersToShow) { + self$.showParameter(parameter, + showParameterType = TRUE, + consoleOutputEnabled = consoleOutputEnabled + ) + } + }, + .getVisibleFieldNamesOrdered = function() { + visibleFieldNames <- self$.getVisibleFieldNames() + + parametersToShowSorted <- self$.getParametersToShow() + if (is.null(parametersToShowSorted) || length(parametersToShowSorted) == 0) { + return(visibleFieldNames) + } + + visibleFieldNames <- visibleFieldNames[!(visibleFieldNames %in% parametersToShowSorted)] + visibleFieldNames <- c(parametersToShowSorted, visibleFieldNames) + return(visibleFieldNames) + }, + .show = function(..., consoleOutputEnabled = FALSE) { + showType <- .getOptionalArgument("showType", ...) + if (!is.null(showType) && showType == 2) { + self$.cat("Technical developer summary of the ", self$.toString(), " object (", + methods::classLabel(class(self)), "):\n\n", + sep = "", heading = 1, + consoleOutputEnabled = consoleOutputEnabled + ) + self$.showAllParameters(consoleOutputEnabled = consoleOutputEnabled) + self$.showParameterTypeDescription(consoleOutputEnabled = consoleOutputEnabled) + } else { + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, + "method '.show()' is not implemented in class '", .getClassName(self), "'" + ) + } + }, + .catMarkdownText = function(...) { + 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 <- "" + if (is.null(parameters) || length(parameters) == 0 || all(is.na(parameters))) { + if (!missing(title) && !is.null(title) && !is.na(title) && consoleOutputEnabled) { + output <- paste0(title, ": not available\n\n") + self$.cat(output, heading = 2, consoleOutputEnabled = consoleOutputEnabled) + } + invisible(output) + } else { + if (orderByParameterName) { + parameters <- sort(parameters) + } + + if (!missing(title) && !is.null(title) && !is.na(title)) { + output <- paste0(title, ":\n") + self$.cat(output, heading = 2, consoleOutputEnabled = consoleOutputEnabled) + } + for (parameterName in parameters) { + output <- paste0(output, self$.showParameter(parameterName, + consoleOutputEnabled = consoleOutputEnabled + )) + } + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) + output <- paste0(output, "\n") + invisible(output) + } + }, + .showParameter = function(parameterName, showParameterType = FALSE, consoleOutputEnabled = TRUE) { + tryCatch( + { + + params <- .getParameterValueFormatted(obj = self, parameterName = parameterName) + if (is.null(params) || !is.list(params)) { + return(invisible("")) + } + + if (!is.null(names(params)) && "paramValue" %in% names(params)) { + return(self$.showParameterSingle( + param = params, + parameterName = parameterName, + showParameterType = showParameterType, + consoleOutputEnabled = consoleOutputEnabled + )) + } + + output <- "" + for (i in 1:length(params)) { + param <- params[[i]] + category <- NULL + parts <- strsplit(param$paramName, "$", fixed = TRUE)[[1]] + if (length(parts) == 2) { + parameterName <- parts[1] + param$paramName <- parameterName + + category <- parts[2] + categoryCaption <- self$.parameterNames[[category]] + if (is.null(categoryCaption)) { + categoryCaption <- paste0("%", category, "%") + } + category <- categoryCaption + } + outputPart <- self$.showParameterSingle( + param = param, + parameterName = parameterName, + category = category, + showParameterType = showParameterType, + consoleOutputEnabled = consoleOutputEnabled + ) + if (nchar(output) > 0) { + output <- paste0(output, "\n", outputPart) + } else { + output <- outputPart + } + } + return(invisible(output)) + }, + error = function(e) { + if (consoleOutputEnabled) { + warning("Failed to show parameter '", parameterName, "': ", e$message) + } + } + ) + }, + .showParameterSingle = function(param, + parameterName, ..., + category = NULL, + showParameterType = FALSE, + consoleOutputEnabled = TRUE) { + if (is.null(param)) { + return(invisible("")) + } + + output <- "" + tryCatch( + { + if (param$type == "array" && length(dim(param$paramValue)) == 3) { + numberOfEntries <- dim(param$paramValue)[3] + numberOfRows <- dim(param$paramValue)[1] + if (numberOfEntries > 0 && numberOfRows > 0) { + index <- 1 + for (i in 1:numberOfEntries) { + for (j in 1:numberOfRows) { + output <- paste0(output, self$.showParameterFormatted( + paramName = param$paramName, + paramValue = param$paramValue[j, , i], + paramValueFormatted = param$paramValueFormatted[[index]], + showParameterType = showParameterType, + category = i, + matrixRow = ifelse(numberOfRows == 1, NA_integer_, j), + consoleOutputEnabled = consoleOutputEnabled, + paramNameRaw = parameterName, + numberOfCategories = numberOfEntries + )) + index <- index + 1 + } + } + } + } else if (param$type %in% c("matrix", "array")) { + n <- length(param$paramValueFormatted) + if (n > 0) { + for (i in 1:n) { + paramValue <- param$paramValue + if (is.array(paramValue) && + length(dim(paramValue)) == 3 && + dim(paramValue)[3] == 1) { + paramValue <- paramValue[i, , 1] + } else if (dim(paramValue)[1] > 1 || dim(paramValue)[2] > 1) { + paramValue <- paramValue[i, ] + } + + output <- paste0(output, self$.showParameterFormatted( + paramName = param$paramName, + paramValue = paramValue, + paramValueFormatted = param$paramValueFormatted[[i]], + showParameterType = showParameterType, + category = category, + matrixRow = ifelse(n == 1, NA_integer_, i), + consoleOutputEnabled = consoleOutputEnabled, + paramNameRaw = parameterName, + numberOfCategories = n + )) + } + } + } else { + output <- self$.showParameterFormatted( paramName = param$paramName, - paramValue = param$paramValue[j, , i], - paramValueFormatted = param$paramValueFormatted[[index]], + paramValue = param$paramValue, + paramValueFormatted = param$paramValueFormatted, showParameterType = showParameterType, - category = i, - matrixRow = ifelse(numberOfRows == 1, NA_integer_, j), + category = category, consoleOutputEnabled = consoleOutputEnabled, - paramNameRaw = parameterName, - numberOfCategories = numberOfEntries - )) - index <- index + 1 + paramNameRaw = parameterName + ) + } + }, + error = function(e) { + if (consoleOutputEnabled) { + warning("Failed to show single parameter '", parameterName, "' (", param$type, "): ", e$message) + } + } + ) + return(invisible(output)) + }, + .extractParameterNameAndValue = function(parameterName) { + d <- regexpr(paste0("\\..+\\$"), parameterName) + if (d[1] != 1) { + return(list(parameterName = parameterName, paramValue = self[[parameterName]])) } - } - } - } else if (param$type %in% c("matrix", "array")) { - n <- length(param$paramValueFormatted) - if (n > 0) { - for (i in 1:n) { - paramValue <- param$paramValue - if (is.array(paramValue) && - length(dim(paramValue)) == 3 && - dim(paramValue)[3] == 1) { - paramValue <- paramValue[i, , 1] - } else if (dim(paramValue)[1] > 1 || dim(paramValue)[2] > 1) { - paramValue <- paramValue[i, ] + + index <- attr(d, "match.length") + objectName <- substr(parameterName, 1, index - 1) + parameterName <- substr(parameterName, index + 1, nchar(parameterName)) + paramValue <- self[[objectName]][[parameterName]] + + # .closedTestResults$rejected + if (objectName == ".closedTestResults" && parameterName == "rejected") { + paramValueLogical <- as.logical(paramValue) + if (is.matrix(paramValue)) { + paramValueLogical <- matrix(paramValueLogical, ncol = ncol(paramValue)) + } + paramValue <- paramValueLogical } - - output <- paste0(output, .showParameterFormatted( - paramName = param$paramName, - paramValue = paramValue, - paramValueFormatted = param$paramValueFormatted[[i]], - showParameterType = showParameterType, - category = category, - matrixRow = ifelse(n == 1, NA_integer_, i), - consoleOutputEnabled = consoleOutputEnabled, - paramNameRaw = parameterName, - numberOfCategories = n + + return(list(parameterName = parameterName, paramValue = paramValue)) + }, + .showUnknownParameters = function(consoleOutputEnabled = TRUE) { + params <- self$.getUndefinedParameters() + if (length(params) > 0) { + self$.showParametersOfOneGroup(params, "ISSUES (parameters with undefined type)", + consoleOutputEnabled = consoleOutputEnabled + ) + } + }, + .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 <- self$.parameterNames[[paramNameRaw]] + } + if (is.null(paramCaption)) { + paramCaption <- self$.parameterNames[[paramName]] + } + if (is.null(paramCaption)) { + paramCaption <- paste0("%", paramName, "%") + } + if (!is.null(category) && !is.na(category)) { + if (.isMultiArmSimulationResults(self) && paramName == "singleNumberOfEventsPerStage") { + if (!(inherits(self, "SimulationResultsEnrichmentSurvival") || inherits(self, "SimulationResultsEnrichmentSurvivalR6")) && + !is.na(numberOfCategories) && numberOfCategories == category) { + category <- "control" + } + paramCaption <- paste0(paramCaption, " {", category, "}") + } else if (paramName == "effectList") { + paramCaption <- paste0(paramCaption, " [", category, "]") + } else if (.isEnrichmentSimulationResults(self)) { + categoryCaption <- .getCategoryCaptionEnrichment(self, paramName, category) + paramCaption <- paste0(paramCaption, " (", categoryCaption, ")") + } else { + paramCaption <- paste0(paramCaption, " (", category, ")") + } + + if (!is.na(matrixRow)) { + if (paramName == "effectList") { + paramCaption <- paste0(paramCaption, " (", matrixRow, ")") + } else { + paramCaption <- paste0(paramCaption, " [", matrixRow, "]") + } + } + } else if (!is.na(matrixRow)) { + if (.isMultiArmAnalysisResults(self) && paramName %in% + c( + "conditionalErrorRate", "secondStagePValues", + "adjustedStageWisePValues", "overallAdjustedTestStatistics" + )) { + treatments <- self$.closedTestResults$.getHypothesisTreatmentArmVariants()[matrixRow] + paramCaption <- paste0( + "Treatment", ifelse(grepl(",", treatments), "s", ""), " ", + treatments, " vs. control" + ) + } else if (.isEnrichmentAnalysisResults(self) || .isEnrichmentStageResults(self) || + (inherits(self, "ClosedCombinationTestResults") && isTRUE(self$.enrichment))) { + if (paramName %in% c( + "indices", "conditionalErrorRate", "secondStagePValues", + "adjustedStageWisePValues", "overallAdjustedTestStatistics", "rejectedIntersections" + )) { + if (.isEnrichmentAnalysisResults(self)) { + populations <- self$.closedTestResults$.getHypothesisPopulationVariants()[matrixRow] + } else if (inherits(self, "ClosedCombinationTestResults")) { + populations <- self$.getHypothesisPopulationVariants()[matrixRow] + } else { + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, "only ClosedCombinationTestResults ", + "supports function .getHypothesisPopulationVariants() (object is ", .getClassName(self), ")" + ) + } + paramCaption <- paste0(paramCaption, " ", populations) + } else { + if (!is.na(numberOfCategories) && numberOfCategories == matrixRow) { + paramCaption <- paste0(paramCaption, " F") + } else { + paramCaption <- paste0(paramCaption, " S", matrixRow) + } + } + } else if (.isMultiArmAnalysisResults(self) || grepl("StageResultsMultiArm", .getClassName(self)) || + ((inherits(self, "SimulationResults") || inherits(self, "SimulationResultsR6")) && paramName == "effectMatrix") || + (inherits(self, "ClosedCombinationTestResults") && + paramName %in% c("rejected", "separatePValues"))) { + paramCaption <- paste0(paramCaption, " (", matrixRow, ")") + } else { + paramCaption <- paste0(paramCaption, " [", matrixRow, "]") + } + } + if (is.null(paramValueFormatted) || length(paramValueFormatted) == 0 || + is.na(paramValueFormatted)) { + paramValueFormatted <- paramValue + } + if (is.list(paramValueFormatted)) { + paramValueFormatted <- .listToString(paramValueFormatted) + } + if (is.function(paramValue) || grepl("Function$", paramName)) { + paramValueFormatted <- ifelse( + self$.getParameterType(paramName) == C_PARAM_USER_DEFINED, + ifelse(.isCppCode(paramValueFormatted), "user defined (C++)", "user defined"), + "default" + ) + } + prefix <- ifelse(showParameterType, self$.showParameterType(paramName), "") + variableNameFormatted <- .getFormattedVariableName( + name = paramCaption, + n = self$.getNChar(), prefix = prefix + ) + + output <- paste(variableNameFormatted, paramValueFormatted, "\n") + self$.cat(output, consoleOutputEnabled = consoleOutputEnabled) + invisible(output) + }, + .getNChar = function() { + if (length(self$.parameterNames) == 0) { + return(40) + } + + return(min(40, max(nchar(self$.parameterNames))) + 4) + }, + .showParameterTypeDescription = function(consoleOutputEnabled = consoleOutputEnabled) { + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" ", C_PARAM_USER_DEFINED, ": user defined\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" ", C_PARAM_DERIVED, ": derived value\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" ", C_PARAM_DEFAULT_VALUE, ": default value\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" ", C_PARAM_GENERATED, ": generated/calculated value\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" ", C_PARAM_NOT_APPLICABLE, ": not applicable or hidden\n", consoleOutputEnabled = consoleOutputEnabled) + }, + .printAsDataFrame = function(parameterNames, niceColumnNamesEnabled = FALSE, + includeAllParameters = FALSE, handleParameterNamesAsToBeExcluded = FALSE, + lineBreakEnabled = FALSE) { + if (.isTrialDesign(self)) { + tableColumnNames <- .getTableColumnNames(design = self) + } else { + tableColumnNames <- C_TABLE_COLUMN_NAMES + } + + if (.isTrialDesignPlan(self)) { + parameterNames <- NULL + } + + dataFrame <- .getAsDataFrame( + parameterSet = self, + parameterNames = parameterNames, + niceColumnNamesEnabled = niceColumnNamesEnabled, + includeAllParameters = includeAllParameters, + handleParameterNamesAsToBeExcluded = handleParameterNamesAsToBeExcluded, + returnParametersAsCharacter = TRUE, + tableColumnNames = tableColumnNames + ) + + result <- as.matrix(dataFrame) + if (.isTrialDesignPlan(self)) { + dimnames(result)[[1]] <- paste(" ", c(1:nrow(dataFrame))) + } else if (!is.null(dataFrame[["stages"]])) { + dimnames(result)[[1]] <- paste(" Stage", dataFrame$stages) + } + + print(result, quote = FALSE, right = FALSE) + }, + .getNumberOfRows = function(parameterNames) { + numberOfRows <- 1 + for (parameterName in parameterNames) { + parameterValues <- self[[parameterName]] + if (is.vector(parameterValues) && length(parameterValues) > numberOfRows) { + numberOfRows <- length(parameterValues) + } else if (is.matrix(parameterValues) && (nrow(parameterValues) == 1 || ncol(parameterValues) == 1) && + length(parameterValues) > numberOfRows) { + numberOfRows <- length(parameterValues) + } + } + return(numberOfRows) + }, + .containsMultidimensionalParameters = function(parameterNames) { + for (parameterName in parameterNames) { + parameterValues <- self[[parameterName]] + if (!is.null(parameterValues) && is.matrix(parameterValues) && + nrow(parameterValues) > 0 && ncol(parameterValues) > 0) { + return(TRUE) + } + } + return(FALSE) + }, + .getMultidimensionalNumberOfStages = function(parameterNames) { + if (!is.null(self[[".design"]])) { + return(self$.design$kMax) + } + + n <- 1 + for (parameterName in parameterNames) { + parameterValues <- self[[parameterName]] + if (!is.null(parameterValues) && is.matrix(parameterValues) && + ncol(parameterValues) > 0 && nrow(parameterValues) > n) { + n <- nrow(parameterValues) + } + } + return(n) + }, + .getVariedParameter = function(parameterNames, numberOfVariants) { + + # search for user defined parameters + for (parameterName in parameterNames) { + parameterValues <- self[[parameterName]] + if (!is.null(parameterValues) && !is.matrix(parameterValues) && + length(parameterValues) == numberOfVariants && + parameterName %in% C_VARIABLE_DESIGN_PLAN_PARAMETERS && + self$.getParameterType(parameterName) == C_PARAM_USER_DEFINED) { + return(parameterName) + } + } + + # search for default values + for (parameterName in parameterNames) { + parameterValues <- self[[parameterName]] + if (!is.null(parameterValues) && !is.matrix(parameterValues) && + length(parameterValues) == numberOfVariants && + parameterName %in% C_VARIABLE_DESIGN_PLAN_PARAMETERS && + self$.getParameterType(parameterName) == C_PARAM_DEFAULT_VALUE) { + return(parameterName) + } + } + + return(NULL) + }, + .getDataFrameColumnCaption = function(parameterName, tableColumnNames, niceColumnNamesEnabled) { + if (length(parameterName) == 0 || parameterName == "") { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'parameterName' must be a valid parameter name") + } + + tableColumnName <- tableColumnNames[[parameterName]] + return(ifelse(niceColumnNamesEnabled && !is.null(tableColumnName), + tableColumnName, parameterName )) - } - } - } else { - output <- .showParameterFormatted( - paramName = param$paramName, - paramValue = param$paramValue, - paramValueFormatted = param$paramValueFormatted, - showParameterType = showParameterType, - category = category, - consoleOutputEnabled = consoleOutputEnabled, - paramNameRaw = parameterName - ) - } - }, - error = function(e) { - if (consoleOutputEnabled) { - warning("Failed to show single parameter '", parameterName, "' (", param$type, "): ", e$message) - } - } - ) - return(invisible(output)) - }, - .extractParameterNameAndValue = function(parameterName) { - d <- regexpr(paste0("\\..+\\$"), parameterName) - if (d[1] != 1) { - return(list(parameterName = parameterName, paramValue = get(parameterName))) - } - - 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)) - } - paramValue <- paramValueLogical - } - - return(list(parameterName = parameterName, paramValue = paramValue)) - }, - .showUnknownParameters = function(consoleOutputEnabled = TRUE) { - params <- .getUndefinedParameters() - if (length(params) > 0) { - .showParametersOfOneGroup(params, "ISSUES (parameters with undefined type)", - consoleOutputEnabled = consoleOutputEnabled - ) - } - }, - .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 <- .parameterNames[[paramNameRaw]] - } - if (is.null(paramCaption)) { - paramCaption <- .parameterNames[[paramName]] - } - if (is.null(paramCaption)) { - paramCaption <- paste0("%", paramName, "%") - } - if (!is.null(category) && !is.na(category)) { - if (.isMultiArmSimulationResults(.self) && paramName == "singleNumberOfEventsPerStage") { - if (!(inherits(.self, "SimulationResultsEnrichmentSurvival") || inherits(.self, "SimulationResultsEnrichmentSurvivalR6")) && - !is.na(numberOfCategories) && numberOfCategories == category) { - category <- "control" - } - paramCaption <- paste0(paramCaption, " {", category, "}") - } else if (paramName == "effectList") { - paramCaption <- paste0(paramCaption, " [", category, "]") - } else if (.isEnrichmentSimulationResults(.self)) { - categoryCaption <- .getCategoryCaptionEnrichment(.self, paramName, category) - paramCaption <- paste0(paramCaption, " (", categoryCaption, ")") - } else { - paramCaption <- paste0(paramCaption, " (", category, ")") - } - - if (!is.na(matrixRow)) { - if (paramName == "effectList") { - paramCaption <- paste0(paramCaption, " (", matrixRow, ")") - } else { - paramCaption <- paste0(paramCaption, " [", matrixRow, "]") - } - } - } else if (!is.na(matrixRow)) { - if (.isMultiArmAnalysisResults(.self) && paramName %in% - c( - "conditionalErrorRate", "secondStagePValues", - "adjustedStageWisePValues", "overallAdjustedTestStatistics" - )) { - treatments <- .closedTestResults$.getHypothesisTreatmentArmVariants()[matrixRow] - paramCaption <- paste0( - "Treatment", ifelse(grepl(",", treatments), "s", ""), " ", - treatments, " vs. control" - ) - } else if (.isEnrichmentAnalysisResults(.self) || .isEnrichmentStageResults(.self) || - (inherits(.self, "ClosedCombinationTestResults") && isTRUE(.self$.enrichment))) { - if (paramName %in% c( - "indices", "conditionalErrorRate", "secondStagePValues", - "adjustedStageWisePValues", "overallAdjustedTestStatistics", "rejectedIntersections" - )) { - if (.isEnrichmentAnalysisResults(.self)) { - populations <- .closedTestResults$.getHypothesisPopulationVariants()[matrixRow] - } else if (inherits(.self, "ClosedCombinationTestResults")) { - populations <- .self$.getHypothesisPopulationVariants()[matrixRow] - } else { - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, "only ClosedCombinationTestResults ", - "supports function .getHypothesisPopulationVariants() (object is ", .getClassName(.self), ")" + }, + .getUnidimensionalNumberOfStages = function(parameterNames) { + kMax <- self[["kMax"]] + if (is.null(kMax) && !is.null(self[[".design"]])) { + kMax <- self[[".design"]][["kMax"]] + } + if (!is.null(kMax) && length(kMax) == 1 && is.integer(kMax)) { + return(kMax) + } + + n <- 1 + for (parameterName in parameterNames) { + parameterValues <- self[[parameterName]] + if (!is.null(parameterValues) && !is.matrix(parameterValues) && + length(parameterValues) > n) { + n <- length(parameterValues) + } + } + return(n) + }, + .formatDataFrameParametersAsCharacter = function(dataFrame, + parameterName, parameterValues, parameterCaption) { + tryCatch( + { + formatFunctionName <- self$.parameterFormatFunctions[[parameterName]] + if (!is.null(formatFunctionName)) { + parameterValuesFormatted <- eval(call(formatFunctionName, parameterValues)) + } else { + parameterValuesFormatted <- as.character(parameterValues) + } + + if (parameterName == "sided") { + parameterValuesFormatted <- ifelse(parameterValues == 1, + "one-sided", "two-sided" + ) + } + + if (!is.null(dataFrame[[parameterCaption]])) { + parameterValuesFormatted[is.na(dataFrame[[parameterCaption]])] <- "" + } + parameterValuesFormatted[is.na(parameterValuesFormatted)] <- "" + parameterValuesFormatted[parameterValuesFormatted == "NA"] <- "" + if (is.null(dataFrame)) { + dataFrame <- data.frame(x = parameterValuesFormatted) + names(dataFrame) <- parameterCaption + } else { + dataFrame[[parameterCaption]] <- parameterValuesFormatted + } + }, + error = function(e) { + .logError(paste0( + "Error in '.getAsDataFrame'. Failed to show parameter '%s' ", + "(class '%s'): %s" + ), parameterName, .getClassName(self), e) + } + ) + }, + + # + # Returns a sub-list. + # + # @param x A list from which you would like to get a sub-list. + # @param listEntryNames A vector of names which specify the entries of the sub-list to return. + # + .getSubListByNames = function(x, listEntryNames) { + "Returns a sub-list." + if (!is.list(x)) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'x' must be a list") + } + + if (!is.character(listEntryNames)) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'listEntryNames' must be a character vector") + } + + return(x[which(names(x) %in% listEntryNames)]) + }, + .isMultiHypothesesObject = function() { + return(.isEnrichmentAnalysisResults(self) || .isEnrichmentStageResults(self) || + .isMultiArmAnalysisResults(self) || .isMultiArmStageResults(self)) + }, + .isEnrichmentObject = function() { + return(.isEnrichmentAnalysisResults(self) || .isEnrichmentStageResults(self)) + } ) - } - paramCaption <- paste0(paramCaption, " ", populations) - } else { - if (!is.na(numberOfCategories) && numberOfCategories == matrixRow) { - paramCaption <- paste0(paramCaption, " F") - } else { - paramCaption <- paste0(paramCaption, " S", matrixRow) - } - } - } else if (.isMultiArmAnalysisResults(.self) || grepl("StageResultsMultiArm", .getClassName(.self)) || - ((inherits(.self, "SimulationResults") || inherits(.self, "SimulationResultsR6")) && paramName == "effectMatrix") || - (inherits(.self, "ClosedCombinationTestResults") && - paramName %in% c("rejected", "separatePValues"))) { - paramCaption <- paste0(paramCaption, " (", matrixRow, ")") - } else { - paramCaption <- paste0(paramCaption, " [", matrixRow, "]") - } - } - if (is.null(paramValueFormatted) || length(paramValueFormatted) == 0 || - is.na(paramValueFormatted)) { - paramValueFormatted <- paramValue - } - if (is.list(paramValueFormatted)) { - paramValueFormatted <- .listToString(paramValueFormatted) - } - if (is.function(paramValue) || grepl("Function$", paramName)) { - paramValueFormatted <- ifelse( - .getParameterType(paramName) == C_PARAM_USER_DEFINED, - ifelse(.isCppCode(paramValueFormatted), "user defined (C++)", "user defined"), - "default" - ) - } - prefix <- ifelse(showParameterType, .showParameterType(paramName), "") - variableNameFormatted <- .getFormattedVariableName( - name = paramCaption, - n = .getNChar(), prefix = prefix - ) - - output <- paste(variableNameFormatted, paramValueFormatted, "\n") - .cat(output, consoleOutputEnabled = consoleOutputEnabled) - invisible(output) - }, - .getNChar = function() { - if (length(.parameterNames) == 0) { - return(40) - } +) - return(min(40, max(nchar(.parameterNames))) + 4) - }, - .showParameterTypeDescription = function(consoleOutputEnabled = consoleOutputEnabled) { - .cat("\n", consoleOutputEnabled = consoleOutputEnabled) - .cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) - .cat(" ", C_PARAM_USER_DEFINED, ": user defined\n", consoleOutputEnabled = consoleOutputEnabled) - .cat(" ", C_PARAM_DERIVED, ": derived value\n", consoleOutputEnabled = consoleOutputEnabled) - .cat(" ", C_PARAM_DEFAULT_VALUE, ": default value\n", consoleOutputEnabled = consoleOutputEnabled) - .cat(" ", C_PARAM_GENERATED, ": generated/calculated value\n", consoleOutputEnabled = consoleOutputEnabled) - .cat(" ", C_PARAM_NOT_APPLICABLE, ": not applicable or hidden\n", consoleOutputEnabled = consoleOutputEnabled) - }, - .printAsDataFrame = function(parameterNames, niceColumnNamesEnabled = FALSE, - includeAllParameters = FALSE, handleParameterNamesAsToBeExcluded = FALSE, - lineBreakEnabled = FALSE) { - if (.isTrialDesign(.self)) { - tableColumnNames <- .getTableColumnNames(design = .self) - } else { - tableColumnNames <- C_TABLE_COLUMN_NAMES - } +.getMultidimensionalNumberOfVariants <- function(parameterSet, parameterNames) { + if (!is.null(parameterSet[["effectList"]])) { + effectMatrixName <- .getSimulationEnrichmentEffectMatrixName(parameterSet) + return(nrow(parameterSet$effectList[[effectMatrixName]])) + } + + parameterNames <- parameterNames[!(parameterNames %in% c( + "accrualTime", "accrualIntensity", + "plannedSubjects", "plannedEvents", + "minNumberOfSubjectsPerStage", "maxNumberOfSubjectsPerStage", + "minNumberOfEventsPerStage", "maxNumberOfEventsPerStage", + "piecewiseSurvivalTime", "lambda2", "adaptations", + "adjustedStageWisePValues", "overallAdjustedTestStatistics" + ))] + if (!is.null(parameterSet[[".piecewiseSurvivalTime"]]) && + parameterSet$.piecewiseSurvivalTime$piecewiseSurvivalEnabled) { + parameterNames <- parameterNames[!(parameterNames %in% c("lambda1"))] + } + + n <- 1 + for (parameterName in parameterNames) { + parameterValues <- parameterSet[[parameterName]] + if (!is.null(parameterValues) && (is.matrix(parameterValues) || !is.array(parameterValues))) { + if (is.matrix(parameterValues)) { + if (parameterSet$.isMultiHypothesesObject()) { + if (nrow(parameterValues) > n && ncol(parameterValues) > 0) { + n <- nrow(parameterValues) + } + } else if (nrow(parameterValues) > 0 && ncol(parameterValues) > n) { + n <- ncol(parameterValues) + } + } else if (length(parameterValues) > n && + !parameterSet$.isMultiHypothesesObject()) { + n <- length(parameterValues) + } + } + } + return(n) +} - if (.isTrialDesignPlan(.self)) { - parameterNames <- NULL - } +.getDataFrameColumnValues <- function(parameterSet, + parameterName, + numberOfVariants, + numberOfStages, + includeAllParameters, + mandatoryParameterNames) { + if (parameterSet$.getParameterType(parameterName) == C_PARAM_TYPE_UNKNOWN && + parameterName != "futilityStop") { + return(NULL) + } + + if (!includeAllParameters && + parameterSet$.getParameterType(parameterName) == C_PARAM_NOT_APPLICABLE && + !(parameterName %in% mandatoryParameterNames)) { + return(NULL) + } + + parameterValues <- parameterSet[[parameterName]] + if (is.null(parameterValues) || length(parameterValues) == 0) { + return(NULL) + } + + if (is.function(parameterValues)) { + return(NULL) + } + + if (is.array(parameterValues) && !is.matrix(parameterValues)) { + return(NULL) + } + + if (parameterName %in% c("adjustedStageWisePValues", "overallAdjustedTestStatistics")) { + return(NULL) + } + + if (!is.matrix(parameterValues)) { + if (length(parameterValues) == 1) { + return(rep(parameterValues, numberOfVariants * numberOfStages)) + } + + if (parameterSet$.isMultiHypothesesObject()) { + if (length(parameterValues) == numberOfStages) { + return(as.vector(sapply(FUN = rep, X = parameterValues, times = numberOfVariants))) + } + } + + if (length(parameterValues) == numberOfVariants) { + return(rep(parameterValues, numberOfStages)) + } + + if (length(parameterValues) == numberOfStages && + parameterName %in% c( + "plannedEvents", "plannedSubjects", + "minNumberOfEventsPerStage", "maxNumberOfEventsPerStage", + "minNumberOfSubjectsPerStage", "maxNumberOfSubjectsPerStage", + "allocationRatioPlanned" + )) { + values <- c() + for (stage in 1:numberOfStages) { + values <- c(values, rep(parameterValues[stage], numberOfVariants)) + } + return(values) + } + + if (parameterName %in% c( + "accrualTime", "accrualIntensity", + "plannedEvents", "plannedSubjects", + "minNumberOfEventsPerStage", "maxNumberOfEventsPerStage", + "minNumberOfSubjectsPerStage", "maxNumberOfSubjectsPerStage", + "piecewiseSurvivalTime", "lambda2" + )) { + return(NULL) + } + + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, + "parameter '", parameterName, "' has an invalid ", + "dimension (length is ", length(parameterValues), ")" + ) + } else if (parameterName == "effectMatrix") { + # return effect matrix row if 'effectMatrix' is user defined + if (parameterSet$.getParameterType("effectMatrix") == C_PARAM_USER_DEFINED) { + return(1:ncol(parameterValues)) + } + + return(parameterValues[nrow(parameterValues), ]) + } + + if (grepl("futility|alpha0Vec|earlyStop", parameterName) && + nrow(parameterValues) == numberOfStages - 1) { + parameterValues <- rbind(parameterValues, rep(NA_real_, ncol(parameterValues))) + } + + if (nrow(parameterValues) == numberOfStages && ncol(parameterValues) == 1) { + columnValues <- c() + for (parameterValue in parameterValues) { + columnValues <- c(columnValues, rep(parameterValue, numberOfVariants)) + } + return(columnValues) + } + + if (nrow(parameterValues) == numberOfStages && ncol(parameterValues) == numberOfVariants) { + columnValues <- c() + for (i in 1:nrow(parameterValues)) { + for (j in 1:ncol(parameterValues)) { + columnValues <- c(columnValues, parameterValues[i, j]) + } + } + return(columnValues) + } + + # applicable for analysis enrichment + if (parameterSet$.isMultiHypothesesObject()) { + if (nrow(parameterValues) %in% c(1, numberOfVariants) && + ncol(parameterValues) %in% c(1, numberOfStages)) { + columnValues <- c() + for (j in 1:ncol(parameterValues)) { + for (i in 1:nrow(parameterValues)) { + columnValues <- c(columnValues, parameterValues[i, j]) + } + } + if (nrow(parameterValues) == 1) { + columnValues <- as.vector(sapply(FUN = rep, X = columnValues, times = numberOfVariants)) + } + if (ncol(parameterValues) == 1) { + columnValues <- rep(columnValues, numberOfStages) + } + return(columnValues) + } + } + + if (nrow(parameterValues) == 1 && ncol(parameterValues) == 1) { + return(rep(parameterValues[1, 1], numberOfStages * numberOfVariants)) + } + + if (nrow(parameterValues) == 1 && ncol(parameterValues) == numberOfVariants) { + return(rep(parameterValues[1, ], numberOfStages)) + } + + if (nrow(parameterValues) == numberOfStages && ncol(parameterValues) == 1) { + return(rep(parameterValues[, 1], numberOfVariants)) + } + + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, + "parameter '", parameterName, "' has an invalid ", + "dimension (", nrow(parameterValues), " x ", ncol(parameterValues), "); ", + "expected was (", numberOfStages, " x ", numberOfVariants, ")" + ) +} - dataFrame <- .getAsDataFrame( - parameterSet = .self, - parameterNames = parameterNames, - niceColumnNamesEnabled = niceColumnNamesEnabled, - includeAllParameters = includeAllParameters, - handleParameterNamesAsToBeExcluded = handleParameterNamesAsToBeExcluded, - returnParametersAsCharacter = TRUE, - tableColumnNames = tableColumnNames +.getAsDataFrameMultidimensional <- function(parameterSet, + parameterNames, + niceColumnNamesEnabled, + includeAllParameters, + returnParametersAsCharacter, + tableColumnNames, + mandatoryParameterNames) { + numberOfVariants <- .getMultidimensionalNumberOfVariants(parameterSet, parameterNames) + numberOfStages <- parameterSet$.getMultidimensionalNumberOfStages(parameterNames) + + stagesCaption <- parameterSet$.getDataFrameColumnCaption( + "stages", + tableColumnNames, niceColumnNamesEnabled + ) + + dataFrame <- data.frame( + stages = sort(rep(1:numberOfStages, numberOfVariants)) + ) + names(dataFrame) <- stagesCaption + + if (parameterSet$.isEnrichmentObject()) { + populations <- character(0) + for (i in 1:numberOfVariants) { + populations <- c(populations, ifelse(i == numberOfVariants, "F", paste0("S", i))) + } + dataFrame$populations <- rep(populations, numberOfStages) + populationsCaption <- parameterSet$.getDataFrameColumnCaption( + "populations", + tableColumnNames, niceColumnNamesEnabled + ) + names(dataFrame) <- c(stagesCaption, populationsCaption) + } + + variedParameter <- parameterSet$.getVariedParameter(parameterNames, numberOfVariants) + tryCatch( + { + if (!is.null(variedParameter) && variedParameter != "stages") { + variedParameterCaption <- parameterSet$.getDataFrameColumnCaption( + variedParameter, + tableColumnNames, niceColumnNamesEnabled + ) + dataFrame[[variedParameterCaption]] <- rep(parameterSet[[variedParameter]], numberOfStages) + } + }, + error = function(e) { + warning( + ".getAsDataFrameMultidimensional: ", + "failed to add 'variedParameterCaption' to data.frame; ", e$message + ) + } + ) + + usedParameterNames <- character(0) + for (parameterName in parameterNames) { + tryCatch( + { + if (!(parameterName %in% c("stages", "adaptations", "effectList")) && + !grepl("Function$", parameterName) && + (is.null(variedParameter) || parameterName != variedParameter)) { + columnValues <- .getDataFrameColumnValues( + parameterSet, parameterName, + numberOfVariants, numberOfStages, + includeAllParameters, mandatoryParameterNames + ) + if (!is.null(columnValues)) { + columnCaption <- parameterSet$.getDataFrameColumnCaption( + parameterName, + tableColumnNames, niceColumnNamesEnabled ) - result <- as.matrix(dataFrame) - if (.isTrialDesignPlan(.self)) { - dimnames(result)[[1]] <- paste(" ", c(1:nrow(dataFrame))) - } else if (!is.null(dataFrame[["stages"]])) { - dimnames(result)[[1]] <- paste(" Stage", dataFrame$stages) - } - - print(result, quote = FALSE, right = FALSE) - }, - .getNumberOfRows = function(parameterNames) { - numberOfRows <- 1 - for (parameterName in parameterNames) { - parameterValues <- .self[[parameterName]] - if (is.vector(parameterValues) && length(parameterValues) > numberOfRows) { - numberOfRows <- length(parameterValues) - } else if (is.matrix(parameterValues) && (nrow(parameterValues) == 1 || ncol(parameterValues) == 1) && - length(parameterValues) > numberOfRows) { - numberOfRows <- length(parameterValues) - } - } - return(numberOfRows) - }, - .containsMultidimensionalParameters = function(parameterNames) { - for (parameterName in parameterNames) { - parameterValues <- .self[[parameterName]] - if (!is.null(parameterValues) && is.matrix(parameterValues) && - nrow(parameterValues) > 0 && ncol(parameterValues) > 0) { - return(TRUE) - } - } - return(FALSE) - }, - .getMultidimensionalNumberOfStages = function(parameterNames) { - if (!is.null(.self[[".design"]])) { - return(.self$.design$kMax) - } - - n <- 1 - for (parameterName in parameterNames) { - parameterValues <- .self[[parameterName]] - if (!is.null(parameterValues) && is.matrix(parameterValues) && - ncol(parameterValues) > 0 && nrow(parameterValues) > n) { - n <- nrow(parameterValues) - } - } - return(n) - }, - .getVariedParameter = function(parameterNames, numberOfVariants) { - # search for user defined parameters - for (parameterName in parameterNames) { - parameterValues <- .self[[parameterName]] - if (!is.null(parameterValues) && !is.matrix(parameterValues) && - length(parameterValues) == numberOfVariants && - parameterName %in% C_VARIABLE_DESIGN_PLAN_PARAMETERS && - .getParameterType(parameterName) == C_PARAM_USER_DEFINED) { - return(parameterName) - } - } - - # search for default values - for (parameterName in parameterNames) { - parameterValues <- .self[[parameterName]] - if (!is.null(parameterValues) && !is.matrix(parameterValues) && - length(parameterValues) == numberOfVariants && - parameterName %in% C_VARIABLE_DESIGN_PLAN_PARAMETERS && - .getParameterType(parameterName) == C_PARAM_DEFAULT_VALUE) { - return(parameterName) - } - } - - return(NULL) - }, - .getDataFrameColumnCaption = function(parameterName, tableColumnNames, niceColumnNamesEnabled) { - if (length(parameterName) == 0 || parameterName == "") { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'parameterName' must be a valid parameter name") + dataFrame[[columnCaption]] <- columnValues + if (returnParametersAsCharacter) { + parameterSet$.formatDataFrameParametersAsCharacter( + dataFrame, + parameterName, columnValues, columnCaption + ) } - - tableColumnName <- tableColumnNames[[parameterName]] - return(ifelse(niceColumnNamesEnabled && !is.null(tableColumnName), - tableColumnName, parameterName - )) - }, - .getUnidimensionalNumberOfStages = function(parameterNames) { - kMax <- .self[["kMax"]] - if (is.null(kMax) && !is.null(.self[[".design"]])) { - kMax <- .self[[".design"]][["kMax"]] - } - if (!is.null(kMax) && length(kMax) == 1 && is.integer(kMax)) { - return(kMax) - } - - n <- 1 - for (parameterName in parameterNames) { - parameterValues <- .self[[parameterName]] - if (!is.null(parameterValues) && !is.matrix(parameterValues) && - length(parameterValues) > n) { - n <- length(parameterValues) - } + usedParameterNames <- c(usedParameterNames, parameterName) + } + } + + if (parameterName == "effectList") { + effectMatrixName <- .getSimulationEnrichmentEffectMatrixName(parameterSet) + effectMatrixNameSingular <- sub("s$", "", effectMatrixName) + effectMatrix <- parameterSet$effectList[[effectMatrixName]] + if (ncol(effectMatrix) == 1) { + dataFrame[[effectMatrixNameSingular]] <- rep(effectMatrix, numberOfStages) + } else { + for (j in 1:ncol(effectMatrix)) { + dataFrame[[paste0(effectMatrixNameSingular, j)]] <- rep(effectMatrix[, j], numberOfStages) } - return(n) - }, - .formatDataFrameParametersAsCharacter = function(dataFrame, - parameterName, parameterValues, parameterCaption) { - tryCatch( - { - formatFunctionName <- .parameterFormatFunctions[[parameterName]] - if (!is.null(formatFunctionName)) { - parameterValuesFormatted <- eval(call(formatFunctionName, parameterValues)) - } else { - parameterValuesFormatted <- as.character(parameterValues) - } - - if (parameterName == "sided") { - parameterValuesFormatted <- ifelse(parameterValues == 1, - "one-sided", "two-sided" - ) - } - - if (!is.null(dataFrame[[parameterCaption]])) { - parameterValuesFormatted[is.na(dataFrame[[parameterCaption]])] <- "" - } - parameterValuesFormatted[is.na(parameterValuesFormatted)] <- "" - parameterValuesFormatted[parameterValuesFormatted == "NA"] <- "" - if (is.null(dataFrame)) { - dataFrame <- data.frame(x = parameterValuesFormatted) - names(dataFrame) <- parameterCaption - } else { - dataFrame[[parameterCaption]] <- parameterValuesFormatted - } - }, - error = function(e) { - .logError(paste0( - "Error in '.getAsDataFrame'. Failed to show parameter '%s' ", - "(class '%s'): %s" - ), parameterName, .getClassName(.self), e) - } + } + dataFrame$situation <- rep(1:nrow(effectMatrix), numberOfStages) + usedParameterNames <- c(usedParameterNames, parameterName) + } + }, + error = function(e) { + warning( + ".getAsDataFrameMultidimensional: failed to add parameter ", + sQuote(parameterName), " to data.frame; ", e$message + ) + } + ) + } + + if (includeAllParameters) { + extraParameterNames <- names(parameterSet) + extraParameterNames <- extraParameterNames[!grepl("^\\.", extraParameterNames)] + extraParameterNames <- extraParameterNames[!(extraParameterNames %in% parameterNames)] + extraParameterNames <- unique(c(parameterNames[!(parameterNames %in% usedParameterNames)], extraParameterNames)) + for (extraParameter in extraParameterNames) { + tryCatch({ + if (parameterSet$.getParameterType(extraParameter) != C_PARAM_TYPE_UNKNOWN) { + value <- parameterSet[[extraParameter]] + if (!is.null(value) && length(value) > 0 && + !is.matrix(value) && !is.array(value) && !is.data.frame(value) && + (is.numeric(value) || is.character(value) || is.logical(value))) { + + columnCaption <- parameterSet$.getDataFrameColumnCaption( + extraParameter, + tableColumnNames, niceColumnNamesEnabled ) - }, - - # - # Returns a sub-list. - # - # @param x A list from which you would like to get a sub-list. - # @param listEntryNames A vector of names which specify the entries of the sub-list to return. - # - .getSubListByNames = function(x, listEntryNames) { - "Returns a sub-list." - if (!is.list(x)) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'x' must be a list") - } - - if (!is.character(listEntryNames)) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'listEntryNames' must be a character vector") + + if (length(value) == 1) { + dataFrame[[columnCaption]] <- rep(value, nrow(dataFrame)) + } else { + dataFrame[[columnCaption]] <- rep(.arrayToString(value, maxLength = 10), nrow(dataFrame)) } + } + } + }, error = function(e) { + warning( + ".getAsDataFrameMultidimensional: failed to add extra parameter ", + sQuote(parameterName), " to data.frame; ", e$message + ) + }) + } + } + + return(dataFrame) +} - return(x[which(names(x) %in% listEntryNames)]) - }, - .isMultiHypothesesObject = function() { - return(.isEnrichmentAnalysisResults(.self) || .isEnrichmentStageResults(.self) || - .isMultiArmAnalysisResults(.self) || .isMultiArmStageResults(.self)) - }, - .isEnrichmentObject = function() { - return(.isEnrichmentAnalysisResults(.self) || .isEnrichmentStageResults(.self)) +.getAsDataFrameUnidimensional <- function(parameterSet, parameterNames, niceColumnNamesEnabled, + includeAllParameters, returnParametersAsCharacter, tableColumnNames) { + numberOfStages <- parameterSet$.getUnidimensionalNumberOfStages(parameterNames) + dataFrame <- NULL + for (parameterName in parameterNames) { + tryCatch( + { + parameterCaption <- ifelse(niceColumnNamesEnabled && + !is.null(tableColumnNames[[parameterName]]), + tableColumnNames[[parameterName]], parameterName + ) + parameterValues <- parameterSet[[parameterName]] + if (parameterName == "futilityBounds") { + parameterValues[parameterValues == C_FUTILITY_BOUNDS_DEFAULT] <- -Inf + } + if (length(parameterValues) == 1) { + parameterValues <- rep(parameterValues, numberOfStages) + } else { + while (length(parameterValues) < numberOfStages) { + parameterValues <- c(parameterValues, NA) + } + } + if (includeAllParameters || ( + parameterSet$.getParameterType(parameterName) != C_PARAM_NOT_APPLICABLE && + sum(is.na(parameterValues)) < length(parameterValues))) { + if (is.null(dataFrame)) { + dataFrame <- data.frame(x = parameterValues) + names(dataFrame) <- parameterCaption + } else { + dataFrame[[parameterCaption]] <- parameterValues + } } + if (returnParametersAsCharacter) { + parameterSet$.formatDataFrameParametersAsCharacter( + dataFrame, + parameterName, parameterValues, parameterCaption + ) + } + }, + error = function(e) { + .logError("Failed to add parameter '%s' to data.frame: %s", parameterName, e) + } ) -) + } + + return(dataFrame) +} + +.getAsDataFrame <- function(..., + parameterSet, + parameterNames, + niceColumnNamesEnabled = FALSE, + includeAllParameters = FALSE, + handleParameterNamesAsToBeExcluded = FALSE, + returnParametersAsCharacter = FALSE, + tableColumnNames = C_TABLE_COLUMN_NAMES, + mandatoryParameterNames = character(0)) { + + parameterNamesToBeExcluded <- c() + if (handleParameterNamesAsToBeExcluded) { + parameterNamesToBeExcluded <- parameterNames + parameterNames <- parameterSet$.getVisibleFieldNamesOrdered() + if (!is.null(parameterNamesToBeExcluded) && length(parameterNamesToBeExcluded) > 0) { + parameterNames <- parameterNames[!(parameterNames %in% parameterNamesToBeExcluded)] + } + } else if (is.null(parameterNames)) { + parameterNames <- parameterSet$.getVisibleFieldNamesOrdered() + } + parameterNames <- parameterNames[!grepl("^\\.", parameterNames)] + + parametersToIgnore <- character(0) + if (!is.null(parameterSet[[".piecewiseSurvivalTime"]]) && + parameterSet$.piecewiseSurvivalTime$piecewiseSurvivalEnabled) { + parametersToIgnore <- c(parametersToIgnore, + "lambda1", "lambda2", "median1", "median2", + "pi1", "pi2", "piecewiseSurvivalTime") + parametersToIgnore <- intersect(parametersToIgnore, parameterNames) + } + + if (parameterSet$.getParameterType("hazardRatio") == C_PARAM_GENERATED && + !is.null(parameterSet[[".piecewiseSurvivalTime"]]) && + isTRUE(parameterSet$.piecewiseSurvivalTime$piecewiseSurvivalEnabled)) { + parametersToIgnore <- c(parametersToIgnore, "hazardRatio") + } + + if (!(inherits(parameterSet, "AccrualTime") || !inherits(parameterSet, "AccrualTimeR6"))) { + accrualTime <- parameterSet[["accrualTime"]] + if (!is.null(accrualTime) && length(accrualTime) > 1) { + parametersToIgnore <- c(parametersToIgnore, c("accrualTime", "accrualIntensity")) + } + } + + if (length(parametersToIgnore) > 0) { + parameterNames <- parameterNames[!(parameterNames %in% parametersToIgnore)] + } + + if (parameterSet$.containsMultidimensionalParameters(parameterNames)) { + + return(.addDelayedInformationRates(.getAsDataFrameMultidimensional( + parameterSet, parameterNames, niceColumnNamesEnabled, + includeAllParameters, returnParametersAsCharacter, tableColumnNames, + mandatoryParameterNames + ))) + } + + # remove matrices + for (parameterName in parameterNames) { + parameterValues <- parameterSet[[parameterName]] + if (is.matrix(parameterValues) && nrow(parameterValues) != 1 && ncol(parameterValues) != 1) { + parameterNames <- parameterNames[parameterNames != parameterName] + } + } + + if (length(parameterNames) == 0) { + return(data.frame()) + } + + return(.addDelayedInformationRates(.getAsDataFrameUnidimensional( + parameterSet, parameterNames, niceColumnNamesEnabled, + includeAllParameters, returnParametersAsCharacter, tableColumnNames + ))) +} +.getCategoryCaptionEnrichment <- function(parameterSet, parameterName, categoryNumber) { + categoryCaption <- categoryNumber + if (parameterName %in% c("sampleSizes", "singleNumberOfEventsPerStage")) { + categoryCaption <- parameterSet$effectList$subGroups[categoryNumber] + maxNumberOfDigits <- max(nchar(sub("\\D*", "", parameterSet$effectList$subGroups))) + if (parameterSet$populations > 2 && grepl(paste0("^S\\d{1,", maxNumberOfDigits - 1, "}$"), categoryCaption)) { + categoryCaption <- paste0(categoryCaption, " only") + } + } else { + if (parameterSet$populations <= 2) { + categoryCaption <- ifelse(categoryNumber == parameterSet$populations, "F", "S") + } else { + categoryCaption <- ifelse(categoryNumber == parameterSet$populations, "F", paste0("S", categoryNumber)) + } + } + return(categoryCaption) +} #' #' @title @@ -924,8 +1367,8 @@ ParameterSet <- setRefClass("ParameterSet", #' #' @keywords internal #' -names.FieldSet <- function(x) { - return(x$.getVisibleFieldNames()) +names.FieldSetR6 <- function(x) { + return(x$.getVisibleFieldNames()) } #' @@ -945,9 +1388,9 @@ names.FieldSet <- function(x) { #' #' @keywords internal #' -print.FieldSet <- function(x, ...) { - x$show() - invisible(x) +print.FieldSetR6 <- function(x, ...) { + x$show() + invisible(x) } #' @@ -971,16 +1414,16 @@ print.FieldSet <- function(x, ...) { #' #' @keywords internal #' -as.data.frame.ParameterSet <- function(x, row.names = NULL, - optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ...) { - .warnInCaseOfUnknownArguments(functionName = "as.data.frame", ...) - - return(.getAsDataFrame( - parameterSet = x, - parameterNames = NULL, - niceColumnNamesEnabled = niceColumnNamesEnabled, - includeAllParameters = includeAllParameters - )) +as.data.frame.ParameterSetR6 <- function(x, row.names = NULL, + optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ...) { + .warnInCaseOfUnknownArguments(functionName = "as.data.frame", ...) + + return(.getAsDataFrame( + parameterSet = x, + parameterNames = NULL, + niceColumnNamesEnabled = niceColumnNamesEnabled, + includeAllParameters = includeAllParameters + )) } #' @@ -999,13 +1442,75 @@ as.data.frame.ParameterSet <- function(x, row.names = NULL, #' #' @export #' -setMethod( - "t", "FieldSet", - function(x) { - x <- as.matrix(x, niceColumnNamesEnabled = TRUE) - return(t(x)) +#setMethod( +# "t", "FieldSet",#TODO +# function(x) { +# x <- as.matrix(x, niceColumnNamesEnabled = TRUE) +# return(t(x)) +# } +#) + +#' +#' @title +#' Create output in Markdown +#' +#' @description +#' The \code{kable()} function returns the output of the specified object formatted in Markdown. +#' +#' @param x A \code{ParameterSet}. If x does not inherit from class \code{\link{ParameterSet}}, +#' \code{knitr::kable(x)} will be returned. +#' @param ... Other arguments (see \code{\link[knitr]{kable}}). +#' +#' @details +#' 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. +#' +#' @export +#' +kable.ParameterSetR6 <- function(x, ...) { + fCall <- match.call(expand.dots = FALSE) + if (inherits(x, "ParameterSetR6")) { + objName <- deparse(fCall$x) + if (all(grepl("^ *print\\(", objName))) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "kable(", objName, ") does not work correctly. ", + "Use ", sub("print", "kable", objName), " without 'print' instead or ", sub("\\)", ", markdown = TRUE)", objName) + ) } -) + + if (.isSimulationResults(x)) { + showStatistics <- .getOptionalArgument("showStatistics", optionalArgumentDefaultValue = FALSE, ...) + if (isTRUE(showStatistics)) { + return(print(x, markdown = TRUE, showStatistics = TRUE)) + } + } + + return(print(x, markdown = TRUE)) + } + + .assertPackageIsInstalled("knitr") + knitr::kable(x, ...) +} + +#' +#' @title +#' Create tables in Markdown +#' +#' @description +#' The \code{kable()} function returns a single table for a single object that inherits from class \code{\link{ParameterSet}}. +#' +#' @details +#' Generic to represent a parameter set in Markdown. +#' +#' @param x The object that inherits from \code{\link{ParameterSet}}. +#' @param ... Other arguments (see \code{\link[knitr]{kable}}). +#' +#' @export +#' +setGeneric("kable", kable.ParameterSetR6) #' #' @title @@ -1029,45 +1534,62 @@ setMethod( #' #' @keywords internal #' -as.matrix.FieldSet <- function(x, ..., enforceRowNames = TRUE, niceColumnNamesEnabled = TRUE) { - dataFrame <- as.data.frame(x, niceColumnNamesEnabled = niceColumnNamesEnabled) - dataFrame <- .setStagesAsFirstColumn(dataFrame) - result <- as.matrix(dataFrame) - - if (nrow(result) == 0) { - return(result) - } - - if (inherits(x, "PowerAndAverageSampleNumberResult") || inherits(x, "PowerAndAverageSampleNumberResultR6")) { - dimnames(result)[[1]] <- rep("", nrow(result)) - return(result) - } - - 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))]), ] - if (length(intersect(names(dfDesign), names(dfStageResults))) == 1) { - dfTemp <- merge(dfDesign, dfStageResults) - if (length(intersect(names(dfTemp), names(dataFrame))) >= 1) { - dataFrame <- merge(dfTemp, dataFrame, all.x = FALSE, all.y = TRUE) - dataFrame <- .setStagesAsFirstColumn(dataFrame) - result <- as.matrix(dataFrame) - } - } else if (length(intersect(names(dfStageResults), names(dataFrame))) >= 1) { - dataFrame <- merge(dfStageResults, dataFrame, all.x = FALSE, all.y = TRUE) - dataFrame <- .setStagesAsFirstColumn(dataFrame) - result <- as.matrix(dataFrame) - } - } - - if (any(grepl("^(S|s)tages?$", colnames(result)))) { - dimnames(result)[[1]] <- rep("", nrow(result)) - } - +as.matrix.FieldSetR6 <- function(x, ..., enforceRowNames = TRUE, niceColumnNamesEnabled = TRUE) { + dataFrame <- as.data.frame(x, niceColumnNamesEnabled = niceColumnNamesEnabled) + dataFrame <- .setStagesAsFirstColumn(dataFrame) + result <- as.matrix(dataFrame) + + if (nrow(result) == 0) { + return(result) + } + + if (inherits(x, "PowerAndAverageSampleNumberResult") || inherits(x, "PowerAndAverageSampleNumberResultR6")) { + dimnames(result)[[1]] <- rep("", nrow(result)) return(result) + } + + 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))]), ] + if (length(intersect(names(dfDesign), names(dfStageResults))) == 1) { + dfTemp <- merge(dfDesign, dfStageResults) + if (length(intersect(names(dfTemp), names(dataFrame))) >= 1) { + dataFrame <- merge(dfTemp, dataFrame, all.x = FALSE, all.y = TRUE) + dataFrame <- .setStagesAsFirstColumn(dataFrame) + result <- as.matrix(dataFrame) + } + } else if (length(intersect(names(dfStageResults), names(dataFrame))) >= 1) { + dataFrame <- merge(dfStageResults, dataFrame, all.x = FALSE, all.y = TRUE) + dataFrame <- .setStagesAsFirstColumn(dataFrame) + result <- as.matrix(dataFrame) + } + } + + if (any(grepl("^(S|s)tages?$", colnames(result)))) { + dimnames(result)[[1]] <- rep("", nrow(result)) + } + + return(result) } +.setStagesAsFirstColumn <- function(data) { + columnNames <- colnames(data) + index <- grep("^(S|s)tages?$", columnNames) + if (length(index) == 0 || index == 1) { + return(data) + } + + stageName <- columnNames[index[1]] + stageNumbers <- data[, stageName] + if (is.null(stageNumbers) || length(stageNumbers) == 0) { + return(data) + } + + data <- data[, c(stageName, columnNames[columnNames != stageName])] + + return(data) +} #' #' @title @@ -1078,9 +1600,6 @@ as.matrix.FieldSet <- function(x, ..., enforceRowNames = TRUE, niceColumnNamesEn #' #' @param object A \code{\link{ParameterSet}} object. #' @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. #' @inheritParams param_three_dots #' #' @details @@ -1095,56 +1614,44 @@ as.matrix.FieldSet <- function(x, ..., enforceRowNames = TRUE, niceColumnNamesEn #' #' @keywords internal #' -summary.ParameterSet <- function(object, ..., - type = 1, - digits = NA_integer_, - output = c("all", "title", "overview", "body"), - printObject = FALSE, - sep = "\n-----\n\n") { - - .warnInCaseOfUnknownArguments(functionName = "summary", ignore = c("printObject"), ...) - - base::attr(object, "printObject") <- printObject - base::attr(object, "printObjectSeparator") <- sep - - if (type == 1 && inherits(object, "SummaryFactory")) { - return(object) - } - - if (type == 1 && ( - inherits(object, "TrialDesign") || - inherits(object, "TrialDesignPlan") || - inherits(object, "SimulationResults") || - inherits(object, "AnalysisResults") || - inherits(object, "TrialDesignCharacteristics") || - inherits(object, "PerformanceScore"))) { - output <- match.arg(output) - return(.createSummary(object, digits = digits, output = output)) - } - - # create technical summary - object$show(showType = 2) +summary.ParameterSetR6 <- function(object, ..., type = 1, digits = NA_integer_, output = c("all", "title", "overview", "body")) { + .warnInCaseOfUnknownArguments(functionName = "summary", ...) + + if (type == 1 && (inherits(object, "SummaryFactory") || inherits(object, "SummaryFactoryR6"))) { + return(object) + } + + if (type == 1 && (inherits(object, "TrialDesign") || inherits(object, "TrialDesignR6") || inherits(object, "TrialDesignPlan") || inherits(object, "TrialDesignPlanR6") || + inherits(object, "SimulationResults") || inherits(object, "SimulationResultsR6") || (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) || + inherits(object, "TrialDesignCharacteristics") || inherits(object, "TrialDesignCharacteristicsR6") || + inherits(object, "PerformanceScore") || inherits(object, "PerformanceScoreR6"))) { + output <- match.arg(output) + return(.createSummary(object, digits = digits, output = output)) + } + + # create technical summary + object$show(showType = 2) + object$.cat("\n") + + if (!is.null(object[[".piecewiseSurvivalTim"]])) { + object$.piecewiseSurvivalTime$show() object$.cat("\n") - - if (!is.null(object[[".piecewiseSurvivalTim"]])) { - object$.piecewiseSurvivalTime$show() - object$.cat("\n") - } - - if (!is.null(object[[".accrualTime"]])) { - object$.accrualTime$show() - object$.cat("\n") - } - - object$.cat(object$.toString(startWithUpperCase = TRUE), " table:\n", heading = 1) - parametersToShow <- object$.getParametersToShow() - for (parameter in parametersToShow) { - if (length(object[[parameter]]) == 1) { - parametersToShow <- parametersToShow[parametersToShow != parameter] - } + } + + if (!is.null(object[[".accrualTime"]])) { + object$.accrualTime$show() + object$.cat("\n") + } + + object$.cat(object$.toString(startWithUpperCase = TRUE), " table:\n", heading = 1) + parametersToShow <- object$.getParametersToShow() + for (parameter in parametersToShow) { + if (length(object[[parameter]]) == 1) { + parametersToShow <- parametersToShow[parametersToShow != parameter] } - object$.printAsDataFrame(parameterNames = parametersToShow, niceColumnNamesEnabled = TRUE) - invisible(object) + } + object$.printAsDataFrame(parameterNames = parametersToShow, niceColumnNamesEnabled = TRUE) + invisible(object) } #' @@ -1166,19 +1673,14 @@ summary.ParameterSet <- function(object, ..., #' #' @keywords internal #' -print.ParameterSet <- function(x, ..., markdown = NA) { - if (is.na(markdown)) { - markdown <- .isMarkdownEnabled() - } - - if (markdown) { - x$.catMarkdownText() - cat("\n\n") - } else { - x$show() - } - +print.ParameterSetR6 <- function(x, ..., markdown = FALSE) { + if (markdown) { + x$.catMarkdownText() return(invisible(x)) + } + + x$show() + invisible(x) } #' @@ -1207,102 +1709,13 @@ print.ParameterSet <- function(x, ..., markdown = NA) { #' #' @export #' -plot.ParameterSet <- function(x, y, ..., main = NA_character_, - xlab = NA_character_, ylab = NA_character_, type = 1L, palette = "Set1", - legendPosition = NA_integer_, showSource = FALSE, plotSettings = NULL) { - .assertGgplotIsInstalled() - - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, - "sorry, function 'plot' is not implemented yet for class '", .getClassName(x), "'" - ) -} - -#' -#' @title -#' Print Parameter Set in Markdown Code Chunks -#' -#' @description -#' The function `knit_print.ParameterSet` is the default printing function for rpact result objects in knitr. -#' The chunk option `render` uses this function by default. -#' To fall back to the normal printing behavior set the chunk option `render = normal_print`. -#' For more information see \code{\link[knitr]{knit_print}}. -#' -#' @param x A \code{ParameterSet}. -#' @param ... Other arguments (see \code{\link[knitr]{knit_print}}). -#' -#' @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. -#' -#' @export -#' -knit_print.ParameterSet <- function(x, ...) { - result <- paste0(utils::capture.output(x$.catMarkdownText()), collapse = "\n") - return(knitr::asis_output(result)) +plot.ParameterSetR6 <- function(x, y, ..., main = NA_character_, + xlab = NA_character_, ylab = NA_character_, type = 1L, palette = "Set1", + legendPosition = NA_integer_, showSource = FALSE, plotSettings = NULL) { + .assertGgplotIsInstalled() + + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, + "sorry, function 'plot' is not implemented yet for class '", .getClassName(x), "'" + ) } - -#' -#' @title -#' Create output in Markdown -#' -#' @description -#' The \code{kable()} function returns the output of the specified object formatted in Markdown. -#' -#' @param x A \code{ParameterSet}. If x does not inherit from class \code{\link{ParameterSet}}, -#' \code{knitr::kable(x)} will be returned. -#' @param ... Other arguments (see \code{\link[knitr]{kable}}). -#' -#' @details -#' 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. -#' -#' @export -#' -kable.ParameterSet <- function(x, ...) { - fCall <- match.call(expand.dots = FALSE) - if (inherits(x, "ParameterSet")) { - objName <- deparse(fCall$x) - if (length(objName) > 0) { - if (length(objName) > 1) { - objName <- paste0(objName[1], "...") - } - if (grepl("^ *print\\(", objName)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "kable(", objName, ") ", - "does not work correctly. ", - "Use ", sub("print", "kable", objName), " without 'print' ", - "instead or ", sub("\\)", ", markdown = TRUE)", objName) - ) - } - } - - return(knit_print.ParameterSet(x = x, ...)) - } - - .assertPackageIsInstalled("knitr") - knitr::kable(x, ...) -} - -#' -#' @title -#' Create tables in Markdown -#' -#' @description -#' The \code{kable()} function returns a single table for a single object that inherits from class \code{\link{ParameterSet}}. -#' -#' @details -#' Generic to represent a parameter set in Markdown. -#' -#' @param x The object that inherits from \code{\link{ParameterSet}}. -#' @param ... Other arguments (see \code{\link[knitr]{kable}}). -#' -#' @export -#' -setGeneric("kable", kable.ParameterSet) diff --git a/R/class_core_parameter_set_r6.R b/R/class_core_parameter_set_r6.R deleted file mode 100644 index 48691d31..00000000 --- a/R/class_core_parameter_set_r6.R +++ /dev/null @@ -1,1721 +0,0 @@ -library("R6") -## | -## | *Parameter set classes* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | rpact package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File version: $Revision: 6902 $ -## | Last changed: $Date: 2023-03-29 10:01:19 +0200 (Mi, 29 Mrz 2023) $ -## | Last changed by: $Author: pahlke $ -## | - -#' @include f_core_constants.R -#' @include f_core_assertions.R -NULL - -#' -#' @name FieldSetR6 -#' -#' @title -#' Field Set -#' -#' @description -#' Basic class for field sets. -#' -#' @details -#' The field set implements basic functions for a set of fields. -#' -#' @include class_core_plot_settings.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -FieldSetR6 <- R6Class("FieldSetR6", - public = list( - .parameterTypes = NULL, - .parameterNames = NULL, - .parameterFormatFunctions = NULL, - .showParameterTypeEnabled = NULL, - .catLines = NULL, - .getFieldNames = function() { - return(unlist(lapply(class(self)[1:(length(class(self))-1)],function(x) {names(get(x)$public_fields)}))) - }, - .getVisibleFieldNames = function() { - fieldNames <- self$.getFieldNames() - fieldNames <- fieldNames[!startsWith(fieldNames, ".")] - return(fieldNames) - }, - .resetCat = function() { - self$.catLines <- character(0) - }, - .cat = function(..., file = "", sep = "", fill = FALSE, labels = NULL, - append = FALSE, heading = 0, tableColumns = 0, consoleOutputEnabled = TRUE, - na = NA_character_) { - if (consoleOutputEnabled) { - cat(..., file = file, sep = sep, fill = fill, labels = labels, append = append) - return(invisible()) #TODO self? - } - - args <- list(...) - line <- "" - if (length(args) > 0) { - if (tableColumns > 0) { - values <- unlist(args, use.names = FALSE) - values <- values[values != "\n"] - for (i in 1:length(values)) { - values[i] <- gsub("\n", "", values[i]) - } - if (!is.null(na) && length(na) == 1 && !is.na(na)) { - len <- min(nchar(values)) - naStr <- paste0(trimws(na), " ") - while (nchar(naStr) < len) { - naStr <- paste0(" ", naStr) - } - values[is.na(values) | nchar(trimws(values)) == 0] <- naStr - } - line <- paste0(values, collapse = "| ") - if (trimws(line) != "" && !grepl("\\| *$", line)) { - line <- paste0(line, "|") - } - line <- paste0("| ", line) - extraCells <- tableColumns - length(values) - if (extraCells > 0 && trimws(line) != "") { - line <- paste0(line, paste0(rep(" |", extraCells), collapse = "")) - } - line <- paste0(line, "\n") - } else { - line <- paste0(args, collapse = sep) - listItemEnabled <- grepl("^ ", line) - - headingBaseNumber <- as.integer(getOption("rpact.print.heading.base.number", 0L)) - if (is.na(headingBaseNumber)) { - headingBaseNumber <- 0L - } - if (headingBaseNumber < -1) { - warning( - "Illegal option ", sQuote("rpact.print.heading.base.number"), - " (", headingBaseNumber, ") was set to 0" - ) - headingBaseNumber <- 0L - } - if (headingBaseNumber > 4) { - warning( - "Illgeal option ", sQuote("rpact.print.heading.base.number"), - " (", headingBaseNumber, ") was set to 4 becasue it was too large" - ) - headingBaseNumber <- 4L - } - - if (heading > 0) { - if (headingBaseNumber == -1) { - lineBreak <- "" - if (grepl("\n *$", line)) { - lineBreak <- "\n\n" - } - line <- paste0("**", sub(": *", "", trimws(line)), "**", lineBreak) - } else { - headingCmd <- paste0(rep("#", heading + headingBaseNumber + 1), collapse = "") - lineBreak <- "" - if (grepl("\n *$", line)) { - lineBreak <- "\n\n" - } - line <- paste0(headingCmd, " ", sub(": *", "", trimws(line)), lineBreak) - } - } else { - parts <- strsplit(line, " *: ")[[1]] - if (length(parts) == 2) { - line <- paste0("*", trimws(parts[1]), "*: ", parts[2]) - } - } - if (listItemEnabled) { - if (grepl("^ ", line)) { - line <- sub("^ ", "* ", line) - } else { - line <- paste0("* ", line) - } - } - } - } - if (length(self$.catLines) == 0) { - self$.catLines <- line - } else { - self$.catLines <- c(self$.catLines, line) - } - return(invisible()) - }, - .getFields = function(values) { - flds <- self$.getFieldNames() - if (!missing(values)) { - flds <- flds[flds %in% values] - } - result <- setNames(vector("list", length(flds)), flds) - for (fld in flds) { - result[[fld]] <- self[[fld]] - } - return(result) - } - ) -) - -#' -#' @name ParameterSetR6 -#' -#' @title -#' Parameter Set -#' -#' @description -#' Basic class for parameter sets. -#' -#' @details -#' The parameter set implements basic functions for a set of parameters. -#' -#' @include f_core_constants.R -#' @include f_core_utilities.R -#' @include f_parameter_set_utilities.R -#' @include f_analysis_utilities.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -ParameterSetR6 <- R6Class("ParameterSetR6", - inherit = FieldSetR6, - public = list( - initialize = function(..., .showParameterTypeEnabled = TRUE) { - self$.showParameterTypeEnabled <- .showParameterTypeEnabled - self$.parameterTypes <- list() - self$.parameterNames <- list() - self$.parameterFormatFunctions <- list() - self$.catLines <- character(0) - }, - .toString = function(startWithUpperCase = FALSE) { - s <- .formatCamelCase(.getClassName(self)) - return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) - }, - .initParameterTypes = function() { - for (parameterName in names(self$.parameterNames)) { - self$.parameterTypes[[parameterName]] <- C_PARAM_TYPE_UNKNOWN - } - }, - .getParameterType = function(parameterName) { - if (is.null(parameterName) || length(parameterName) == 0 || is.na(parameterName)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'parameterName' must be a valid character with length > 0" - ) - } - - parameterType <- self$.parameterTypes[[parameterName]] - if (is.null(parameterType)) { - return(C_PARAM_TYPE_UNKNOWN) - } - - return(parameterType[1]) - }, - .getParametersToShow = function() { - return(self$.getVisibleFieldNames()) - }, - .setParameterType = function(parameterName, parameterType) { - if (is.null(parameterName) || length(parameterName) == 0 || is.na(parameterName)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'parameterName' must be a valid character with length > 0" - ) - } - - parameterType <- parameterType[1] - - if (!all(parameterType %in% c( - C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE, - C_PARAM_GENERATED, C_PARAM_DERIVED, C_PARAM_NOT_APPLICABLE - ))) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'parameterType' ('", parameterType, "') is invalid" - ) - } - - self$.parameterTypes[[parameterName]] <- parameterType - - invisible(parameterType) #TODO return? - }, - isUserDefinedParameter = function(parameterName) { - return(self$.getParameterType(parameterName) == C_PARAM_USER_DEFINED) - }, - isDefaultParameter = function(parameterName) { - return(self$.getParameterType(parameterName) == C_PARAM_DEFAULT_VALUE) - }, - isGeneratedParameter = function(parameterName) { - return(self$.getParameterType(parameterName) == C_PARAM_GENERATED) - }, - isDerivedParameter = function(parameterName) { - return(self$.getParameterType(parameterName) == C_PARAM_DERIVED) - }, - isUndefinedParameter = function(parameterName) { - return(self$.getParameterType(parameterName) == C_PARAM_TYPE_UNKNOWN) - }, - .getInputParameters = function() { - params <- self$.getParametersOfOneGroup(c(C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE)) - return(params) - }, - .getUserDefinedParameters = function() { - return(self$.getParametersOfOneGroup(C_PARAM_USER_DEFINED)) - }, - .getDefaultParameters = function() { - return(self$.getParametersOfOneGroup(C_PARAM_DEFAULT_VALUE)) - }, - .getGeneratedParameters = function() { - return(self$.getParametersOfOneGroup(C_PARAM_GENERATED)) - }, - .getDerivedParameters = function() { - return(self$.getParametersOfOneGroup(C_PARAM_DERIVED)) - }, - .getUndefinedParameters = function() { - return(self$.getParametersOfOneGroup(C_PARAM_TYPE_UNKNOWN)) - }, - .getParameterValueIfUserDefinedOrDefault = function(parameterName) { - if (self$isUserDefinedParameter(parameterName) || self$isDefaultParameter(parameterName)) { - return(self[[parameterName]]) #TODO does this work? - } - - parameterType <- .self$getRefClass()$fields()[[parameterName]]#TODO - if (parameterType == "numeric") { - return(NA_real_) - } - - if (parameterType == "integer") { - return(NA_integer_) - } - - if (parameterType == "character") { - return(NA_character_) - } - - return(NA) - }, - .getParametersOfOneGroup = function(parameterType) { - if (length(parameterType) == 1) { - parameterNames <- names(self$.parameterTypes[self$.parameterTypes == parameterType]) - - } else { - parameterNames <- names(self$.parameterTypes[which(self$.parameterTypes %in% parameterType)]) - } - parametersToShow <- self$.getParametersToShow() - if (is.null(parametersToShow) || length(parametersToShow) == 0) { - return(parameterNames) - } - - return(parametersToShow[parametersToShow %in% parameterNames]) - }, - .showParameterType = function(parameterName) { - if (!self$.showParameterTypeEnabled) { - return(" ") - } - - return(paste0("[", self$.getParameterType(parameterName), "]")) - }, - .showAllParameters = function(consoleOutputEnabled = TRUE) { - parametersToShow <- self$.getVisibleFieldNamesOrdered() - for (parameter in parametersToShow) { - self$.showParameter(parameter, - showParameterType = TRUE, - consoleOutputEnabled = consoleOutputEnabled - ) - } - }, - .getVisibleFieldNamesOrdered = function() { - visibleFieldNames <- self$.getVisibleFieldNames() - - parametersToShowSorted <- self$.getParametersToShow() - if (is.null(parametersToShowSorted) || length(parametersToShowSorted) == 0) { - return(visibleFieldNames) - } - - visibleFieldNames <- visibleFieldNames[!(visibleFieldNames %in% parametersToShowSorted)] - visibleFieldNames <- c(parametersToShowSorted, visibleFieldNames) - return(visibleFieldNames) - }, - .show = function(..., consoleOutputEnabled = FALSE) { - showType <- .getOptionalArgument("showType", ...) - if (!is.null(showType) && showType == 2) { - self$.cat("Technical developer summary of the ", self$.toString(), " object (", - methods::classLabel(class(self)), "):\n\n", - sep = "", heading = 1, - consoleOutputEnabled = consoleOutputEnabled - ) - self$.showAllParameters(consoleOutputEnabled = consoleOutputEnabled) - self$.showParameterTypeDescription(consoleOutputEnabled = consoleOutputEnabled) - } else { - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, - "method '.show()' is not implemented in class '", .getClassName(self), "'" - ) - } - }, - .catMarkdownText = function(...) { - 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 <- "" - if (is.null(parameters) || length(parameters) == 0 || all(is.na(parameters))) { - if (!missing(title) && !is.null(title) && !is.na(title) && consoleOutputEnabled) { - output <- paste0(title, ": not available\n\n") - self$.cat(output, heading = 2, consoleOutputEnabled = consoleOutputEnabled) - } - invisible(output) - } else { - if (orderByParameterName) { - parameters <- sort(parameters) - } - - if (!missing(title) && !is.null(title) && !is.na(title)) { - output <- paste0(title, ":\n") - self$.cat(output, heading = 2, consoleOutputEnabled = consoleOutputEnabled) - } - for (parameterName in parameters) { - output <- paste0(output, self$.showParameter(parameterName, - consoleOutputEnabled = consoleOutputEnabled - )) - } - self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) - output <- paste0(output, "\n") - invisible(output) - } - }, - .showParameter = function(parameterName, showParameterType = FALSE, consoleOutputEnabled = TRUE) { - tryCatch( - { - - params <- .getParameterValueFormatted(obj = self, parameterName = parameterName) - if (is.null(params) || !is.list(params)) { - return(invisible("")) - } - - if (!is.null(names(params)) && "paramValue" %in% names(params)) { - return(self$.showParameterSingle( - param = params, - parameterName = parameterName, - showParameterType = showParameterType, - consoleOutputEnabled = consoleOutputEnabled - )) - } - - output <- "" - for (i in 1:length(params)) { - param <- params[[i]] - category <- NULL - parts <- strsplit(param$paramName, "$", fixed = TRUE)[[1]] - if (length(parts) == 2) { - parameterName <- parts[1] - param$paramName <- parameterName - - category <- parts[2] - categoryCaption <- self$.parameterNames[[category]] - if (is.null(categoryCaption)) { - categoryCaption <- paste0("%", category, "%") - } - category <- categoryCaption - } - outputPart <- self$.showParameterSingle( - param = param, - parameterName = parameterName, - category = category, - showParameterType = showParameterType, - consoleOutputEnabled = consoleOutputEnabled - ) - if (nchar(output) > 0) { - output <- paste0(output, "\n", outputPart) - } else { - output <- outputPart - } - } - return(invisible(output)) - }, - error = function(e) { - if (consoleOutputEnabled) { - warning("Failed to show parameter '", parameterName, "': ", e$message) - } - } - ) - }, - .showParameterSingle = function(param, - parameterName, ..., - category = NULL, - showParameterType = FALSE, - consoleOutputEnabled = TRUE) { - if (is.null(param)) { - return(invisible("")) - } - - output <- "" - tryCatch( - { - if (param$type == "array" && length(dim(param$paramValue)) == 3) { - numberOfEntries <- dim(param$paramValue)[3] - numberOfRows <- dim(param$paramValue)[1] - if (numberOfEntries > 0 && numberOfRows > 0) { - index <- 1 - for (i in 1:numberOfEntries) { - for (j in 1:numberOfRows) { - output <- paste0(output, self$.showParameterFormatted( - paramName = param$paramName, - paramValue = param$paramValue[j, , i], - paramValueFormatted = param$paramValueFormatted[[index]], - showParameterType = showParameterType, - category = i, - matrixRow = ifelse(numberOfRows == 1, NA_integer_, j), - consoleOutputEnabled = consoleOutputEnabled, - paramNameRaw = parameterName, - numberOfCategories = numberOfEntries - )) - index <- index + 1 - } - } - } - } else if (param$type %in% c("matrix", "array")) { - n <- length(param$paramValueFormatted) - if (n > 0) { - for (i in 1:n) { - paramValue <- param$paramValue - if (is.array(paramValue) && - length(dim(paramValue)) == 3 && - dim(paramValue)[3] == 1) { - paramValue <- paramValue[i, , 1] - } else if (dim(paramValue)[1] > 1 || dim(paramValue)[2] > 1) { - paramValue <- paramValue[i, ] - } - - output <- paste0(output, self$.showParameterFormatted( - paramName = param$paramName, - paramValue = paramValue, - paramValueFormatted = param$paramValueFormatted[[i]], - showParameterType = showParameterType, - category = category, - matrixRow = ifelse(n == 1, NA_integer_, i), - consoleOutputEnabled = consoleOutputEnabled, - paramNameRaw = parameterName, - numberOfCategories = n - )) - } - } - } else { - output <- self$.showParameterFormatted( - paramName = param$paramName, - paramValue = param$paramValue, - paramValueFormatted = param$paramValueFormatted, - showParameterType = showParameterType, - category = category, - consoleOutputEnabled = consoleOutputEnabled, - paramNameRaw = parameterName - ) - } - }, - error = function(e) { - if (consoleOutputEnabled) { - warning("Failed to show single parameter '", parameterName, "' (", param$type, "): ", e$message) - } - } - ) - return(invisible(output)) - }, - .extractParameterNameAndValue = function(parameterName) { - d <- regexpr(paste0("\\..+\\$"), parameterName) - if (d[1] != 1) { - return(list(parameterName = parameterName, paramValue = self[[parameterName]])) - } - - index <- attr(d, "match.length") - objectName <- substr(parameterName, 1, index - 1) - parameterName <- substr(parameterName, index + 1, nchar(parameterName)) - paramValue <- self[[objectName]][[parameterName]] - - # .closedTestResults$rejected - 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)) - }, - .showUnknownParameters = function(consoleOutputEnabled = TRUE) { - params <- self$.getUndefinedParameters() - if (length(params) > 0) { - self$.showParametersOfOneGroup(params, "ISSUES (parameters with undefined type)", - consoleOutputEnabled = consoleOutputEnabled - ) - } - }, - .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 <- self$.parameterNames[[paramNameRaw]] - } - if (is.null(paramCaption)) { - paramCaption <- self$.parameterNames[[paramName]] - } - if (is.null(paramCaption)) { - paramCaption <- paste0("%", paramName, "%") - } - if (!is.null(category) && !is.na(category)) { - if (.isMultiArmSimulationResults(self) && paramName == "singleNumberOfEventsPerStage") { - if (!(inherits(self, "SimulationResultsEnrichmentSurvival") || inherits(self, "SimulationResultsEnrichmentSurvivalR6")) && - !is.na(numberOfCategories) && numberOfCategories == category) { - category <- "control" - } - paramCaption <- paste0(paramCaption, " {", category, "}") - } else if (paramName == "effectList") { - paramCaption <- paste0(paramCaption, " [", category, "]") - } else if (.isEnrichmentSimulationResults(self)) { - categoryCaption <- .getCategoryCaptionEnrichment(self, paramName, category) - paramCaption <- paste0(paramCaption, " (", categoryCaption, ")") - } else { - paramCaption <- paste0(paramCaption, " (", category, ")") - } - - if (!is.na(matrixRow)) { - if (paramName == "effectList") { - paramCaption <- paste0(paramCaption, " (", matrixRow, ")") - } else { - paramCaption <- paste0(paramCaption, " [", matrixRow, "]") - } - } - } else if (!is.na(matrixRow)) { - if (.isMultiArmAnalysisResults(self) && paramName %in% - c( - "conditionalErrorRate", "secondStagePValues", - "adjustedStageWisePValues", "overallAdjustedTestStatistics" - )) { - treatments <- self$.closedTestResults$.getHypothesisTreatmentArmVariants()[matrixRow] - paramCaption <- paste0( - "Treatment", ifelse(grepl(",", treatments), "s", ""), " ", - treatments, " vs. control" - ) - } else if (.isEnrichmentAnalysisResults(self) || .isEnrichmentStageResults(self) || - (inherits(self, "ClosedCombinationTestResults") && isTRUE(self$.enrichment))) { - if (paramName %in% c( - "indices", "conditionalErrorRate", "secondStagePValues", - "adjustedStageWisePValues", "overallAdjustedTestStatistics", "rejectedIntersections" - )) { - if (.isEnrichmentAnalysisResults(self)) { - populations <- self$.closedTestResults$.getHypothesisPopulationVariants()[matrixRow] - } else if (inherits(self, "ClosedCombinationTestResults")) { - populations <- self$.getHypothesisPopulationVariants()[matrixRow] - } else { - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, "only ClosedCombinationTestResults ", - "supports function .getHypothesisPopulationVariants() (object is ", .getClassName(self), ")" - ) - } - paramCaption <- paste0(paramCaption, " ", populations) - } else { - if (!is.na(numberOfCategories) && numberOfCategories == matrixRow) { - paramCaption <- paste0(paramCaption, " F") - } else { - paramCaption <- paste0(paramCaption, " S", matrixRow) - } - } - } else if (.isMultiArmAnalysisResults(self) || grepl("StageResultsMultiArm", .getClassName(self)) || - ((inherits(self, "SimulationResults") || inherits(self, "SimulationResultsR6")) && paramName == "effectMatrix") || - (inherits(self, "ClosedCombinationTestResults") && - paramName %in% c("rejected", "separatePValues"))) { - paramCaption <- paste0(paramCaption, " (", matrixRow, ")") - } else { - paramCaption <- paste0(paramCaption, " [", matrixRow, "]") - } - } - if (is.null(paramValueFormatted) || length(paramValueFormatted) == 0 || - is.na(paramValueFormatted)) { - paramValueFormatted <- paramValue - } - if (is.list(paramValueFormatted)) { - paramValueFormatted <- .listToString(paramValueFormatted) - } - if (is.function(paramValue) || grepl("Function$", paramName)) { - paramValueFormatted <- ifelse( - self$.getParameterType(paramName) == C_PARAM_USER_DEFINED, - ifelse(.isCppCode(paramValueFormatted), "user defined (C++)", "user defined"), - "default" - ) - } - prefix <- ifelse(showParameterType, self$.showParameterType(paramName), "") - variableNameFormatted <- .getFormattedVariableName( - name = paramCaption, - n = self$.getNChar(), prefix = prefix - ) - - output <- paste(variableNameFormatted, paramValueFormatted, "\n") - self$.cat(output, consoleOutputEnabled = consoleOutputEnabled) - invisible(output) - }, - .getNChar = function() { - if (length(self$.parameterNames) == 0) { - return(40) - } - - return(min(40, max(nchar(self$.parameterNames))) + 4) - }, - .showParameterTypeDescription = function(consoleOutputEnabled = consoleOutputEnabled) { - self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) - self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) - self$.cat(" ", C_PARAM_USER_DEFINED, ": user defined\n", consoleOutputEnabled = consoleOutputEnabled) - self$.cat(" ", C_PARAM_DERIVED, ": derived value\n", consoleOutputEnabled = consoleOutputEnabled) - self$.cat(" ", C_PARAM_DEFAULT_VALUE, ": default value\n", consoleOutputEnabled = consoleOutputEnabled) - self$.cat(" ", C_PARAM_GENERATED, ": generated/calculated value\n", consoleOutputEnabled = consoleOutputEnabled) - self$.cat(" ", C_PARAM_NOT_APPLICABLE, ": not applicable or hidden\n", consoleOutputEnabled = consoleOutputEnabled) - }, - .printAsDataFrame = function(parameterNames, niceColumnNamesEnabled = FALSE, - includeAllParameters = FALSE, handleParameterNamesAsToBeExcluded = FALSE, - lineBreakEnabled = FALSE) { - if (.isTrialDesign(self)) { - tableColumnNames <- .getTableColumnNames(design = self) - } else { - tableColumnNames <- C_TABLE_COLUMN_NAMES - } - - if (.isTrialDesignPlan(self)) { - parameterNames <- NULL - } - - dataFrame <- .getAsDataFrame( - parameterSet = self, - parameterNames = parameterNames, - niceColumnNamesEnabled = niceColumnNamesEnabled, - includeAllParameters = includeAllParameters, - handleParameterNamesAsToBeExcluded = handleParameterNamesAsToBeExcluded, - returnParametersAsCharacter = TRUE, - tableColumnNames = tableColumnNames - ) - - result <- as.matrix(dataFrame) - if (.isTrialDesignPlan(self)) { - dimnames(result)[[1]] <- paste(" ", c(1:nrow(dataFrame))) - } else if (!is.null(dataFrame[["stages"]])) { - dimnames(result)[[1]] <- paste(" Stage", dataFrame$stages) - } - - print(result, quote = FALSE, right = FALSE) - }, - .getNumberOfRows = function(parameterNames) { - numberOfRows <- 1 - for (parameterName in parameterNames) { - parameterValues <- self[[parameterName]] - if (is.vector(parameterValues) && length(parameterValues) > numberOfRows) { - numberOfRows <- length(parameterValues) - } else if (is.matrix(parameterValues) && (nrow(parameterValues) == 1 || ncol(parameterValues) == 1) && - length(parameterValues) > numberOfRows) { - numberOfRows <- length(parameterValues) - } - } - return(numberOfRows) - }, - .containsMultidimensionalParameters = function(parameterNames) { - for (parameterName in parameterNames) { - parameterValues <- self[[parameterName]] - if (!is.null(parameterValues) && is.matrix(parameterValues) && - nrow(parameterValues) > 0 && ncol(parameterValues) > 0) { - return(TRUE) - } - } - return(FALSE) - }, - .getMultidimensionalNumberOfStages = function(parameterNames) { - if (!is.null(self[[".design"]])) { - return(self$.design$kMax) - } - - n <- 1 - for (parameterName in parameterNames) { - parameterValues <- self[[parameterName]] - if (!is.null(parameterValues) && is.matrix(parameterValues) && - ncol(parameterValues) > 0 && nrow(parameterValues) > n) { - n <- nrow(parameterValues) - } - } - return(n) - }, - .getVariedParameter = function(parameterNames, numberOfVariants) { - - # search for user defined parameters - for (parameterName in parameterNames) { - parameterValues <- self[[parameterName]] - if (!is.null(parameterValues) && !is.matrix(parameterValues) && - length(parameterValues) == numberOfVariants && - parameterName %in% C_VARIABLE_DESIGN_PLAN_PARAMETERS && - self$.getParameterType(parameterName) == C_PARAM_USER_DEFINED) { - return(parameterName) - } - } - - # search for default values - for (parameterName in parameterNames) { - parameterValues <- self[[parameterName]] - if (!is.null(parameterValues) && !is.matrix(parameterValues) && - length(parameterValues) == numberOfVariants && - parameterName %in% C_VARIABLE_DESIGN_PLAN_PARAMETERS && - self$.getParameterType(parameterName) == C_PARAM_DEFAULT_VALUE) { - return(parameterName) - } - } - - return(NULL) - }, - .getDataFrameColumnCaption = function(parameterName, tableColumnNames, niceColumnNamesEnabled) { - if (length(parameterName) == 0 || parameterName == "") { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'parameterName' must be a valid parameter name") - } - - tableColumnName <- tableColumnNames[[parameterName]] - return(ifelse(niceColumnNamesEnabled && !is.null(tableColumnName), - tableColumnName, parameterName - )) - }, - .getUnidimensionalNumberOfStages = function(parameterNames) { - kMax <- self[["kMax"]] - if (is.null(kMax) && !is.null(self[[".design"]])) { - kMax <- self[[".design"]][["kMax"]] - } - if (!is.null(kMax) && length(kMax) == 1 && is.integer(kMax)) { - return(kMax) - } - - n <- 1 - for (parameterName in parameterNames) { - parameterValues <- self[[parameterName]] - if (!is.null(parameterValues) && !is.matrix(parameterValues) && - length(parameterValues) > n) { - n <- length(parameterValues) - } - } - return(n) - }, - .formatDataFrameParametersAsCharacter = function(dataFrame, - parameterName, parameterValues, parameterCaption) { - tryCatch( - { - formatFunctionName <- self$.parameterFormatFunctions[[parameterName]] - if (!is.null(formatFunctionName)) { - parameterValuesFormatted <- eval(call(formatFunctionName, parameterValues)) - } else { - parameterValuesFormatted <- as.character(parameterValues) - } - - if (parameterName == "sided") { - parameterValuesFormatted <- ifelse(parameterValues == 1, - "one-sided", "two-sided" - ) - } - - if (!is.null(dataFrame[[parameterCaption]])) { - parameterValuesFormatted[is.na(dataFrame[[parameterCaption]])] <- "" - } - parameterValuesFormatted[is.na(parameterValuesFormatted)] <- "" - parameterValuesFormatted[parameterValuesFormatted == "NA"] <- "" - if (is.null(dataFrame)) { - dataFrame <- data.frame(x = parameterValuesFormatted) - names(dataFrame) <- parameterCaption - } else { - dataFrame[[parameterCaption]] <- parameterValuesFormatted - } - }, - error = function(e) { - .logError(paste0( - "Error in '.getAsDataFrame'. Failed to show parameter '%s' ", - "(class '%s'): %s" - ), parameterName, .getClassName(self), e) - } - ) - }, - - # - # Returns a sub-list. - # - # @param x A list from which you would like to get a sub-list. - # @param listEntryNames A vector of names which specify the entries of the sub-list to return. - # - .getSubListByNames = function(x, listEntryNames) { - "Returns a sub-list." - if (!is.list(x)) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'x' must be a list") - } - - if (!is.character(listEntryNames)) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'listEntryNames' must be a character vector") - } - - return(x[which(names(x) %in% listEntryNames)]) - }, - .isMultiHypothesesObject = function() { - return(.isEnrichmentAnalysisResults(self) || .isEnrichmentStageResults(self) || - .isMultiArmAnalysisResults(self) || .isMultiArmStageResults(self)) - }, - .isEnrichmentObject = function() { - return(.isEnrichmentAnalysisResults(self) || .isEnrichmentStageResults(self)) - } - ) -) - -.getMultidimensionalNumberOfVariants <- function(parameterSet, parameterNames) { - if (!is.null(parameterSet[["effectList"]])) { - effectMatrixName <- .getSimulationEnrichmentEffectMatrixName(parameterSet) - return(nrow(parameterSet$effectList[[effectMatrixName]])) - } - - parameterNames <- parameterNames[!(parameterNames %in% c( - "accrualTime", "accrualIntensity", - "plannedSubjects", "plannedEvents", - "minNumberOfSubjectsPerStage", "maxNumberOfSubjectsPerStage", - "minNumberOfEventsPerStage", "maxNumberOfEventsPerStage", - "piecewiseSurvivalTime", "lambda2", "adaptations", - "adjustedStageWisePValues", "overallAdjustedTestStatistics" - ))] - if (!is.null(parameterSet[[".piecewiseSurvivalTime"]]) && - parameterSet$.piecewiseSurvivalTime$piecewiseSurvivalEnabled) { - parameterNames <- parameterNames[!(parameterNames %in% c("lambda1"))] - } - - n <- 1 - for (parameterName in parameterNames) { - parameterValues <- parameterSet[[parameterName]] - if (!is.null(parameterValues) && (is.matrix(parameterValues) || !is.array(parameterValues))) { - if (is.matrix(parameterValues)) { - if (parameterSet$.isMultiHypothesesObject()) { - if (nrow(parameterValues) > n && ncol(parameterValues) > 0) { - n <- nrow(parameterValues) - } - } else if (nrow(parameterValues) > 0 && ncol(parameterValues) > n) { - n <- ncol(parameterValues) - } - } else if (length(parameterValues) > n && - !parameterSet$.isMultiHypothesesObject()) { - n <- length(parameterValues) - } - } - } - return(n) -} - -.getDataFrameColumnValues <- function(parameterSet, - parameterName, - numberOfVariants, - numberOfStages, - includeAllParameters, - mandatoryParameterNames) { - if (parameterSet$.getParameterType(parameterName) == C_PARAM_TYPE_UNKNOWN && - parameterName != "futilityStop") { - return(NULL) - } - - if (!includeAllParameters && - parameterSet$.getParameterType(parameterName) == C_PARAM_NOT_APPLICABLE && - !(parameterName %in% mandatoryParameterNames)) { - return(NULL) - } - - parameterValues <- parameterSet[[parameterName]] - if (is.null(parameterValues) || length(parameterValues) == 0) { - return(NULL) - } - - if (is.function(parameterValues)) { - return(NULL) - } - - if (is.array(parameterValues) && !is.matrix(parameterValues)) { - return(NULL) - } - - if (parameterName %in% c("adjustedStageWisePValues", "overallAdjustedTestStatistics")) { - return(NULL) - } - - if (!is.matrix(parameterValues)) { - if (length(parameterValues) == 1) { - return(rep(parameterValues, numberOfVariants * numberOfStages)) - } - - if (parameterSet$.isMultiHypothesesObject()) { - if (length(parameterValues) == numberOfStages) { - return(as.vector(sapply(FUN = rep, X = parameterValues, times = numberOfVariants))) - } - } - - if (length(parameterValues) == numberOfVariants) { - return(rep(parameterValues, numberOfStages)) - } - - if (length(parameterValues) == numberOfStages && - parameterName %in% c( - "plannedEvents", "plannedSubjects", - "minNumberOfEventsPerStage", "maxNumberOfEventsPerStage", - "minNumberOfSubjectsPerStage", "maxNumberOfSubjectsPerStage", - "allocationRatioPlanned" - )) { - values <- c() - for (stage in 1:numberOfStages) { - values <- c(values, rep(parameterValues[stage], numberOfVariants)) - } - return(values) - } - - if (parameterName %in% c( - "accrualTime", "accrualIntensity", - "plannedEvents", "plannedSubjects", - "minNumberOfEventsPerStage", "maxNumberOfEventsPerStage", - "minNumberOfSubjectsPerStage", "maxNumberOfSubjectsPerStage", - "piecewiseSurvivalTime", "lambda2" - )) { - return(NULL) - } - - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, - "parameter '", parameterName, "' has an invalid ", - "dimension (length is ", length(parameterValues), ")" - ) - } else if (parameterName == "effectMatrix") { - # return effect matrix row if 'effectMatrix' is user defined - if (parameterSet$.getParameterType("effectMatrix") == C_PARAM_USER_DEFINED) { - return(1:ncol(parameterValues)) - } - - return(parameterValues[nrow(parameterValues), ]) - } - - if (grepl("futility|alpha0Vec|earlyStop", parameterName) && - nrow(parameterValues) == numberOfStages - 1) { - parameterValues <- rbind(parameterValues, rep(NA_real_, ncol(parameterValues))) - } - - if (nrow(parameterValues) == numberOfStages && ncol(parameterValues) == 1) { - columnValues <- c() - for (parameterValue in parameterValues) { - columnValues <- c(columnValues, rep(parameterValue, numberOfVariants)) - } - return(columnValues) - } - - if (nrow(parameterValues) == numberOfStages && ncol(parameterValues) == numberOfVariants) { - columnValues <- c() - for (i in 1:nrow(parameterValues)) { - for (j in 1:ncol(parameterValues)) { - columnValues <- c(columnValues, parameterValues[i, j]) - } - } - return(columnValues) - } - - # applicable for analysis enrichment - if (parameterSet$.isMultiHypothesesObject()) { - if (nrow(parameterValues) %in% c(1, numberOfVariants) && - ncol(parameterValues) %in% c(1, numberOfStages)) { - columnValues <- c() - for (j in 1:ncol(parameterValues)) { - for (i in 1:nrow(parameterValues)) { - columnValues <- c(columnValues, parameterValues[i, j]) - } - } - if (nrow(parameterValues) == 1) { - columnValues <- as.vector(sapply(FUN = rep, X = columnValues, times = numberOfVariants)) - } - if (ncol(parameterValues) == 1) { - columnValues <- rep(columnValues, numberOfStages) - } - return(columnValues) - } - } - - if (nrow(parameterValues) == 1 && ncol(parameterValues) == 1) { - return(rep(parameterValues[1, 1], numberOfStages * numberOfVariants)) - } - - if (nrow(parameterValues) == 1 && ncol(parameterValues) == numberOfVariants) { - return(rep(parameterValues[1, ], numberOfStages)) - } - - if (nrow(parameterValues) == numberOfStages && ncol(parameterValues) == 1) { - return(rep(parameterValues[, 1], numberOfVariants)) - } - - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, - "parameter '", parameterName, "' has an invalid ", - "dimension (", nrow(parameterValues), " x ", ncol(parameterValues), "); ", - "expected was (", numberOfStages, " x ", numberOfVariants, ")" - ) -} - -.getAsDataFrameMultidimensional <- function(parameterSet, - parameterNames, - niceColumnNamesEnabled, - includeAllParameters, - returnParametersAsCharacter, - tableColumnNames, - mandatoryParameterNames) { - numberOfVariants <- .getMultidimensionalNumberOfVariants(parameterSet, parameterNames) - numberOfStages <- parameterSet$.getMultidimensionalNumberOfStages(parameterNames) - - stagesCaption <- parameterSet$.getDataFrameColumnCaption( - "stages", - tableColumnNames, niceColumnNamesEnabled - ) - - dataFrame <- data.frame( - stages = sort(rep(1:numberOfStages, numberOfVariants)) - ) - names(dataFrame) <- stagesCaption - - if (parameterSet$.isEnrichmentObject()) { - populations <- character(0) - for (i in 1:numberOfVariants) { - populations <- c(populations, ifelse(i == numberOfVariants, "F", paste0("S", i))) - } - dataFrame$populations <- rep(populations, numberOfStages) - populationsCaption <- parameterSet$.getDataFrameColumnCaption( - "populations", - tableColumnNames, niceColumnNamesEnabled - ) - names(dataFrame) <- c(stagesCaption, populationsCaption) - } - - variedParameter <- parameterSet$.getVariedParameter(parameterNames, numberOfVariants) - tryCatch( - { - if (!is.null(variedParameter) && variedParameter != "stages") { - variedParameterCaption <- parameterSet$.getDataFrameColumnCaption( - variedParameter, - tableColumnNames, niceColumnNamesEnabled - ) - dataFrame[[variedParameterCaption]] <- rep(parameterSet[[variedParameter]], numberOfStages) - } - }, - error = function(e) { - warning( - ".getAsDataFrameMultidimensional: ", - "failed to add 'variedParameterCaption' to data.frame; ", e$message - ) - } - ) - - usedParameterNames <- character(0) - for (parameterName in parameterNames) { - tryCatch( - { - if (!(parameterName %in% c("stages", "adaptations", "effectList")) && - !grepl("Function$", parameterName) && - (is.null(variedParameter) || parameterName != variedParameter)) { - columnValues <- .getDataFrameColumnValues( - parameterSet, parameterName, - numberOfVariants, numberOfStages, - includeAllParameters, mandatoryParameterNames - ) - if (!is.null(columnValues)) { - columnCaption <- parameterSet$.getDataFrameColumnCaption( - parameterName, - tableColumnNames, niceColumnNamesEnabled - ) - dataFrame[[columnCaption]] <- columnValues - if (returnParametersAsCharacter) { - parameterSet$.formatDataFrameParametersAsCharacter( - dataFrame, - parameterName, columnValues, columnCaption - ) - } - usedParameterNames <- c(usedParameterNames, parameterName) - } - } - - if (parameterName == "effectList") { - effectMatrixName <- .getSimulationEnrichmentEffectMatrixName(parameterSet) - effectMatrixNameSingular <- sub("s$", "", effectMatrixName) - effectMatrix <- parameterSet$effectList[[effectMatrixName]] - if (ncol(effectMatrix) == 1) { - dataFrame[[effectMatrixNameSingular]] <- rep(effectMatrix, numberOfStages) - } else { - for (j in 1:ncol(effectMatrix)) { - dataFrame[[paste0(effectMatrixNameSingular, j)]] <- rep(effectMatrix[, j], numberOfStages) - } - } - dataFrame$situation <- rep(1:nrow(effectMatrix), numberOfStages) - usedParameterNames <- c(usedParameterNames, parameterName) - } - }, - error = function(e) { - warning( - ".getAsDataFrameMultidimensional: failed to add parameter ", - sQuote(parameterName), " to data.frame; ", e$message - ) - } - ) - } - - if (includeAllParameters) { - extraParameterNames <- names(parameterSet) - extraParameterNames <- extraParameterNames[!grepl("^\\.", extraParameterNames)] - extraParameterNames <- extraParameterNames[!(extraParameterNames %in% parameterNames)] - extraParameterNames <- unique(c(parameterNames[!(parameterNames %in% usedParameterNames)], extraParameterNames)) - for (extraParameter in extraParameterNames) { - tryCatch({ - if (parameterSet$.getParameterType(extraParameter) != C_PARAM_TYPE_UNKNOWN) { - value <- parameterSet[[extraParameter]] - if (!is.null(value) && length(value) > 0 && - !is.matrix(value) && !is.array(value) && !is.data.frame(value) && - (is.numeric(value) || is.character(value) || is.logical(value))) { - - columnCaption <- parameterSet$.getDataFrameColumnCaption( - extraParameter, - tableColumnNames, niceColumnNamesEnabled - ) - - if (length(value) == 1) { - dataFrame[[columnCaption]] <- rep(value, nrow(dataFrame)) - } else { - dataFrame[[columnCaption]] <- rep(.arrayToString(value, maxLength = 10), nrow(dataFrame)) - } - } - } - }, error = function(e) { - warning( - ".getAsDataFrameMultidimensional: failed to add extra parameter ", - sQuote(parameterName), " to data.frame; ", e$message - ) - }) - } - } - - return(dataFrame) -} - -.getAsDataFrameUnidimensional <- function(parameterSet, parameterNames, niceColumnNamesEnabled, - includeAllParameters, returnParametersAsCharacter, tableColumnNames) { - numberOfStages <- parameterSet$.getUnidimensionalNumberOfStages(parameterNames) - dataFrame <- NULL - for (parameterName in parameterNames) { - tryCatch( - { - parameterCaption <- ifelse(niceColumnNamesEnabled && - !is.null(tableColumnNames[[parameterName]]), - tableColumnNames[[parameterName]], parameterName - ) - parameterValues <- parameterSet[[parameterName]] - if (parameterName == "futilityBounds") { - parameterValues[parameterValues == C_FUTILITY_BOUNDS_DEFAULT] <- -Inf - } - if (length(parameterValues) == 1) { - parameterValues <- rep(parameterValues, numberOfStages) - } else { - while (length(parameterValues) < numberOfStages) { - parameterValues <- c(parameterValues, NA) - } - } - if (includeAllParameters || ( - parameterSet$.getParameterType(parameterName) != C_PARAM_NOT_APPLICABLE && - sum(is.na(parameterValues)) < length(parameterValues))) { - if (is.null(dataFrame)) { - dataFrame <- data.frame(x = parameterValues) - names(dataFrame) <- parameterCaption - } else { - dataFrame[[parameterCaption]] <- parameterValues - } - } - if (returnParametersAsCharacter) { - parameterSet$.formatDataFrameParametersAsCharacter( - dataFrame, - parameterName, parameterValues, parameterCaption - ) - } - }, - error = function(e) { - .logError("Failed to add parameter '%s' to data.frame: %s", parameterName, e) - } - ) - } - - return(dataFrame) -} - -.getAsDataFrame <- function(..., - parameterSet, - parameterNames, - niceColumnNamesEnabled = FALSE, - includeAllParameters = FALSE, - handleParameterNamesAsToBeExcluded = FALSE, - returnParametersAsCharacter = FALSE, - tableColumnNames = C_TABLE_COLUMN_NAMES, - mandatoryParameterNames = character(0)) { - - parameterNamesToBeExcluded <- c() - if (handleParameterNamesAsToBeExcluded) { - parameterNamesToBeExcluded <- parameterNames - parameterNames <- parameterSet$.getVisibleFieldNamesOrdered() - if (!is.null(parameterNamesToBeExcluded) && length(parameterNamesToBeExcluded) > 0) { - parameterNames <- parameterNames[!(parameterNames %in% parameterNamesToBeExcluded)] - } - } else if (is.null(parameterNames)) { - parameterNames <- parameterSet$.getVisibleFieldNamesOrdered() - } - parameterNames <- parameterNames[!grepl("^\\.", parameterNames)] - - parametersToIgnore <- character(0) - if (!is.null(parameterSet[[".piecewiseSurvivalTime"]]) && - parameterSet$.piecewiseSurvivalTime$piecewiseSurvivalEnabled) { - parametersToIgnore <- c(parametersToIgnore, - "lambda1", "lambda2", "median1", "median2", - "pi1", "pi2", "piecewiseSurvivalTime") - parametersToIgnore <- intersect(parametersToIgnore, parameterNames) - } - - if (parameterSet$.getParameterType("hazardRatio") == C_PARAM_GENERATED && - !is.null(parameterSet[[".piecewiseSurvivalTime"]]) && - isTRUE(parameterSet$.piecewiseSurvivalTime$piecewiseSurvivalEnabled)) { - parametersToIgnore <- c(parametersToIgnore, "hazardRatio") - } - - if (!(inherits(parameterSet, "AccrualTime") || !inherits(parameterSet, "AccrualTimeR6"))) { - accrualTime <- parameterSet[["accrualTime"]] - if (!is.null(accrualTime) && length(accrualTime) > 1) { - parametersToIgnore <- c(parametersToIgnore, c("accrualTime", "accrualIntensity")) - } - } - - if (length(parametersToIgnore) > 0) { - parameterNames <- parameterNames[!(parameterNames %in% parametersToIgnore)] - } - - if (parameterSet$.containsMultidimensionalParameters(parameterNames)) { - - return(.addDelayedInformationRates(.getAsDataFrameMultidimensional( - parameterSet, parameterNames, niceColumnNamesEnabled, - includeAllParameters, returnParametersAsCharacter, tableColumnNames, - mandatoryParameterNames - ))) - } - - # remove matrices - for (parameterName in parameterNames) { - parameterValues <- parameterSet[[parameterName]] - if (is.matrix(parameterValues) && nrow(parameterValues) != 1 && ncol(parameterValues) != 1) { - parameterNames <- parameterNames[parameterNames != parameterName] - } - } - - if (length(parameterNames) == 0) { - return(data.frame()) - } - - return(.addDelayedInformationRates(.getAsDataFrameUnidimensional( - parameterSet, parameterNames, niceColumnNamesEnabled, - includeAllParameters, returnParametersAsCharacter, tableColumnNames - ))) -} - -.getCategoryCaptionEnrichment <- function(parameterSet, parameterName, categoryNumber) { - categoryCaption <- categoryNumber - if (parameterName %in% c("sampleSizes", "singleNumberOfEventsPerStage")) { - categoryCaption <- parameterSet$effectList$subGroups[categoryNumber] - maxNumberOfDigits <- max(nchar(sub("\\D*", "", parameterSet$effectList$subGroups))) - if (parameterSet$populations > 2 && grepl(paste0("^S\\d{1,", maxNumberOfDigits - 1, "}$"), categoryCaption)) { - categoryCaption <- paste0(categoryCaption, " only") - } - } else { - if (parameterSet$populations <= 2) { - categoryCaption <- ifelse(categoryNumber == parameterSet$populations, "F", "S") - } else { - categoryCaption <- ifelse(categoryNumber == parameterSet$populations, "F", paste0("S", categoryNumber)) - } - } - return(categoryCaption) -} - -#' -#' @title -#' Names of a Field Set Object -#' -#' @description -#' Function to get the names of a \code{\link{FieldSet}} object. -#' -#' @param x A \code{\link{FieldSet}} object. -#' -#' @details -#' Returns the names of a field set that can be accessed by the user. -#' -#' @template return_names -#' -#' @export -#' -#' @keywords internal -#' -names.FieldSetR6 <- function(x) { - return(x$.getVisibleFieldNames()) -} - -#' -#' @title -#' Print Field Set Values -#' -#' @description -#' \code{print} prints its \code{\link{FieldSet}} argument and returns it invisibly (via \code{invisible(x)}). -#' -#' @param x A \code{\link{FieldSet}} object. -#' @inheritParams param_three_dots -#' -#' @details -#' Prints the field set. -#' -#' @export -#' -#' @keywords internal -#' -print.FieldSetR6 <- function(x, ...) { - x$show() - invisible(x) -} - -#' -#' @title -#' Coerce Parameter Set to a Data Frame -#' -#' @description -#' Returns the \code{ParameterSet} as data frame. -#' -#' @param x A \code{\link{FieldSet}} object. -#' @inheritParams param_niceColumnNamesEnabled -#' @inheritParams param_includeAllParameters -#' @inheritParams param_three_dots -#' -#' @details -#' Coerces the parameter set to a data frame. -#' -#' @template return_dataframe -#' -#' @export -#' -#' @keywords internal -#' -as.data.frame.ParameterSetR6 <- function(x, row.names = NULL, - optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ...) { - .warnInCaseOfUnknownArguments(functionName = "as.data.frame", ...) - - return(.getAsDataFrame( - parameterSet = x, - parameterNames = NULL, - niceColumnNamesEnabled = niceColumnNamesEnabled, - includeAllParameters = includeAllParameters - )) -} - -#' -#' @title -#' Field Set Transpose -#' -#' @description -#' Given a \code{FieldSet} \code{x}, t returns the transpose of \code{x}. -#' -#' @param x A \code{FieldSet}. -#' -#' @details -#' Implementation of the base R generic function \code{\link[base]{t}} -#' -#' @keywords internal -#' -#' @export -#' -#setMethod( -# "t", "FieldSet",#TODO -# function(x) { -# x <- as.matrix(x, niceColumnNamesEnabled = TRUE) -# return(t(x)) -# } -#) - -#' -#' @title -#' Create output in Markdown -#' -#' @description -#' The \code{kable()} function returns the output of the specified object formatted in Markdown. -#' -#' @param x A \code{ParameterSet}. If x does not inherit from class \code{\link{ParameterSet}}, -#' \code{knitr::kable(x)} will be returned. -#' @param ... Other arguments (see \code{\link[knitr]{kable}}). -#' -#' @details -#' 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. -#' -#' @export -#' -kable.ParameterSetR6 <- function(x, ...) { - fCall <- match.call(expand.dots = FALSE) - if (inherits(x, "ParameterSetR6")) { - objName <- deparse(fCall$x) - if (all(grepl("^ *print\\(", objName))) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "kable(", objName, ") does not work correctly. ", - "Use ", sub("print", "kable", objName), " without 'print' instead or ", sub("\\)", ", markdown = TRUE)", objName) - ) - } - - if (.isSimulationResults(x)) { - showStatistics <- .getOptionalArgument("showStatistics", optionalArgumentDefaultValue = FALSE, ...) - if (isTRUE(showStatistics)) { - return(print(x, markdown = TRUE, showStatistics = TRUE)) - } - } - - return(print(x, markdown = TRUE)) - } - - .assertPackageIsInstalled("knitr") - knitr::kable(x, ...) -} - -#' -#' @title -#' Create tables in Markdown -#' -#' @description -#' The \code{kable()} function returns a single table for a single object that inherits from class \code{\link{ParameterSet}}. -#' -#' @details -#' Generic to represent a parameter set in Markdown. -#' -#' @param x The object that inherits from \code{\link{ParameterSet}}. -#' @param ... Other arguments (see \code{\link[knitr]{kable}}). -#' -#' @export -#' -setGeneric("kable", kable.ParameterSetR6) - -#' -#' @title -#' Coerce Field Set to a Matrix -#' -#' @description -#' Returns the \code{FrameSet} as matrix. -#' -#' @param x A \code{\link{FieldSet}} object. -#' @param enforceRowNames If \code{TRUE}, row names will be created -#' depending on the object type, default is \code{TRUE}. -#' @inheritParams param_niceColumnNamesEnabled -#' @inheritParams param_three_dots -#' -#' @details -#' Coerces the frame set to a matrix. -#' -#' @template return_matrix -#' -#' @export -#' -#' @keywords internal -#' -as.matrix.FieldSetR6 <- function(x, ..., enforceRowNames = TRUE, niceColumnNamesEnabled = TRUE) { - dataFrame <- as.data.frame(x, niceColumnNamesEnabled = niceColumnNamesEnabled) - dataFrame <- .setStagesAsFirstColumn(dataFrame) - result <- as.matrix(dataFrame) - - if (nrow(result) == 0) { - return(result) - } - - if (inherits(x, "PowerAndAverageSampleNumberResult") || inherits(x, "PowerAndAverageSampleNumberResultR6")) { - dimnames(result)[[1]] <- rep("", nrow(result)) - return(result) - } - - 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))]), ] - if (length(intersect(names(dfDesign), names(dfStageResults))) == 1) { - dfTemp <- merge(dfDesign, dfStageResults) - if (length(intersect(names(dfTemp), names(dataFrame))) >= 1) { - dataFrame <- merge(dfTemp, dataFrame, all.x = FALSE, all.y = TRUE) - dataFrame <- .setStagesAsFirstColumn(dataFrame) - result <- as.matrix(dataFrame) - } - } else if (length(intersect(names(dfStageResults), names(dataFrame))) >= 1) { - dataFrame <- merge(dfStageResults, dataFrame, all.x = FALSE, all.y = TRUE) - dataFrame <- .setStagesAsFirstColumn(dataFrame) - result <- as.matrix(dataFrame) - } - } - - if (any(grepl("^(S|s)tages?$", colnames(result)))) { - dimnames(result)[[1]] <- rep("", nrow(result)) - } - - return(result) -} - -.setStagesAsFirstColumn <- function(data) { - columnNames <- colnames(data) - index <- grep("^(S|s)tages?$", columnNames) - if (length(index) == 0 || index == 1) { - return(data) - } - - stageName <- columnNames[index[1]] - stageNumbers <- data[, stageName] - if (is.null(stageNumbers) || length(stageNumbers) == 0) { - return(data) - } - - data <- data[, c(stageName, columnNames[columnNames != stageName])] - - return(data) -} - -#' -#' @title -#' Parameter Set Summary -#' -#' @description -#' Displays a summary of \code{\link{ParameterSet}} object. -#' -#' @param object A \code{\link{ParameterSet}} object. -#' @inheritParams param_digits -#' @inheritParams param_three_dots -#' -#' @details -#' Summarizes the parameters and results of a parameter set. -#' -#' @template details_summary -#' -#' @template return_object_summary -#' @template how_to_get_help_for_generics -#' -#' @export -#' -#' @keywords internal -#' -summary.ParameterSetR6 <- function(object, ..., type = 1, digits = NA_integer_, output = c("all", "title", "overview", "body")) { - .warnInCaseOfUnknownArguments(functionName = "summary", ...) - - if (type == 1 && (inherits(object, "SummaryFactory") || inherits(object, "SummaryFactoryR6"))) { - return(object) - } - - if (type == 1 && (inherits(object, "TrialDesign") || inherits(object, "TrialDesignR6") || inherits(object, "TrialDesignPlan") || inherits(object, "TrialDesignPlanR6") || - inherits(object, "SimulationResults") || inherits(object, "SimulationResultsR6") || (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) || - inherits(object, "TrialDesignCharacteristics") || inherits(object, "TrialDesignCharacteristicsR6") || - inherits(object, "PerformanceScore") || inherits(object, "PerformanceScoreR6"))) { - output <- match.arg(output) - return(.createSummary(object, digits = digits, output = output)) - } - - # create technical summary - object$show(showType = 2) - object$.cat("\n") - - if (!is.null(object[[".piecewiseSurvivalTim"]])) { - object$.piecewiseSurvivalTime$show() - object$.cat("\n") - } - - if (!is.null(object[[".accrualTime"]])) { - object$.accrualTime$show() - object$.cat("\n") - } - - object$.cat(object$.toString(startWithUpperCase = TRUE), " table:\n", heading = 1) - parametersToShow <- object$.getParametersToShow() - for (parameter in parametersToShow) { - if (length(object[[parameter]]) == 1) { - parametersToShow <- parametersToShow[parametersToShow != parameter] - } - } - object$.printAsDataFrame(parameterNames = parametersToShow, niceColumnNamesEnabled = TRUE) - invisible(object) -} - -#' -#' @title -#' Print Parameter Set Values -#' -#' @description -#' \code{print} prints its \code{ParameterSet} argument and returns it invisibly (via \code{invisible(x)}). -#' -#' @param x The \code{\link{ParameterSet}} 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 a parameter set. -#' -#' @export -#' -#' @keywords internal -#' -print.ParameterSetR6 <- function(x, ..., markdown = FALSE) { - if (markdown) { - x$.catMarkdownText() - return(invisible(x)) - } - - x$show() - invisible(x) -} - -#' -#' @title -#' Parameter Set Plotting -#' -#' @description -#' Plots an object that inherits from class \code{\link{ParameterSet}}. -#' -#' @param x The object that inherits from \code{\link{ParameterSet}}. -#' @param y Not available for this kind of plot (is only defined to be compatible to the generic plot function). -#' @param main The main title. -#' @param xlab The x-axis label. -#' @param ylab The y-axis label. -#' @param type The plot type (default = 1). -#' @inheritParams param_palette -#' @inheritParams param_showSource -#' @inheritParams param_plotSettings -#' @inheritParams param_legendPosition -#' @inheritParams param_three_dots_plot -#' -#' @details -#' Generic function to plot a parameter set. -#' -#' @template return_object_ggplot -#' -#' @export -#' -plot.ParameterSetR6 <- function(x, y, ..., main = NA_character_, - xlab = NA_character_, ylab = NA_character_, type = 1L, palette = "Set1", - legendPosition = NA_integer_, showSource = FALSE, plotSettings = NULL) { - .assertGgplotIsInstalled() - - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, - "sorry, function 'plot' is not implemented yet for class '", .getClassName(x), "'" - ) -} diff --git a/R/class_core_plot_settings.R b/R/class_core_plot_settings.R index 8772948f..a4fdc5e1 100644 --- a/R/class_core_plot_settings.R +++ b/R/class_core_plot_settings.R @@ -18,71 +18,75 @@ ## | Last changed by: $Author: pahlke $ ## | -PlotSubTitleItem <- setRefClass("PlotSubTitleItem", - fields = list( - title = "character", - subscript = "character", - value = "numeric", - digits = "integer" - ), - methods = list( +PlotSubTitleItemR6 <- R6Class("PlotSubTitleItemR6", + public = list( + title = NULL, + subscript = NULL, + value = NULL, + digits = NULL, initialize = function(..., title, value, subscript = NA_character_, digits = 3L) { - callSuper( - title = trimws(title), value = value, - subscript = trimws(subscript), digits = digits, ... - ) - value <<- round(value, digits) + #callSuper( + # title = trimws(title), value = value, + # subscript = trimws(subscript), digits = digits, ... + #)#TODO + + self$title <- trimws(title) + self$value <- value + self$subscript <- trimws(subscript) + self$digits <- digits + + self$value <- round(value, digits) }, show = function() { - cat(toString(), "\n") + cat(self$toString(), "\n") }, toQuote = function() { - if (!is.null(subscript) && length(subscript) == 1 && !is.na(subscript)) { - return(bquote(" " * .(title)[.(subscript)] == .(value))) + if (!is.null(self$subscript) && length(self$subscript) == 1 && !is.na(self$subscript)) { + return(bquote(" " * .(self$title)[.(self$subscript)] == .(self$value))) } - return(bquote(" " * .(title) == .(value))) + return(bquote(" " * .(self$title) == .(self$value))) }, toString = function() { - if (!is.null(subscript) && length(subscript) == 1 && !is.na(subscript)) { - if (grepl("^(\\d+)|max|min$", subscript)) { - return(paste0(title, "_", subscript, " = ", value)) + if (!is.null(self$subscript) && length(self$subscript) == 1 && !is.na(self$subscript)) { + if (grepl("^(\\d+)|max|min$", self$subscript)) { + return(paste0(self$title, "_", self$subscript, " = ", self$value)) } - return(paste0(title, "(", trimws(subscript), ") = ", value)) + return(paste0(self$title, "(", trimws(self$subscript), ") = ", self$value)) } - return(paste(title, "=", value)) + return(paste(self$title, "=", self$value)) } ) ) -PlotSubTitleItems <- setRefClass("PlotSubTitleItems", - fields = list( - title = "character", - subtitle = "character", - items = "list" - ), - methods = list( - initialize = function(...) { - callSuper(...) - items <<- list() +PlotSubTitleItemsR6 <- R6Class("PlotSubTitleItemsR6", + public = list( + title = NULL, + subtitle = NULL, + items = NULL, + initialize = function(..., title = NULL, subtitle = NULL) { + self$title <- title + self$subtitle <- subtitle + + self$items <- list() }, show = function() { - cat(title, "\n") - if (length(subtitle) == 1 && !is.na(subtitle)) { - cat(subtitle, "\n") + cat(self$title, "\n") + if (length(self$subtitle) == 1 && !is.na(self$subtitle)) { + cat(self$subtitle, "\n") } - s <- toString() + s <- self$toString() if (length(s) == 1 && !is.na(s) && nchar(s) > 0) { cat(s, "\n") } }, addItem = function(item) { - items <<- c(items, item) + self$items <- c(self$items, item) }, add = function(title, value, subscript = NA_character_, ..., digits = 3L) { titleTemp <- title - if (length(items) == 0) { + if (length(self$items) == 0) { titleTemp <- .formatCamelCase(titleTemp, title = TRUE) } @@ -92,53 +96,53 @@ PlotSubTitleItems <- setRefClass("PlotSubTitleItems", } else { titleTemp <- paste0(titleTemp, " ") } - addItem(PlotSubTitleItem(title = titleTemp, value = value, subscript = subscript, digits = digits)) + self$addItem(PlotSubTitleItemR6$new(title = titleTemp, value = value, subscript = subscript, digits = digits)) }, toString = function() { - if (is.null(items) || length(items) == 0) { + if (is.null(self$items) || length(self$items) == 0) { return(NA_character_) } s <- character(0) - for (item in items) { + for (item in self$items) { s <- c(s, item$toString()) } return(paste0(s, collapse = ", ")) }, toHtml = function() { - htmlStr <- title - if (length(subtitle) == 1 && !is.na(subtitle)) { - htmlStr <- paste0(htmlStr, "
", subtitle, "") + htmlStr <- self$title + if (length(self$subtitle) == 1 && !is.na(self$subtitle)) { + htmlStr <- paste0(htmlStr, "
", self$subtitle, "") } - s <- toString() + s <- self$toString() if (length(s) == 1 && !is.na(s) && nchar(s) > 0) { htmlStr <- paste0(htmlStr, "
", s, "") } return(htmlStr) }, toQuote = function() { - quotedItems <- .getQuotedItems() + quotedItems <- self$.getQuotedItems() if (is.null(quotedItems)) { - if (length(subtitle) > 0) { + if (length(self$subtitle) > 0) { return(bquote(atop( - bold(.(title)), - atop(.(subtitle)) + bold(.(self$title)), + atop(.(self$subtitle)) ))) } - return(title) + return(self$title) } - if (length(subtitle) > 0) { + if (length(self$subtitle) > 0) { return(bquote(atop( - bold(.(title)), - atop(.(subtitle) * "," ~ .(quotedItems)) + bold(.(self$title)), + atop(.(self$subtitle) * "," ~ .(quotedItems)) ))) } return(bquote(atop( - bold(.(title)), - atop(.(quotedItems)) + bold(.(self$title)), + atop(.(self$quotedItems)) ))) }, .getQuotedItems = function() { @@ -146,17 +150,17 @@ PlotSubTitleItems <- setRefClass("PlotSubTitleItems", item2 <- NULL item3 <- NULL item4 <- NULL - if (length(items) > 0) { - item1 <- items[[1]] + if (length(self$items) > 0) { + item1 <- self$items[[1]] } - if (length(items) > 1) { - item2 <- items[[2]] + if (length(self$items) > 1) { + item2 <- self$items[[2]] } - if (length(items) > 2) { - item3 <- items[[3]] + if (length(self$items) > 2) { + item3 <- self$items[[3]] } - if (length(items) > 3) { - item4 <- items[[4]] + if (length(self$items) > 3) { + item4 <- self$items[[4]] } if (!is.null(item1) && !is.null(item2) && !is.null(item3) && !is.null(item4)) { @@ -223,6 +227,45 @@ PlotSubTitleItems <- setRefClass("PlotSubTitleItems", ) ) +#' +#' @title +#' Get Plot Settings +#' +#' @description +#' Returns a plot settings object. +#' +#' @param lineSize The line size, default is \code{0.8}. +#' @param pointSize The point size, default is \code{3}. +#' @param pointColor The point color (character), default is \code{NA_character_}. +#' @param mainTitleFontSize The main title font size, default is \code{14}. +#' @param axesTextFontSize The axes text font size, default is \code{10}. +#' @param legendFontSize The legend font size, default is \code{11}. +#' @param scalingFactor The scaling factor, default is \code{1}. +#' +#' @details +#' Returns an object of class \code{PlotSettings} that collects typical plot settings. +#' +#' @export +#' +#' @keywords internal +#' +getPlotSettings <- function(lineSize = 0.8, + pointSize = 3, + pointColor = NA_character_, + mainTitleFontSize = 14, + axesTextFontSize = 10, + legendFontSize = 11, + scalingFactor = 1) { + return(PlotSettingsR6$new( + lineSize = lineSize, + pointSize = pointSize, + pointColor = pointColor, + mainTitleFontSize = mainTitleFontSize, + axesTextFontSize = axesTextFontSize, + legendFontSize = legendFontSize, + scalingFactor = scalingFactor + )) +} #' #' @name PlotSettings @@ -250,25 +293,23 @@ PlotSubTitleItems <- setRefClass("PlotSubTitleItems", #' #' @importFrom methods new #' -PlotSettings <- setRefClass("PlotSettings", - contains = "ParameterSet", - fields = list( - .legendLineBreakIndex = "numeric", - .pointSize = "numeric", - .legendFontSize = "numeric", - .htmlTitle = "character", - .scalingEnabled = "logical", - .pointScalingCorrectionEnabled = "logical", - .pointBorderEnabled = "logical", - lineSize = "numeric", - pointSize = "numeric", - pointColor = "character", - mainTitleFontSize = "numeric", - axesTextFontSize = "numeric", - legendFontSize = "numeric", - scalingFactor = "numeric" - ), - methods = list( +PlotSettingsR6 <- R6Class("PlotSettingsR6", + inherit = ParameterSetR6, + public = list( + .legendLineBreakIndex = NULL, + .pointSize = NULL, + .legendFontSize = NULL, + .htmlTitle = NULL, + .scalingEnabled = NULL, + .pointScalingCorrectionEnabled = NULL, + .pointBorderEnabled = NULL, + lineSize = NULL, + pointSize = NULL, + pointColor = NULL, + mainTitleFontSize = NULL, + axesTextFontSize = NULL, + legendFontSize = NULL, + scalingFactor = NULL, initialize = function(lineSize = 0.8, pointSize = 3, pointColor = NA_character_, @@ -277,25 +318,35 @@ PlotSettings <- setRefClass("PlotSettings", legendFontSize = 11, scalingFactor = 1, ...) { - callSuper( - lineSize = lineSize, - pointSize = pointSize, - pointColor = pointColor, - mainTitleFontSize = mainTitleFontSize, - axesTextFontSize = axesTextFontSize, - legendFontSize = legendFontSize, - scalingFactor = scalingFactor, - ... - ) - .legendLineBreakIndex <<- 15 - .pointSize <<- pointSize - .legendFontSize <<- legendFontSize - .htmlTitle <<- NA_character_ - .scalingEnabled <<- TRUE - .pointScalingCorrectionEnabled <<- TRUE - .pointBorderEnabled <<- TRUE - - .parameterNames <<- list( + #callSuper( + # lineSize = lineSize, + # pointSize = pointSize, + # pointColor = pointColor, + # mainTitleFontSize = mainTitleFontSize, + # axesTextFontSize = axesTextFontSize, + # legendFontSize = legendFontSize, + # scalingFactor = scalingFactor, + # ... + #)#TODO + + super$initialize() + self$lineSize <- lineSize + self$pointSize <- pointSize + self$pointColor <- pointColor + self$mainTitleFontSize <- mainTitleFontSize + self$axesTextFontSize <- axesTextFontSize + self$legendFontSize <- legendFontSize + self$scalingFactor <- scalingFactor + + self$.legendLineBreakIndex <- 15 + self$.pointSize <- pointSize + self$.legendFontSize <- legendFontSize + self$.htmlTitle <- NA_character_ + self$.scalingEnabled <- TRUE + self$.pointScalingCorrectionEnabled <- TRUE + self$.pointBorderEnabled <- TRUE + + self$.parameterNames <- list( "lineSize" = "Line size", "pointSize" = "Point size", "pointColor" = "Point color", @@ -305,25 +356,25 @@ PlotSettings <- setRefClass("PlotSettings", "scalingFactor" = "Scaling factor" ) }, - clone = function() { - return(PlotSettings( - lineSize = .self$lineSize, - pointSize = .self$pointSize, - pointColor = .self$pointColor, - mainTitleFontSize = .self$mainTitleFontSize, - axesTextFontSize = .self$axesTextFontSize, - legendFontSize = .self$legendFontSize, - scalingFactor = .self$scalingFactor - )) - }, + #clone = function() { + # return(PlotSettingsR6$new( + # lineSize = self$lineSize, + # pointSize = self$pointSize, + # pointColor = self$pointColor, + # mainTitleFontSize = self$mainTitleFontSize, + # axesTextFontSize = self$axesTextFontSize, + # legendFontSize = self$legendFontSize, + # scalingFactor = self$scalingFactor + # )) + #},#TODO show = function(showType = 1, digits = NA_integer_) { - .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) }, .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { "Method for automatically printing plot setting objects" - .resetCat() - .showParametersOfOneGroup( - parameters = .getVisibleFieldNames(), + self$.resetCat() + self$.showParametersOfOneGroup( + parameters = self$.getVisibleFieldNames(), title = "Plot settings", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled ) @@ -367,15 +418,15 @@ PlotSettings <- setRefClass("PlotSettings", }, enlargeAxisTicks = function(p) { "Enlarges the axis ticks" - p <- p + ggplot2::theme(axis.ticks.length = ggplot2::unit(scaleSize(0.3), "cm")) + p <- p + ggplot2::theme(axis.ticks.length = ggplot2::unit(self$scaleSize(0.3), "cm")) return(p) }, setAxesAppearance = function(p) { "Sets the font size and face of the axes titles and texts" - p <- p + ggplot2::theme(axis.title.x = ggplot2::element_text(size = scaleSize(.self$axesTextFontSize + 1), face = "bold")) - p <- p + ggplot2::theme(axis.title.y = ggplot2::element_text(size = scaleSize(.self$axesTextFontSize + 1), face = "bold")) - p <- p + ggplot2::theme(axis.text.x = ggplot2::element_text(size = scaleSize(.self$axesTextFontSize))) - p <- p + ggplot2::theme(axis.text.y = ggplot2::element_text(size = scaleSize(.self$axesTextFontSize))) + p <- p + ggplot2::theme(axis.title.x = ggplot2::element_text(size = self$scaleSize(self$axesTextFontSize + 1), face = "bold")) + p <- p + ggplot2::theme(axis.title.y = ggplot2::element_text(size = self$scaleSize(self$axesTextFontSize + 1), face = "bold")) + p <- p + ggplot2::theme(axis.text.x = ggplot2::element_text(size = self$scaleSize(self$axesTextFontSize))) + p <- p + ggplot2::theme(axis.text.y = ggplot2::element_text(size = self$scaleSize(self$axesTextFontSize))) return(p) }, @@ -409,7 +460,7 @@ PlotSettings <- setRefClass("PlotSettings", } p <- p + ggplot2::ylab(yAxisLabel1) - p <- setSecondYAxisOnRightSide(p, yAxisLabel1, yAxisLabel2, scalingFactor1, scalingFactor2) + p <- self$setSecondYAxisOnRightSide(p, yAxisLabel1, yAxisLabel2, scalingFactor1, scalingFactor2) return(p) }, @@ -427,15 +478,15 @@ PlotSettings <- setRefClass("PlotSettings", if (!is.null(legendTitle) && !is.na(legendTitle) && trimws(legendTitle) != "") { if (mode == "colour") { p <- p + ggplot2::labs(colour = .getTextLineWithLineBreak(legendTitle, - lineBreakIndex = scaleSize(.legendLineBreakIndex) + lineBreakIndex = self$scaleSize(self$.legendLineBreakIndex) )) } else { p <- p + ggplot2::labs(fill = .getTextLineWithLineBreak(legendTitle, - lineBreakIndex = scaleSize(.legendLineBreakIndex) + lineBreakIndex = self$scaleSize(self$.legendLineBreakIndex) )) } p <- p + ggplot2::theme(legend.title = ggplot2::element_text( - colour = "black", size = scaleSize(.self$legendFontSize + 1), face = "bold" + colour = "black", size = self$scaleSize(self$legendFontSize + 1), face = "bold" )) } else { p <- p + ggplot2::theme(legend.title = ggplot2::element_blank()) @@ -444,7 +495,7 @@ PlotSettings <- setRefClass("PlotSettings", return(p) }, setLegendLabelSize = function(p) { - p <- p + ggplot2::theme(legend.text = ggplot2::element_text(size = scaleSize(.self$legendFontSize))) + p <- p + ggplot2::theme(legend.text = ggplot2::element_text(size = self$scaleSize(self$legendFontSize))) return(p) }, setLegendPosition = function(p, legendPosition) { @@ -484,46 +535,46 @@ PlotSettings <- setRefClass("PlotSettings", if (packageVersion("ggplot2") >= "3.4.0") { p <- p + ggplot2::theme( legend.background = - ggplot2::element_rect(fill = "white", colour = "black", linewidth = scaleSize(0.4)) + ggplot2::element_rect(fill = "white", colour = "black", linewidth = self$scaleSize(0.4)) ) } else { p <- p + ggplot2::theme( legend.background = - ggplot2::element_rect(fill = "white", colour = "black", size = scaleSize(0.4)) + ggplot2::element_rect(fill = "white", colour = "black", size = self$scaleSize(0.4)) ) } return(p) }, adjustPointSize = function(adjustingValue) { .assertIsInClosedInterval(adjustingValue, "adjustingValue", lower = 0.1, upper = 2) - pointSize <<- .self$.pointSize * adjustingValue + self$pointSize <- self$.pointSize * adjustingValue }, adjustLegendFontSize = function(adjustingValue) { "Adjusts the legend font size, e.g., run \\cr \\code{adjustLegendFontSize(-2)} # makes the font size 2 points smaller" .assertIsInClosedInterval(adjustingValue, "adjustingValue", lower = 0.1, upper = 2) - legendFontSize <<- .self$.legendFontSize * adjustingValue + self$legendFontSize <- self$.legendFontSize * adjustingValue }, scaleSize = function(size, pointEnabled = FALSE) { - if (isFALSE(.self$.scalingEnabled)) { + if (isFALSE(self$.scalingEnabled)) { return(size) } if (pointEnabled) { - if (isFALSE(.pointScalingCorrectionEnabled)) { + if (isFALSE(self$.pointScalingCorrectionEnabled)) { return(size) } - return(size * .self$scalingFactor^2) + return(size * self$scalingFactor^2) } - return(size * .self$scalingFactor) + return(size * self$scalingFactor) }, setMainTitle = function(p, mainTitle, subtitle = NA_character_) { "Sets the main title" caption <- NA_character_ - if (!is.null(mainTitle) && inherits(mainTitle, "PlotSubTitleItems")) { + if (!is.null(mainTitle) && (inherits(mainTitle, "PlotSubTitleItems") || inherits(mainTitle, "PlotSubTitleItemsR6"))) { plotLabsType <- getOption("rpact.plot.labs.type", "quote") if (plotLabsType == "quote") { mainTitle <- mainTitle$toQuote() @@ -552,7 +603,7 @@ PlotSettings <- setRefClass("PlotSettings", } if (plotLabsType == "html") { - .htmlTitle <<- items$toHtml() + self$.htmlTitle <- items$toHtml() } } } @@ -565,8 +616,8 @@ PlotSettings <- setRefClass("PlotSettings", p <- p + ggplot2::labs(title = mainTitle, subtitle = subtitle, caption = caption) targetWidth <- 130 subtitleFontSize <- targetWidth / nchar(subtitle) * 8 - if (subtitleFontSize > scaleSize(.self$mainTitleFontSize) - 2) { - subtitleFontSize <- scaleSize(.self$mainTitleFontSize) - 2 + if (subtitleFontSize > self$scaleSize(self$mainTitleFontSize) - 2) { + subtitleFontSize <- self$scaleSize(self$mainTitleFontSize) - 2 } } else if (length(caption) == 1 && !is.na(caption)) { p <- p + ggplot2::labs(title = mainTitle, caption = caption) @@ -575,14 +626,14 @@ PlotSettings <- setRefClass("PlotSettings", } p <- p + ggplot2::theme(plot.title = ggplot2::element_text( - hjust = 0.5, size = scaleSize(.self$mainTitleFontSize), face = "bold" + hjust = 0.5, size = self$scaleSize(self$mainTitleFontSize), face = "bold" )) if (!is.na(subtitleFontSize)) { p <- p + ggplot2::theme( plot.subtitle = ggplot2::element_text( hjust = 0.5, - size = scaleSize(subtitleFontSize) + size = self$scaleSize(subtitleFontSize) ) ) } @@ -634,11 +685,11 @@ PlotSettings <- setRefClass("PlotSettings", }, plotPoints = function(p, pointBorder, ..., mapping = NULL) { # plot white border around the points - if (pointBorder > 0 && .pointBorderEnabled) { + if (pointBorder > 0 && self$.pointBorderEnabled) { p <- p + ggplot2::geom_point( mapping = mapping, color = "white", - size = scaleSize(.self$pointSize, TRUE), + size = self$scaleSize(self$pointSize, TRUE), alpha = 1, shape = 21, stroke = pointBorder / 2.25, @@ -646,11 +697,11 @@ PlotSettings <- setRefClass("PlotSettings", ) } - if (!is.null(.self$pointColor) && length(.self$pointColor) == 1 && !is.na(.self$pointColor)) { + if (!is.null(self$pointColor) && length(self$pointColor) == 1 && !is.na(self$pointColor)) { p <- p + ggplot2::geom_point( mapping = mapping, - color = .self$pointColor, - size = scaleSize(.self$pointSize, TRUE), + color = self$pointColor, + size = self$scaleSize(self$pointSize, TRUE), alpha = 1, shape = 19, show.legend = FALSE @@ -658,7 +709,7 @@ PlotSettings <- setRefClass("PlotSettings", } else { p <- p + ggplot2::geom_point( mapping = mapping, - size = scaleSize(.self$pointSize, TRUE), alpha = 1, + size = self$scaleSize(self$pointSize, TRUE), alpha = 1, shape = 19, show.legend = FALSE ) } @@ -668,13 +719,13 @@ PlotSettings <- setRefClass("PlotSettings", plotPointsEnabled = TRUE, pointBorder = 4) { if (plotLineEnabled) { if (packageVersion("ggplot2") >= "3.4.0") { - p <- p + ggplot2::geom_line(linewidth = scaleSize(.self$lineSize)) + p <- p + ggplot2::geom_line(linewidth = self$scaleSize(self$lineSize)) } else { - p <- p + ggplot2::geom_line(size = scaleSize(.self$lineSize)) + p <- p + ggplot2::geom_line(size = self$scaleSize(self$lineSize)) } } if (plotPointsEnabled) { - p <- plotPoints(p, pointBorder) + p <- self$plotPoints(p, pointBorder) } return(p) }, @@ -682,13 +733,13 @@ PlotSettings <- setRefClass("PlotSettings", plotPointsEnabled = TRUE, pointBorder = 4) { if (plotLineEnabled) { if (packageVersion("ggplot2") >= "3.4.0") { - p <- p + ggplot2::geom_line(ggplot2::aes(y = -yValues), linewidth = scaleSize(.self$lineSize)) + p <- p + ggplot2::geom_line(ggplot2::aes(y = -yValues), linewidth = self$scaleSize(self$lineSize)) } else { - p <- p + ggplot2::geom_line(ggplot2::aes(y = -yValues), size = scaleSize(.self$lineSize)) + p <- p + ggplot2::geom_line(ggplot2::aes(y = -yValues), size = self$scaleSize(self$lineSize)) } } if (plotPointsEnabled) { - p <- plotPoints(p, pointBorder, mapping = ggplot2::aes(y = -yValues)) + p <- self$plotPoints(p, pointBorder, mapping = ggplot2::aes(y = -yValues)) } return(p) }, @@ -700,12 +751,12 @@ PlotSettings <- setRefClass("PlotSettings", label <- "www.rpact.org" p <- p + ggplot2::annotate("label", x = -Inf, y = Inf, hjust = -0.1, vjust = 1, - label = label, size = scaleSize(2.8), colour = "white", fill = "white" + label = label, size = self$scaleSize(2.8), colour = "white", fill = "white" ) p <- p + ggplot2::annotate("text", x = -Inf, y = Inf, label = label, - hjust = -.12, vjust = 1, colour = "lightgray", size = scaleSize(2.7) + hjust = -.12, vjust = 1, colour = "lightgray", size = self$scaleSize(2.7) ) return(p) } diff --git a/R/class_core_plot_settings_r6.R b/R/class_core_plot_settings_r6.R deleted file mode 100644 index a4fdc5e1..00000000 --- a/R/class_core_plot_settings_r6.R +++ /dev/null @@ -1,764 +0,0 @@ -## | -## | *Plot setting classes* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | rpact package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File version: $Revision: 7126 $ -## | Last changed: $Date: 2023-06-23 14:26:39 +0200 (Fr, 23 Jun 2023) $ -## | Last changed by: $Author: pahlke $ -## | - -PlotSubTitleItemR6 <- R6Class("PlotSubTitleItemR6", - public = list( - title = NULL, - subscript = NULL, - value = NULL, - digits = NULL, - initialize = function(..., title, value, subscript = NA_character_, digits = 3L) { - #callSuper( - # title = trimws(title), value = value, - # subscript = trimws(subscript), digits = digits, ... - #)#TODO - - self$title <- trimws(title) - self$value <- value - self$subscript <- trimws(subscript) - self$digits <- digits - - self$value <- round(value, digits) - }, - show = function() { - cat(self$toString(), "\n") - }, - toQuote = function() { - if (!is.null(self$subscript) && length(self$subscript) == 1 && !is.na(self$subscript)) { - return(bquote(" " * .(self$title)[.(self$subscript)] == .(self$value))) - } - - return(bquote(" " * .(self$title) == .(self$value))) - }, - toString = function() { - if (!is.null(self$subscript) && length(self$subscript) == 1 && !is.na(self$subscript)) { - if (grepl("^(\\d+)|max|min$", self$subscript)) { - return(paste0(self$title, "_", self$subscript, " = ", self$value)) - } - return(paste0(self$title, "(", trimws(self$subscript), ") = ", self$value)) - } - - return(paste(self$title, "=", self$value)) - } - ) -) - -PlotSubTitleItemsR6 <- R6Class("PlotSubTitleItemsR6", - public = list( - title = NULL, - subtitle = NULL, - items = NULL, - initialize = function(..., title = NULL, subtitle = NULL) { - self$title <- title - self$subtitle <- subtitle - - self$items <- list() - }, - show = function() { - cat(self$title, "\n") - if (length(self$subtitle) == 1 && !is.na(self$subtitle)) { - cat(self$subtitle, "\n") - } - s <- self$toString() - if (length(s) == 1 && !is.na(s) && nchar(s) > 0) { - cat(s, "\n") - } - }, - addItem = function(item) { - self$items <- c(self$items, item) - }, - add = function(title, value, subscript = NA_character_, ..., digits = 3L) { - titleTemp <- title - if (length(self$items) == 0) { - titleTemp <- .formatCamelCase(titleTemp, title = TRUE) - } - - titleTemp <- paste0(" ", titleTemp) - if (length(subscript) == 1 && !is.na(subscript)) { - subscript <- paste0(as.character(subscript), " ") - } else { - titleTemp <- paste0(titleTemp, " ") - } - self$addItem(PlotSubTitleItemR6$new(title = titleTemp, value = value, subscript = subscript, digits = digits)) - }, - toString = function() { - if (is.null(self$items) || length(self$items) == 0) { - return(NA_character_) - } - - s <- character(0) - for (item in self$items) { - s <- c(s, item$toString()) - } - return(paste0(s, collapse = ", ")) - }, - toHtml = function() { - htmlStr <- self$title - if (length(self$subtitle) == 1 && !is.na(self$subtitle)) { - htmlStr <- paste0(htmlStr, "
", self$subtitle, "") - } - s <- self$toString() - if (length(s) == 1 && !is.na(s) && nchar(s) > 0) { - htmlStr <- paste0(htmlStr, "
", s, "") - } - return(htmlStr) - }, - toQuote = function() { - quotedItems <- self$.getQuotedItems() - if (is.null(quotedItems)) { - if (length(self$subtitle) > 0) { - return(bquote(atop( - bold(.(self$title)), - atop(.(self$subtitle)) - ))) - } - - return(self$title) - } - - if (length(self$subtitle) > 0) { - return(bquote(atop( - bold(.(self$title)), - atop(.(self$subtitle) * "," ~ .(quotedItems)) - ))) - } - - return(bquote(atop( - bold(.(self$title)), - atop(.(self$quotedItems)) - ))) - }, - .getQuotedItems = function() { - item1 <- NULL - item2 <- NULL - item3 <- NULL - item4 <- NULL - if (length(self$items) > 0) { - item1 <- self$items[[1]] - } - if (length(self$items) > 1) { - item2 <- self$items[[2]] - } - if (length(self$items) > 2) { - item3 <- self$items[[3]] - } - if (length(self$items) > 3) { - item4 <- self$items[[4]] - } - - if (!is.null(item1) && !is.null(item2) && !is.null(item3) && !is.null(item4)) { - if (length(item1$subscript) == 1 && !is.na(item1$subscript) && - length(item2$subscript) == 1 && !is.na(item2$subscript)) { - return(bquote(" " * .(item1$title)[.(item1$subscript)] == .(item1$value) * "," ~ .(item2$title)[.(item2$subscript)] == .(item2$value) * "," ~ .(item3$title) == .(item3$value) * "," ~ .(item4$title) == .(item4$value) * "")) - } - - if (length(item1$subscript) == 1 && !is.na(item1$subscript)) { - return(bquote(" " * .(item1$title)[.(item1$subscript)] == .(item1$value) * "," ~ .(item2$title) == .(item2$value) * "," ~ .(item3$title) == .(item3$value) * "," ~ .(item4$title) == .(item4$value) * "")) - } - - if (length(item2$subscript) == 1 && !is.na(item2$subscript)) { - return(bquote(" " * .(item1$title) == .(item1$value) * "," ~ .(item2$title)[.(item2$subscript)] == .(item2$value) * "," ~ .(item3$title) == .(item3$value) * "," ~ .(item4$title) == .(item4$value) * "")) - } - - return(bquote(" " * .(item1$title) == .(item1$value) * "," ~ .(item2$title) == .(item2$value) * "," ~ .(item3$title) == .(item3$value) * "," ~ .(item4$title) == .(item4$value) * "")) - } - - if (!is.null(item1) && !is.null(item2) && !is.null(item3)) { - if (length(item1$subscript) == 1 && !is.na(item1$subscript) && - length(item2$subscript) == 1 && !is.na(item2$subscript)) { - return(bquote(" " * .(item1$title)[.(item1$subscript)] == .(item1$value) * "," ~ .(item2$title)[.(item2$subscript)] == .(item2$value) * "," ~ .(item3$title) == .(item3$value) * "")) - } - - if (length(item1$subscript) == 1 && !is.na(item1$subscript)) { - return(bquote(" " * .(item1$title)[.(item1$subscript)] == .(item1$value) * "," ~ .(item2$title) == .(item2$value) * "," ~ .(item3$title) == .(item3$value) * "")) - } - - if (length(item2$subscript) == 1 && !is.na(item2$subscript)) { - return(bquote(" " * .(item1$title) == .(item1$value) * "," ~ .(item2$title)[.(item2$subscript)] == .(item2$value) * "," ~ .(item3$title) == .(item3$value) * "")) - } - - return(bquote(" " * .(item1$title) == .(item1$value) * "," ~ .(item2$title) == .(item2$value) * "," ~ .(item3$title) == .(item3$value) * "")) - } - - if (!is.null(item1) && !is.null(item2)) { - if (length(item1$subscript) == 1 && !is.na(item1$subscript) && - length(item2$subscript) == 1 && !is.na(item2$subscript)) { - return(bquote(" " * .(item1$title)[.(item1$subscript)] == .(item1$value) * "," ~ .(item2$title)[.(item2$subscript)] == .(item2$value) * "")) - } - - if (length(item1$subscript) == 1 && !is.na(item1$subscript)) { - return(bquote(" " * .(item1$title)[.(item1$subscript)] == .(item1$value) * "," ~ .(item2$title) == .(item2$value) * "")) - } - - if (length(item2$subscript) == 1 && !is.na(item2$subscript)) { - return(bquote(" " * .(item1$title) == .(item1$value) * "," ~ .(item2$title)[.(item2$subscript)] == .(item2$value) * "")) - } - - return(bquote(" " * .(item1$title) == .(item1$value) * "," ~ .(item2$title) == .(item2$value) * "")) - } - - if (!is.null(item1)) { - if (length(item1$subscript) == 1 && !is.na(item1$subscript)) { - return(bquote(" " * .(item1$title)[.(item1$subscript)] == .(item1$value) * "")) - } - - return(bquote(" " * .(item1$title) == .(item1$value) * "")) - } - - return(NULL) - } - ) -) - -#' -#' @title -#' Get Plot Settings -#' -#' @description -#' Returns a plot settings object. -#' -#' @param lineSize The line size, default is \code{0.8}. -#' @param pointSize The point size, default is \code{3}. -#' @param pointColor The point color (character), default is \code{NA_character_}. -#' @param mainTitleFontSize The main title font size, default is \code{14}. -#' @param axesTextFontSize The axes text font size, default is \code{10}. -#' @param legendFontSize The legend font size, default is \code{11}. -#' @param scalingFactor The scaling factor, default is \code{1}. -#' -#' @details -#' Returns an object of class \code{PlotSettings} that collects typical plot settings. -#' -#' @export -#' -#' @keywords internal -#' -getPlotSettings <- function(lineSize = 0.8, - pointSize = 3, - pointColor = NA_character_, - mainTitleFontSize = 14, - axesTextFontSize = 10, - legendFontSize = 11, - scalingFactor = 1) { - return(PlotSettingsR6$new( - lineSize = lineSize, - pointSize = pointSize, - pointColor = pointColor, - mainTitleFontSize = mainTitleFontSize, - axesTextFontSize = axesTextFontSize, - legendFontSize = legendFontSize, - scalingFactor = scalingFactor - )) -} - -#' -#' @name PlotSettings -#' -#' @title -#' Plot Settings -#' -#' @description -#' Class for plot settings. -#' -#' @field lineSize The line size. -#' @field pointSize The point size. -#' @field pointColor The point color, e.g., "red" or "blue". -#' @field mainTitleFontSize The main tile font size. -#' @field axesTextFontSize The text font size. -#' @field legendFontSize The legend font size. -#' @field scalingFactor The scaling factor. -#' -#' @details -#' Collects typical plot settings in an object. -#' -#' @keywords internal -#' -#' @include class_core_parameter_set.R -#' -#' @importFrom methods new -#' -PlotSettingsR6 <- R6Class("PlotSettingsR6", - inherit = ParameterSetR6, - public = list( - .legendLineBreakIndex = NULL, - .pointSize = NULL, - .legendFontSize = NULL, - .htmlTitle = NULL, - .scalingEnabled = NULL, - .pointScalingCorrectionEnabled = NULL, - .pointBorderEnabled = NULL, - lineSize = NULL, - pointSize = NULL, - pointColor = NULL, - mainTitleFontSize = NULL, - axesTextFontSize = NULL, - legendFontSize = NULL, - scalingFactor = NULL, - initialize = function(lineSize = 0.8, - pointSize = 3, - pointColor = NA_character_, - mainTitleFontSize = 14, - axesTextFontSize = 10, - legendFontSize = 11, - scalingFactor = 1, - ...) { - #callSuper( - # lineSize = lineSize, - # pointSize = pointSize, - # pointColor = pointColor, - # mainTitleFontSize = mainTitleFontSize, - # axesTextFontSize = axesTextFontSize, - # legendFontSize = legendFontSize, - # scalingFactor = scalingFactor, - # ... - #)#TODO - - super$initialize() - self$lineSize <- lineSize - self$pointSize <- pointSize - self$pointColor <- pointColor - self$mainTitleFontSize <- mainTitleFontSize - self$axesTextFontSize <- axesTextFontSize - self$legendFontSize <- legendFontSize - self$scalingFactor <- scalingFactor - - self$.legendLineBreakIndex <- 15 - self$.pointSize <- pointSize - self$.legendFontSize <- legendFontSize - self$.htmlTitle <- NA_character_ - self$.scalingEnabled <- TRUE - self$.pointScalingCorrectionEnabled <- TRUE - self$.pointBorderEnabled <- TRUE - - self$.parameterNames <- list( - "lineSize" = "Line size", - "pointSize" = "Point size", - "pointColor" = "Point color", - "mainTitleFontSize" = "Main title font size", - "axesTextFontSize" = "Axes text font size", - "legendFontSize" = "Legend font size", - "scalingFactor" = "Scaling factor" - ) - }, - #clone = function() { - # return(PlotSettingsR6$new( - # lineSize = self$lineSize, - # pointSize = self$pointSize, - # pointColor = self$pointColor, - # mainTitleFontSize = self$mainTitleFontSize, - # axesTextFontSize = self$axesTextFontSize, - # legendFontSize = self$legendFontSize, - # scalingFactor = self$scalingFactor - # )) - #},#TODO - show = function(showType = 1, digits = NA_integer_) { - self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) - }, - .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { - "Method for automatically printing plot setting objects" - self$.resetCat() - self$.showParametersOfOneGroup( - parameters = self$.getVisibleFieldNames(), - title = "Plot settings", orderByParameterName = FALSE, - consoleOutputEnabled = consoleOutputEnabled - ) - }, - setColorPalette = function(p, palette, mode = c("colour", "fill", "all")) { - "Sets the color palette" - - mode <- match.arg(mode) - - # l = 45: make colors slightly darker - if (is.null(palette) || is.na(palette)) { - if (mode %in% c("colour", "all")) { - p <- p + ggplot2::scale_colour_hue(l = 45) - } - if (mode %in% c("fill", "all")) { - p <- p + ggplot2::scale_fill_hue(l = 45) - } - } else if (is.character(palette)) { - if (mode %in% c("colour", "all")) { - p <- p + ggplot2::scale_colour_brewer(palette = palette) - } - if (mode %in% c("fill", "all")) { - p <- p + ggplot2::scale_fill_brewer(palette = palette) - } - } else if (palette == 0) { - if (mode %in% c("colour", "all")) { - p <- p + ggplot2::scale_colour_grey() - } - if (mode %in% c("fill", "all")) { - p <- p + ggplot2::scale_fill_grey() - } - } else { - if (mode %in% c("colour", "all")) { - p <- p + ggplot2::scale_colour_hue(l = 45) - } - if (mode %in% c("fill", "all")) { - p <- p + ggplot2::scale_fill_hue(l = 45) - } - } - return(p) - }, - enlargeAxisTicks = function(p) { - "Enlarges the axis ticks" - p <- p + ggplot2::theme(axis.ticks.length = ggplot2::unit(self$scaleSize(0.3), "cm")) - return(p) - }, - setAxesAppearance = function(p) { - "Sets the font size and face of the axes titles and texts" - p <- p + ggplot2::theme(axis.title.x = ggplot2::element_text(size = self$scaleSize(self$axesTextFontSize + 1), face = "bold")) - p <- p + ggplot2::theme(axis.title.y = ggplot2::element_text(size = self$scaleSize(self$axesTextFontSize + 1), face = "bold")) - p <- p + ggplot2::theme(axis.text.x = ggplot2::element_text(size = self$scaleSize(self$axesTextFontSize))) - p <- p + ggplot2::theme(axis.text.y = ggplot2::element_text(size = self$scaleSize(self$axesTextFontSize))) - return(p) - }, - - # Sets the axes labels - setAxesLabels = function(p, xAxisLabel = NULL, yAxisLabel1 = NULL, yAxisLabel2 = NULL, - xlab = NA_character_, ylab = NA_character_, - scalingFactor1 = 1, scalingFactor2 = 1) { - if (is.null(xAxisLabel) && !is.na(xlab)) { - xAxisLabel <- xlab - } - - plotLabsType <- getOption("rpact.plot.labs.type", "quote") - if (plotLabsType == "quote" && !is.null(xAxisLabel)) { - if (xAxisLabel == "Theta") { - xAxisLabel <- bquote(bold("Theta" ~ Theta)) - } else if (xAxisLabel == "pi1") { - xAxisLabel <- bquote(bold("pi"["1"])) - } else if (xAxisLabel == "pi2") { - xAxisLabel <- bbquote(bold("pi"["2"])) - } else if (xAxisLabel == "Theta") { - xAxisLabel <- bquote(bold("Theta" ~ Theta)) - } - } - - p <- p + ggplot2::xlab(xAxisLabel) - if (sum(is.na(ylab)) == 0) { - yAxisLabel1 <- ylab[1] - if (length(ylab) == 2) { - yAxisLabel2 <- ylab[2] - } - } - p <- p + ggplot2::ylab(yAxisLabel1) - - p <- self$setSecondYAxisOnRightSide(p, yAxisLabel1, yAxisLabel2, scalingFactor1, scalingFactor2) - - return(p) - }, - setSecondYAxisOnRightSide = function(p, yAxisLabel1, yAxisLabel2, scalingFactor1 = 1, scalingFactor2 = 1) { - if (!is.null(yAxisLabel2) && scalingFactor1 != scalingFactor2) { - p <- p + ggplot2::scale_y_continuous(yAxisLabel1, - sec.axis = ggplot2::sec_axis(~ . * scalingFactor1 / scalingFactor2, name = yAxisLabel2) - ) - } - return(p) - }, - setLegendTitle = function(p, legendTitle, mode = c("colour", "fill")) { - mode <- match.arg(mode) - - if (!is.null(legendTitle) && !is.na(legendTitle) && trimws(legendTitle) != "") { - if (mode == "colour") { - p <- p + ggplot2::labs(colour = .getTextLineWithLineBreak(legendTitle, - lineBreakIndex = self$scaleSize(self$.legendLineBreakIndex) - )) - } else { - p <- p + ggplot2::labs(fill = .getTextLineWithLineBreak(legendTitle, - lineBreakIndex = self$scaleSize(self$.legendLineBreakIndex) - )) - } - p <- p + ggplot2::theme(legend.title = ggplot2::element_text( - colour = "black", size = self$scaleSize(self$legendFontSize + 1), face = "bold" - )) - } else { - p <- p + ggplot2::theme(legend.title = ggplot2::element_blank()) - p <- p + ggplot2::labs(colour = NULL) - } - return(p) - }, - setLegendLabelSize = function(p) { - p <- p + ggplot2::theme(legend.text = ggplot2::element_text(size = self$scaleSize(self$legendFontSize))) - return(p) - }, - setLegendPosition = function(p, legendPosition) { - .assertIsValidLegendPosition(legendPosition) - - switch(as.character(legendPosition), - "-1" = { - p <- p + ggplot2::theme(legend.position = "none") - }, - "0" = { - p <- p + ggplot2::theme(aspect.ratio = 1) - }, - "1" = { - p <- p + ggplot2::theme(legend.position = c(0.05, 1), legend.justification = c(0, 1)) - }, - "2" = { - p <- p + ggplot2::theme(legend.position = c(0.05, 0.5), legend.justification = c(0, 0.5)) - }, - "3" = { - p <- p + ggplot2::theme(legend.position = c(0.05, 0.05), legend.justification = c(0, 0)) - }, - "4" = { - p <- p + ggplot2::theme(legend.position = c(0.95, 1), legend.justification = c(1, 1)) - }, - "5" = { - p <- p + ggplot2::theme(legend.position = c(0.95, 0.5), legend.justification = c(1, 0.5)) - }, - "6" = { - p <- p + ggplot2::theme(legend.position = c(0.95, 0.05), legend.justification = c(1, 0)) - } - ) - - return(p) - }, - setLegendBorder = function(p) { - "Sets the legend border" - if (packageVersion("ggplot2") >= "3.4.0") { - p <- p + ggplot2::theme( - legend.background = - ggplot2::element_rect(fill = "white", colour = "black", linewidth = self$scaleSize(0.4)) - ) - } else { - p <- p + ggplot2::theme( - legend.background = - ggplot2::element_rect(fill = "white", colour = "black", size = self$scaleSize(0.4)) - ) - } - return(p) - }, - adjustPointSize = function(adjustingValue) { - .assertIsInClosedInterval(adjustingValue, "adjustingValue", lower = 0.1, upper = 2) - self$pointSize <- self$.pointSize * adjustingValue - }, - adjustLegendFontSize = function(adjustingValue) { - "Adjusts the legend font size, e.g., run \\cr - \\code{adjustLegendFontSize(-2)} # makes the font size 2 points smaller" - .assertIsInClosedInterval(adjustingValue, "adjustingValue", lower = 0.1, upper = 2) - self$legendFontSize <- self$.legendFontSize * adjustingValue - }, - scaleSize = function(size, pointEnabled = FALSE) { - if (isFALSE(self$.scalingEnabled)) { - return(size) - } - - if (pointEnabled) { - if (isFALSE(self$.pointScalingCorrectionEnabled)) { - return(size) - } - - return(size * self$scalingFactor^2) - } - - return(size * self$scalingFactor) - }, - setMainTitle = function(p, mainTitle, subtitle = NA_character_) { - "Sets the main title" - - caption <- NA_character_ - if (!is.null(mainTitle) && (inherits(mainTitle, "PlotSubTitleItems") || inherits(mainTitle, "PlotSubTitleItemsR6"))) { - plotLabsType <- getOption("rpact.plot.labs.type", "quote") - if (plotLabsType == "quote") { - mainTitle <- mainTitle$toQuote() - } else { - items <- mainTitle - mainTitle <- items$title - if (length(items$subtitle) == 1 && !is.na(items$subtitle)) { - if (length(subtitle) == 1 && !is.na(subtitle)) { - subtitle <- paste0(subtitle, ", ", items$subtitle) - } else { - subtitle <- items$subtitle - } - } - s <- items$toString() - if (length(s) == 1 && !is.na(s) && nchar(s) > 0) { - plotLabsCaptionEnabled <- as.logical(getOption("rpact.plot.labs.caption.enabled", "true")) - if (isTRUE(plotLabsCaptionEnabled)) { - caption <- s - } else { - if (length(subtitle) == 1 && !is.na(subtitle)) { - subtitle <- paste0(subtitle, ", ", s) - } else { - subtitle <- s - } - } - } - - if (plotLabsType == "html") { - self$.htmlTitle <- items$toHtml() - } - } - } - - subtitleFontSize <- NA_real_ - if (length(subtitle) == 1 && !is.na(subtitle)) { - if (is.na(caption)) { - caption <- ggplot2::waiver() - } - p <- p + ggplot2::labs(title = mainTitle, subtitle = subtitle, caption = caption) - targetWidth <- 130 - subtitleFontSize <- targetWidth / nchar(subtitle) * 8 - if (subtitleFontSize > self$scaleSize(self$mainTitleFontSize) - 2) { - subtitleFontSize <- self$scaleSize(self$mainTitleFontSize) - 2 - } - } else if (length(caption) == 1 && !is.na(caption)) { - p <- p + ggplot2::labs(title = mainTitle, caption = caption) - } else { - p <- p + ggplot2::ggtitle(mainTitle) - } - - p <- p + ggplot2::theme(plot.title = ggplot2::element_text( - hjust = 0.5, size = self$scaleSize(self$mainTitleFontSize), face = "bold" - )) - - if (!is.na(subtitleFontSize)) { - p <- p + ggplot2::theme( - plot.subtitle = ggplot2::element_text( - hjust = 0.5, - size = self$scaleSize(subtitleFontSize) - ) - ) - } - - return(p) - }, - setMarginAroundPlot = function(p, margin = 0.2) { - "Sets the margin around the plot, e.g., run \\cr - \\code{setMarginAroundPlot(p, .2)} or \\cr - \\code{setMarginAroundPlot(p, c(.1, .2, .1, .2)}" - if (length(margin == 1)) { - margin <- base::rep(margin, 4) - } - if (!(length(margin) %in% c(1, 4))) { - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'margin' (", .arrayToString(margin), - ") must be a numeric vector with length 1 or 4" - ) - } - p <- p + ggplot2::theme(plot.margin = ggplot2::unit(margin, "cm")) - return(p) - }, - expandAxesRange = function(p, x = NA_real_, y = NA_real_) { - "Expands the axes range" - if (!is.na(x)) { - p <- p + ggplot2::expand_limits(x = x) - } - if (!is.na(y)) { - p <- p + ggplot2::expand_limits(y = y) - } - return(p) - }, - hideGridLines = function(p) { - "Hides the grid lines" - p <- p + ggplot2::theme(panel.grid.major.x = ggplot2::element_blank()) - p <- p + ggplot2::theme(panel.grid.minor.x = ggplot2::element_blank()) - p <- p + ggplot2::theme(panel.grid.major.y = ggplot2::element_blank()) - p <- p + ggplot2::theme(panel.grid.minor.y = ggplot2::element_blank()) - return(p) - }, - setTheme = function(p) { - "Sets the theme" - p <- p + ggplot2::theme_bw() - p <- p + ggplot2::theme( - panel.border = ggplot2::element_blank(), - axis.line = ggplot2::element_line(colour = "black") - ) - return(p) - }, - plotPoints = function(p, pointBorder, ..., mapping = NULL) { - # plot white border around the points - if (pointBorder > 0 && self$.pointBorderEnabled) { - p <- p + ggplot2::geom_point( - mapping = mapping, - color = "white", - size = self$scaleSize(self$pointSize, TRUE), - alpha = 1, - shape = 21, - stroke = pointBorder / 2.25, - show.legend = FALSE - ) - } - - if (!is.null(self$pointColor) && length(self$pointColor) == 1 && !is.na(self$pointColor)) { - p <- p + ggplot2::geom_point( - mapping = mapping, - color = self$pointColor, - size = self$scaleSize(self$pointSize, TRUE), - alpha = 1, - shape = 19, - show.legend = FALSE - ) - } else { - p <- p + ggplot2::geom_point( - mapping = mapping, - size = self$scaleSize(self$pointSize, TRUE), alpha = 1, - shape = 19, show.legend = FALSE - ) - } - return(p) - }, - plotValues = function(p, ..., plotLineEnabled = TRUE, - plotPointsEnabled = TRUE, pointBorder = 4) { - if (plotLineEnabled) { - if (packageVersion("ggplot2") >= "3.4.0") { - p <- p + ggplot2::geom_line(linewidth = self$scaleSize(self$lineSize)) - } else { - p <- p + ggplot2::geom_line(size = self$scaleSize(self$lineSize)) - } - } - if (plotPointsEnabled) { - p <- self$plotPoints(p, pointBorder) - } - return(p) - }, - mirrorYValues = function(p, yValues, plotLineEnabled = TRUE, - plotPointsEnabled = TRUE, pointBorder = 4) { - if (plotLineEnabled) { - if (packageVersion("ggplot2") >= "3.4.0") { - p <- p + ggplot2::geom_line(ggplot2::aes(y = -yValues), linewidth = self$scaleSize(self$lineSize)) - } else { - p <- p + ggplot2::geom_line(ggplot2::aes(y = -yValues), size = self$scaleSize(self$lineSize)) - } - } - if (plotPointsEnabled) { - p <- self$plotPoints(p, pointBorder, mapping = ggplot2::aes(y = -yValues)) - } - return(p) - }, - addCompanyAnnotation = function(p, enabled = TRUE) { - if (!enabled) { - return(p) - } - - label <- "www.rpact.org" - p <- p + ggplot2::annotate("label", - x = -Inf, y = Inf, hjust = -0.1, vjust = 1, - label = label, size = self$scaleSize(2.8), colour = "white", fill = "white" - ) - - p <- p + ggplot2::annotate("text", - x = -Inf, y = Inf, label = label, - hjust = -.12, vjust = 1, colour = "lightgray", size = self$scaleSize(2.7) - ) - return(p) - } - ) -) diff --git a/R/class_design.R b/R/class_design.R index 395fea90..9644fd29 100644 --- a/R/class_design.R +++ b/R/class_design.R @@ -1,3 +1,4 @@ +library("R6") ## | ## | *Trial design classes* ## | @@ -62,132 +63,132 @@ NULL #' #' @importFrom methods new #' -TrialDesign <- setRefClass("TrialDesign", - contains = "ParameterSet", - fields = list( - .plotSettings = "ANY", - kMax = "integer", - alpha = "numeric", - stages = "integer", - informationRates = "numeric", - userAlphaSpending = "numeric", - criticalValues = "numeric", - stageLevels = "numeric", - alphaSpent = "numeric", - bindingFutility = "logical", - tolerance = "numeric" - ), - methods = list( - initialize = function(..., - alpha = NA_real_, - informationRates = NA_real_, - userAlphaSpending = NA_real_, - criticalValues = NA_real_, - stageLevels = NA_real_, - alphaSpent = NA_real_, - bindingFutility = NA, - tolerance = 1e-06 # C_ANALYSIS_TOLERANCE_DEFAULT - ) { - callSuper(..., - alpha = alpha, - informationRates = informationRates, - userAlphaSpending = userAlphaSpending, - criticalValues = criticalValues, - stageLevels = stageLevels, - alphaSpent = alphaSpent, - bindingFutility = bindingFutility, - tolerance = tolerance - ) - - .plotSettings <<- PlotSettingsR6$new() - - if (inherits(.self, "TrialDesignConditionalDunnett")) { - .parameterNames <<- C_PARAMETER_NAMES - } else { - .parameterNames <<- .getSubListByNames(.getParameterNames(design = .self), c( - "stages", - "kMax", - "alpha", - "informationRates", - "userAlphaSpending", - "criticalValues", - "stageLevels", - "alphaSpent", - "bindingFutility", - "tolerance" - )) - } - - .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS - - .initStages() - }, - show = function(showType = 1, digits = NA_integer_) { - .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) - }, - .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { - "Method for automatically printing trial design objects" - .resetCat() - if (showType == 3) { - .createSummary(.self, digits = digits)$.show( - showType = 1, - digits = digits, consoleOutputEnabled = consoleOutputEnabled - ) - } else if (showType == 2) { - callSuper(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) - } else { - .cat("Design parameters and output of ", .toString(), ":\n\n", - heading = 1, - consoleOutputEnabled = consoleOutputEnabled - ) - .showParametersOfOneGroup(.getUserDefinedParameters(), "User defined parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - .showParametersOfOneGroup(.getDerivedParameters(), "Derived from user defined parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - .showParametersOfOneGroup(.getDefaultParameters(), "Default parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - .showParametersOfOneGroup(.getGeneratedParameters(), "Output", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - .showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - } - }, - .toString = function(startWithUpperCase = FALSE) { - s <- "unknown trial design" - if (.isTrialDesignGroupSequential(.self)) { - s <- "group sequential design" - } else if (.isTrialDesignInverseNormal(.self)) { - s <- "inverse normal combination test design" - } else if (.isTrialDesignFisher(.self)) { - s <- "Fisher's combination test design" - } else if (.isTrialDesignConditionalDunnett(.self)) { - s <- "conditional Dunnett test design" - } - return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) - }, - .initStages = function() { - if (length(kMax) == 1 && !is.na(kMax) && kMax > 0) { - stages <<- c(1L:kMax) - if (kMax == C_KMAX_DEFAULT) { - .setParameterType("stages", C_PARAM_DEFAULT_VALUE) - } else { - type <- .getParameterType("kMax") - .setParameterType("stages", ifelse(type != C_PARAM_TYPE_UNKNOWN, type, C_PARAM_USER_DEFINED)) - } - } else { - .setParameterType("stages", C_PARAM_NOT_APPLICABLE) - } - }, - .isDelayedResponseDesign = function() { - return((inherits(.self, "TrialDesignGroupSequential") || inherits(.self, "TrialDesignInverseNormal")) && - .self$kMax > 1 && - !is.null(.self[["delayedInformation"]]) && - !any(is.na(.self$delayedInformation)) && any(.self$delayedInformation > 0)) - } - ) +TrialDesignR6 <- R6Class("TrialDesignR6", + inherit = ParameterSetR6, + public = list( + .plotSettings = NULL, + kMax = NULL, + alpha = NULL, + stages = NULL, + informationRates = NULL, + userAlphaSpending = NULL, + criticalValues = NULL, + stageLevels = NULL, + alphaSpent = NULL, + bindingFutility = NULL, + tolerance = NULL, + initialize = function(..., + kMax = NA_integer_, + alpha = NA_real_, + informationRates = NA_real_, + userAlphaSpending = NA_real_, + criticalValues = NA_real_, + stageLevels = NA_real_, + alphaSpent = NA_real_, + bindingFutility = NA, + tolerance = 1e-06 # C_ANALYSIS_TOLERANCE_DEFAULT + ) { + + self$kMax <- kMax #NEW + self$alpha <- alpha + self$informationRates <- informationRates + self$userAlphaSpending <- userAlphaSpending + self$criticalValues <- criticalValues + self$stageLevels <- stageLevels + self$alphaSpent <- alphaSpent + self$bindingFutility <- bindingFutility + self$tolerance <- tolerance + super$initialize(...) + + self$.plotSettings <- PlotSettingsR6$new() + + if (inherits(self, "TrialDesignConditionalDunnettR6")) { + self$.parameterNames <- C_PARAMETER_NAMES + } else { + self$.parameterNames <- self$.getSubListByNames(.getParameterNames(design = self), c(#TODO + "stages", + "kMax", + "alpha", + "informationRates", + "userAlphaSpending", + "criticalValues", + "stageLevels", + "alphaSpent", + "bindingFutility", + "tolerance" + )) + } + + self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS + + self$.initStages() + }, + show = function(showType = 1, digits = NA_integer_) { + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + }, + .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { + "Method for automatically printing trial design objects" + self$.resetCat() + if (showType == 3) { + .createSummary(self, digits = digits)$.show(#TODO should not work + showType = 1, + digits = digits, consoleOutputEnabled = consoleOutputEnabled + ) + } else if (showType == 2) { + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + } else { + self$.cat("Design parameters and output of ", self$.toString(), ":\n\n", + heading = 1, + consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getDerivedParameters(), "Derived from user defined parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Output", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + } + }, + .toString = function(startWithUpperCase = FALSE) { + s <- "unknown trial design" + if (.isTrialDesignGroupSequential(self)) { + s <- "group sequential design" + } else if (.isTrialDesignInverseNormal(self)) { + s <- "inverse normal combination test design" + } else if (.isTrialDesignFisher(self)) { + s <- "Fisher's combination test design" + } else if (.isTrialDesignConditionalDunnett(self)) { + s <- "conditional Dunnett test design" + } + return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) + }, + .initStages = function() { + if (length(self$kMax) == 1 && !is.na(self$kMax) && self$kMax > 0) { + self$stages <- c(1L:self$kMax) + if (self$kMax == C_KMAX_DEFAULT) { + self$.setParameterType("stages", C_PARAM_DEFAULT_VALUE) + } else { + type <- self$.getParameterType("kMax")#TODO + self$.setParameterType("stages", ifelse(type != C_PARAM_TYPE_UNKNOWN, type, C_PARAM_USER_DEFINED)) + } + } else { + self$.setParameterType("stages", C_PARAM_NOT_APPLICABLE) + } + }, + .isDelayedResponseDesign = function() { + return((inherits(self, "TrialDesignGroupSequentialR6") || inherits(self, "TrialDesignInverseNormalR6")) && + self$kMax > 1 && + !is.null(self[["delayedInformation"]]) &&#TODO + !any(is.na(self$delayedInformation)) && any(self$delayedInformation > 0)) + } + ) ) #' @@ -225,71 +226,71 @@ TrialDesign <- setRefClass("TrialDesign", #' #' @importFrom methods new #' -TrialDesignCharacteristics <- setRefClass("TrialDesignCharacteristics", - contains = "ParameterSet", - fields = list( - .design = "TrialDesign", - .probs = "matrix", - nFixed = "numeric", - shift = "numeric", - inflationFactor = "numeric", - stages = "integer", - information = "numeric", - power = "numeric", - rejectionProbabilities = "numeric", # efficacy probabilities - futilityProbabilities = "numeric", - averageSampleNumber1 = "numeric", - averageSampleNumber01 = "numeric", - averageSampleNumber0 = "numeric" - ), - methods = list( - initialize = function(design, ...) { - callSuper(.design = design, ...) - .parameterNames <<- .getParameterNames(design = design) - .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS - .parameterFormatFunctions[["nFixed"]] <<- ".formatProbabilities" - .initStages() - }, - show = function(showType = 1, digits = NA_integer_) { - .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) - }, - .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { - "Method for automatically printing trial design characteristics objects" - .resetCat() - if (showType == 2) { - callSuper(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) - } else { - .showParametersOfOneGroup(.getGeneratedParameters(), - title = .toString(startWithUpperCase = TRUE), - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - .showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - } - }, - .initStages = function() { - if (!is.na(.design$kMax) && .design$kMax > 0) { - stages <<- c(1L:.design$kMax) - if (.design$kMax == C_KMAX_DEFAULT) { - .setParameterType("stages", C_PARAM_DEFAULT_VALUE) - } else { - .setParameterType("stages", C_PARAM_USER_DEFINED) - } - } else { - .setParameterType("stages", C_PARAM_NOT_APPLICABLE) - } - }, - .toString = function(startWithUpperCase = FALSE) { - if (.design$.isDelayedResponseDesign()) { - prefix <- "delayed response" - if (startWithUpperCase) { - prefix <- .firstCharacterToUpperCase(prefix) - } - return(paste(prefix, .design$.toString(startWithUpperCase = FALSE), "characteristics")) - } - - return(paste(.design$.toString(startWithUpperCase = startWithUpperCase), "characteristics")) - } - ) +TrialDesignCharacteristicsR6 <- R6Class("TrialDesignCharacteristicsR6", + inherit = ParameterSetR6, + public = list( + .design = NULL, + .probs = NULL, + nFixed = NULL, + shift = NULL, + inflationFactor = NULL, + stages = NULL, + information = NULL, + power = NULL, + rejectionProbabilities = NULL, # efficacy probabilities + futilityProbabilities = NULL, + averageSampleNumber1 = NULL, + averageSampleNumber01 = NULL, + averageSampleNumber0 = NULL, + initialize = function(design, ...) { + + self$.design <- design + self$.parameterNames <- .getParameterNames(design = design) + self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS + self$.parameterFormatFunctions[["nFixed"]] <- ".formatProbabilities" + super$initialize(...)#TODO init vars? + self$.initStages() + }, + show = function(showType = 1, digits = NA_integer_) { + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + }, + .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { + "Method for automatically printing trial design characteristics objects" + self$.resetCat() + if (showType == 2) { + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + } else { + self$.showParametersOfOneGroup(self$.getGeneratedParameters(), + title = self$.toString(startWithUpperCase = TRUE), + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + } + }, + .initStages = function() { + if (!is.na(self$.design$kMax) && self$.design$kMax > 0) { + self$stages <- c(1L:self$.design$kMax) + if (self$.design$kMax == C_KMAX_DEFAULT) { + self$.setParameterType("stages", C_PARAM_DEFAULT_VALUE) + } else { + self$.setParameterType("stages", C_PARAM_USER_DEFINED) + } + } else { + self$.setParameterType("stages", C_PARAM_NOT_APPLICABLE) + } + }, + .toString = function(startWithUpperCase = FALSE) { + if (self$.design$.isDelayedResponseDesign()) { + prefix <- "delayed response" + if (startWithUpperCase) { + prefix <- .firstCharacterToUpperCase(prefix) + } + return(paste(prefix, self$.design$.toString(startWithUpperCase = FALSE), "characteristics")) + } + + return(paste(self$.design$.toString(startWithUpperCase = startWithUpperCase), "characteristics")) + } + ) ) #' @@ -310,11 +311,11 @@ TrialDesignCharacteristics <- setRefClass("TrialDesignCharacteristics", #' #' @export #' -print.TrialDesignCharacteristics <- function(x, ..., markdown = FALSE, showDesign = TRUE) { - if (showDesign) { - print.ParameterSet(x$.design, ..., markdown = markdown) - } - print.ParameterSet(x, ..., markdown = markdown) +print.TrialDesignCharacteristicsR6 <- function(x, ..., markdown = FALSE, showDesign = TRUE) { + if (showDesign) { + print.ParameterSetR6(x$.design, ..., markdown = markdown) + } + print.ParameterSetR6(x, ..., markdown = markdown) } #' @@ -341,21 +342,21 @@ print.TrialDesignCharacteristics <- function(x, ..., markdown = FALSE, showDesig #' #' @keywords internal #' -as.data.frame.TrialDesignCharacteristics <- function(x, row.names = NULL, - optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ...) { - if (x$.design$kMax > 1) { - parameterNamesToBeExcluded <- c("nFixed", "shift") - } else { - parameterNamesToBeExcluded <- c("inflationFactor") - } - return(.getAsDataFrame( - parameterSet = x, - parameterNames = parameterNamesToBeExcluded, - niceColumnNamesEnabled = niceColumnNamesEnabled, - includeAllParameters = includeAllParameters, - handleParameterNamesAsToBeExcluded = TRUE, - tableColumnNames = .getTableColumnNames(design = x$.design) - )) +as.data.frame.TrialDesignCharacteristicsR6 <- function(x, row.names = NULL, + optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ...) { + if (x$.design$kMax > 1) { + parameterNamesToBeExcluded <- c("nFixed", "shift") + } else { + parameterNamesToBeExcluded <- c("inflationFactor") + } + return(.getAsDataFrame( + parameterSet = x, + parameterNames = parameterNamesToBeExcluded, + niceColumnNamesEnabled = niceColumnNamesEnabled, + includeAllParameters = includeAllParameters, + handleParameterNamesAsToBeExcluded = TRUE, + tableColumnNames = .getTableColumnNames(design = x$.design) + )) } #' @@ -400,122 +401,120 @@ as.data.frame.TrialDesignCharacteristics <- function(x, row.names = NULL, #' #' @importFrom methods new #' -TrialDesignFisher <- setRefClass(C_CLASS_NAME_TRIAL_DESIGN_FISHER, - contains = "TrialDesign", - fields = list( - method = "character", - alpha0Vec = "numeric", - scale = "numeric", - nonStochasticCurtailment = "logical", - sided = "integer", - simAlpha = "numeric", - iterations = "integer", - seed = "numeric" - ), - methods = list( - initialize = function(..., - method = NA_character_, - alpha0Vec = NA_real_, - scale = NA_real_, - nonStochasticCurtailment = FALSE, - sided = as.integer(C_SIDED_DEFAULT), - simAlpha = NA_real_, - iterations = 0L, - seed = NA_real_, - tolerance = C_ANALYSIS_TOLERANCE_FISHER_DEFAULT) { - callSuper(..., - method = method, - alpha0Vec = alpha0Vec, - scale = scale, - nonStochasticCurtailment = nonStochasticCurtailment, - sided = sided, - simAlpha = simAlpha, - iterations = iterations, - seed = seed, - tolerance = tolerance - ) - - .parameterNames <<- c(.parameterNames, .getSubListByNames( - .getParameterNames(design = .self), c( - "method", - "alpha0Vec", - "scale", - "nonStochasticCurtailment", - "sided", - "simAlpha", - "iterations", - "seed" - ) - )) - - .parameterFormatFunctions$criticalValues <<- ".formatCriticalValuesFisher" - - .initParameterTypes() - .setParameterType("iterations", C_PARAM_NOT_APPLICABLE) - .setParameterType("seed", C_PARAM_NOT_APPLICABLE) - .initStages() - }, - hasChanged = function(kMax, alpha, sided, method, informationRates, alpha0Vec, userAlphaSpending, bindingFutility) { - informationRatesTemp <- informationRates - if (any(is.na(informationRatesTemp))) { - informationRatesTemp <- .getInformationRatesDefault(kMax) - } - alpha0VecTemp <- alpha0Vec[1:(kMax - 1)] - if (any(is.na(alpha0VecTemp))) { - alpha0VecTemp <- rep(C_FUTILITY_BOUNDS_DEFAULT, kMax - 1) - } - - if (!identical(kMax, .self$kMax)) { - return(TRUE) - } - if (!identical(alpha, .self$alpha)) { - return(TRUE) - } - if (!identical(sided, .self$sided)) { - return(TRUE) - } - if (!identical(method, .self$method)) { - return(TRUE) - } - if (!identical(informationRatesTemp, .self$informationRates)) { - return(TRUE) - } - if (!identical(alpha0VecTemp, .self$alpha0Vec)) { - return(TRUE) - } - if (!identical(userAlphaSpending, .self$userAlphaSpending)) { - return(TRUE) - } - if (!identical(bindingFutility, .self$bindingFutility)) { - return(TRUE) - } - return(FALSE) - }, - - # Defines the order of the parameter output - .getParametersToShow = function() { - return(c( - "method", - "kMax", - "stages", - "informationRates", - "alpha", - "alpha0Vec", - "bindingFutility", - "sided", - "tolerance", - "iterations", - "seed", - "alphaSpent", - "userAlphaSpending", - "criticalValues", - "stageLevels", - "scale", - "simAlpha", - "nonStochasticCurtailment" - )) - } - ) +TrialDesignFisherR6 <- R6Class("TrialDesignFisherR6", + inherit = TrialDesignR6, + public = list( + method = NULL, + alpha0Vec = NULL, + scale = NULL, + nonStochasticCurtailment = NULL, + sided = NULL, + simAlpha = NULL, + iterations = NULL, + seed = NULL, + initialize = function(..., + method = NA_character_, + alpha0Vec = NA_real_, + scale = NA_real_, + nonStochasticCurtailment = FALSE, + sided = as.integer(C_SIDED_DEFAULT), + simAlpha = NA_real_, + iterations = 0L, + seed = NA_real_, + tolerance = C_ANALYSIS_TOLERANCE_FISHER_DEFAULT) { + + self$method <- method + self$alpha0Vec <- alpha0Vec + self$scale <- scale + self$nonStochasticCurtailment <- nonStochasticCurtailment + self$sided <- sided + self$simAlpha <- simAlpha + self$iterations <- iterations + self$seed <- seed + self$tolerance <- tolerance + super$initialize(...) + + self$.parameterNames <- c(self$.parameterNames, self$.getSubListByNames( + .getParameterNames(design = self), c( + "method", + "alpha0Vec", + "scale", + "nonStochasticCurtailment", + "sided", + "simAlpha", + "iterations", + "seed" + ) + )) + + self$.parameterFormatFunctions$criticalValues <- ".formatCriticalValuesFisher" + + self$.initParameterTypes() + self$.setParameterType("iterations", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("seed", C_PARAM_NOT_APPLICABLE) + self$.initStages() + }, + hasChanged = function(kMax, alpha, sided, method, informationRates, alpha0Vec, userAlphaSpending, bindingFutility) { + informationRatesTemp <- informationRates + if (any(is.na(informationRatesTemp))) { + informationRatesTemp <- .getInformationRatesDefault(kMax) + } + alpha0VecTemp <- alpha0Vec[1:(kMax - 1)] + if (any(is.na(alpha0VecTemp))) { + alpha0VecTemp <- rep(C_FUTILITY_BOUNDS_DEFAULT, kMax - 1) + } + + if (!identical(kMax, self$kMax)) { + return(TRUE) + } + if (!identical(alpha, self$alpha)) { + return(TRUE) + } + if (!identical(sided, self$sided)) { + return(TRUE) + } + if (!identical(method, self$method)) { + return(TRUE) + } + if (!identical(informationRatesTemp, self$informationRates)) { + return(TRUE) + } + if (!identical(alpha0VecTemp, self$alpha0Vec)) { + return(TRUE) + } + if (!identical(userAlphaSpending, self$userAlphaSpending)) { + return(TRUE) + } + if (!identical(bindingFutility, self$bindingFutility)) { + return(TRUE) + } + return(FALSE) + }, + + # Defines the order of the parameter output + .getParametersToShow = function() { + return(c( + "method", + "kMax", + "stages", + "informationRates", + "alpha", + "alpha0Vec", + "bindingFutility", + "sided", + "tolerance", + "iterations", + "seed", + "alphaSpent", + "userAlphaSpending", + "criticalValues", + "stageLevels", + "scale", + "simAlpha", + "nonStochasticCurtailment" + )) + } + ) ) #' @@ -572,275 +571,274 @@ TrialDesignFisher <- setRefClass(C_CLASS_NAME_TRIAL_DESIGN_FISHER, #' #' @importFrom methods new #' -TrialDesignInverseNormal <- setRefClass(C_CLASS_NAME_TRIAL_DESIGN_INVERSE_NORMAL, - contains = "TrialDesign", - fields = list( - typeOfDesign = "character", - beta = "numeric", - deltaWT = "numeric", - deltaPT1 = "numeric", - deltaPT0 = "numeric", - futilityBounds = "numeric", - gammaA = "numeric", - gammaB = "numeric", - optimizationCriterion = "character", - sided = "integer", - betaSpent = "numeric", - typeBetaSpending = "character", - userBetaSpending = "numeric", - power = "numeric", - twoSidedPower = "logical", - constantBoundsHP = "numeric", - betaAdjustment = "logical", - delayedInformation = "numeric", - decisionCriticalValues = "numeric", - reversalProbabilities = "numeric" - ), - methods = list( - initialize = function(..., - beta = C_BETA_DEFAULT, - betaSpent = NA_real_, - sided = C_SIDED_DEFAULT, - futilityBounds = NA_real_, - typeOfDesign = C_DEFAULT_TYPE_OF_DESIGN, - deltaWT = NA_real_, - deltaPT1 = NA_real_, - deltaPT0 = NA_real_, - optimizationCriterion = C_OPTIMIZATION_CRITERION_DEFAULT, - gammaA = NA_real_, - gammaB = NA_real_, - typeBetaSpending = C_TYPE_OF_DESIGN_BS_NONE, - userBetaSpending = NA_real_, - power = NA_real_, - twoSidedPower = C_TWO_SIDED_POWER_DEFAULT, - constantBoundsHP = NA_real_, - betaAdjustment = TRUE, # impl as constant - delayedInformation = NA_real_) { - callSuper(..., - beta = beta, - betaSpent = betaSpent, - sided = sided, - futilityBounds = futilityBounds, - typeOfDesign = typeOfDesign, - deltaWT = deltaWT, - deltaPT1 = deltaPT1, - deltaPT0 = deltaPT0, - optimizationCriterion = optimizationCriterion, - gammaA = gammaA, - gammaB = gammaB, - typeBetaSpending = typeBetaSpending, - userBetaSpending = userBetaSpending, - power = power, - twoSidedPower = twoSidedPower, - constantBoundsHP = constantBoundsHP, - betaAdjustment = betaAdjustment, - delayedInformation = delayedInformation - ) - - .initParameterNames() - .parameterFormatFunctions$criticalValues <<- ".formatCriticalValues" - .initParameterTypes() - .initStages() - - .setParameterType("betaAdjustment", C_PARAM_NOT_APPLICABLE) - .setParameterType("delayedInformation", C_PARAM_NOT_APPLICABLE) - .setParameterType("decisionCriticalValues", C_PARAM_NOT_APPLICABLE) - .setParameterType("reversalProbabilities", C_PARAM_NOT_APPLICABLE) - }, - .initParameterNames = function() { - .parameterNames <<- c(.parameterNames, .getSubListByNames( - .getParameterNames(design = .self), c( - "beta", - "betaSpent", - "sided", - "futilityBounds", - "typeOfDesign", - "deltaWT", - "deltaPT1", - "deltaPT0", - "optimizationCriterion", - "gammaA", - "gammaB", - "typeBetaSpending", - "userBetaSpending", - "power", - "twoSidedPower", - "constantBoundsHP", - "betaAdjustment", - "delayedInformation", - "decisionCriticalValues", - "reversalProbabilities" - ) - )) - }, - .formatComparisonResult = function(x) { - if (is.null(x) || length(x) == 0 || !is.numeric(x)) { - return(x) - } - - s <- sprintf("%.9f", x) - s <- sub("\\.0+", "", s) - return(s) - }, - .pasteComparisonResult = function(name, newValue, oldValue) { - return(paste0( - name, "_new = ", .arrayToString(.formatComparisonResult(newValue)), " (", .getClassName(newValue), "), ", - name, "_old = ", .arrayToString(.formatComparisonResult(oldValue)), " (", .getClassName(oldValue), ")" - )) - }, - hasChanged = function(..., - kMax, - alpha, - beta, - sided, - typeOfDesign, - deltaWT, - deltaPT1, - deltaPT0, - informationRates, - futilityBounds, - optimizationCriterion, - typeBetaSpending, - gammaA, - gammaB, - bindingFutility, - userAlphaSpending, - userBetaSpending, - twoSidedPower, - constantBoundsHP, - betaAdjustment = TRUE, - delayedInformation = NA_real_) { - informationRatesTemp <- informationRates - if (any(is.na(informationRatesTemp))) { - informationRatesTemp <- .getInformationRatesDefault(kMax) - } - futilityBoundsTemp <- futilityBounds[1:(kMax - 1)] - if (any(is.na(futilityBoundsTemp))) { - futilityBoundsTemp <- rep(C_FUTILITY_BOUNDS_DEFAULT, kMax - 1) - } - - if (!identical(kMax, .self$kMax)) { - return(.pasteComparisonResult("kMax", kMax, .self$kMax)) - } - if (!identical(alpha, .self$alpha)) { - return(.pasteComparisonResult("alpha", alpha, .self$alpha)) - } - if (!identical(beta, .self$beta)) { - return(.pasteComparisonResult("beta", beta, .self$beta)) - } - if (!identical(sided, .self$sided)) { - return(.pasteComparisonResult("sided", sided, .self$sided)) - } - if (!identical(twoSidedPower, .self$twoSidedPower)) { - return(.pasteComparisonResult("twoSidedPower", twoSidedPower, .self$twoSidedPower)) - } - if (kMax == 1) { - return(FALSE) - } - - if (!identical(betaAdjustment, .self$betaAdjustment)) { - return(.pasteComparisonResult("betaAdjustment", betaAdjustment, .self$betaAdjustment)) - } - if (!identical(delayedInformation, .self$delayedInformation)) { - return(.pasteComparisonResult("delayedInformation", delayedInformation, .self$delayedInformation)) - } - if (!identical(typeOfDesign, .self$typeOfDesign)) { - return(.pasteComparisonResult("typeOfDesign", typeOfDesign, .self$typeOfDesign)) - } - if (typeOfDesign == C_TYPE_OF_DESIGN_WT) { - if (!identical(deltaWT, .self$deltaWT)) { - return(.pasteComparisonResult("deltaWT", deltaWT, .self$deltaWT)) - } - } - if (typeOfDesign == C_TYPE_OF_DESIGN_PT) { - if (!identical(deltaPT1, .self$deltaPT1)) { - return(.pasteComparisonResult("deltaPT1", deltaPT1, .self$deltaPT1)) - } - if (!identical(deltaPT0, .self$deltaPT0)) { - return(.pasteComparisonResult("deltaPT0", deltaPT0, .self$deltaPT0)) - } - } - if (!identical(informationRatesTemp, .self$informationRates)) { - return(.pasteComparisonResult("informationRates", informationRatesTemp, .self$informationRates)) - } - if (.getParameterType("futilityBounds") != C_PARAM_GENERATED && - (!grepl("^as.*", typeOfDesign) || typeBetaSpending == C_TYPE_OF_DESIGN_BS_NONE) && - !identical(futilityBoundsTemp, .self$futilityBounds)) { - return(.pasteComparisonResult("futilityBounds", futilityBoundsTemp, .self$futilityBounds)) - } - if (!identical(optimizationCriterion, .self$optimizationCriterion)) { - return(.pasteComparisonResult("optimizationCriterion", optimizationCriterion, .self$optimizationCriterion)) - } - if (!identical(typeBetaSpending, .self$typeBetaSpending)) { - return(.pasteComparisonResult("typeBetaSpending", typeBetaSpending, .self$typeBetaSpending)) - } - if (!identical(gammaA, .self$gammaA)) { - return(.pasteComparisonResult("gammaA", gammaA, .self$gammaA)) - } - if (!identical(gammaB, .self$gammaB)) { - return(.pasteComparisonResult("gammaB", gammaB, .self$gammaB)) - } - if ((typeOfDesign == C_TYPE_OF_DESIGN_PT && !identical(bindingFutility, .self$bindingFutility)) || - (!identical(bindingFutility, .self$bindingFutility) && - .getParameterType("futilityBounds") != C_PARAM_NOT_APPLICABLE && - (sided == 1 || !grepl("^as.*", typeOfDesign) || typeBetaSpending == C_TYPE_OF_DESIGN_BS_NONE) && - (any(na.omit(futilityBounds) > -6) || any(na.omit(.self$futilityBounds) > -6)) - )) { - return(.pasteComparisonResult("bindingFutility", bindingFutility, .self$bindingFutility)) - } - if (!identical(userAlphaSpending, .self$userAlphaSpending)) { - return(.pasteComparisonResult("userAlphaSpending", userAlphaSpending, .self$userAlphaSpending)) - } - if (!identical(userBetaSpending, .self$userBetaSpending)) { - return(.pasteComparisonResult("userBetaSpending", userBetaSpending, .self$userBetaSpending)) - } - if (!identical(twoSidedPower, .self$twoSidedPower)) { - return(.pasteComparisonResult("twoSidedPower", twoSidedPower, .self$twoSidedPower)) - } - if (typeOfDesign == C_TYPE_OF_DESIGN_HP) { - if (!identical(constantBoundsHP, .self$constantBoundsHP)) { - return(.pasteComparisonResult("constantBoundsHP", constantBoundsHP, .self$constantBoundsHP)) - } - } - return(FALSE) - }, - - # Defines the order of the parameter output - .getParametersToShow = function() { - return(c( - "typeOfDesign", - "kMax", - "stages", - "informationRates", - "alpha", - "beta", - "power", - "twoSidedPower", - "deltaWT", - "deltaPT1", - "deltaPT0", - "futilityBounds", - "bindingFutility", - "constantBoundsHP", - "gammaA", - "gammaB", - "optimizationCriterion", - "sided", - "betaAdjustment", - "delayedInformation", - "tolerance", - "alphaSpent", - "userAlphaSpending", - "betaSpent", - "typeBetaSpending", - "userBetaSpending", - "criticalValues", - "stageLevels", - "decisionCriticalValues", - "reversalProbabilities" - )) - } - ) +TrialDesignInverseNormalR6 <- R6Class("TrialDesignInverseNormalR6", + inherit = TrialDesignR6, + public = list( + typeOfDesign = NULL, + beta = NULL, + deltaWT = NULL, + deltaPT1 = NULL, + deltaPT0 = NULL, + futilityBounds = NULL, + gammaA = NULL, + gammaB = NULL, + optimizationCriterion = NULL, + sided = NULL, + betaSpent = NULL, + typeBetaSpending = NULL, + userBetaSpending = NULL, + power = NULL, + twoSidedPower = NULL, + constantBoundsHP = NULL, + betaAdjustment = NULL, + delayedInformation = NULL, + decisionCriticalValues = NULL, + reversalProbabilities = NULL, + initialize = function(..., + beta = C_BETA_DEFAULT, + betaSpent = NA_real_, + sided = C_SIDED_DEFAULT, + futilityBounds = NA_real_, + typeOfDesign = C_DEFAULT_TYPE_OF_DESIGN, + deltaWT = NA_real_, + deltaPT1 = NA_real_, + deltaPT0 = NA_real_, + optimizationCriterion = C_OPTIMIZATION_CRITERION_DEFAULT, + gammaA = NA_real_, + gammaB = NA_real_, + typeBetaSpending = C_TYPE_OF_DESIGN_BS_NONE, + userBetaSpending = NA_real_, + power = NA_real_, + twoSidedPower = C_TWO_SIDED_POWER_DEFAULT, + constantBoundsHP = NA_real_, + betaAdjustment = TRUE, # impl as constant + delayedInformation = NA_real_) { + + + self$beta <- beta + self$betaSpent <- betaSpent + self$sided <- sided + self$futilityBounds <- futilityBounds + self$typeOfDesign <- typeOfDesign + self$deltaWT <- deltaWT + self$deltaPT1 <- deltaPT1 + self$deltaPT0 <- deltaPT0 + self$optimizationCriterion <- optimizationCriterion + self$gammaA <- gammaA + self$gammaB <- gammaB + self$typeBetaSpending <- typeBetaSpending + self$userBetaSpending <- userBetaSpending + self$power <- power + self$twoSidedPower <- twoSidedPower + self$constantBoundsHP <- constantBoundsHP + self$betaAdjustment <- betaAdjustment + self$delayedInformation <- delayedInformation + super$initialize(...) + self$.initParameterNames() + self$.parameterFormatFunctions$criticalValues <- ".formatCriticalValues" + self$.initParameterTypes() + self$.initStages() + + self$.setParameterType("betaAdjustment", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("delayedInformation", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("decisionCriticalValues", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("reversalProbabilities", C_PARAM_NOT_APPLICABLE) + + }, + .initParameterNames = function() { + self$.parameterNames <- c(self$.parameterNames, self$.getSubListByNames( + .getParameterNames(design = self), c( + "beta", + "betaSpent", + "sided", + "futilityBounds", + "typeOfDesign", + "deltaWT", + "deltaPT1", + "deltaPT0", + "optimizationCriterion", + "gammaA", + "gammaB", + "typeBetaSpending", + "userBetaSpending", + "power", + "twoSidedPower", + "constantBoundsHP", + "betaAdjustment", + "delayedInformation", + "decisionCriticalValues", + "reversalProbabilities" + ) + )) + }, + .formatComparisonResult = function(x) { + if (is.null(x) || length(x) == 0 || !is.numeric(x)) { + return(x) + } + + s <- sprintf("%.9f", x) + s <- sub("\\.0+", "", s) + return(s) + }, + .pasteComparisonResult = function(name, newValue, oldValue) { + return(paste0( + name, "_new = ", .arrayToString(.formatComparisonResult(newValue)), " (", .getClassName(newValue), "), ", + name, "_old = ", .arrayToString(.formatComparisonResult(oldValue)), " (", .getClassName(oldValue), ")" + )) + }, + hasChanged = function(..., + kMax, + alpha, + beta, + sided, + typeOfDesign, + deltaWT, + deltaPT1, + deltaPT0, + informationRates, + futilityBounds, + optimizationCriterion, + typeBetaSpending, + gammaA, + gammaB, + bindingFutility, + userAlphaSpending, + userBetaSpending, + twoSidedPower, + constantBoundsHP, + betaAdjustment = TRUE, + delayedInformation = NA_real_) { + informationRatesTemp <- informationRates + if (any(is.na(informationRatesTemp))) { + informationRatesTemp <- .getInformationRatesDefault(kMax) + } + futilityBoundsTemp <- futilityBounds[1:(kMax - 1)] + if (any(is.na(futilityBoundsTemp))) { + futilityBoundsTemp <- rep(C_FUTILITY_BOUNDS_DEFAULT, kMax - 1) + } + + if (!identical(kMax, self$kMax)) { + return(self$.pasteComparisonResult("kMax", kMax, self$kMax)) + } + if (!identical(alpha, self$alpha)) { + return(self$.pasteComparisonResult("alpha", alpha, self$alpha)) + } + if (!identical(beta, self$beta)) { + return(self$.pasteComparisonResult("beta", beta, self$beta)) + } + if (!identical(sided, self$sided)) { + return(self$.pasteComparisonResult("sided", sided, self$sided)) + } + if (!identical(twoSidedPower, self$twoSidedPower)) { + return(self$.pasteComparisonResult("twoSidedPower", twoSidedPower, self$twoSidedPower)) + } + if (kMax == 1) { + return(FALSE) + } + + if (!identical(betaAdjustment, self$betaAdjustment)) { + return(self$.pasteComparisonResult("betaAdjustment", betaAdjustment, self$betaAdjustment)) + } + if (!identical(delayedInformation, self$delayedInformation)) { + return(self$.pasteComparisonResult("delayedInformation", delayedInformation, self$delayedInformation)) + } + if (!identical(typeOfDesign, self$typeOfDesign)) { + return(self$.pasteComparisonResult("typeOfDesign", typeOfDesign, self$typeOfDesign)) + } + if (typeOfDesign == C_TYPE_OF_DESIGN_WT) { + if (!identical(deltaWT, self$deltaWT)) { + return(self$.pasteComparisonResult("deltaWT", deltaWT, self$deltaWT)) + } + } + if (typeOfDesign == C_TYPE_OF_DESIGN_PT) { + if (!identical(deltaPT1, self$deltaPT1)) { + return(self$.pasteComparisonResult("deltaPT1", deltaPT1, self$deltaPT1)) + } + if (!identical(deltaPT0, self$deltaPT0)) { + return(self$.pasteComparisonResult("deltaPT0", deltaPT0, self$deltaPT0)) + } + } + if (!identical(informationRatesTemp, self$informationRates)) { + return(self$.pasteComparisonResult("informationRates", informationRatesTemp, self$informationRates)) + } + if (self$.getParameterType("futilityBounds") != C_PARAM_GENERATED && + (!grepl("^as.*", typeOfDesign) || typeBetaSpending == C_TYPE_OF_DESIGN_BS_NONE) && + !identical(futilityBoundsTemp, self$futilityBounds)) { + return(self$.pasteComparisonResult("futilityBounds", futilityBoundsTemp, self$futilityBounds)) + } + if (!identical(optimizationCriterion, self$optimizationCriterion)) { + return(self$.pasteComparisonResult("optimizationCriterion", optimizationCriterion, self$optimizationCriterion)) + } + if (!identical(typeBetaSpending, self$typeBetaSpending)) { + return(self$.pasteComparisonResult("typeBetaSpending", typeBetaSpending, self$typeBetaSpending)) + } + if (!identical(gammaA, self$gammaA)) { + return(self$.pasteComparisonResult("gammaA", gammaA, self$gammaA)) + } + if (!identical(gammaB, self$gammaB)) {#TODO + return(self$.pasteComparisonResult("gammaB", gammaB, self$gammaB)) + } + if ((typeOfDesign == C_TYPE_OF_DESIGN_PT && !identical(bindingFutility, self$bindingFutility)) || + (!identical(bindingFutility, self$bindingFutility) && + self$.getParameterType("futilityBounds") != C_PARAM_NOT_APPLICABLE && + (sided == 1 || !grepl("^as.*", typeOfDesign) || typeBetaSpending == C_TYPE_OF_DESIGN_BS_NONE) && + (any(na.omit(futilityBounds) > -6) || any(na.omit(self$futilityBounds) > -6)) + )) { + return(self$.pasteComparisonResult("bindingFutility", bindingFutility, self$bindingFutility)) + } + if (!identical(userAlphaSpending, self$userAlphaSpending)) { + return(self$.pasteComparisonResult("userAlphaSpending", userAlphaSpending, self$userAlphaSpending)) + } + if (!identical(userBetaSpending, self$userBetaSpending)) { + return(self$.pasteComparisonResult("userBetaSpending", userBetaSpending, self$userBetaSpending)) + } + if (!identical(twoSidedPower, self$twoSidedPower)) { + return(self$.pasteComparisonResult("twoSidedPower", twoSidedPower, self$twoSidedPower)) + } + if (typeOfDesign == C_TYPE_OF_DESIGN_HP) { + if (!identical(constantBoundsHP, self$constantBoundsHP)) { + return(self$.pasteComparisonResult("constantBoundsHP", constantBoundsHP, self$constantBoundsHP)) + } + } + return(FALSE) + }, + + # Defines the order of the parameter output + .getParametersToShow = function() { + return(c( + "typeOfDesign", + "kMax", + "stages", + "informationRates", + "alpha", + "beta", + "power", + "twoSidedPower", + "deltaWT", + "deltaPT1", + "deltaPT0", + "futilityBounds", + "bindingFutility", + "constantBoundsHP", + "gammaA", + "gammaB", + "optimizationCriterion", + "sided", + "betaAdjustment", + "delayedInformation", + "tolerance", + "alphaSpent", + "userAlphaSpending", + "betaSpent", + "typeBetaSpending", + "userBetaSpending", + "criticalValues", + "stageLevels", + "decisionCriticalValues", + "reversalProbabilities" + )) + } + ) ) #' @@ -897,20 +895,19 @@ TrialDesignInverseNormal <- setRefClass(C_CLASS_NAME_TRIAL_DESIGN_INVERSE_NORMAL #' #' @importFrom methods new #' -TrialDesignGroupSequential <- setRefClass( - C_CLASS_NAME_TRIAL_DESIGN_GROUP_SEQUENTIAL, - contains = C_CLASS_NAME_TRIAL_DESIGN_INVERSE_NORMAL, - methods = list( - initialize = function(...) { - callSuper(...) - .parameterFormatFunctions$criticalValues <<- ".formatCriticalValues" - .initStages() - }, - show = function(showType = 1, digits = NA_integer_) { - "Method for automatically printing trial design objects" - callSuper(showType = showType, digits = digits) - } - ) +TrialDesignGroupSequentialR6 <- R6Class("TrialDesignGroupSequentialR6", + inherit = TrialDesignInverseNormalR6, + public = list( + initialize = function(...) { + self$.parameterFormatFunctions$criticalValues <- ".formatCriticalValues" + super$initialize(...) + self$.initStages() + }, + show = function(showType = 1, digits = NA_integer_) { + "Method for automatically printing trial design objects" + super$show(showType = showType, digits = digits) + } + ) ) #' @@ -950,52 +947,49 @@ TrialDesignGroupSequential <- setRefClass( #' #' @seealso \code{\link{getDesignConditionalDunnett}} for creating a conditional Dunnett test design. #' -TrialDesignConditionalDunnett <- setRefClass( - C_CLASS_NAME_TRIAL_DESIGN_CONDITIONAL_DUNNETT, - contains = "TrialDesign", - fields = list( - informationAtInterim = "numeric", - secondStageConditioning = "logical", - sided = "integer" - ), - methods = list( - initialize = function(...) { - callSuper(...) - - notApplicableParameters <- c( - "kMax", - "stages", - "informationRates", - "userAlphaSpending", - "criticalValues", - "stageLevels", - "alphaSpent", - "bindingFutility", - "tolerance" - ) - for (notApplicableParameter in notApplicableParameters) { - .setParameterType(notApplicableParameter, C_PARAM_NOT_APPLICABLE) - } - .setParameterType("alpha", ifelse( - identical(alpha, C_ALPHA_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - .setParameterType("informationAtInterim", ifelse( - identical(informationAtInterim, 0.5), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - .setParameterType("secondStageConditioning", ifelse( - identical(secondStageConditioning, TRUE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - - kMax <<- 2L - sided <<- 1L - - .initStages() - }, - show = function(showType = 1, digits = NA_integer_) { - "Method for automatically printing trial design objects" - callSuper(showType = showType, digits = digits) - } - ) +TrialDesignConditionalDunnettR6 <- R6Class("TrialDesignConditionalDunnettR6", + inherit = TrialDesignR6, + public = list( + informationAtInterim = NULL, + secondStageConditioning = NULL, + sided = NULL, + initialize = function(...,informationAtInterim = NULL, secondStageConditioning = NULL) { + super$initialize(...) + + notApplicableParameters <- c( + "kMax", + "stages", + "informationRates", + "userAlphaSpending", + "criticalValues", + "stageLevels", + "alphaSpent", + "bindingFutility", + "tolerance" + ) + for (notApplicableParameter in notApplicableParameters) { + self$.setParameterType(notApplicableParameter, C_PARAM_NOT_APPLICABLE) + } + self$.setParameterType("alpha", ifelse( + identical(self$alpha, C_ALPHA_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + self$.setParameterType("informationAtInterim", ifelse( + identical(self$informationAtInterim, 0.5), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + self$.setParameterType("secondStageConditioning", ifelse( + identical(self$secondStageConditioning, TRUE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + + self$kMax <- 2L + self$sided <- 1L + + self$.initStages() + }, + show = function(showType = 1, digits = NA_integer_) { + "Method for automatically printing trial design objects" + super$show(showType = showType, digits = digits) + } + ) ) #' @@ -1028,15 +1022,15 @@ TrialDesignConditionalDunnett <- setRefClass( #' @export #' getDesignConditionalDunnett <- function(alpha = 0.025, # C_ALPHA_DEFAULT - informationAtInterim = 0.5, secondStageConditioning = TRUE) { - .assertIsValidAlpha(alpha) - .assertIsSingleNumber(informationAtInterim, "informationAtInterim") - .assertIsInOpenInterval(informationAtInterim, "informationAtInterim", 0, 1) - return(TrialDesignConditionalDunnett( - alpha = alpha, - informationAtInterim = informationAtInterim, - secondStageConditioning = secondStageConditioning - )) + informationAtInterim = 0.5, secondStageConditioning = TRUE) { + .assertIsValidAlpha(alpha) + .assertIsSingleNumber(informationAtInterim, "informationAtInterim") + .assertIsInOpenInterval(informationAtInterim, "informationAtInterim", 0, 1) + return(TrialDesignConditionalDunnettR6$new( + alpha = alpha, + informationAtInterim = informationAtInterim, + secondStageConditioning = secondStageConditioning + )) } #' @@ -1109,57 +1103,110 @@ getDesignConditionalDunnett <- function(alpha = 0.025, # C_ALPHA_DEFAULT #' #' @export #' -plot.TrialDesign <- function(x, y, ..., main = NA_character_, - xlab = NA_character_, ylab = NA_character_, type = 1L, palette = "Set1", - theta = seq(-1, 1, 0.01), nMax = NA_integer_, plotPointsEnabled = NA, - legendPosition = NA_integer_, showSource = FALSE, - grid = 1, plotSettings = NULL) { - fCall <- match.call(expand.dots = FALSE) - designName <- deparse(fCall$x) - .assertGgplotIsInstalled() - .assertIsSingleInteger(grid, "grid", validateType = FALSE) - typeNumbers <- .getPlotTypeNumber(type, x) - if (is.null(plotSettings)) { - plotSettings <- .getGridPlotSettings(x, typeNumbers, grid) - } - p <- NULL - plotList <- list() - for (typeNumber in typeNumbers) { - p <- .plotTrialDesign( - x = x, y = y, main = main, - xlab = xlab, ylab = ylab, type = typeNumber, palette = palette, - theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, - legendPosition = .getGridLegendPosition(legendPosition, typeNumbers, grid), - showSource = showSource, designName = designName, - plotSettings = plotSettings, ... - ) - .printPlotShowSourceSeparator(showSource, typeNumber, typeNumbers) - if (length(typeNumbers) > 1) { - caption <- .getPlotCaption(x, typeNumber, stopIfNotFound = TRUE) - plotList[[caption]] <- p - } - } - if (length(typeNumbers) == 1) { - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(p)) - } - - return(p) +plot.TrialDesignR6 <- function(x, y, ..., main = NA_character_, + xlab = NA_character_, ylab = NA_character_, type = 1L, palette = "Set1", + theta = seq(-1, 1, 0.01), nMax = NA_integer_, plotPointsEnabled = NA, + legendPosition = NA_integer_, showSource = FALSE, + grid = 1, plotSettings = NULL) { + fCall <- match.call(expand.dots = FALSE) + designName <- deparse(fCall$x) + .assertGgplotIsInstalled() + .assertIsSingleInteger(grid, "grid", validateType = FALSE) + typeNumbers <- .getPlotTypeNumber(type, x) + if (is.null(plotSettings)) { + plotSettings <- .getGridPlotSettings(x, typeNumbers, grid) + } + p <- NULL + plotList <- list() + for (typeNumber in typeNumbers) { + p <- .plotTrialDesign( + x = x, y = y, main = main, + xlab = xlab, ylab = ylab, type = typeNumber, palette = palette, + theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, + legendPosition = .getGridLegendPosition(legendPosition, typeNumbers, grid), + showSource = showSource, designName = designName, + plotSettings = plotSettings, ... + ) + .printPlotShowSourceSeparator(showSource, typeNumber, typeNumbers) + if (length(typeNumbers) > 1) { + caption <- .getPlotCaption(x, typeNumber, stopIfNotFound = TRUE) + plotList[[caption]] <- p } - + } + if (length(typeNumbers) == 1) { if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(plotList)) + return(invisible(p)) } - - return(.createPlotResultObject(plotList, grid)) + + return(p) + } + + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(plotList)) + } + + return(.createPlotResultObject(plotList, grid)) } #' @rdname plot.TrialDesign #' @export -plot.TrialDesignCharacteristics <- function(x, y, ...) { - plot(x = x$.design, y = y, ...) +plot.TrialDesignCharacteristicsR6 <- function(x, y, ...) { + plot(x = x$.design, y = y, ...) } +.plotTrialDesign <- function(..., x, y, main, + xlab, ylab, type, palette, + theta, nMax, plotPointsEnabled, + legendPosition, showSource, designName, plotSettings = NULL) {#TODO + .assertGgplotIsInstalled() + + .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) + if (any(.isTrialDesignFisher(x)) && !(type %in% c(1, 3, 4))) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'type' (", type, ") is not allowed for Fisher designs; must be 1, 3 or 4" + ) + } + + .warnInCaseOfUnknownArguments( + functionName = "plot", + ignore = c("xlim", "ylim", "companyAnnotationEnabled", "variedParameters"), ... + ) + + if ((type < 5 || type > 9) && !identical(theta, seq(-1, 1, 0.01))) { + warning("'theta' (", .reconstructSequenceCommand(theta), ") will be ignored for plot type ", type, call. = FALSE) + } + + if (!missing(y) && !is.null(y) && length(y) == 1 && inherits(y, "TrialDesign")) { + args <- list(...) + variedParameters <- args[["variedParameters"]] + if (is.null(variedParameters)) { + if (.isTrialDesignInverseNormalOrGroupSequential(x) && + .isTrialDesignInverseNormalOrGroupSequential(y) && + x$typeOfDesign != y$typeOfDesign) { + variedParameters <- "typeOfDesign" + } else { + stop( + C_EXCEPTION_TYPE_MISSING_ARGUMENT, + "'variedParameters' needs to be specified, e.g., variedParameters = \"typeOfDesign\"" + ) + } + } + designSet <- getDesignSet(designs = c(x, y), variedParameters = variedParameters) + } else { + designSet <- TrialDesignSetR6$new(design = x, singleDesign = TRUE) + if (!is.null(plotSettings)) { + designSet$.plotSettings <- plotSettings + } + } + + .plotTrialDesignSet( + x = designSet, y = y, main = main, xlab = xlab, ylab = ylab, type = type, + palette = palette, theta = theta, nMax = nMax, + plotPointsEnabled = plotPointsEnabled, legendPosition = legendPosition, + showSource = showSource, designSetName = designName, ... + ) +} #' #' @title @@ -1185,20 +1232,20 @@ plot.TrialDesignCharacteristics <- function(x, y, ...) { #' #' @keywords internal #' -as.data.frame.TrialDesign <- function(x, row.names = NULL, - optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ...) { - .assertIsTrialDesign(x) - - if (includeAllParameters) { - parameterNames <- NULL - } else { - parameterNames <- x$.getParametersToShow() - } - return(.getAsDataFrame( - parameterSet = x, - parameterNames = parameterNames, - niceColumnNamesEnabled = niceColumnNamesEnabled, - includeAllParameters = includeAllParameters, - tableColumnNames = .getTableColumnNames(design = x) - )) +as.data.frame.TrialDesignR6 <- function(x, row.names = NULL, + optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ...) { + .assertIsTrialDesign(x) + + if (includeAllParameters) { + parameterNames <- NULL + } else { + parameterNames <- x$.getParametersToShow() + } + return(.getAsDataFrame( + parameterSet = x, + parameterNames = parameterNames, + niceColumnNamesEnabled = niceColumnNamesEnabled, + includeAllParameters = includeAllParameters, + tableColumnNames = .getTableColumnNames(design = x) + )) } diff --git a/R/class_design_plan.R b/R/class_design_plan.R index 331505c7..476aa28c 100644 --- a/R/class_design_plan.R +++ b/R/class_design_plan.R @@ -94,42 +94,42 @@ C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_SURVIVAL <- list( #' #' @importFrom methods new #' -TrialDesignPlan <- setRefClass("TrialDesignPlan", - contains = "ParameterSet", - fields = list( - .plotSettings = "ANY", - .design = "ANY", - .objectType = "character" # "sampleSize" or "power" - ), - methods = list( +TrialDesignPlanR6 <- R6Class("TrialDesignPlanR6", + inherit = ParameterSetR6, + public = list( + .plotSettings = NULL, + .design = NULL, + .objectType = NULL, # "sampleSize" or "power" initialize = function(design, ...) { - callSuper(.design = design, ...) + self$.design <- design + + super$initialize(...)#TODO - .plotSettings <<- PlotSettingsR6$new() - .parameterNames <<- .getParameterNames(design = design, designPlan = .self) - .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS + self$.plotSettings <- PlotSettingsR6$new() + self$.parameterNames <- .getParameterNames(design = design, designPlan = self) + self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS - if (.isTrialDesignPlanMeans(.self)) { + if (.isTrialDesignPlanMeans(self)) { defaultValueList <- C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS - } else if (.isTrialDesignPlanRates(.self)) { + } else if (.isTrialDesignPlanRates(self)) { defaultValueList <- C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES - } else if (.isTrialDesignPlanSurvival(.self)) { + } else if (.isTrialDesignPlanSurvival(self)) { defaultValueList <- C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_SURVIVAL } - for (parameterName in .getVisibleFieldNames()) { + for (parameterName in self$.getVisibleFieldNames()) { defaultValue <- defaultValueList[[parameterName]] - existingValue <- .self[[parameterName]] + existingValue <- self[[parameterName]] if (all(is.na(existingValue))) { - .setParameterType(parameterName, C_PARAM_DEFAULT_VALUE) + self$.setParameterType(parameterName, C_PARAM_DEFAULT_VALUE) } else if (!is.null(defaultValue) && length(defaultValue) == length(existingValue) && !any(is.na(defaultValue)) && !any(is.na(existingValue)) && sum(defaultValue == existingValue) == length(defaultValue)) { - .setParameterType(parameterName, C_PARAM_DEFAULT_VALUE) + self$.setParameterType(parameterName, C_PARAM_DEFAULT_VALUE) } else { - .setParameterType(parameterName, C_PARAM_USER_DEFINED) + self$.setParameterType(parameterName, C_PARAM_USER_DEFINED) } } - .setParameterType("optimumAllocationRatio", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("optimumAllocationRatio", C_PARAM_NOT_APPLICABLE) }, .setSampleSizeObject = function(objectType) { if (length(objectType) == 0 || !(objectType %in% c("sampleSize", "power"))) { @@ -138,105 +138,105 @@ TrialDesignPlan <- setRefClass("TrialDesignPlan", ") must be specified as 'sampleSize' or 'power'" ) } - .objectType <<- objectType + self$.objectType <- objectType }, .isSampleSizeObject = function() { - if (length(.objectType) == 0 || !(.objectType %in% c("sampleSize", "power"))) { + if (length(self$.objectType) == 0 || !(self$.objectType %in% c("sampleSize", "power"))) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'.objectType' must be specified as 'sampleSize' or 'power'") } - return(.objectType == "sampleSize") + return(self$.objectType == "sampleSize") }, .isPowerObject = function() { - if (length(.objectType) == 0 || !(.objectType %in% c("sampleSize", "power"))) { + if (length(self$.objectType) == 0 || !(self$.objectType %in% c("sampleSize", "power"))) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'.objectType' must be specified as 'sampleSize' or 'power'") } - return(.objectType == "power") + return(self$.objectType == "power") }, getPlotSettings = function() { - return(.plotSettings) + return(self$.plotSettings) }, show = function(showType = 1, digits = NA_integer_) { - .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) }, .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { "Method for automatically printing trial plan objects" - .resetCat() + self$.resetCat() if (showType == 3) { - .createSummary(.self, digits = digits)$.show( + .createSummary(self, digits = digits)$.show( showType = 1, digits = digits, consoleOutputEnabled = consoleOutputEnabled ) } else if (showType == 2) { - callSuper(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) } else { - .cat("Design plan parameters and output for ", .toString(), ":\n\n", + self$.cat("Design plan parameters and output for ", self$.toString(), ":\n\n", heading = 1, consoleOutputEnabled = consoleOutputEnabled ) - .showParametersOfOneGroup(.getDesignParametersToShow(.self), "Design parameters", + self$.showParametersOfOneGroup(.getDesignParametersToShow(self), "Design parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled ) - .showParametersOfOneGroup(.getUserDefinedParameters(), "User defined parameters", + self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled ) - .showParametersOfOneGroup(.getDefaultParameters(), "Default parameters", + self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled ) - .showParametersOfOneGroup(.getGeneratedParameters(), "Sample size and output", + self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Sample size and output", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled ) - .showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - if (inherits(.self, "TrialDesignPlanSurvival") || groups == 2 || .design$kMax > 1) { - .cat("Legend:\n", + if (inherits(self, "TrialDesignPlanSurvival") || inherits(self, "TrialDesignPlanSurvivalR6") || self$groups == 2 || self$.design$kMax > 1) {#TODO Groups???? + self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled ) - if (inherits(.self, "TrialDesignPlanSurvival") || groups == 2) { - .cat(" (i): values of treatment arm i\n", + if (inherits(self, "TrialDesignPlanSurvival") || inherits(self, "TrialDesignPlanSurvivalR6") || self$groups == 2) { + self$.cat(" (i): values of treatment arm i\n", consoleOutputEnabled = consoleOutputEnabled ) } - if (.design$kMax > 1) { - .cat(" [k]: values at stage k\n", consoleOutputEnabled = consoleOutputEnabled) + if (self$.design$kMax > 1) { + self$.cat(" [k]: values at stage k\n", consoleOutputEnabled = consoleOutputEnabled) } } - .cat("\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) } }, getAlpha = function() { - return(.design$alpha) + return(self$.design$alpha) }, getBeta = function() { - if (.isTrialDesignInverseNormalOrGroupSequential(.design)) { - return(.design$beta) + if (.isTrialDesignInverseNormalOrGroupSequential(self$.design)) { + return(self$.design$beta) } return(NA_real_) }, getSided = function() { - return(.design$sided) + return(self$.design$sided) }, getTwoSidedPower = function() { - if (.isTrialDesignInverseNormalOrGroupSequential(.design)) { - return(.design$twoSidedPower) + if (.isTrialDesignInverseNormalOrGroupSequential(self$.design)) { + return(self$.design$twoSidedPower) } return(NA) }, .toString = function(startWithUpperCase = FALSE) { - if (.isTrialDesignPlanMeans(.self)) { + if (.isTrialDesignPlanMeans(self)) { s <- "means" - } else if (.isTrialDesignPlanRates(.self)) { + } else if (.isTrialDesignPlanRates(self)) { s <- "rates" - } else if (.isTrialDesignPlanSurvival(.self)) { + } else if (.isTrialDesignPlanSurvival(self)) { s <- "survival data" } else { - s <- paste0("unknown data class '", .getClassName(.self), "'") + s <- paste0("unknown data class '", .getClassName(self), "'") } - return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) + return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) #TODO correct closure of s? } ) ) @@ -265,7 +265,7 @@ TrialDesignPlan <- setRefClass("TrialDesignPlan", #' #' @keywords internal #' -as.data.frame.TrialDesignPlan <- function(x, row.names = NULL, +as.data.frame.TrialDesignPlanR6 <- function(x, row.names = NULL, optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ...) { return(.getAsDataFrame( parameterSet = x, @@ -335,48 +335,46 @@ as.data.frame.TrialDesignPlan <- function(x, row.names = NULL, #' #' @importFrom methods new #' -TrialDesignPlanMeans <- setRefClass("TrialDesignPlanMeans", - contains = "TrialDesignPlan", - fields = list( - meanRatio = "logical", - thetaH0 = "numeric", - normalApproximation = "logical", - alternative = "numeric", - stDev = "numeric", - groups = "numeric", - allocationRatioPlanned = "numeric", - optimumAllocationRatio = "logical", - directionUpper = "logical", - effect = "numeric", - overallReject = "numeric", - rejectPerStage = "matrix", - futilityStop = "numeric", - futilityPerStage = "matrix", - earlyStop = "numeric", - expectedNumberOfSubjects = "numeric", - nFixed = "numeric", - nFixed1 = "numeric", - nFixed2 = "numeric", - informationRates = "matrix", - maxNumberOfSubjects = "numeric", - maxNumberOfSubjects1 = "numeric", - maxNumberOfSubjects2 = "numeric", - numberOfSubjects = "matrix", - numberOfSubjects1 = "matrix", - numberOfSubjects2 = "matrix", - expectedNumberOfSubjectsH0 = "numeric", - expectedNumberOfSubjectsH01 = "numeric", - expectedNumberOfSubjectsH1 = "numeric", - criticalValuesEffectScale = "matrix", - criticalValuesEffectScaleLower = "matrix", - criticalValuesEffectScaleUpper = "matrix", - criticalValuesPValueScale = "matrix", - futilityBoundsEffectScale = "matrix", - futilityBoundsEffectScaleLower = "matrix", - futilityBoundsEffectScaleUpper = "matrix", - futilityBoundsPValueScale = "matrix" - ), - methods = list( +TrialDesignPlanMeansR6 <- R6Class("TrialDesignPlanMeansR6", + inherit = TrialDesignPlanR6, + public = list( + meanRatio = NULL, + thetaH0 = NULL, + normalApproximation = NULL, + alternative = NULL, + stDev = NULL, + groups = NULL, + allocationRatioPlanned = NULL, + optimumAllocationRatio = NULL, + directionUpper = NULL, + effect = NULL, + overallReject = NULL, + rejectPerStage = NULL, + futilityStop = NULL, + futilityPerStage = NULL, + earlyStop = NULL, + expectedNumberOfSubjects = NULL, + nFixed = NULL, + nFixed1 = NULL, + nFixed2 = NULL, + informationRates = NULL, + maxNumberOfSubjects = NULL, + maxNumberOfSubjects1 = NULL, + maxNumberOfSubjects2 = NULL, + numberOfSubjects = NULL, + numberOfSubjects1 = NULL, + numberOfSubjects2 = NULL, + expectedNumberOfSubjectsH0 = NULL, + expectedNumberOfSubjectsH01 = NULL, + expectedNumberOfSubjectsH1 = NULL, + criticalValuesEffectScale = NULL, + criticalValuesEffectScaleLower = NULL, + criticalValuesEffectScaleUpper = NULL, + criticalValuesPValueScale = NULL, + futilityBoundsEffectScale = NULL, + futilityBoundsEffectScaleLower = NULL, + futilityBoundsEffectScaleUpper = NULL, + futilityBoundsPValueScale = NULL, initialize = function(..., normalApproximation = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS[["normalApproximation"]], meanRatio = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS[["meanRatio"]], @@ -385,75 +383,43 @@ TrialDesignPlanMeans <- setRefClass("TrialDesignPlanMeans", stDev = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS[["stDev"]], groups = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS[["groups"]], allocationRatioPlanned = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS[["allocationRatioPlanned"]]) { - callSuper(..., - normalApproximation = normalApproximation, - meanRatio = meanRatio, - thetaH0 = thetaH0, - alternative = alternative, - stDev = stDev, - groups = groups, - allocationRatioPlanned = allocationRatioPlanned - ) + + super$initialize(...)#TODO - optimumAllocationRatio <<- FALSE - visibleFieldNames <- .getVisibleFieldNames() + self$normalApproximation <- normalApproximation + self$meanRatio <- meanRatio + self$thetaH0 <- thetaH0 + self$alternative <- alternative + self$stDev <- stDev + self$groups <- groups + self$allocationRatioPlanned <- allocationRatioPlanned + + self$optimumAllocationRatio <- FALSE + visibleFieldNames <- self$.getVisibleFieldNames() startIndex <- which(visibleFieldNames == "directionUpper") for (i in startIndex:length(visibleFieldNames)) { - .setParameterType(visibleFieldNames[i], C_PARAM_NOT_APPLICABLE) + self$.setParameterType(visibleFieldNames[i], C_PARAM_NOT_APPLICABLE) } - if (groups == 1) { - .setParameterType("meanRatio", C_PARAM_NOT_APPLICABLE) - .setParameterType("allocationRatioPlanned", C_PARAM_NOT_APPLICABLE) + if (self$groups == 1) { + self$.setParameterType("meanRatio", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("allocationRatioPlanned", C_PARAM_NOT_APPLICABLE) } - .setParameterType("maxNumberOfSubjects1", C_PARAM_NOT_APPLICABLE) - .setParameterType("maxNumberOfSubjects2", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("maxNumberOfSubjects1", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("maxNumberOfSubjects2", C_PARAM_NOT_APPLICABLE) - .setParameterType("criticalValuesEffectScale", C_PARAM_NOT_APPLICABLE) - .setParameterType("criticalValuesEffectScaleLower", C_PARAM_NOT_APPLICABLE) - .setParameterType("criticalValuesEffectScaleUpper", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("criticalValuesEffectScale", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("criticalValuesEffectScaleLower", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("criticalValuesEffectScaleUpper", C_PARAM_NOT_APPLICABLE) - .setParameterType("futilityBoundsEffectScale", C_PARAM_NOT_APPLICABLE) - .setParameterType("futilityBoundsEffectScaleLower", C_PARAM_NOT_APPLICABLE) - .setParameterType("futilityBoundsEffectScaleUpper", C_PARAM_NOT_APPLICABLE) - }, - clone = function(alternative = NA_real_) { - alternativeTemp <- alternative - if (any(is.na(alternative))) { - alternativeTemp <- .self$alternative - } - if (.objectType == "sampleSize") { - result <- getSampleSizeMeans( - design = .self$.design, - normalApproximation = .self$.getParameterValueIfUserDefinedOrDefault("normalApproximation"), - meanRatio = .self$meanRatio, # .getParameterValueIfUserDefinedOrDefault("meanRatio"), - thetaH0 = .self$.getParameterValueIfUserDefinedOrDefault("thetaH0"), - alternative = alternativeTemp, - stDev = .self$.getParameterValueIfUserDefinedOrDefault("stDev"), - groups = .self$.getParameterValueIfUserDefinedOrDefault("groups"), - allocationRatioPlanned = .self$.getParameterValueIfUserDefinedOrDefault("allocationRatioPlanned") - ) - } else { - result <- getPowerMeans( - design = .self$.design, - normalApproximation = .self$.getParameterValueIfUserDefinedOrDefault("normalApproximation"), - meanRatio = .self$meanRatio, # .getParameterValueIfUserDefinedOrDefault("meanRatio"), - thetaH0 = .self$.getParameterValueIfUserDefinedOrDefault("thetaH0"), - alternative = alternativeTemp, - stDev = .self$.getParameterValueIfUserDefinedOrDefault("stDev"), - directionUpper = .self$.getParameterValueIfUserDefinedOrDefault("directionUpper"), - maxNumberOfSubjects = .self$.getParameterValueIfUserDefinedOrDefault("maxNumberOfSubjects"), - groups = .self$.getParameterValueIfUserDefinedOrDefault("groups"), - allocationRatioPlanned = .self$.getParameterValueIfUserDefinedOrDefault("allocationRatioPlanned") - ) - } - result$.plotSettings <- .self$.plotSettings - return(result) + self$.setParameterType("futilityBoundsEffectScale", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("futilityBoundsEffectScaleLower", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("futilityBoundsEffectScaleUpper", C_PARAM_NOT_APPLICABLE) }, show = function(showType = 1, digits = NA_integer_) { "Method for automatically printing trial plan objects" - callSuper(showType = showType, digits = digits) + super$show(showType = showType, digits = digits) } ) ) @@ -518,48 +484,46 @@ TrialDesignPlanMeans <- setRefClass("TrialDesignPlanMeans", #' #' @importFrom methods new #' -TrialDesignPlanRates <- setRefClass("TrialDesignPlanRates", - contains = "TrialDesignPlan", - fields = list( - riskRatio = "logical", - thetaH0 = "numeric", - normalApproximation = "logical", - pi1 = "numeric", - pi2 = "numeric", - groups = "numeric", - allocationRatioPlanned = "numeric", - optimumAllocationRatio = "logical", - directionUpper = "logical", - effect = "numeric", - expectedNumberOfSubjects = "numeric", - nFixed = "numeric", - nFixed1 = "numeric", - nFixed2 = "numeric", - overallReject = "numeric", - rejectPerStage = "matrix", - futilityStop = "numeric", - futilityPerStage = "matrix", - earlyStop = "numeric", - informationRates = "matrix", - maxNumberOfSubjects = "numeric", - maxNumberOfSubjects1 = "numeric", - maxNumberOfSubjects2 = "numeric", - numberOfSubjects = "matrix", - numberOfSubjects1 = "matrix", - numberOfSubjects2 = "matrix", - expectedNumberOfSubjectsH0 = "numeric", - expectedNumberOfSubjectsH01 = "numeric", - expectedNumberOfSubjectsH1 = "numeric", - criticalValuesEffectScale = "matrix", - criticalValuesEffectScaleLower = "matrix", - criticalValuesEffectScaleUpper = "matrix", - criticalValuesPValueScale = "matrix", - futilityBoundsEffectScale = "matrix", - futilityBoundsEffectScaleLower = "matrix", - futilityBoundsEffectScaleUpper = "matrix", - futilityBoundsPValueScale = "matrix" - ), - methods = list( +TrialDesignPlanRatesR6 <- R6Class("TrialDesignPlanRatesR6", + inherit = TrialDesignPlanR6, + public = list( + riskRatio = NULL, + thetaH0 = NULL, + normalApproximation = NULL, + pi1 = NULL, + pi2 = NULL, + groups = NULL, + allocationRatioPlanned = NULL, + optimumAllocationRatio = NULL, + directionUpper = NULL, + effect = NULL, + expectedNumberOfSubjects = NULL, + nFixed = NULL, + nFixed1 = NULL, + nFixed2 = NULL, + overallReject = NULL, + rejectPerStage = NULL, + futilityStop = NULL, + futilityPerStage = NULL, + earlyStop = NULL, + informationRates = NULL, + maxNumberOfSubjects = NULL, + maxNumberOfSubjects1 = NULL, + maxNumberOfSubjects2 = NULL, + numberOfSubjects = NULL, + numberOfSubjects1 = NULL, + numberOfSubjects2 = NULL, + expectedNumberOfSubjectsH0 = NULL, + expectedNumberOfSubjectsH01 = NULL, + expectedNumberOfSubjectsH1 = NULL, + criticalValuesEffectScale = NULL, + criticalValuesEffectScaleLower = NULL, + criticalValuesEffectScaleUpper = NULL, + criticalValuesPValueScale = NULL, + futilityBoundsEffectScale = NULL, + futilityBoundsEffectScaleLower = NULL, + futilityBoundsEffectScaleUpper = NULL, + futilityBoundsPValueScale = NULL, initialize = function(..., normalApproximation = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["normalApproximation"]], riskRatio = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["riskRatio"]], @@ -568,72 +532,42 @@ TrialDesignPlanRates <- setRefClass("TrialDesignPlanRates", pi2 = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["pi2"]], groups = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["groups"]], allocationRatioPlanned = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["allocationRatioPlanned"]]) { - callSuper(..., - normalApproximation = normalApproximation, - riskRatio = riskRatio, - thetaH0 = thetaH0, - pi1 = pi1, - pi2 = pi2, - groups = groups, - allocationRatioPlanned = allocationRatioPlanned - ) + super$initialize(...) #TODO + + self$normalApproximation <- normalApproximation + self$riskRatio <- riskRatio + self$thetaH0 <- thetaH0 + self$pi1 <- pi1 + self$pi2 <- pi2 + self$groups <- groups + self$allocationRatioPlanned <- allocationRatioPlanned - optimumAllocationRatio <<- FALSE - visibleFieldNames <- .getVisibleFieldNames() + self$optimumAllocationRatio <- FALSE + visibleFieldNames <- self$.getVisibleFieldNames() startIndex <- which(visibleFieldNames == "directionUpper") for (i in startIndex:length(visibleFieldNames)) { - .setParameterType(visibleFieldNames[i], C_PARAM_NOT_APPLICABLE) + self$.setParameterType(visibleFieldNames[i], C_PARAM_NOT_APPLICABLE) } - if (groups == 1) { - .setParameterType("meanRatio", C_PARAM_NOT_APPLICABLE) - .setParameterType("allocationRatioPlanned", C_PARAM_NOT_APPLICABLE) + if (self$groups == 1) { + self$.setParameterType("meanRatio", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("allocationRatioPlanned", C_PARAM_NOT_APPLICABLE) } - .setParameterType("maxNumberOfSubjects1", C_PARAM_NOT_APPLICABLE) - .setParameterType("maxNumberOfSubjects2", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("maxNumberOfSubjects1", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("maxNumberOfSubjects2", C_PARAM_NOT_APPLICABLE) - .setParameterType("criticalValuesEffectScale", C_PARAM_NOT_APPLICABLE) - .setParameterType("criticalValuesEffectScaleLower", C_PARAM_NOT_APPLICABLE) - .setParameterType("criticalValuesEffectScaleUpper", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("criticalValuesEffectScale", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("criticalValuesEffectScaleLower", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("criticalValuesEffectScaleUpper", C_PARAM_NOT_APPLICABLE) - .setParameterType("futilityBoundsEffectScale", C_PARAM_NOT_APPLICABLE) - .setParameterType("futilityBoundsEffectScaleLower", C_PARAM_NOT_APPLICABLE) - .setParameterType("futilityBoundsEffectScaleUpper", C_PARAM_NOT_APPLICABLE) - }, - clone = function(pi1 = NA_real_) { - pi1Temp <- pi1 - if (any(is.na(pi1))) { - pi1Temp <- .self$pi1 - } - if (.objectType == "sampleSize") { - return(getSampleSizeRates( - design = .self$.design, - normalApproximation = .self$.getParameterValueIfUserDefinedOrDefault("normalApproximation"), - riskRatio = .self$riskRatio, # .getParameterValueIfUserDefinedOrDefault("riskRatio"), - thetaH0 = .self$.getParameterValueIfUserDefinedOrDefault("thetaH0"), - pi1 = pi1Temp, - pi2 = .self$.getParameterValueIfUserDefinedOrDefault("pi2"), - groups = .self$.getParameterValueIfUserDefinedOrDefault("groups"), - allocationRatioPlanned = .self$.getParameterValueIfUserDefinedOrDefault("allocationRatioPlanned") - )) - } else { - return(getPowerRates( - design = .self$.design, - riskRatio = .self$riskRatio, # .getParameterValueIfUserDefinedOrDefault("riskRatio"), - thetaH0 = .self$.getParameterValueIfUserDefinedOrDefault("thetaH0"), - pi1 = pi1Temp, - pi2 = .self$.getParameterValueIfUserDefinedOrDefault("pi2"), - directionUpper = .self$.getParameterValueIfUserDefinedOrDefault("directionUpper"), - maxNumberOfSubjects = .self$.getParameterValueIfUserDefinedOrDefault("maxNumberOfSubjects"), - groups = .self$.getParameterValueIfUserDefinedOrDefault("groups"), - allocationRatioPlanned = .self$.getParameterValueIfUserDefinedOrDefault("allocationRatioPlanned") - )) - } + self$.setParameterType("futilityBoundsEffectScale", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("futilityBoundsEffectScaleLower", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("futilityBoundsEffectScaleUpper", C_PARAM_NOT_APPLICABLE) }, show = function(showType = 1, digits = NA_integer_) { "Method for automatically printing trial plan objects" - callSuper(showType = showType, digits = digits) + super$show(showType = showType, digits = digits) } ) ) @@ -723,102 +657,130 @@ TrialDesignPlanRates <- setRefClass("TrialDesignPlanRates", #' #' @importFrom methods new #' -TrialDesignPlanSurvival <- setRefClass("TrialDesignPlanSurvival", - contains = "TrialDesignPlan", - fields = list( - .piecewiseSurvivalTime = "ANY", - .accrualTime = "ANY", - .calculateFollowUpTime = "logical", - thetaH0 = "numeric", - typeOfComputation = "character", - directionUpper = "logical", - pi1 = "numeric", - pi2 = "numeric", - median1 = "numeric", - median2 = "numeric", - lambda1 = "numeric", - lambda2 = "numeric", - hazardRatio = "numeric", - maxNumberOfSubjects = "numeric", - maxNumberOfSubjects1 = "numeric", - maxNumberOfSubjects2 = "numeric", - maxNumberOfEvents = "numeric", - allocationRatioPlanned = "numeric", - optimumAllocationRatio = "logical", - accountForObservationTimes = "logical", - eventTime = "numeric", - accrualTime = "numeric", - totalAccrualTime = "numeric", - accrualIntensity = "numeric", - accrualIntensityRelative = "numeric", - kappa = "numeric", - piecewiseSurvivalTime = "numeric", - followUpTime = "numeric", - dropoutRate1 = "numeric", - dropoutRate2 = "numeric", - dropoutTime = "numeric", - chi = "numeric", - expectedNumberOfEvents = "numeric", - eventsFixed = "numeric", - nFixed = "numeric", - nFixed1 = "numeric", - nFixed2 = "numeric", - overallReject = "numeric", - rejectPerStage = "matrix", - futilityStop = "numeric", - futilityPerStage = "matrix", - earlyStop = "numeric", - informationRates = "matrix", - analysisTime = "matrix", - studyDurationH1 = "numeric", - studyDuration = "numeric", - maxStudyDuration = "numeric", - eventsPerStage = "matrix", - expectedEventsH0 = "numeric", - expectedEventsH01 = "numeric", - expectedEventsH1 = "numeric", - numberOfSubjects = "matrix", - numberOfSubjects1 = "matrix", - numberOfSubjects2 = "matrix", - expectedNumberOfSubjectsH1 = "numeric", - expectedNumberOfSubjects = "numeric", - criticalValuesEffectScale = "matrix", - criticalValuesEffectScaleLower = "matrix", - criticalValuesEffectScaleUpper = "matrix", - criticalValuesPValueScale = "matrix", - futilityBoundsEffectScale = "matrix", - futilityBoundsEffectScaleLower = "matrix", - futilityBoundsEffectScaleUpper = "matrix", - futilityBoundsPValueScale = "matrix" - ), - methods = list( - initialize = function(...) { - callSuper(...) - - optimumAllocationRatio <<- FALSE - visibleFieldNames <- .getVisibleFieldNames() +TrialDesignPlanSurvivalR6 <- R6Class("TrialDesignPlanSurvivalR6", + inherit = TrialDesignPlanR6, + public = list( + .piecewiseSurvivalTime = NULL, + .accrualTime = NULL, + .calculateFollowUpTime = NULL, + thetaH0 = NULL, + typeOfComputation = NULL, + directionUpper = NULL, + pi1 = NULL, + pi2 = NULL, + median1 = NULL, + median2 = NULL, + lambda1 = NULL, + lambda2 = NULL, + hazardRatio = NULL, + maxNumberOfSubjects = NULL, + maxNumberOfSubjects1 = NULL, + maxNumberOfSubjects2 = NULL, + maxNumberOfEvents = NULL, + allocationRatioPlanned = NULL, + optimumAllocationRatio = NULL, + accountForObservationTimes = NULL, + eventTime = NULL, + accrualTime = NULL, + totalAccrualTime = NULL, + accrualIntensity = NULL, + accrualIntensityRelative = NULL, + kappa = NULL, + piecewiseSurvivalTime = NULL, + followUpTime = NULL, + dropoutRate1 = NULL, + dropoutRate2 = NULL, + dropoutTime = NULL, + chi = NULL, + expectedNumberOfEvents = NULL, + eventsFixed = NULL, + nFixed = NULL, + nFixed1 = NULL, + nFixed2 = NULL, + overallReject = NULL, + rejectPerStage = NULL, + futilityStop = NULL, + futilityPerStage = NULL, + earlyStop = NULL, + informationRates = NULL, + analysisTime = NULL, + studyDurationH1 = NULL, + studyDuration = NULL, + maxStudyDuration = NULL, + eventsPerStage = NULL, + expectedEventsH0 = NULL, + expectedEventsH01 = NULL, + expectedEventsH1 = NULL, + numberOfSubjects = NULL, + numberOfSubjects1 = NULL, + numberOfSubjects2 = NULL, + expectedNumberOfSubjectsH1 = NULL, + expectedNumberOfSubjects = NULL, + criticalValuesEffectScale = NULL, + criticalValuesEffectScaleLower = NULL, + criticalValuesEffectScaleUpper = NULL, + criticalValuesPValueScale = NULL, + futilityBoundsEffectScale = NULL, + futilityBoundsEffectScaleLower = NULL, + futilityBoundsEffectScaleUpper = NULL, + futilityBoundsPValueScale = NULL, + initialize = function(...,typeOfComputation = NULL, + thetaH0 = NULL, + allocationRatioPlanned = NULL, + accountForObservationTimes = NULL, + eventTime = NULL, + accrualTime = NULL, + accrualIntensity = NULL, + kappa = NULL, + followUpTime = NULL, + maxNumberOfSubjects = NULL, + dropoutRate1 = NULL, + dropoutRate2 = NULL, + dropoutTime = NULL, + hazardRatio = NULL) { + + + self$typeOfComputation <- typeOfComputation + self$thetaH0 <- thetaH0 + self$allocationRatioPlanned <- allocationRatioPlanned + self$accountForObservationTimes <- accountForObservationTimes + self$eventTime <- eventTime + self$accrualTime <- accrualTime + self$accrualIntensity <- accrualIntensity + self$kappa <- kappa + self$followUpTime <- followUpTime + self$maxNumberOfSubjects <- maxNumberOfSubjects + self$dropoutRate1 <- dropoutRate1 + self$dropoutRate2 <- dropoutRate2 + self$dropoutTime <- dropoutTime + self$hazardRatio <- hazardRatio + + super$initialize(...) + + self$optimumAllocationRatio <- FALSE + visibleFieldNames <- self$.getVisibleFieldNames() startIndex <- which(visibleFieldNames == "hazardRatio") for (i in startIndex:length(visibleFieldNames)) { - .setParameterType(visibleFieldNames[i], C_PARAM_NOT_APPLICABLE) + self$.setParameterType(visibleFieldNames[i], C_PARAM_NOT_APPLICABLE) } - .setParameterType("maxNumberOfSubjects", C_PARAM_NOT_APPLICABLE) - .setParameterType("maxNumberOfSubjects1", C_PARAM_NOT_APPLICABLE) - .setParameterType("maxNumberOfSubjects2", C_PARAM_NOT_APPLICABLE) - .setParameterType("median1", C_PARAM_NOT_APPLICABLE) - .setParameterType("median2", C_PARAM_NOT_APPLICABLE) - .setParameterType("accountForObservationTimes", C_PARAM_NOT_APPLICABLE) - .setParameterType("chi", C_PARAM_NOT_APPLICABLE) - .setParameterType("maxStudyDuration", C_PARAM_NOT_APPLICABLE) - .setParameterType("accrualIntensityRelative", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("maxNumberOfSubjects", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("maxNumberOfSubjects1", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("maxNumberOfSubjects2", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("median1", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("median2", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("accountForObservationTimes", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("chi", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("maxStudyDuration", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("accrualIntensityRelative", C_PARAM_NOT_APPLICABLE) - .setParameterType("criticalValuesEffectScale", C_PARAM_NOT_APPLICABLE) - .setParameterType("criticalValuesEffectScaleLower", C_PARAM_NOT_APPLICABLE) - .setParameterType("criticalValuesEffectScaleUpper", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("criticalValuesEffectScale", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("criticalValuesEffectScaleLower", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("criticalValuesEffectScaleUpper", C_PARAM_NOT_APPLICABLE) - .setParameterType("futilityBoundsEffectScale", C_PARAM_NOT_APPLICABLE) - .setParameterType("futilityBoundsEffectScaleLower", C_PARAM_NOT_APPLICABLE) - .setParameterType("futilityBoundsEffectScaleUpper", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("futilityBoundsEffectScale", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("futilityBoundsEffectScaleLower", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("futilityBoundsEffectScaleUpper", C_PARAM_NOT_APPLICABLE) # set default values for (parameterName in c( @@ -826,94 +788,18 @@ TrialDesignPlanSurvival <- setRefClass("TrialDesignPlanSurvival", "kappa", "piecewiseSurvivalTime", "lambda1", "lambda2", "followUpTime", "dropoutTime" )) { - .setDefaultValue(parameterName) - } - }, - clone = function(hazardRatio = NA_real_, pi1 = NA_real_) { - hr <- NA_real_ - if (.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) { - pi1Temp <- pi1 - if (any(is.na(pi1))) { - pi1Temp <- .self$pi1 - } - } - accrualTimeTemp <- .self$.getParameterValueIfUserDefinedOrDefault("accrualTime") - if (!is.null(accrualTimeTemp) && length(accrualTimeTemp) > 0 && - !all(is.na(accrualTimeTemp)) && accrualTimeTemp[1] != 0) { - accrualTimeTemp <- c(0, accrualTimeTemp) - } - accrualIntensityTemp <- .self$.getParameterValueIfUserDefinedOrDefault("accrualIntensity") - if (all(is.na(accrualIntensityTemp))) { - accrualIntensityTemp <- C_ACCRUAL_INTENSITY_DEFAULT - } - if (.objectType == "sampleSize") { - return(getSampleSizeSurvival( - design = .self$.design, - typeOfComputation = .self$.getParameterValueIfUserDefinedOrDefault("typeOfComputation"), - thetaH0 = .self$.getParameterValueIfUserDefinedOrDefault("thetaH0"), - pi1 = pi1Temp, - pi2 = .self$.getParameterValueIfUserDefinedOrDefault("pi2"), - allocationRatioPlanned = .self$allocationRatioPlanned, - accountForObservationTimes = .self$.getParameterValueIfUserDefinedOrDefault("accountForObservationTimes"), - eventTime = .self$eventTime, - accrualTime = accrualTimeTemp, - accrualIntensity = accrualIntensityTemp, - kappa = .self$kappa, - piecewiseSurvivalTime = .self$.getParameterValueIfUserDefinedOrDefault("piecewiseSurvivalTime"), - lambda2 = .self$.getParameterValueIfUserDefinedOrDefault("lambda2"), - lambda1 = .self$.getParameterValueIfUserDefinedOrDefault("lambda1"), - followUpTime = .self$.getParameterValueIfUserDefinedOrDefault("followUpTime"), - maxNumberOfSubjects = .self$.getParameterValueIfUserDefinedOrDefault("maxNumberOfSubjects"), - dropoutRate1 = .self$dropoutRate1, - dropoutRate2 = .self$dropoutRate2, - dropoutTime = .self$dropoutTime, - hazardRatio = hr - )) - } else { - directionUpperTemp <- directionUpper - if (length(directionUpperTemp) > 1) { - directionUpperTemp <- directionUpperTemp[1] - } - return(getPowerSurvival( - design = .self$.design, - typeOfComputation = .self$.getParameterValueIfUserDefinedOrDefault("typeOfComputation"), - thetaH0 = .self$.getParameterValueIfUserDefinedOrDefault("thetaH0"), - pi1 = pi1Temp, - pi2 = .self$.getParameterValueIfUserDefinedOrDefault("pi2"), - directionUpper = directionUpperTemp, - allocationRatioPlanned = .self$allocationRatioPlanned, - eventTime = .self$eventTime, - accrualTime = accrualTimeTemp, - accrualIntensity = accrualIntensityTemp, - kappa = .self$kappa, - piecewiseSurvivalTime = .self$.getParameterValueIfUserDefinedOrDefault("piecewiseSurvivalTime"), - lambda2 = .self$.getParameterValueIfUserDefinedOrDefault("lambda2"), - lambda1 = .self$.getParameterValueIfUserDefinedOrDefault("lambda1"), - hazardRatio = hr, - maxNumberOfSubjects = .self$.getParameterValueIfUserDefinedOrDefault("maxNumberOfSubjects"), - maxNumberOfEvents = .self$.getParameterValueIfUserDefinedOrDefault("maxNumberOfEvents"), - dropoutRate1 = .self$dropoutRate1, - dropoutRate2 = .self$dropoutRate2, - dropoutTime = .self$dropoutTime - )) + self$.setDefaultValue(parameterName) } }, .setDefaultValue = function(argumentName) { - if (is.null(.self[[argumentName]]) || all(is.na(.self[[argumentName]]))) { - .self[[argumentName]] <<- C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_SURVIVAL[[argumentName]] - .setParameterType(argumentName, C_PARAM_DEFAULT_VALUE) + if (is.null(self[[argumentName]]) || all(is.na(self[[argumentName]]))) { + self[[argumentName]] <- C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_SURVIVAL[[argumentName]] + self$.setParameterType(argumentName, C_PARAM_DEFAULT_VALUE) } }, show = function(showType = 1, digits = NA_integer_) { "Method for automatically printing trial plan objects" - callSuper(showType = showType, digits = digits) + super$show(showType = showType, digits = digits) }, .warnInCaseArgumentExists = function(argument, argumentName) { if (!all(is.na(argument)) && any(argument > 0)) { @@ -926,6 +812,1230 @@ TrialDesignPlanSurvival <- setRefClass("TrialDesignPlanSurvival", ) ) +.addPlotSubTitleItems <- function(designPlan, designMaster, items, type) { + if (type %in% c(1, 3, 4)) { + return(invisible()) + } + + if (.isTrialDesignPlanMeans(designPlan)) { + nMax <- designPlan$maxNumberOfSubjects[1] # use first value for plotting + + if (!(type %in% c(5))) { + items$add("N", round(nMax, 1), "max") + } + + if ((type %in% c(5)) && !(items$title == "Sample Size")) { + items$add("N", round(nMax, 1), "max") + } + + if (designPlan$meanRatio) { + items$add("coefficient of variation", designPlan$stDev) + } else { + items$add("standard deviation", designPlan$stDev) + } + + if (designPlan$groups == 1) { + if (type %in% c(2, (5:9))) { + items$add("H0: mu", designPlan$thetaH0) + items$add("allocation ratio", round(designPlan$allocationRatioPlanned, 2)) + } + } else { + if (type %in% c(2, (5:9))) { + if (designPlan$meanRatio) { + items$add("H0: mean ratio", designPlan$thetaH0) + } else { + items$add("H0: mean difference", designPlan$thetaH0) + } + items$add("allocation ratio", round(designPlan$allocationRatioPlanned, 2)) + } + } + } else if (.isTrialDesignPlanRates(designPlan)) { + nMax <- designPlan$maxNumberOfSubjects[1] # use first value for plotting + + if (!(type %in% c(5))) { + items$add("N", round(nMax, 1), "max") + } + + if ((type %in% c(5)) && !(items$title == "Sample Size")) { + items$add("N", round(nMax, 1), "max") + } + + if (designPlan$groups == 2 && !(type %in% c(3, 4)) && + length(designPlan$pi2) == 1 && !is.na(designPlan$pi2)) { + items$add("pi", designPlan$pi2, 2) + } + + if (designPlan$groups == 1) { + if (type %in% c(2, (5:9))) { + items$add("H0: pi", designPlan$thetaH0) + } + } else { + if (type %in% c(2, (5:9))) { + if (designPlan$riskRatio) { + items$add("H0: risk ratio", designPlan$thetaH0) + } else { + items$add("H0: risk difference", designPlan$thetaH0) + } + items$add("allocation ratio", round(designPlan$allocationRatioPlanned, 2)) + } + } + } else if (.isTrialDesignPlanSurvival(designPlan)) { + if (designPlan$.isPowerObject() && !(type %in% (13:14))) { + items$add("maximum number of events", designPlan$maxNumberOfEvents[1]) + } + if (type %in% (10:12)) { + items$add("maximum number of subjects", designPlan$maxNumberOfSubjects[1]) + } + if (type %in% c(2, (5:12))) { + items$add("H0: hazard ratio", designPlan$thetaH0) + items$add("allocation ratio", round(designPlan$allocationRatioPlanned, 2)) + } + } +} + +.assertIsValidVariedParameterVectorForPlotting <- function(designPlan, plotType) { + if (.isTrialDesignPlanMeans(designPlan)) { + if (is.null(designPlan$alternative) || any(is.na(designPlan$alternative)) || + length(designPlan$alternative) <= 1) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "plot type ", plotType, + " is only available if 'alternative' with length > 1 is defined" + ) + } + } else if (.isTrialDesignPlanRates(designPlan)) { + if (is.null(designPlan$pi1) || any(is.na(designPlan$pi1)) || + length(designPlan$pi1) <= 1) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "plot type ", plotType, + " is only available if 'pi1' with length > 1 is defined" + ) + } + } else if (.isTrialDesignPlanSurvival(designPlan)) { + if (is.null(designPlan$hazardRatio) || any(is.na(designPlan$hazardRatio)) || + length(designPlan$hazardRatio) <= 1) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "plot type ", plotType, + " is only available if 'hazardRatio' with length > 1 is defined" + ) + } + } +} + +.plotTrialDesignPlan <- function(designPlan, type = 1L, main = NA_character_, + xlab = NA_character_, ylab = NA_character_, palette = "Set1", + theta = seq(-1, 1, 0.02), plotPointsEnabled = NA, + legendPosition = NA_integer_, showSource = FALSE, + designPlanName = NA_character_, plotSettings = NULL, ...) { + .assertGgplotIsInstalled() + .assertIsTrialDesignPlan(designPlan) + .assertIsValidLegendPosition(legendPosition) + .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) + theta <- .assertIsValidThetaRange(thetaRange = theta) + + survivalDesignPlanEnabled <- .isTrialDesignPlanSurvival(designPlan) + + nMax <- ifelse(survivalDesignPlanEnabled, designPlan$maxNumberOfEvents[1], + designPlan$maxNumberOfSubjects[1] + ) # use first value for plotting + + if (is.null(plotSettings)) { + plotSettings <- designPlan$.plotSettings + } + + designMaster <- designPlan$.design + + if (designMaster$kMax == 1 && (type %in% c(1:4))) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, + ") is not available for 'kMax' = 1" + ) + } + + if (designPlan$.isSampleSizeObject()) { + if (survivalDesignPlanEnabled) { + if (!(type %in% c(1:5, 13, 14))) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, + ") is not allowed; must be 1, 2, 3, 4, 5, 13 or 14" + ) + } + } else { + if (!(type %in% c(1:5))) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, + ") is not allowed; must be 1, 2, 3, 4, 5" + ) + } + } + } + + if (is.na(plotPointsEnabled)) { + plotPointsEnabled <- type < 4 + } + + ratioEnabled <- (survivalDesignPlanEnabled || + (.isTrialDesignPlanMeans(designPlan) && designPlan$meanRatio) || + (.isTrialDesignPlanRates(designPlan) && designPlan$riskRatio)) + + variedParameters <- logical(0) + + showSourceHint <- "" + if (type %in% c(5:12)) { + if (.isTrialDesignPlanMeans(designPlan) && length(designPlan$alternative) == 2 && + designPlan$.getParameterType("alternative") == C_PARAM_USER_DEFINED) { + if (!is.logical(showSource) || isTRUE(showSource)) { + showSourceHint <- .getVariedParameterHint(designPlan$alternative, "alternative") + } + designPlan <- designPlan$clone( + alternative = + .getVariedParameterVector(designPlan$alternative, "alternative") + ) + } else if ((.isTrialDesignPlanRates(designPlan) || survivalDesignPlanEnabled) && + length(designPlan$pi1) == 2 && + designPlan$.getParameterType("pi1") == C_PARAM_USER_DEFINED) { + if (!is.logical(showSource) || isTRUE(showSource)) { + showSourceHint <- .getVariedParameterHint(designPlan$pi1, "pi1") + } + designPlan <- designPlan$clone( + pi1 = + .getVariedParameterVector(designPlan$pi1, "pi1") + ) + } else if (survivalDesignPlanEnabled && length(designPlan$hazardRatio) == 2 && + designPlan$.getParameterType("hazardRatio") == C_PARAM_USER_DEFINED) { + if (!is.logical(showSource) || isTRUE(showSource)) { + showSourceHint <- .getVariedParameterHint(designPlan$hazardRatio, "hazardRatio") + } + designPlan <- designPlan$clone( + hazardRatio = + .getVariedParameterVector(designPlan$hazardRatio, "hazardRatio") + ) + } + } + + srcCmd <- NULL + + reducedParam <- NULL + if (type %in% c(1:4)) { + reducedParam <- .warnInCaseOfUnusedValuesForPlotting(designPlan) + } + + if (type == 1) { # Boundary plot + if (survivalDesignPlanEnabled) { + if (is.na(main)) { + main <- PlotSubTitleItems(title = "Boundaries Z Scale") + .addPlotSubTitleItems(designPlan, designMaster, main, type) + if (!is.null(reducedParam)) { + main$add(reducedParam$title, reducedParam$value, reducedParam$subscript) + } + } + + if (designMaster$sided == 1) { + designPlan <- data.frame( + eventsPerStage = designPlan$eventsPerStage[, 1], + criticalValues = designMaster$criticalValues, + futilityBounds = c(designMaster$futilityBounds, designMaster$criticalValues[designMaster$kMax]) + ) + } else { + designPlan <- data.frame( + eventsPerStage = designPlan$eventsPerStage[, 1], + criticalValues = designMaster$criticalValues, + criticalValuesMirrored = -designMaster$criticalValues + ) + } + + xParameterName <- "eventsPerStage" + if (designMaster$sided == 1) { + if (any(designMaster$futilityBounds > C_FUTILITY_BOUNDS_DEFAULT)) { + yParameterNames <- c("futilityBounds", "criticalValues") + } else { + yParameterNames <- "criticalValues" + } + yParameterNamesSrc <- yParameterNames + } else { + yParameterNames <- c("criticalValues", "criticalValuesMirrored") + yParameterNamesSrc <- c("criticalValues", paste0("-", designPlanName, "$.design$criticalValues")) + } + + if (is.na(legendPosition)) { + legendPosition <- C_POSITION_RIGHT_TOP + } + + srcCmd <- .showPlotSourceInformation( + objectName = paste0(designPlanName, "$.design"), + xParameterName = paste0(designPlanName, "$", xParameterName, "[, 1]"), + yParameterNames = yParameterNamesSrc, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + } else { + if (is.na(main)) { + main <- PlotSubTitleItems(title = "Boundaries") + .addPlotSubTitleItems(designPlan, designMaster, main, type) + if (!is.null(reducedParam)) { + main$add(reducedParam$title, reducedParam$value, reducedParam$subscript) + } + } + + designSet <- TrialDesignSetR6$new(design = designMaster, singleDesign = TRUE) + designSet$.plotSettings <- designPlan$.plotSettings + designPlanName <- paste0(designPlanName, "$.design") + return(.plotTrialDesignSet( + x = designSet, y = NULL, main = main, + xlab = xlab, ylab = ylab, type = type, + palette = palette, theta = theta, nMax = nMax, + plotPointsEnabled = plotPointsEnabled, legendPosition = legendPosition, + designSetName = designPlanName, showSource = showSource, + plotSettings = plotSettings # , ... + )) + } + } else if (type == 2) { # Effect Scale Boundary plot + if (is.na(main)) { + main <- PlotSubTitleItems(title = "Boundaries Effect Scale") + .addPlotSubTitleItems(designPlan, designMaster, main, type) + if (!is.null(reducedParam)) { + main$add(reducedParam$title, reducedParam$value, reducedParam$subscript) + } + } + + if (is.na(ylab)) { + if (.isTrialDesignPlanMeans(designPlan)) { + if (designPlan$groups == 1) { + ylab <- "Mean" + } else if (!designPlan$meanRatio) { + ylab <- "Mean Difference" + } else { + ylab <- "Mean Ratio" + } + } else if (.isTrialDesignPlanRates(designPlan)) { + if (designPlan$groups == 1) { + ylab <- "Rate" + } else if (!designPlan$riskRatio) { + ylab <- "Rate Difference" + } else { + ylab <- "Risk Ratio" + } + } else if (survivalDesignPlanEnabled) { + ylab <- "Hazard Ratio" + } + } + + groupedPlotEnabled <- FALSE + yParameterNamesSrc <- c() + if (designMaster$sided == 1) { + if (any(designMaster$futilityBounds > C_FUTILITY_BOUNDS_DEFAULT)) { + data <- data.frame( + criticalValuesEffectScale = designPlan$criticalValuesEffectScale[, 1], + futilityBoundsEffectScale = c( + designPlan$futilityBoundsEffectScale[, 1], + designPlan$criticalValuesEffectScale[designMaster$kMax, 1] + ) + ) + yParameterNamesSrc <- c(yParameterNamesSrc, "criticalValuesEffectScale[, 1]") + yParameterNamesSrc <- c(yParameterNamesSrc, paste0( + "c(", designPlanName, "$futilityBoundsEffectScale[, 1], ", + designPlanName, "$criticalValuesEffectScale[nrow(", designPlanName, "$criticalValuesEffectScale), 1])" + )) + } else { + data <- data.frame( + criticalValuesEffectScale = designPlan$criticalValuesEffectScale[, 1] + ) + yParameterNamesSrc <- c(yParameterNamesSrc, "criticalValuesEffectScale[, 1]") + } + } else if (designMaster$typeOfDesign == C_TYPE_OF_DESIGN_PT) { + data <- data.frame( + criticalValues = designPlan$criticalValuesEffectScaleUpper[, 1], + criticalValuesMirrored = designPlan$criticalValuesEffectScaleLower[, 1], + futilityBounds = c( + designPlan$futilityBoundsEffectScaleUpper[, 1], + designPlan$criticalValuesEffectScaleUpper[designMaster$kMax, 1] + ), + futilityBoundsMirrored = c( + designPlan$futilityBoundsEffectScaleLower[, 1], + designPlan$criticalValuesEffectScaleLower[designMaster$kMax, 1] + ) + ) + yParameterNamesSrc <- c(yParameterNamesSrc, "criticalValuesEffectScaleUpper[, 1]") + yParameterNamesSrc <- c(yParameterNamesSrc, "criticalValuesEffectScaleLower[, 1]") + yParameterNamesSrc <- c(yParameterNamesSrc, paste0( + "c(", designPlanName, "$futilityBoundsEffectScaleUpper[, 1], ", + designPlanName, "$criticalValuesEffectScaleUpper[nrow(", designPlanName, "$criticalValuesEffectScaleUpper), 1])" + )) + yParameterNamesSrc <- c(yParameterNamesSrc, paste0( + "c(", designPlanName, "$futilityBoundsEffectScaleLower[, 1], ", + designPlanName, "$criticalValuesEffectScaleLower[nrow(", designPlanName, "$criticalValuesEffectScaleLower), 1])" + )) + groupedPlotEnabled <- TRUE + } else { + data <- data.frame( + criticalValuesEffectScale = designPlan$criticalValuesEffectScaleUpper[, 1], + criticalValuesEffectScaleMirrored = designPlan$criticalValuesEffectScaleLower[, 1] + ) + yParameterNamesSrc <- c(yParameterNamesSrc, "criticalValuesEffectScaleUpper[, 1]") + yParameterNamesSrc <- c(yParameterNamesSrc, "criticalValuesEffectScaleLower[, 1]") + } + + if (survivalDesignPlanEnabled) { + xParameterName <- "eventsPerStage" + xParameterNameSrc <- paste0(designPlanName, "$", xParameterName, "[, 1]") + data <- cbind(data.frame(eventsPerStage = designPlan$eventsPerStage[, 1]), data) + } else { + xParameterName <- "informationRates" + xParameterNameSrc <- paste0(designPlanName, "$.design$", xParameterName) + data <- cbind(data.frame(informationRates = designMaster$informationRates), data) + } + if (designMaster$sided == 1 || designMaster$typeOfDesign == C_TYPE_OF_DESIGN_PT) { + if (any(designMaster$futilityBounds > C_FUTILITY_BOUNDS_DEFAULT)) { + yParameterNames <- c("futilityBoundsEffectScale", "criticalValuesEffectScale") + } else { + yParameterNames <- "criticalValuesEffectScale" + } + } else { + yParameterNames <- c("criticalValuesEffectScale", "criticalValuesEffectScaleMirrored") + } + + if (is.na(legendPosition)) { + legendPosition <- C_POSITION_RIGHT_TOP + } + + if (is.na(legendPosition)) { + legendPosition <- C_POSITION_RIGHT_TOP + } + + srcCmd <- .showPlotSourceInformation( + objectName = designPlanName, + xParameterName = xParameterNameSrc, + yParameterNames = yParameterNamesSrc, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + + if (groupedPlotEnabled) { + tableColumnNames <- C_TABLE_COLUMN_NAMES + criticalValuesName <- designPlan$.getDataFrameColumnCaption("criticalValuesEffectScale", tableColumnNames, TRUE) + futilityBoundsName <- designPlan$.getDataFrameColumnCaption("futilityBoundsEffectScale", tableColumnNames, TRUE) + + designPlan <- data.frame( + xValues = rep(data[[xParameterName]], 4), + yValues = c( + data$criticalValues, data$criticalValuesMirrored, + data$futilityBounds, data$futilityBoundsMirrored + ), + categories = c( + rep(criticalValuesName, nrow(data)), rep("criticalValuesMirrored", nrow(data)), + rep(futilityBoundsName, nrow(data)), rep("futilityBoundsMirrored", nrow(data)) + ), + groups = c(rep(criticalValuesName, 2 * nrow(data)), rep(futilityBoundsName, 2 * nrow(data))) + ) + } else { + designPlan <- data + } + } else if (type == 3) { # Stage Levels + if (is.na(main)) { + main <- PlotSubTitleItems(title = "Boundaries p Values Scale") + .addPlotSubTitleItems(designPlan, designMaster, main, type) + if (!is.null(reducedParam)) { + main$add(reducedParam$title, reducedParam$value, reducedParam$subscript) + } + } + + if (survivalDesignPlanEnabled) { + xParameterName <- "eventsPerStage" + yParameterNames <- "stageLevels" + designPlan <- data.frame( + eventsPerStage = designPlan$eventsPerStage[, 1], + stageLevels = designMaster$stageLevels + ) + xParameterNameSrc <- "eventsPerStage[, 1]" + yParameterNamesSrc <- ".design$stageLevels" + } else { + xParameterName <- "informationRates" + yParameterNames <- "stageLevels" + designPlan <- TrialDesignSetR6$new(design = designMaster, singleDesign = TRUE) + xParameterNameSrc <- ".design$informationRates" + yParameterNamesSrc <- ".design$stageLevels" + } + + srcCmd <- .showPlotSourceInformation( + objectName = designPlanName, + xParameterName = xParameterNameSrc, + yParameterNames = yParameterNamesSrc, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + } else if (type == 4) { # Alpha Spending + if (is.na(main)) { + main <- PlotSubTitleItems(title = "Error Spending") + .addPlotSubTitleItems(designPlan, designMaster, main, type) + if (!is.null(reducedParam)) { + main$add(reducedParam$title, reducedParam$value, reducedParam$subscript) + } + } + if (survivalDesignPlanEnabled) { + xParameterName <- "eventsPerStage" + yParameterNames <- "alphaSpent" + designPlan <- data.frame( + eventsPerStage = designPlan$eventsPerStage[, 1], + alphaSpent = designMaster$alphaSpent + ) + xParameterNameSrc <- "eventsPerStage[, 1]" + yParameterNamesSrc <- ".design$alphaSpent" + } else { + xParameterName <- "informationRates" + yParameterNames <- "alphaSpent" + designPlan <- TrialDesignSetR6$new(design = designMaster, singleDesign = TRUE) + xParameterNameSrc <- ".design$informationRates" + yParameterNamesSrc <- ".design$alphaSpent" + } + plotPointsEnabled <- ifelse(is.na(plotPointsEnabled), FALSE, plotPointsEnabled) + + srcCmd <- .showPlotSourceInformation( + objectName = designPlanName, + xParameterName = xParameterNameSrc, + yParameterNames = yParameterNamesSrc, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + } else if (type == 5) { # Power and Stopping Probabilities + + .assertIsValidVariedParameterVectorForPlotting(designPlan, type) + + if (designPlan$.isSampleSizeObject()) { + if (is.na(main)) { + main <- PlotSubTitleItems(title = "Sample Size") + .addPlotSubTitleItems(designPlan, designMaster, main, type) + } + + yAxisScalingEnabled <- TRUE + + if (.isTrialDesignPlanMeans(designPlan)) { + xParameterName <- "alternative" + yParameterNames <- c("nFixed") + if (designMaster$kMax > 1) { + yParameterNames <- c(yParameterNames, "maxNumberOfSubjects", "expectedNumberOfSubjectsH1") + } + if (is.na(ylab)) { + ylab <- "Sample Size" + } + yAxisScalingEnabled <- FALSE + if (is.na(legendPosition)) { + legendPosition <- C_POSITION_RIGHT_TOP + } + yParameterNamesSrc <- yParameterNames + } else if (.isTrialDesignPlanRates(designPlan)) { + xParameterName <- "pi1" + yParameterNames <- c("nFixed") + if (designMaster$kMax > 1) { + yParameterNames <- c(yParameterNames, "maxNumberOfSubjects", "expectedNumberOfSubjectsH1") + } + if (is.na(ylab)) { + ylab <- "Sample Size" + } + yAxisScalingEnabled <- FALSE + if (is.na(legendPosition)) { + legendPosition <- C_POSITION_RIGHT_TOP + } + yParameterNamesSrc <- yParameterNames + } else if (survivalDesignPlanEnabled) { + designPlan <- data.frame( + hazardRatio = designPlan$hazardRatio, + eventsFixed = designPlan$eventsFixed, + maxNumberOfEvents = designPlan$eventsPerStage[designMaster$kMax, ], + expectedEventsH1 = designPlan$expectedEventsH1 + ) + xParameterName <- "hazardRatio" + yParameterNames <- c("eventsFixed") + if (designMaster$kMax > 1) { + yParameterNames <- c(yParameterNames, "maxNumberOfEvents", "expectedEventsH1") + } + if (is.na(ylab)) { + ylab <- "# Events" + } + + if (is.na(legendPosition)) { + legendPosition <- C_POSITION_RIGHT_TOP + } + yParameterNamesSrc <- c( + "eventsFixed", + paste0("eventsPerStage[", designMaster$kMax, ", ]"), "expectedEventsH1" + ) + } + + srcCmd <- .showPlotSourceInformation( + objectName = designPlanName, + xParameterName = xParameterName, + yParameterNames = yParameterNamesSrc, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + if (!is.null(srcCmd)) { + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(srcCmd)) + } + return(srcCmd) + } + + return(.plotParameterSet( + parameterSet = designPlan, designMaster = designMaster, + xParameterName = xParameterName, + yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, + palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, + legendPosition = legendPosition, variedParameters = variedParameters, + qnormAlphaLineEnabled = FALSE, yAxisScalingEnabled = FALSE, + plotSettings = plotSettings # , ... + )) + } else { + if (is.na(main)) { + main <- PlotSubTitleItems(title = "Overall Power and Early Stopping") + .addPlotSubTitleItems(designPlan, designMaster, main, type) + } + if (survivalDesignPlanEnabled) { + xParameterName <- "hazardRatio" + } else { + xParameterName <- "effect" + } + yParameterNames <- c("overallReject", "futilityStop", "earlyStop") + + if (is.na(ylab)) { + ylab <- "" + } + if (is.na(legendPosition)) { + legendPosition <- C_POSITION_LEFT_TOP + } + + srcCmd <- .showPlotSourceInformation( + objectName = designPlanName, + xParameterName = xParameterName, + yParameterNames = yParameterNames, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + if (!is.null(srcCmd)) { + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(srcCmd)) + } + return(srcCmd) + } + + if (is.null(list(...)[["ylim"]])) { + ylim <- c(0, 1) + return(.plotParameterSet( + parameterSet = designPlan, designMaster = designMaster, + xParameterName = xParameterName, + yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, + palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, + legendPosition = legendPosition, variedParameters = variedParameters, + qnormAlphaLineEnabled = FALSE, yAxisScalingEnabled = FALSE, + plotSettings = plotSettings, ylim = ylim # , ... + )) + } else { + return(.plotParameterSet( + parameterSet = designPlan, designMaster = designMaster, + xParameterName = xParameterName, + yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, + palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, + legendPosition = legendPosition, variedParameters = variedParameters, + qnormAlphaLineEnabled = FALSE, yAxisScalingEnabled = FALSE, + plotSettings = plotSettings # , ... + )) + } + } + } else if (type == 6) { # Average Sample Size / Average Event Number + .assertIsValidVariedParameterVectorForPlotting(designPlan, type) + + if (is.na(main)) { + titlePart <- ifelse(survivalDesignPlanEnabled, "Number of Events", "Sample Size") + main <- PlotSubTitleItems(title = paste0("Expected ", titlePart, " and Power / Early Stop")) + .addPlotSubTitleItems(designPlan, designMaster, main, type) + } + + if (survivalDesignPlanEnabled) { + xParameterName <- "hazardRatio" + yParameterNames <- "expectedNumberOfEvents" + expectedNumberOfEvents <- designPlan[["expectedNumberOfEvents"]] + if (is.null(expectedNumberOfEvents) || length(expectedNumberOfEvents) == 0) { + yParameterNames <- "expectedEventsH1" + } + yParameterNames <- c(yParameterNames, "overallReject", "earlyStop") # overallReject = power + if (is.na(legendPosition)) { + legendPosition <- C_POSITION_RIGHT_CENTER + } + } else { + xParameterName <- "effect" + yParameterNames <- c("expectedNumberOfSubjects", "overallReject", "earlyStop") # overallReject = power + } + srcCmd <- .showPlotSourceInformation( + objectName = designPlanName, + xParameterName = xParameterName, + yParameterNames = yParameterNames, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + } else if (type == 7) { + .assertIsValidVariedParameterVectorForPlotting(designPlan, type) + + if (is.na(main)) { + main <- PlotSubTitleItems(title = "Overall Power") + .addPlotSubTitleItems(designPlan, designMaster, main, type) + } + + if (survivalDesignPlanEnabled) { + xParameterName <- "hazardRatio" + } else { + xParameterName <- "effect" + } + yParameterNames <- "overallReject" + if (is.na(legendPosition)) { + legendPosition <- C_POSITION_RIGHT_CENTER + } + srcCmd <- .showPlotSourceInformation( + objectName = designPlanName, + xParameterName = xParameterName, + yParameterNames = yParameterNames, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + } else if (type == 8) { + .assertIsValidVariedParameterVectorForPlotting(designPlan, type) + + if (is.na(main)) { + main <- PlotSubTitleItems(title = "Overall Early Stopping") + .addPlotSubTitleItems(designPlan, designMaster, main, type) + } + + if (survivalDesignPlanEnabled) { + xParameterName <- "hazardRatio" + } else { + xParameterName <- "effect" + } + yParameterNames <- c("earlyStop", "futilityStop") + if (is.na(legendPosition)) { + legendPosition <- C_POSITION_RIGHT_CENTER + } + srcCmd <- .showPlotSourceInformation( + objectName = designPlanName, + xParameterName = xParameterName, + yParameterNames = yParameterNames, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + } else if (type == 9) { + .assertIsValidVariedParameterVectorForPlotting(designPlan, type) + + if (is.na(main)) { + if (survivalDesignPlanEnabled) { + main <- PlotSubTitleItems(title = "Expected Number of Events") + } else { + main <- PlotSubTitleItems(title = "Expected Sample Size") + } + .addPlotSubTitleItems(designPlan, designMaster, main, type) + } + + if (survivalDesignPlanEnabled) { + xParameterName <- "hazardRatio" + yParameterNames <- "expectedNumberOfEvents" + expectedNumberOfEvents <- designPlan[["expectedNumberOfEvents"]] + if (is.null(expectedNumberOfEvents) || length(expectedNumberOfEvents) == 0) { + yParameterNames <- c("expectedEventsH0", "expectedEventsH1") + if (is.na(legendPosition)) { + legendPosition <- C_POSITION_RIGHT_CENTER + } + } + } else { + xParameterName <- "effect" + yParameterNames <- "expectedNumberOfSubjects" + } + srcCmd <- .showPlotSourceInformation( + objectName = designPlanName, + xParameterName = xParameterName, + yParameterNames = yParameterNames, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + } else if (survivalDesignPlanEnabled) { + if (type == 10) { # Study Duration + .assertIsValidVariedParameterVectorForPlotting(designPlan, type) + if (is.na(main)) { + main <- PlotSubTitleItems(title = "Study Duration") + .addPlotSubTitleItems(designPlan, designMaster, main, type) + } + xParameterName <- "hazardRatio" + yParameterNames <- "studyDuration" + srcCmd <- .showPlotSourceInformation( + objectName = designPlanName, + xParameterName = xParameterName, + yParameterNames = yParameterNames, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + } else if (type == 11) { + .assertIsValidVariedParameterVectorForPlotting(designPlan, type) + if (is.na(main)) { + main <- PlotSubTitleItems(title = "Expected Number of Subjects") + .addPlotSubTitleItems(designPlan, designMaster, main, type) + } + xParameterName <- "hazardRatio" + yParameterNames <- "expectedNumberOfSubjects" + srcCmd <- .showPlotSourceInformation( + objectName = designPlanName, + xParameterName = xParameterName, + yParameterNames = yParameterNames, + hint = showSourceHint, nMax = nMax, + type = type, showSource = showSource + ) + } else if (type == 12) { # Analysis Time + .assertIsValidVariedParameterVectorForPlotting(designPlan, type) + if (is.na(main)) { + main <- PlotSubTitleItems(title = "Analysis Time") + .addPlotSubTitleItems(designPlan, designMaster, main, type) + } + + xParameterName <- "hazardRatio" + yParameterNames <- "analysisTime" + yParameterNamesSrc <- c() + for (i in 1:nrow(designPlan[["analysisTime"]])) { + yParameterNamesSrc <- c(yParameterNamesSrc, paste0("analysisTime[", i, ", ]")) + } + + data <- NULL + for (k in 1:designMaster$kMax) { + part <- data.frame( + categories = rep(k, length(designPlan$hazardRatio)), + xValues = designPlan$hazardRatio, + yValues = designPlan$analysisTime[k, ] + ) + if (is.null(data)) { + data <- part + } else { + data <- rbind(data, part) + } + } + + srcCmd <- .showPlotSourceInformation( + objectName = designPlanName, + xParameterName = xParameterName, + yParameterNames = yParameterNamesSrc, + hint = showSourceHint, + type = type, showSource = showSource + ) + if (!is.null(srcCmd)) { + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(srcCmd)) + } + return(srcCmd) + } + + return(.plotDataFrame(data, + mainTitle = main, + xlab = NA_character_, ylab = NA_character_, xAxisLabel = "Hazard Ratio", + yAxisLabel1 = "Analysis Time", yAxisLabel2 = NA_character_, + plotPointsEnabled = TRUE, legendTitle = "Stage", + legendPosition = legendPosition, sided = designMaster$sided, + plotSettings = plotSettings, ... + )) + } else if (type == 13 || type == 14) { # Cumulative Distribution Function / Survival function + return(.plotSurvivalFunction(designPlan, + designMaster = designMaster, type = type, main = main, + xlab = xlab, ylab = ylab, palette = palette, + legendPosition = legendPosition, showSource = showSource, + designPlanName = designPlanName, + plotSettings = plotSettings, ... + )) + } else { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is not allowed; must be 1, 2, ..., 14") + } + } else { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is not allowed; must be 1, 2, ..., 9") + } + + if (!is.null(srcCmd)) { + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(srcCmd)) + } + return(srcCmd) + } + + p <- .plotParameterSet( + parameterSet = designPlan, designMaster = designMaster, + xParameterName = xParameterName, + yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, + palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, + legendPosition = legendPosition, variedParameters = variedParameters, + qnormAlphaLineEnabled = (type != 2), ratioEnabled = ratioEnabled, + plotSettings = plotSettings # , ... + ) + + if (type == 1 && survivalDesignPlanEnabled) { + p <- .addDecistionCriticalValuesToPlot(p = p, designMaster = designMaster, type = type, nMax = nMax) + } + return(p) +} + +.getSurvivalFunctionPlotCommand <- function(functionType = c("pwExpDist", "lambdaStep"), timeValues, lambda, + designPlan, type, piecewiseSurvivalEnabled, multiplyByHazardRatio = FALSE) { + functionType <- match.arg(functionType) + signPrefix <- ifelse(type == 13, "", "-") + if (functionType == "pwExpDist") { + functionName <- "getPiecewiseExponentialDistribution" + } else { + functionName <- "getLambdaStepFunction" + } + cmd <- paste0( + signPrefix, functionName, + "(", .reconstructSequenceCommand(timeValues), + ", piecewiseLambda = ", .arrayToString(lambda, vectorLookAndFeelEnabled = TRUE) + ) + if (piecewiseSurvivalEnabled) { + cmd <- paste0( + cmd, ", piecewiseSurvivalTime = ", + .arrayToString(designPlan$piecewiseSurvivalTime, vectorLookAndFeelEnabled = TRUE) + ) + } + if (functionType == "pwExpDist") { + cmd <- paste0(cmd, ", kappa = ", designPlan$kappa) + } + cmd <- paste0(cmd, ")") + if (multiplyByHazardRatio) { + cmd <- paste0(cmd, " * ", designPlan$hazardRatio[1]) + } + return(cmd) +} + +# Cumulative Distribution Function / Survival function +.plotSurvivalFunction <- function(designPlan, ..., designMaster, type = c(13, 14), main = NA_character_, + xlab = NA_character_, ylab = NA_character_, palette = "Set1", + legendPosition = NA_integer_, showSource = FALSE, + designPlanName = NA_character_, plotSettings = NULL) { + startTime <- Sys.time() + if (is.null(designPlan$piecewiseSurvivalTime) || + length(designPlan$piecewiseSurvivalTime) == 0) { + stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'piecewiseSurvivalTime' must be specified") + } + + type <- type[1] + if (!(type %in% c(13, 14))) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' must be 13 or 14") + } + + lambda1 <- designPlan[["lambda1"]] + lambda2 <- designPlan[["lambda2"]] + if (is.null(lambda2) || length(lambda2) == 0) { + stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'lambda2' must be specified") + } + + if (is.null(designPlan$kappa) || length(designPlan$kappa) == 0) { + stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'kappa' must be specified") + } + + if (is.null(designPlan$hazardRatio) || length(designPlan$hazardRatio) == 0) { + stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'hazardRatio' must be specified") + } + + piecewiseSurvivalEnabled <- designPlan$.piecewiseSurvivalTime$piecewiseSurvivalEnabled + + if (is.na(main)) { + if (type == 13) { + main <- PlotSubTitleItems(title = "Cumulative Distribution Function") + } else { + main <- PlotSubTitleItems(title = "Survival Function") + } + .addPlotSubTitleItems(designPlan, designMaster, main, type) + if (!piecewiseSurvivalEnabled) { + if (designPlan$.piecewiseSurvivalTime$.isLambdaBased(minNumberOfLambdas = 1)) { + main$add("lambda", round(designPlan$lambda1[1], 4), 1) + main$add("lambda", round(designPlan$lambda2, 4), 2) + } else { + main$add("pi", round(designPlan$pi1[1], 3), 1) + main$add("pi", round(designPlan$pi2, 3), 2) + } + } else if (length(designPlan$hazardRatio) == 1) { + main$add("Hazard Ratio", round(designPlan$hazardRatio[1], 3)) + } + } + + if (!piecewiseSurvivalEnabled || (length(designPlan$piecewiseSurvivalTime) == 1 && + designPlan$piecewiseSurvivalTime[1] == 0)) { + timeTo <- max(designPlan$analysisTime[designMaster$kMax, ]) + } else { + timeTo <- max(designPlan$piecewiseSurvivalTime) + } + if (is.na(timeTo) || !is.numeric(timeTo) || is.infinite(timeTo)) { + # warning("Unable to determine upper bound of time values", call. = FALSE) + timeTo <- 0 + } + + timeTo <- timeTo + 10 + by <- timeTo / 1000 + timeValues <- seq(from = 0, to = timeTo, by = by) + + data <- data.frame( + time = timeValues, + lambdaGroup1 = rep(-1, length(timeValues)), + lambdaGroup2 = rep(-1, length(timeValues)), + survival1 = rep(-1, length(timeValues)), + survival2 = rep(-1, length(timeValues)), + survivalGroup1 = rep(-1, length(timeValues)), + survivalGroup2 = rep(-1, length(timeValues)) + ) + + signPrefix <- ifelse(type == 13, "", "-") + if (piecewiseSurvivalEnabled) { + data$survival2 <- .getPiecewiseExponentialDistribution( + timeValues, + lambda2, designPlan$piecewiseSurvivalTime, designPlan$kappa + ) + + yParameterNames <- .getSurvivalFunctionPlotCommand( + "pwExpDist", + timeValues, lambda2, designPlan, type, piecewiseSurvivalEnabled + ) + + if (!is.null(lambda1) && !all(is.na(lambda1)) && + length(lambda1) == length(lambda2)) { + data$survival1 <- .getPiecewiseExponentialDistribution( + timeValues, + lambda1, designPlan$piecewiseSurvivalTime, designPlan$kappa + ) + yParameterNames <- c( + yParameterNames, + .getSurvivalFunctionPlotCommand( + "pwExpDist", + timeValues, lambda1, designPlan, type, piecewiseSurvivalEnabled + ) + ) + } else { + .warnInCaseOfUnusedValuesForPlottingSurvival(designPlan$hazardRatio) + data$survival1 <- data$survival2 * designPlan$hazardRatio[1] + yParameterNames <- c( + yParameterNames, + .getSurvivalFunctionPlotCommand("pwExpDist", timeValues, lambda2, + designPlan, type, piecewiseSurvivalEnabled, + multiplyByHazardRatio = TRUE + ) + ) + } + + yParameterNames <- c( + yParameterNames, + .getSurvivalFunctionPlotCommand( + "lambdaStep", + timeValues, lambda2, designPlan, type, piecewiseSurvivalEnabled + ) + ) + if (!is.null(lambda1) && !all(is.na(lambda1)) && + length(lambda1) == length(lambda2)) { + yParameterNames <- c( + yParameterNames, + .getSurvivalFunctionPlotCommand( + "lambdaStep", + timeValues, lambda1, designPlan, type, piecewiseSurvivalEnabled + ) + ) + } else { + yParameterNames <- c( + yParameterNames, + .getSurvivalFunctionPlotCommand("lambdaStep", timeValues, lambda2, + designPlan, type, piecewiseSurvivalEnabled, + multiplyByHazardRatio = TRUE + ) + ) + } + } else { + if (designPlan$.piecewiseSurvivalTime$.isLambdaBased(minNumberOfLambdas = 1)) { + if (length(designPlan$lambda1) > 1) { + lambda1 <- designPlan$lambda1[1] + warning("Only the first 'lambda1' (", round(lambda1, 4), + ") was used for plotting", + call. = FALSE + ) + } + } else { + .warnInCaseOfUnusedValuesForPlottingRates(designPlan$pi1) + } + + if (!is.na(designPlan$pi1[1]) && !is.na(designPlan$pi2) && !is.na(designPlan$eventTime)) { + lambda2 <- (-log(1 - designPlan$pi2))^(1 / designPlan$kappa) / designPlan$eventTime + lambda1 <- (-log(1 - designPlan$pi1[1]))^(1 / designPlan$kappa) / designPlan$eventTime + } + + data$survival2 <- .getPiecewiseExponentialDistribution( + timeValues, + lambda2, 0, designPlan$kappa + ) + data$survival1 <- .getPiecewiseExponentialDistribution( + timeValues, + lambda1, 0, designPlan$kappa + ) + + yParameterNames <- .getSurvivalFunctionPlotCommand( + "pwExpDist", + timeValues, lambda2, designPlan, type, piecewiseSurvivalEnabled + ) + yParameterNames <- c( + yParameterNames, + .getSurvivalFunctionPlotCommand( + "pwExpDist", + timeValues, lambda1, designPlan, type, piecewiseSurvivalEnabled + ) + ) + yParameterNames <- c( + yParameterNames, + .getSurvivalFunctionPlotCommand( + "lambdaStep", + timeValues, lambda2, designPlan, type, piecewiseSurvivalEnabled + ) + ) + yParameterNames <- c( + yParameterNames, + .getSurvivalFunctionPlotCommand( + "lambdaStep", timeValues, lambda1, + designPlan, type, piecewiseSurvivalEnabled + ) + ) + } + + # two groups: 1 = treatment, 2 = control + if (type == 14) { + data$survival1 <- 1 - data$survival1 + data$survival2 <- 1 - data$survival2 + } + + if (piecewiseSurvivalEnabled) { + data$lambdaGroup2 <- .getLambdaStepFunction( + timeValues, + designPlan$piecewiseSurvivalTime, lambda2 + ) + if (length(lambda1) == 1) { + if (!is.na(lambda1)) { + data$lambdaGroup1 <- rep(lambda1, length(data$lambdaGroup2)) + } else { + data$lambdaGroup1 <- data$lambdaGroup2 * designPlan$hazardRatio[1] + } + } else { + data$lambdaGroup1 <- .getLambdaStepFunction( + timeValues, + designPlan$piecewiseSurvivalTime, lambda1 + ) + } + } else { + data$lambdaGroup2 <- .getLambdaStepFunction(timeValues, 0, lambda2) + data$lambdaGroup1 <- .getLambdaStepFunction(timeValues, 0, lambda1) + } + + scalingBaseValues1 <- na.omit(c(data$survival1, data$survival2)) + scalingBaseValues2 <- na.omit(c(data$lambdaGroup1, data$lambdaGroup2)) + scalingFactor <- 1 + if (length(scalingBaseValues1) > 0 && length(scalingBaseValues2) > 0) { + scalingFactor <- max(scalingBaseValues1) / max(.getNextHigherValue(scalingBaseValues2)) + } + data2 <- data.frame( + categories = c( + rep("Treatm. piecew. exp.", nrow(data)), + rep("Control piecew. exp.", nrow(data)), + rep("Treatm. piecew. lambda", nrow(data)), + rep("Control piecew. lambda", nrow(data)) + ), + xValues = rep(data$time, 4), + yValues = c( + data$survival1, + data$survival2, + data$lambdaGroup1 * scalingFactor, + data$lambdaGroup2 * scalingFactor + ) + ) + + if (is.na(legendPosition)) { + if (type == 13) { + legendPosition <- C_POSITION_LEFT_TOP + } else { + legendPosition <- C_POSITION_RIGHT_TOP + } + } + + if (is.na(palette) || palette == "Set1") { + palette <- "Paired" + } + + if (type == 13) { + yAxisLabel1 <- "Cumulative Distribution Function" + } else { + yAxisLabel1 <- "Survival Function" + } + + srcCmd <- .showPlotSourceInformation( + objectName = designPlanName, + xParameterName = "time", + yParameterNames = yParameterNames, + showSource = showSource, + xValues = timeValues + ) + if (!is.null(srcCmd)) { + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(srcCmd)) + } + return(srcCmd) + } + + if (is.null(plotSettings)) { + plotSettings <- designPlan$.plotSettings + } + + return(.plotDataFrame(data2, + mainTitle = main, + xlab = xlab, ylab = ylab, xAxisLabel = "Time", + yAxisLabel1 = yAxisLabel1, yAxisLabel2 = "Lambda", + plotPointsEnabled = FALSE, legendTitle = NA_character_, + legendPosition = legendPosition, scalingFactor1 = 1, + scalingFactor2 = scalingFactor, palette = palette, sided = designMaster$sided, + plotSettings = plotSettings + )) +} + +.warnInCaseOfUnusedValuesForPlottingMeans <- function(alternative) { + if (length(alternative) > 1) { + warning("Only the first 'alternative' (", round(alternative[1], 3), + ") was used for plotting", + call. = FALSE + ) + return(list(title = "alternative", value = alternative[1], subscript = NA_character_)) + } + return(NULL) +} + +.warnInCaseOfUnusedValuesForPlottingRates <- function(pi1) { + if (length(pi1) > 1) { + warning("Only the first 'pi1' (", round(pi1[1], 3), + ") was used for plotting", + call. = FALSE + ) + return(list(title = "pi", value = pi1[1], subscript = "1")) + } + return(NULL) +} + +.warnInCaseOfUnusedValuesForPlottingSurvival <- function(hazardRatio) { + if (length(hazardRatio) > 1) { + warning("Only the first 'hazardRatio' (", round(hazardRatio[1], 3), + ") was used for plotting", + call. = FALSE + ) + return(list(title = "hazardRatio", value = hazardRatio[1], subscript = NA_character_)) + } + return(NULL) +} + +.warnInCaseOfUnusedValuesForPlotting <- function(designPlan) { + if (.isTrialDesignPlanMeans(designPlan) && designPlan$.isSampleSizeObject()) { + return(.warnInCaseOfUnusedValuesForPlottingMeans(designPlan$alternative)) + } + if (.isTrialDesignPlanRates(designPlan) && designPlan$.isSampleSizeObject()) { + return(.warnInCaseOfUnusedValuesForPlottingRates(designPlan$pi1)) + } + if (.isTrialDesignPlanSurvival(designPlan) && designPlan$.isSampleSizeObject()) { + return(.warnInCaseOfUnusedValuesForPlottingSurvival(designPlan$hazardRatio)) + } + return(NULL) +} + #' #' @title #' Trial Design Plan Plotting @@ -983,7 +2093,7 @@ TrialDesignPlanSurvival <- setRefClass("TrialDesignPlanSurvival", #' #' @export #' -plot.TrialDesignPlan <- function(x, y, ..., main = NA_character_, +plot.TrialDesignPlanR6 <- function(x, y, ..., main = NA_character_, xlab = NA_character_, ylab = NA_character_, type = ifelse(x$.design$kMax == 1, 5L, 1L), palette = "Set1", theta = seq(-1, 1, 0.01), plotPointsEnabled = NA, diff --git a/R/class_design_plan_r6.R b/R/class_design_plan_r6.R deleted file mode 100644 index 476aa28c..00000000 --- a/R/class_design_plan_r6.R +++ /dev/null @@ -1,2153 +0,0 @@ -## | -## | *Trial design plan classes* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | rpact package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File version: $Revision: 7352 $ -## | Last changed: $Date: 2023-10-12 07:56:59 +0200 (Do, 12 Okt 2023) $ -## | Last changed by: $Author: pahlke $ -## | - -#' @include f_core_constants.R -#' @include f_design_utilities.R -NULL - -C_VARIABLE_DESIGN_PLAN_PARAMETERS <- c("lambda1", "pi1", "median1", "alternative", "hazardRatio") - -C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS <- list( - normalApproximation = FALSE, - meanRatio = FALSE, - thetaH0 = 0, - alternative = seq(0.2, 1, 0.2), - stDev = 1, - groups = 2L, - allocationRatioPlanned = 1 -) - -C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES <- list( - normalApproximation = TRUE, - riskRatio = FALSE, - thetaH0 = 0, - pi1 = C_PI_1_SAMPLE_SIZE_DEFAULT, - pi2 = C_PI_2_DEFAULT, - groups = 2L, - allocationRatioPlanned = 1 -) - -C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_SURVIVAL <- list( - typeOfComputation = "Schoenfeld", - thetaH0 = 1, - pi2 = C_PI_2_DEFAULT, - pi1 = C_PI_1_SAMPLE_SIZE_DEFAULT, - allocationRatioPlanned = 1, - accountForObservationTimes = NA, - eventTime = 12, - accrualTime = C_ACCRUAL_TIME_DEFAULT, - accrualIntensity = C_ACCRUAL_INTENSITY_DEFAULT, - kappa = 1, - piecewiseSurvivalTime = NA_real_, - lambda2 = NA_real_, - lambda1 = NA_real_, - followUpTime = C_FOLLOW_UP_TIME_DEFAULT, - maxNumberOfSubjects = 0, - dropoutRate1 = 0, - dropoutRate2 = 0, - dropoutTime = 12 -) - -#' -#' @name TrialDesignPlan -#' -#' @title -#' Basic Trial Design Plan -#' -#' @description -#' Basic class for trial design plans. -#' -#' @details -#' \code{TrialDesignPlan} is the basic class for -#' \itemize{ -#' \item \code{\link{TrialDesignPlanMeans}}, -#' \item \code{\link{TrialDesignPlanRates}}, and -#' \item \code{\link{TrialDesignPlanSurvival}}. -#' } -#' -#' @include f_core_constants.R -#' @include f_core_utilities.R -#' @include class_core_parameter_set.R -#' @include class_core_plot_settings.R -#' @include class_design.R -#' @include class_design_set.R -#' @include f_core_plot.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -TrialDesignPlanR6 <- R6Class("TrialDesignPlanR6", - inherit = ParameterSetR6, - public = list( - .plotSettings = NULL, - .design = NULL, - .objectType = NULL, # "sampleSize" or "power" - initialize = function(design, ...) { - self$.design <- design - - super$initialize(...)#TODO - - self$.plotSettings <- PlotSettingsR6$new() - self$.parameterNames <- .getParameterNames(design = design, designPlan = self) - self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS - - if (.isTrialDesignPlanMeans(self)) { - defaultValueList <- C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS - } else if (.isTrialDesignPlanRates(self)) { - defaultValueList <- C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES - } else if (.isTrialDesignPlanSurvival(self)) { - defaultValueList <- C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_SURVIVAL - } - for (parameterName in self$.getVisibleFieldNames()) { - defaultValue <- defaultValueList[[parameterName]] - existingValue <- self[[parameterName]] - if (all(is.na(existingValue))) { - self$.setParameterType(parameterName, C_PARAM_DEFAULT_VALUE) - } else if (!is.null(defaultValue) && length(defaultValue) == length(existingValue) && - !any(is.na(defaultValue)) && !any(is.na(existingValue)) && - sum(defaultValue == existingValue) == length(defaultValue)) { - self$.setParameterType(parameterName, C_PARAM_DEFAULT_VALUE) - } else { - self$.setParameterType(parameterName, C_PARAM_USER_DEFINED) - } - } - self$.setParameterType("optimumAllocationRatio", C_PARAM_NOT_APPLICABLE) - }, - .setSampleSizeObject = function(objectType) { - if (length(objectType) == 0 || !(objectType %in% c("sampleSize", "power"))) { - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'.objectType' (", objectType, - ") must be specified as 'sampleSize' or 'power'" - ) - } - self$.objectType <- objectType - }, - .isSampleSizeObject = function() { - if (length(self$.objectType) == 0 || !(self$.objectType %in% c("sampleSize", "power"))) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'.objectType' must be specified as 'sampleSize' or 'power'") - } - return(self$.objectType == "sampleSize") - }, - .isPowerObject = function() { - if (length(self$.objectType) == 0 || !(self$.objectType %in% c("sampleSize", "power"))) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'.objectType' must be specified as 'sampleSize' or 'power'") - } - return(self$.objectType == "power") - }, - getPlotSettings = function() { - return(self$.plotSettings) - }, - show = function(showType = 1, digits = NA_integer_) { - self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) - }, - .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { - "Method for automatically printing trial plan objects" - self$.resetCat() - if (showType == 3) { - .createSummary(self, digits = digits)$.show( - showType = 1, - digits = digits, consoleOutputEnabled = consoleOutputEnabled - ) - } else if (showType == 2) { - super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) - } else { - self$.cat("Design plan parameters and output for ", self$.toString(), ":\n\n", - heading = 1, - consoleOutputEnabled = consoleOutputEnabled - ) - - self$.showParametersOfOneGroup(.getDesignParametersToShow(self), "Design parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - - self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Sample size and output", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - - self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - - if (inherits(self, "TrialDesignPlanSurvival") || inherits(self, "TrialDesignPlanSurvivalR6") || self$groups == 2 || self$.design$kMax > 1) {#TODO Groups???? - self$.cat("Legend:\n", - heading = 2, - consoleOutputEnabled = consoleOutputEnabled - ) - if (inherits(self, "TrialDesignPlanSurvival") || inherits(self, "TrialDesignPlanSurvivalR6") || self$groups == 2) { - self$.cat(" (i): values of treatment arm i\n", - consoleOutputEnabled = consoleOutputEnabled - ) - } - if (self$.design$kMax > 1) { - self$.cat(" [k]: values at stage k\n", consoleOutputEnabled = consoleOutputEnabled) - } - } - - self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) - } - }, - getAlpha = function() { - return(self$.design$alpha) - }, - getBeta = function() { - if (.isTrialDesignInverseNormalOrGroupSequential(self$.design)) { - return(self$.design$beta) - } - return(NA_real_) - }, - getSided = function() { - return(self$.design$sided) - }, - getTwoSidedPower = function() { - if (.isTrialDesignInverseNormalOrGroupSequential(self$.design)) { - return(self$.design$twoSidedPower) - } - return(NA) - }, - .toString = function(startWithUpperCase = FALSE) { - if (.isTrialDesignPlanMeans(self)) { - s <- "means" - } else if (.isTrialDesignPlanRates(self)) { - s <- "rates" - } else if (.isTrialDesignPlanSurvival(self)) { - s <- "survival data" - } else { - s <- paste0("unknown data class '", .getClassName(self), "'") - } - return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) #TODO correct closure of s? - } - ) -) - -#' -#' @title -#' Coerce Trial Design Plan to a Data Frame -#' -#' @description -#' Returns the \code{\link{TrialDesignPlan}} as data frame. -#' -#' @param x A \code{\link{TrialDesignPlan}} object. -#' @inheritParams param_niceColumnNamesEnabled -#' @inheritParams param_includeAllParameters -#' @inheritParams param_three_dots -#' -#' @details -#' Coerces the design plan to a data frame. -#' -#' @template return_dataframe -#' -#' @examples -#' as.data.frame(getSampleSizeMeans()) -#' -#' @export -#' -#' @keywords internal -#' -as.data.frame.TrialDesignPlanR6 <- function(x, row.names = NULL, - optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ...) { - return(.getAsDataFrame( - parameterSet = x, - parameterNames = NULL, - niceColumnNamesEnabled = niceColumnNamesEnabled, - includeAllParameters = includeAllParameters - )) -} - -#' -#' @name TrialDesignPlanMeans -#' -#' @title -#' Trial Design Plan Means -#' -#' @description -#' Trial design plan for means. -#' -#' @template field_meanRatio -#' @template field_thetaH0 -#' @template field_normalApproximation -#' @template field_alternative -#' @template field_stDev -#' @template field_groups -#' @template field_allocationRatioPlanned -#' @template field_optimumAllocationRatio -#' @template field_directionUpper -#' @template field_effect -#' @template field_overallReject -#' @template field_rejectPerStage -#' @template field_futilityStop -#' @template field_futilityPerStage -#' @template field_earlyStop -#' @template field_expectedNumberOfSubjects -#' @template field_nFixed -#' @template field_nFixed1 -#' @template field_nFixed2 -#' @template field_informationRates -#' @template field_maxNumberOfSubjects -#' @template field_maxNumberOfSubjects1 -#' @template field_maxNumberOfSubjects2 -#' @template field_numberOfSubjects -#' @template field_numberOfSubjects1 -#' @template field_numberOfSubjects2 -#' @template field_expectedNumberOfSubjectsH0 -#' @template field_expectedNumberOfSubjectsH01 -#' @template field_expectedNumberOfSubjectsH1 -#' @template field_criticalValuesEffectScale -#' @template field_criticalValuesEffectScaleLower -#' @template field_criticalValuesEffectScaleUpper -#' @template field_criticalValuesPValueScale -#' @template field_futilityBoundsEffectScale -#' @template field_futilityBoundsEffectScaleLower -#' @template field_futilityBoundsEffectScaleUpper -#' @template field_futilityBoundsPValueScale -#' -#' @details -#' This object cannot be created directly; use \code{\link[=getSampleSizeMeans]{getSampleSizeMeans()}} -#' with suitable arguments to create a design plan for a dataset of means. -#' -#' @include class_core_parameter_set.R -#' @include class_design.R -#' @include class_design_set.R -#' @include f_core_constants.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -TrialDesignPlanMeansR6 <- R6Class("TrialDesignPlanMeansR6", - inherit = TrialDesignPlanR6, - public = list( - meanRatio = NULL, - thetaH0 = NULL, - normalApproximation = NULL, - alternative = NULL, - stDev = NULL, - groups = NULL, - allocationRatioPlanned = NULL, - optimumAllocationRatio = NULL, - directionUpper = NULL, - effect = NULL, - overallReject = NULL, - rejectPerStage = NULL, - futilityStop = NULL, - futilityPerStage = NULL, - earlyStop = NULL, - expectedNumberOfSubjects = NULL, - nFixed = NULL, - nFixed1 = NULL, - nFixed2 = NULL, - informationRates = NULL, - maxNumberOfSubjects = NULL, - maxNumberOfSubjects1 = NULL, - maxNumberOfSubjects2 = NULL, - numberOfSubjects = NULL, - numberOfSubjects1 = NULL, - numberOfSubjects2 = NULL, - expectedNumberOfSubjectsH0 = NULL, - expectedNumberOfSubjectsH01 = NULL, - expectedNumberOfSubjectsH1 = NULL, - criticalValuesEffectScale = NULL, - criticalValuesEffectScaleLower = NULL, - criticalValuesEffectScaleUpper = NULL, - criticalValuesPValueScale = NULL, - futilityBoundsEffectScale = NULL, - futilityBoundsEffectScaleLower = NULL, - futilityBoundsEffectScaleUpper = NULL, - futilityBoundsPValueScale = NULL, - initialize = function(..., - normalApproximation = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS[["normalApproximation"]], - meanRatio = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS[["meanRatio"]], - thetaH0 = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS[["thetaH0"]], - alternative = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS[["alternative"]], - stDev = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS[["stDev"]], - groups = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS[["groups"]], - allocationRatioPlanned = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS[["allocationRatioPlanned"]]) { - - super$initialize(...)#TODO - - self$normalApproximation <- normalApproximation - self$meanRatio <- meanRatio - self$thetaH0 <- thetaH0 - self$alternative <- alternative - self$stDev <- stDev - self$groups <- groups - self$allocationRatioPlanned <- allocationRatioPlanned - - self$optimumAllocationRatio <- FALSE - visibleFieldNames <- self$.getVisibleFieldNames() - startIndex <- which(visibleFieldNames == "directionUpper") - for (i in startIndex:length(visibleFieldNames)) { - self$.setParameterType(visibleFieldNames[i], C_PARAM_NOT_APPLICABLE) - } - - if (self$groups == 1) { - self$.setParameterType("meanRatio", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("allocationRatioPlanned", C_PARAM_NOT_APPLICABLE) - } - - self$.setParameterType("maxNumberOfSubjects1", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("maxNumberOfSubjects2", C_PARAM_NOT_APPLICABLE) - - self$.setParameterType("criticalValuesEffectScale", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("criticalValuesEffectScaleLower", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("criticalValuesEffectScaleUpper", C_PARAM_NOT_APPLICABLE) - - self$.setParameterType("futilityBoundsEffectScale", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("futilityBoundsEffectScaleLower", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("futilityBoundsEffectScaleUpper", C_PARAM_NOT_APPLICABLE) - }, - show = function(showType = 1, digits = NA_integer_) { - "Method for automatically printing trial plan objects" - super$show(showType = showType, digits = digits) - } - ) -) - -#' -#' @name TrialDesignPlanRates -#' -#' @title -#' Trial Design Plan Rates -#' -#' @description -#' Trial design plan for rates. -#' -#' @template field_riskRatio -#' @template field_thetaH0 -#' @template field_normalApproximation -#' @template field_pi1 -#' @template field_pi2 -#' @template field_groups -#' @template field_allocationRatioPlanned -#' @template field_optimumAllocationRatio -#' @template field_directionUpper -#' @template field_effect -#' @template field_overallReject -#' @template field_rejectPerStage -#' @template field_futilityStop -#' @template field_futilityPerStage -#' @template field_earlyStop -#' @template field_expectedNumberOfSubjects -#' @template field_nFixed -#' @template field_nFixed1 -#' @template field_nFixed2 -#' @template field_informationRates -#' @template field_maxNumberOfSubjects -#' @template field_maxNumberOfSubjects1 -#' @template field_maxNumberOfSubjects2 -#' @template field_numberOfSubjects -#' @template field_numberOfSubjects1 -#' @template field_numberOfSubjects2 -#' @template field_expectedNumberOfSubjectsH0 -#' @template field_expectedNumberOfSubjectsH01 -#' @template field_expectedNumberOfSubjectsH1 -#' @template field_criticalValuesEffectScale -#' @template field_criticalValuesEffectScaleLower -#' @template field_criticalValuesEffectScaleUpper -#' @template field_criticalValuesPValueScale -#' @template field_futilityBoundsEffectScale -#' @template field_futilityBoundsEffectScaleLower -#' @template field_futilityBoundsEffectScaleUpper -#' @template field_futilityBoundsPValueScale -#' -#' @details -#' This object cannot be created directly; use \code{\link[=getSampleSizeRates]{getSampleSizeRates()}} -#' with suitable arguments to create a design plan for a dataset of rates. -#' -#' @include class_core_parameter_set.R -#' @include class_design.R -#' @include class_design_set.R -#' @include f_core_constants.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -TrialDesignPlanRatesR6 <- R6Class("TrialDesignPlanRatesR6", - inherit = TrialDesignPlanR6, - public = list( - riskRatio = NULL, - thetaH0 = NULL, - normalApproximation = NULL, - pi1 = NULL, - pi2 = NULL, - groups = NULL, - allocationRatioPlanned = NULL, - optimumAllocationRatio = NULL, - directionUpper = NULL, - effect = NULL, - expectedNumberOfSubjects = NULL, - nFixed = NULL, - nFixed1 = NULL, - nFixed2 = NULL, - overallReject = NULL, - rejectPerStage = NULL, - futilityStop = NULL, - futilityPerStage = NULL, - earlyStop = NULL, - informationRates = NULL, - maxNumberOfSubjects = NULL, - maxNumberOfSubjects1 = NULL, - maxNumberOfSubjects2 = NULL, - numberOfSubjects = NULL, - numberOfSubjects1 = NULL, - numberOfSubjects2 = NULL, - expectedNumberOfSubjectsH0 = NULL, - expectedNumberOfSubjectsH01 = NULL, - expectedNumberOfSubjectsH1 = NULL, - criticalValuesEffectScale = NULL, - criticalValuesEffectScaleLower = NULL, - criticalValuesEffectScaleUpper = NULL, - criticalValuesPValueScale = NULL, - futilityBoundsEffectScale = NULL, - futilityBoundsEffectScaleLower = NULL, - futilityBoundsEffectScaleUpper = NULL, - futilityBoundsPValueScale = NULL, - initialize = function(..., - normalApproximation = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["normalApproximation"]], - riskRatio = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["riskRatio"]], - thetaH0 = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["thetaH0"]], - pi1 = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["pi1"]], - pi2 = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["pi2"]], - groups = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["groups"]], - allocationRatioPlanned = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["allocationRatioPlanned"]]) { - super$initialize(...) #TODO - - self$normalApproximation <- normalApproximation - self$riskRatio <- riskRatio - self$thetaH0 <- thetaH0 - self$pi1 <- pi1 - self$pi2 <- pi2 - self$groups <- groups - self$allocationRatioPlanned <- allocationRatioPlanned - - self$optimumAllocationRatio <- FALSE - visibleFieldNames <- self$.getVisibleFieldNames() - startIndex <- which(visibleFieldNames == "directionUpper") - for (i in startIndex:length(visibleFieldNames)) { - self$.setParameterType(visibleFieldNames[i], C_PARAM_NOT_APPLICABLE) - } - - if (self$groups == 1) { - self$.setParameterType("meanRatio", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("allocationRatioPlanned", C_PARAM_NOT_APPLICABLE) - } - - self$.setParameterType("maxNumberOfSubjects1", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("maxNumberOfSubjects2", C_PARAM_NOT_APPLICABLE) - - self$.setParameterType("criticalValuesEffectScale", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("criticalValuesEffectScaleLower", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("criticalValuesEffectScaleUpper", C_PARAM_NOT_APPLICABLE) - - self$.setParameterType("futilityBoundsEffectScale", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("futilityBoundsEffectScaleLower", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("futilityBoundsEffectScaleUpper", C_PARAM_NOT_APPLICABLE) - }, - show = function(showType = 1, digits = NA_integer_) { - "Method for automatically printing trial plan objects" - super$show(showType = showType, digits = digits) - } - ) -) - -#' -#' @name TrialDesignPlanSurvival -#' -#' @title -#' Trial Design Plan Survival -#' -#' @description -#' Trial design plan for survival data. -#' -#' @template field_thetaH0 -#' @template field_typeOfComputation -#' @template field_directionUpper -#' @template field_pi1_survival -#' @template field_pi2_survival -#' @template field_median1 -#' @template field_median2 -#' @template field_lambda1 -#' @template field_lambda2 -#' @template field_hazardRatio -#' @template field_maxNumberOfSubjects -#' @template field_maxNumberOfSubjects1 -#' @template field_maxNumberOfSubjects2 -#' @template field_maxNumberOfEvents -#' @template field_allocationRatioPlanned -#' @template field_optimumAllocationRatio -#' @template field_accountForObservationTimes -#' @template field_eventTime -#' @template field_accrualTime -#' @template field_totalAccrualTime -#' @template field_accrualIntensity -#' @template field_accrualIntensityRelative -#' @template field_kappa -#' @template field_piecewiseSurvivalTime -#' @template field_followUpTime -#' @template field_dropoutRate1 -#' @template field_dropoutRate2 -#' @template field_dropoutTime -#' @template field_chi -#' @template field_expectedNumberOfEvents -#' @template field_eventsFixed -#' @template field_nFixed -#' @template field_nFixed1 -#' @template field_nFixed2 -#' @template field_overallReject -#' @template field_rejectPerStage -#' @template field_futilityStop -#' @template field_futilityPerStage -#' @template field_earlyStop -#' @template field_informationRates -#' @template field_analysisTime -#' @template field_studyDurationH1 -#' @template field_studyDuration -#' @template field_maxStudyDuration -#' @template field_eventsPerStage -#' @template field_expectedEventsH0 -#' @template field_expectedEventsH01 -#' @template field_expectedEventsH1 -#' @template field_numberOfSubjects -#' @template field_numberOfSubjects1 -#' @template field_numberOfSubjects2 -#' @template field_expectedNumberOfSubjectsH1 -#' @template field_expectedNumberOfSubjects -#' @template field_criticalValuesEffectScale -#' @template field_criticalValuesEffectScaleLower -#' @template field_criticalValuesEffectScaleUpper -#' @template field_criticalValuesPValueScale -#' @template field_futilityBoundsEffectScale -#' @template field_futilityBoundsEffectScaleLower -#' @template field_futilityBoundsEffectScaleUpper -#' @template field_futilityBoundsPValueScale -#' -#' @details -#' This object cannot be created directly; use \code{\link[=getSampleSizeSurvival]{getSampleSizeSurvival()}} -#' with suitable arguments to create a design plan for a dataset of survival data. -#' -#' @include class_core_parameter_set.R -#' @include class_design.R -#' @include class_design_set.R -#' @include class_time.R -#' @include f_core_constants.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -TrialDesignPlanSurvivalR6 <- R6Class("TrialDesignPlanSurvivalR6", - inherit = TrialDesignPlanR6, - public = list( - .piecewiseSurvivalTime = NULL, - .accrualTime = NULL, - .calculateFollowUpTime = NULL, - thetaH0 = NULL, - typeOfComputation = NULL, - directionUpper = NULL, - pi1 = NULL, - pi2 = NULL, - median1 = NULL, - median2 = NULL, - lambda1 = NULL, - lambda2 = NULL, - hazardRatio = NULL, - maxNumberOfSubjects = NULL, - maxNumberOfSubjects1 = NULL, - maxNumberOfSubjects2 = NULL, - maxNumberOfEvents = NULL, - allocationRatioPlanned = NULL, - optimumAllocationRatio = NULL, - accountForObservationTimes = NULL, - eventTime = NULL, - accrualTime = NULL, - totalAccrualTime = NULL, - accrualIntensity = NULL, - accrualIntensityRelative = NULL, - kappa = NULL, - piecewiseSurvivalTime = NULL, - followUpTime = NULL, - dropoutRate1 = NULL, - dropoutRate2 = NULL, - dropoutTime = NULL, - chi = NULL, - expectedNumberOfEvents = NULL, - eventsFixed = NULL, - nFixed = NULL, - nFixed1 = NULL, - nFixed2 = NULL, - overallReject = NULL, - rejectPerStage = NULL, - futilityStop = NULL, - futilityPerStage = NULL, - earlyStop = NULL, - informationRates = NULL, - analysisTime = NULL, - studyDurationH1 = NULL, - studyDuration = NULL, - maxStudyDuration = NULL, - eventsPerStage = NULL, - expectedEventsH0 = NULL, - expectedEventsH01 = NULL, - expectedEventsH1 = NULL, - numberOfSubjects = NULL, - numberOfSubjects1 = NULL, - numberOfSubjects2 = NULL, - expectedNumberOfSubjectsH1 = NULL, - expectedNumberOfSubjects = NULL, - criticalValuesEffectScale = NULL, - criticalValuesEffectScaleLower = NULL, - criticalValuesEffectScaleUpper = NULL, - criticalValuesPValueScale = NULL, - futilityBoundsEffectScale = NULL, - futilityBoundsEffectScaleLower = NULL, - futilityBoundsEffectScaleUpper = NULL, - futilityBoundsPValueScale = NULL, - initialize = function(...,typeOfComputation = NULL, - thetaH0 = NULL, - allocationRatioPlanned = NULL, - accountForObservationTimes = NULL, - eventTime = NULL, - accrualTime = NULL, - accrualIntensity = NULL, - kappa = NULL, - followUpTime = NULL, - maxNumberOfSubjects = NULL, - dropoutRate1 = NULL, - dropoutRate2 = NULL, - dropoutTime = NULL, - hazardRatio = NULL) { - - - self$typeOfComputation <- typeOfComputation - self$thetaH0 <- thetaH0 - self$allocationRatioPlanned <- allocationRatioPlanned - self$accountForObservationTimes <- accountForObservationTimes - self$eventTime <- eventTime - self$accrualTime <- accrualTime - self$accrualIntensity <- accrualIntensity - self$kappa <- kappa - self$followUpTime <- followUpTime - self$maxNumberOfSubjects <- maxNumberOfSubjects - self$dropoutRate1 <- dropoutRate1 - self$dropoutRate2 <- dropoutRate2 - self$dropoutTime <- dropoutTime - self$hazardRatio <- hazardRatio - - super$initialize(...) - - self$optimumAllocationRatio <- FALSE - visibleFieldNames <- self$.getVisibleFieldNames() - startIndex <- which(visibleFieldNames == "hazardRatio") - for (i in startIndex:length(visibleFieldNames)) { - self$.setParameterType(visibleFieldNames[i], C_PARAM_NOT_APPLICABLE) - } - - self$.setParameterType("maxNumberOfSubjects", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("maxNumberOfSubjects1", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("maxNumberOfSubjects2", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("median1", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("median2", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("accountForObservationTimes", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("chi", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("maxStudyDuration", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("accrualIntensityRelative", C_PARAM_NOT_APPLICABLE) - - self$.setParameterType("criticalValuesEffectScale", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("criticalValuesEffectScaleLower", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("criticalValuesEffectScaleUpper", C_PARAM_NOT_APPLICABLE) - - self$.setParameterType("futilityBoundsEffectScale", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("futilityBoundsEffectScaleLower", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("futilityBoundsEffectScaleUpper", C_PARAM_NOT_APPLICABLE) - - # set default values - for (parameterName in c( - "eventTime", "accrualTime", "accrualIntensity", - "kappa", "piecewiseSurvivalTime", "lambda1", "lambda2", - "followUpTime", "dropoutTime" - )) { - self$.setDefaultValue(parameterName) - } - }, - .setDefaultValue = function(argumentName) { - if (is.null(self[[argumentName]]) || all(is.na(self[[argumentName]]))) { - self[[argumentName]] <- C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_SURVIVAL[[argumentName]] - self$.setParameterType(argumentName, C_PARAM_DEFAULT_VALUE) - } - }, - show = function(showType = 1, digits = NA_integer_) { - "Method for automatically printing trial plan objects" - super$show(showType = showType, digits = digits) - }, - .warnInCaseArgumentExists = function(argument, argumentName) { - if (!all(is.na(argument)) && any(argument > 0)) { - warning(sprintf( - "Specified '%s' (%s) not taken into account", - argumentName, .arrayToString(argument) - ), call. = FALSE) - } - } - ) -) - -.addPlotSubTitleItems <- function(designPlan, designMaster, items, type) { - if (type %in% c(1, 3, 4)) { - return(invisible()) - } - - if (.isTrialDesignPlanMeans(designPlan)) { - nMax <- designPlan$maxNumberOfSubjects[1] # use first value for plotting - - if (!(type %in% c(5))) { - items$add("N", round(nMax, 1), "max") - } - - if ((type %in% c(5)) && !(items$title == "Sample Size")) { - items$add("N", round(nMax, 1), "max") - } - - if (designPlan$meanRatio) { - items$add("coefficient of variation", designPlan$stDev) - } else { - items$add("standard deviation", designPlan$stDev) - } - - if (designPlan$groups == 1) { - if (type %in% c(2, (5:9))) { - items$add("H0: mu", designPlan$thetaH0) - items$add("allocation ratio", round(designPlan$allocationRatioPlanned, 2)) - } - } else { - if (type %in% c(2, (5:9))) { - if (designPlan$meanRatio) { - items$add("H0: mean ratio", designPlan$thetaH0) - } else { - items$add("H0: mean difference", designPlan$thetaH0) - } - items$add("allocation ratio", round(designPlan$allocationRatioPlanned, 2)) - } - } - } else if (.isTrialDesignPlanRates(designPlan)) { - nMax <- designPlan$maxNumberOfSubjects[1] # use first value for plotting - - if (!(type %in% c(5))) { - items$add("N", round(nMax, 1), "max") - } - - if ((type %in% c(5)) && !(items$title == "Sample Size")) { - items$add("N", round(nMax, 1), "max") - } - - if (designPlan$groups == 2 && !(type %in% c(3, 4)) && - length(designPlan$pi2) == 1 && !is.na(designPlan$pi2)) { - items$add("pi", designPlan$pi2, 2) - } - - if (designPlan$groups == 1) { - if (type %in% c(2, (5:9))) { - items$add("H0: pi", designPlan$thetaH0) - } - } else { - if (type %in% c(2, (5:9))) { - if (designPlan$riskRatio) { - items$add("H0: risk ratio", designPlan$thetaH0) - } else { - items$add("H0: risk difference", designPlan$thetaH0) - } - items$add("allocation ratio", round(designPlan$allocationRatioPlanned, 2)) - } - } - } else if (.isTrialDesignPlanSurvival(designPlan)) { - if (designPlan$.isPowerObject() && !(type %in% (13:14))) { - items$add("maximum number of events", designPlan$maxNumberOfEvents[1]) - } - if (type %in% (10:12)) { - items$add("maximum number of subjects", designPlan$maxNumberOfSubjects[1]) - } - if (type %in% c(2, (5:12))) { - items$add("H0: hazard ratio", designPlan$thetaH0) - items$add("allocation ratio", round(designPlan$allocationRatioPlanned, 2)) - } - } -} - -.assertIsValidVariedParameterVectorForPlotting <- function(designPlan, plotType) { - if (.isTrialDesignPlanMeans(designPlan)) { - if (is.null(designPlan$alternative) || any(is.na(designPlan$alternative)) || - length(designPlan$alternative) <= 1) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "plot type ", plotType, - " is only available if 'alternative' with length > 1 is defined" - ) - } - } else if (.isTrialDesignPlanRates(designPlan)) { - if (is.null(designPlan$pi1) || any(is.na(designPlan$pi1)) || - length(designPlan$pi1) <= 1) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "plot type ", plotType, - " is only available if 'pi1' with length > 1 is defined" - ) - } - } else if (.isTrialDesignPlanSurvival(designPlan)) { - if (is.null(designPlan$hazardRatio) || any(is.na(designPlan$hazardRatio)) || - length(designPlan$hazardRatio) <= 1) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "plot type ", plotType, - " is only available if 'hazardRatio' with length > 1 is defined" - ) - } - } -} - -.plotTrialDesignPlan <- function(designPlan, type = 1L, main = NA_character_, - xlab = NA_character_, ylab = NA_character_, palette = "Set1", - theta = seq(-1, 1, 0.02), plotPointsEnabled = NA, - legendPosition = NA_integer_, showSource = FALSE, - designPlanName = NA_character_, plotSettings = NULL, ...) { - .assertGgplotIsInstalled() - .assertIsTrialDesignPlan(designPlan) - .assertIsValidLegendPosition(legendPosition) - .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) - theta <- .assertIsValidThetaRange(thetaRange = theta) - - survivalDesignPlanEnabled <- .isTrialDesignPlanSurvival(designPlan) - - nMax <- ifelse(survivalDesignPlanEnabled, designPlan$maxNumberOfEvents[1], - designPlan$maxNumberOfSubjects[1] - ) # use first value for plotting - - if (is.null(plotSettings)) { - plotSettings <- designPlan$.plotSettings - } - - designMaster <- designPlan$.design - - if (designMaster$kMax == 1 && (type %in% c(1:4))) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, - ") is not available for 'kMax' = 1" - ) - } - - if (designPlan$.isSampleSizeObject()) { - if (survivalDesignPlanEnabled) { - if (!(type %in% c(1:5, 13, 14))) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, - ") is not allowed; must be 1, 2, 3, 4, 5, 13 or 14" - ) - } - } else { - if (!(type %in% c(1:5))) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, - ") is not allowed; must be 1, 2, 3, 4, 5" - ) - } - } - } - - if (is.na(plotPointsEnabled)) { - plotPointsEnabled <- type < 4 - } - - ratioEnabled <- (survivalDesignPlanEnabled || - (.isTrialDesignPlanMeans(designPlan) && designPlan$meanRatio) || - (.isTrialDesignPlanRates(designPlan) && designPlan$riskRatio)) - - variedParameters <- logical(0) - - showSourceHint <- "" - if (type %in% c(5:12)) { - if (.isTrialDesignPlanMeans(designPlan) && length(designPlan$alternative) == 2 && - designPlan$.getParameterType("alternative") == C_PARAM_USER_DEFINED) { - if (!is.logical(showSource) || isTRUE(showSource)) { - showSourceHint <- .getVariedParameterHint(designPlan$alternative, "alternative") - } - designPlan <- designPlan$clone( - alternative = - .getVariedParameterVector(designPlan$alternative, "alternative") - ) - } else if ((.isTrialDesignPlanRates(designPlan) || survivalDesignPlanEnabled) && - length(designPlan$pi1) == 2 && - designPlan$.getParameterType("pi1") == C_PARAM_USER_DEFINED) { - if (!is.logical(showSource) || isTRUE(showSource)) { - showSourceHint <- .getVariedParameterHint(designPlan$pi1, "pi1") - } - designPlan <- designPlan$clone( - pi1 = - .getVariedParameterVector(designPlan$pi1, "pi1") - ) - } else if (survivalDesignPlanEnabled && length(designPlan$hazardRatio) == 2 && - designPlan$.getParameterType("hazardRatio") == C_PARAM_USER_DEFINED) { - if (!is.logical(showSource) || isTRUE(showSource)) { - showSourceHint <- .getVariedParameterHint(designPlan$hazardRatio, "hazardRatio") - } - designPlan <- designPlan$clone( - hazardRatio = - .getVariedParameterVector(designPlan$hazardRatio, "hazardRatio") - ) - } - } - - srcCmd <- NULL - - reducedParam <- NULL - if (type %in% c(1:4)) { - reducedParam <- .warnInCaseOfUnusedValuesForPlotting(designPlan) - } - - if (type == 1) { # Boundary plot - if (survivalDesignPlanEnabled) { - if (is.na(main)) { - main <- PlotSubTitleItems(title = "Boundaries Z Scale") - .addPlotSubTitleItems(designPlan, designMaster, main, type) - if (!is.null(reducedParam)) { - main$add(reducedParam$title, reducedParam$value, reducedParam$subscript) - } - } - - if (designMaster$sided == 1) { - designPlan <- data.frame( - eventsPerStage = designPlan$eventsPerStage[, 1], - criticalValues = designMaster$criticalValues, - futilityBounds = c(designMaster$futilityBounds, designMaster$criticalValues[designMaster$kMax]) - ) - } else { - designPlan <- data.frame( - eventsPerStage = designPlan$eventsPerStage[, 1], - criticalValues = designMaster$criticalValues, - criticalValuesMirrored = -designMaster$criticalValues - ) - } - - xParameterName <- "eventsPerStage" - if (designMaster$sided == 1) { - if (any(designMaster$futilityBounds > C_FUTILITY_BOUNDS_DEFAULT)) { - yParameterNames <- c("futilityBounds", "criticalValues") - } else { - yParameterNames <- "criticalValues" - } - yParameterNamesSrc <- yParameterNames - } else { - yParameterNames <- c("criticalValues", "criticalValuesMirrored") - yParameterNamesSrc <- c("criticalValues", paste0("-", designPlanName, "$.design$criticalValues")) - } - - if (is.na(legendPosition)) { - legendPosition <- C_POSITION_RIGHT_TOP - } - - srcCmd <- .showPlotSourceInformation( - objectName = paste0(designPlanName, "$.design"), - xParameterName = paste0(designPlanName, "$", xParameterName, "[, 1]"), - yParameterNames = yParameterNamesSrc, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - } else { - if (is.na(main)) { - main <- PlotSubTitleItems(title = "Boundaries") - .addPlotSubTitleItems(designPlan, designMaster, main, type) - if (!is.null(reducedParam)) { - main$add(reducedParam$title, reducedParam$value, reducedParam$subscript) - } - } - - designSet <- TrialDesignSetR6$new(design = designMaster, singleDesign = TRUE) - designSet$.plotSettings <- designPlan$.plotSettings - designPlanName <- paste0(designPlanName, "$.design") - return(.plotTrialDesignSet( - x = designSet, y = NULL, main = main, - xlab = xlab, ylab = ylab, type = type, - palette = palette, theta = theta, nMax = nMax, - plotPointsEnabled = plotPointsEnabled, legendPosition = legendPosition, - designSetName = designPlanName, showSource = showSource, - plotSettings = plotSettings # , ... - )) - } - } else if (type == 2) { # Effect Scale Boundary plot - if (is.na(main)) { - main <- PlotSubTitleItems(title = "Boundaries Effect Scale") - .addPlotSubTitleItems(designPlan, designMaster, main, type) - if (!is.null(reducedParam)) { - main$add(reducedParam$title, reducedParam$value, reducedParam$subscript) - } - } - - if (is.na(ylab)) { - if (.isTrialDesignPlanMeans(designPlan)) { - if (designPlan$groups == 1) { - ylab <- "Mean" - } else if (!designPlan$meanRatio) { - ylab <- "Mean Difference" - } else { - ylab <- "Mean Ratio" - } - } else if (.isTrialDesignPlanRates(designPlan)) { - if (designPlan$groups == 1) { - ylab <- "Rate" - } else if (!designPlan$riskRatio) { - ylab <- "Rate Difference" - } else { - ylab <- "Risk Ratio" - } - } else if (survivalDesignPlanEnabled) { - ylab <- "Hazard Ratio" - } - } - - groupedPlotEnabled <- FALSE - yParameterNamesSrc <- c() - if (designMaster$sided == 1) { - if (any(designMaster$futilityBounds > C_FUTILITY_BOUNDS_DEFAULT)) { - data <- data.frame( - criticalValuesEffectScale = designPlan$criticalValuesEffectScale[, 1], - futilityBoundsEffectScale = c( - designPlan$futilityBoundsEffectScale[, 1], - designPlan$criticalValuesEffectScale[designMaster$kMax, 1] - ) - ) - yParameterNamesSrc <- c(yParameterNamesSrc, "criticalValuesEffectScale[, 1]") - yParameterNamesSrc <- c(yParameterNamesSrc, paste0( - "c(", designPlanName, "$futilityBoundsEffectScale[, 1], ", - designPlanName, "$criticalValuesEffectScale[nrow(", designPlanName, "$criticalValuesEffectScale), 1])" - )) - } else { - data <- data.frame( - criticalValuesEffectScale = designPlan$criticalValuesEffectScale[, 1] - ) - yParameterNamesSrc <- c(yParameterNamesSrc, "criticalValuesEffectScale[, 1]") - } - } else if (designMaster$typeOfDesign == C_TYPE_OF_DESIGN_PT) { - data <- data.frame( - criticalValues = designPlan$criticalValuesEffectScaleUpper[, 1], - criticalValuesMirrored = designPlan$criticalValuesEffectScaleLower[, 1], - futilityBounds = c( - designPlan$futilityBoundsEffectScaleUpper[, 1], - designPlan$criticalValuesEffectScaleUpper[designMaster$kMax, 1] - ), - futilityBoundsMirrored = c( - designPlan$futilityBoundsEffectScaleLower[, 1], - designPlan$criticalValuesEffectScaleLower[designMaster$kMax, 1] - ) - ) - yParameterNamesSrc <- c(yParameterNamesSrc, "criticalValuesEffectScaleUpper[, 1]") - yParameterNamesSrc <- c(yParameterNamesSrc, "criticalValuesEffectScaleLower[, 1]") - yParameterNamesSrc <- c(yParameterNamesSrc, paste0( - "c(", designPlanName, "$futilityBoundsEffectScaleUpper[, 1], ", - designPlanName, "$criticalValuesEffectScaleUpper[nrow(", designPlanName, "$criticalValuesEffectScaleUpper), 1])" - )) - yParameterNamesSrc <- c(yParameterNamesSrc, paste0( - "c(", designPlanName, "$futilityBoundsEffectScaleLower[, 1], ", - designPlanName, "$criticalValuesEffectScaleLower[nrow(", designPlanName, "$criticalValuesEffectScaleLower), 1])" - )) - groupedPlotEnabled <- TRUE - } else { - data <- data.frame( - criticalValuesEffectScale = designPlan$criticalValuesEffectScaleUpper[, 1], - criticalValuesEffectScaleMirrored = designPlan$criticalValuesEffectScaleLower[, 1] - ) - yParameterNamesSrc <- c(yParameterNamesSrc, "criticalValuesEffectScaleUpper[, 1]") - yParameterNamesSrc <- c(yParameterNamesSrc, "criticalValuesEffectScaleLower[, 1]") - } - - if (survivalDesignPlanEnabled) { - xParameterName <- "eventsPerStage" - xParameterNameSrc <- paste0(designPlanName, "$", xParameterName, "[, 1]") - data <- cbind(data.frame(eventsPerStage = designPlan$eventsPerStage[, 1]), data) - } else { - xParameterName <- "informationRates" - xParameterNameSrc <- paste0(designPlanName, "$.design$", xParameterName) - data <- cbind(data.frame(informationRates = designMaster$informationRates), data) - } - if (designMaster$sided == 1 || designMaster$typeOfDesign == C_TYPE_OF_DESIGN_PT) { - if (any(designMaster$futilityBounds > C_FUTILITY_BOUNDS_DEFAULT)) { - yParameterNames <- c("futilityBoundsEffectScale", "criticalValuesEffectScale") - } else { - yParameterNames <- "criticalValuesEffectScale" - } - } else { - yParameterNames <- c("criticalValuesEffectScale", "criticalValuesEffectScaleMirrored") - } - - if (is.na(legendPosition)) { - legendPosition <- C_POSITION_RIGHT_TOP - } - - if (is.na(legendPosition)) { - legendPosition <- C_POSITION_RIGHT_TOP - } - - srcCmd <- .showPlotSourceInformation( - objectName = designPlanName, - xParameterName = xParameterNameSrc, - yParameterNames = yParameterNamesSrc, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - - if (groupedPlotEnabled) { - tableColumnNames <- C_TABLE_COLUMN_NAMES - criticalValuesName <- designPlan$.getDataFrameColumnCaption("criticalValuesEffectScale", tableColumnNames, TRUE) - futilityBoundsName <- designPlan$.getDataFrameColumnCaption("futilityBoundsEffectScale", tableColumnNames, TRUE) - - designPlan <- data.frame( - xValues = rep(data[[xParameterName]], 4), - yValues = c( - data$criticalValues, data$criticalValuesMirrored, - data$futilityBounds, data$futilityBoundsMirrored - ), - categories = c( - rep(criticalValuesName, nrow(data)), rep("criticalValuesMirrored", nrow(data)), - rep(futilityBoundsName, nrow(data)), rep("futilityBoundsMirrored", nrow(data)) - ), - groups = c(rep(criticalValuesName, 2 * nrow(data)), rep(futilityBoundsName, 2 * nrow(data))) - ) - } else { - designPlan <- data - } - } else if (type == 3) { # Stage Levels - if (is.na(main)) { - main <- PlotSubTitleItems(title = "Boundaries p Values Scale") - .addPlotSubTitleItems(designPlan, designMaster, main, type) - if (!is.null(reducedParam)) { - main$add(reducedParam$title, reducedParam$value, reducedParam$subscript) - } - } - - if (survivalDesignPlanEnabled) { - xParameterName <- "eventsPerStage" - yParameterNames <- "stageLevels" - designPlan <- data.frame( - eventsPerStage = designPlan$eventsPerStage[, 1], - stageLevels = designMaster$stageLevels - ) - xParameterNameSrc <- "eventsPerStage[, 1]" - yParameterNamesSrc <- ".design$stageLevels" - } else { - xParameterName <- "informationRates" - yParameterNames <- "stageLevels" - designPlan <- TrialDesignSetR6$new(design = designMaster, singleDesign = TRUE) - xParameterNameSrc <- ".design$informationRates" - yParameterNamesSrc <- ".design$stageLevels" - } - - srcCmd <- .showPlotSourceInformation( - objectName = designPlanName, - xParameterName = xParameterNameSrc, - yParameterNames = yParameterNamesSrc, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - } else if (type == 4) { # Alpha Spending - if (is.na(main)) { - main <- PlotSubTitleItems(title = "Error Spending") - .addPlotSubTitleItems(designPlan, designMaster, main, type) - if (!is.null(reducedParam)) { - main$add(reducedParam$title, reducedParam$value, reducedParam$subscript) - } - } - if (survivalDesignPlanEnabled) { - xParameterName <- "eventsPerStage" - yParameterNames <- "alphaSpent" - designPlan <- data.frame( - eventsPerStage = designPlan$eventsPerStage[, 1], - alphaSpent = designMaster$alphaSpent - ) - xParameterNameSrc <- "eventsPerStage[, 1]" - yParameterNamesSrc <- ".design$alphaSpent" - } else { - xParameterName <- "informationRates" - yParameterNames <- "alphaSpent" - designPlan <- TrialDesignSetR6$new(design = designMaster, singleDesign = TRUE) - xParameterNameSrc <- ".design$informationRates" - yParameterNamesSrc <- ".design$alphaSpent" - } - plotPointsEnabled <- ifelse(is.na(plotPointsEnabled), FALSE, plotPointsEnabled) - - srcCmd <- .showPlotSourceInformation( - objectName = designPlanName, - xParameterName = xParameterNameSrc, - yParameterNames = yParameterNamesSrc, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - } else if (type == 5) { # Power and Stopping Probabilities - - .assertIsValidVariedParameterVectorForPlotting(designPlan, type) - - if (designPlan$.isSampleSizeObject()) { - if (is.na(main)) { - main <- PlotSubTitleItems(title = "Sample Size") - .addPlotSubTitleItems(designPlan, designMaster, main, type) - } - - yAxisScalingEnabled <- TRUE - - if (.isTrialDesignPlanMeans(designPlan)) { - xParameterName <- "alternative" - yParameterNames <- c("nFixed") - if (designMaster$kMax > 1) { - yParameterNames <- c(yParameterNames, "maxNumberOfSubjects", "expectedNumberOfSubjectsH1") - } - if (is.na(ylab)) { - ylab <- "Sample Size" - } - yAxisScalingEnabled <- FALSE - if (is.na(legendPosition)) { - legendPosition <- C_POSITION_RIGHT_TOP - } - yParameterNamesSrc <- yParameterNames - } else if (.isTrialDesignPlanRates(designPlan)) { - xParameterName <- "pi1" - yParameterNames <- c("nFixed") - if (designMaster$kMax > 1) { - yParameterNames <- c(yParameterNames, "maxNumberOfSubjects", "expectedNumberOfSubjectsH1") - } - if (is.na(ylab)) { - ylab <- "Sample Size" - } - yAxisScalingEnabled <- FALSE - if (is.na(legendPosition)) { - legendPosition <- C_POSITION_RIGHT_TOP - } - yParameterNamesSrc <- yParameterNames - } else if (survivalDesignPlanEnabled) { - designPlan <- data.frame( - hazardRatio = designPlan$hazardRatio, - eventsFixed = designPlan$eventsFixed, - maxNumberOfEvents = designPlan$eventsPerStage[designMaster$kMax, ], - expectedEventsH1 = designPlan$expectedEventsH1 - ) - xParameterName <- "hazardRatio" - yParameterNames <- c("eventsFixed") - if (designMaster$kMax > 1) { - yParameterNames <- c(yParameterNames, "maxNumberOfEvents", "expectedEventsH1") - } - if (is.na(ylab)) { - ylab <- "# Events" - } - - if (is.na(legendPosition)) { - legendPosition <- C_POSITION_RIGHT_TOP - } - yParameterNamesSrc <- c( - "eventsFixed", - paste0("eventsPerStage[", designMaster$kMax, ", ]"), "expectedEventsH1" - ) - } - - srcCmd <- .showPlotSourceInformation( - objectName = designPlanName, - xParameterName = xParameterName, - yParameterNames = yParameterNamesSrc, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - if (!is.null(srcCmd)) { - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(srcCmd)) - } - return(srcCmd) - } - - return(.plotParameterSet( - parameterSet = designPlan, designMaster = designMaster, - xParameterName = xParameterName, - yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, - palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, - legendPosition = legendPosition, variedParameters = variedParameters, - qnormAlphaLineEnabled = FALSE, yAxisScalingEnabled = FALSE, - plotSettings = plotSettings # , ... - )) - } else { - if (is.na(main)) { - main <- PlotSubTitleItems(title = "Overall Power and Early Stopping") - .addPlotSubTitleItems(designPlan, designMaster, main, type) - } - if (survivalDesignPlanEnabled) { - xParameterName <- "hazardRatio" - } else { - xParameterName <- "effect" - } - yParameterNames <- c("overallReject", "futilityStop", "earlyStop") - - if (is.na(ylab)) { - ylab <- "" - } - if (is.na(legendPosition)) { - legendPosition <- C_POSITION_LEFT_TOP - } - - srcCmd <- .showPlotSourceInformation( - objectName = designPlanName, - xParameterName = xParameterName, - yParameterNames = yParameterNames, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - if (!is.null(srcCmd)) { - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(srcCmd)) - } - return(srcCmd) - } - - if (is.null(list(...)[["ylim"]])) { - ylim <- c(0, 1) - return(.plotParameterSet( - parameterSet = designPlan, designMaster = designMaster, - xParameterName = xParameterName, - yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, - palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, - legendPosition = legendPosition, variedParameters = variedParameters, - qnormAlphaLineEnabled = FALSE, yAxisScalingEnabled = FALSE, - plotSettings = plotSettings, ylim = ylim # , ... - )) - } else { - return(.plotParameterSet( - parameterSet = designPlan, designMaster = designMaster, - xParameterName = xParameterName, - yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, - palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, - legendPosition = legendPosition, variedParameters = variedParameters, - qnormAlphaLineEnabled = FALSE, yAxisScalingEnabled = FALSE, - plotSettings = plotSettings # , ... - )) - } - } - } else if (type == 6) { # Average Sample Size / Average Event Number - .assertIsValidVariedParameterVectorForPlotting(designPlan, type) - - if (is.na(main)) { - titlePart <- ifelse(survivalDesignPlanEnabled, "Number of Events", "Sample Size") - main <- PlotSubTitleItems(title = paste0("Expected ", titlePart, " and Power / Early Stop")) - .addPlotSubTitleItems(designPlan, designMaster, main, type) - } - - if (survivalDesignPlanEnabled) { - xParameterName <- "hazardRatio" - yParameterNames <- "expectedNumberOfEvents" - expectedNumberOfEvents <- designPlan[["expectedNumberOfEvents"]] - if (is.null(expectedNumberOfEvents) || length(expectedNumberOfEvents) == 0) { - yParameterNames <- "expectedEventsH1" - } - yParameterNames <- c(yParameterNames, "overallReject", "earlyStop") # overallReject = power - if (is.na(legendPosition)) { - legendPosition <- C_POSITION_RIGHT_CENTER - } - } else { - xParameterName <- "effect" - yParameterNames <- c("expectedNumberOfSubjects", "overallReject", "earlyStop") # overallReject = power - } - srcCmd <- .showPlotSourceInformation( - objectName = designPlanName, - xParameterName = xParameterName, - yParameterNames = yParameterNames, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - } else if (type == 7) { - .assertIsValidVariedParameterVectorForPlotting(designPlan, type) - - if (is.na(main)) { - main <- PlotSubTitleItems(title = "Overall Power") - .addPlotSubTitleItems(designPlan, designMaster, main, type) - } - - if (survivalDesignPlanEnabled) { - xParameterName <- "hazardRatio" - } else { - xParameterName <- "effect" - } - yParameterNames <- "overallReject" - if (is.na(legendPosition)) { - legendPosition <- C_POSITION_RIGHT_CENTER - } - srcCmd <- .showPlotSourceInformation( - objectName = designPlanName, - xParameterName = xParameterName, - yParameterNames = yParameterNames, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - } else if (type == 8) { - .assertIsValidVariedParameterVectorForPlotting(designPlan, type) - - if (is.na(main)) { - main <- PlotSubTitleItems(title = "Overall Early Stopping") - .addPlotSubTitleItems(designPlan, designMaster, main, type) - } - - if (survivalDesignPlanEnabled) { - xParameterName <- "hazardRatio" - } else { - xParameterName <- "effect" - } - yParameterNames <- c("earlyStop", "futilityStop") - if (is.na(legendPosition)) { - legendPosition <- C_POSITION_RIGHT_CENTER - } - srcCmd <- .showPlotSourceInformation( - objectName = designPlanName, - xParameterName = xParameterName, - yParameterNames = yParameterNames, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - } else if (type == 9) { - .assertIsValidVariedParameterVectorForPlotting(designPlan, type) - - if (is.na(main)) { - if (survivalDesignPlanEnabled) { - main <- PlotSubTitleItems(title = "Expected Number of Events") - } else { - main <- PlotSubTitleItems(title = "Expected Sample Size") - } - .addPlotSubTitleItems(designPlan, designMaster, main, type) - } - - if (survivalDesignPlanEnabled) { - xParameterName <- "hazardRatio" - yParameterNames <- "expectedNumberOfEvents" - expectedNumberOfEvents <- designPlan[["expectedNumberOfEvents"]] - if (is.null(expectedNumberOfEvents) || length(expectedNumberOfEvents) == 0) { - yParameterNames <- c("expectedEventsH0", "expectedEventsH1") - if (is.na(legendPosition)) { - legendPosition <- C_POSITION_RIGHT_CENTER - } - } - } else { - xParameterName <- "effect" - yParameterNames <- "expectedNumberOfSubjects" - } - srcCmd <- .showPlotSourceInformation( - objectName = designPlanName, - xParameterName = xParameterName, - yParameterNames = yParameterNames, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - } else if (survivalDesignPlanEnabled) { - if (type == 10) { # Study Duration - .assertIsValidVariedParameterVectorForPlotting(designPlan, type) - if (is.na(main)) { - main <- PlotSubTitleItems(title = "Study Duration") - .addPlotSubTitleItems(designPlan, designMaster, main, type) - } - xParameterName <- "hazardRatio" - yParameterNames <- "studyDuration" - srcCmd <- .showPlotSourceInformation( - objectName = designPlanName, - xParameterName = xParameterName, - yParameterNames = yParameterNames, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - } else if (type == 11) { - .assertIsValidVariedParameterVectorForPlotting(designPlan, type) - if (is.na(main)) { - main <- PlotSubTitleItems(title = "Expected Number of Subjects") - .addPlotSubTitleItems(designPlan, designMaster, main, type) - } - xParameterName <- "hazardRatio" - yParameterNames <- "expectedNumberOfSubjects" - srcCmd <- .showPlotSourceInformation( - objectName = designPlanName, - xParameterName = xParameterName, - yParameterNames = yParameterNames, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - } else if (type == 12) { # Analysis Time - .assertIsValidVariedParameterVectorForPlotting(designPlan, type) - if (is.na(main)) { - main <- PlotSubTitleItems(title = "Analysis Time") - .addPlotSubTitleItems(designPlan, designMaster, main, type) - } - - xParameterName <- "hazardRatio" - yParameterNames <- "analysisTime" - yParameterNamesSrc <- c() - for (i in 1:nrow(designPlan[["analysisTime"]])) { - yParameterNamesSrc <- c(yParameterNamesSrc, paste0("analysisTime[", i, ", ]")) - } - - data <- NULL - for (k in 1:designMaster$kMax) { - part <- data.frame( - categories = rep(k, length(designPlan$hazardRatio)), - xValues = designPlan$hazardRatio, - yValues = designPlan$analysisTime[k, ] - ) - if (is.null(data)) { - data <- part - } else { - data <- rbind(data, part) - } - } - - srcCmd <- .showPlotSourceInformation( - objectName = designPlanName, - xParameterName = xParameterName, - yParameterNames = yParameterNamesSrc, - hint = showSourceHint, - type = type, showSource = showSource - ) - if (!is.null(srcCmd)) { - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(srcCmd)) - } - return(srcCmd) - } - - return(.plotDataFrame(data, - mainTitle = main, - xlab = NA_character_, ylab = NA_character_, xAxisLabel = "Hazard Ratio", - yAxisLabel1 = "Analysis Time", yAxisLabel2 = NA_character_, - plotPointsEnabled = TRUE, legendTitle = "Stage", - legendPosition = legendPosition, sided = designMaster$sided, - plotSettings = plotSettings, ... - )) - } else if (type == 13 || type == 14) { # Cumulative Distribution Function / Survival function - return(.plotSurvivalFunction(designPlan, - designMaster = designMaster, type = type, main = main, - xlab = xlab, ylab = ylab, palette = palette, - legendPosition = legendPosition, showSource = showSource, - designPlanName = designPlanName, - plotSettings = plotSettings, ... - )) - } else { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is not allowed; must be 1, 2, ..., 14") - } - } else { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is not allowed; must be 1, 2, ..., 9") - } - - if (!is.null(srcCmd)) { - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(srcCmd)) - } - return(srcCmd) - } - - p <- .plotParameterSet( - parameterSet = designPlan, designMaster = designMaster, - xParameterName = xParameterName, - yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, - palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, - legendPosition = legendPosition, variedParameters = variedParameters, - qnormAlphaLineEnabled = (type != 2), ratioEnabled = ratioEnabled, - plotSettings = plotSettings # , ... - ) - - if (type == 1 && survivalDesignPlanEnabled) { - p <- .addDecistionCriticalValuesToPlot(p = p, designMaster = designMaster, type = type, nMax = nMax) - } - return(p) -} - -.getSurvivalFunctionPlotCommand <- function(functionType = c("pwExpDist", "lambdaStep"), timeValues, lambda, - designPlan, type, piecewiseSurvivalEnabled, multiplyByHazardRatio = FALSE) { - functionType <- match.arg(functionType) - signPrefix <- ifelse(type == 13, "", "-") - if (functionType == "pwExpDist") { - functionName <- "getPiecewiseExponentialDistribution" - } else { - functionName <- "getLambdaStepFunction" - } - cmd <- paste0( - signPrefix, functionName, - "(", .reconstructSequenceCommand(timeValues), - ", piecewiseLambda = ", .arrayToString(lambda, vectorLookAndFeelEnabled = TRUE) - ) - if (piecewiseSurvivalEnabled) { - cmd <- paste0( - cmd, ", piecewiseSurvivalTime = ", - .arrayToString(designPlan$piecewiseSurvivalTime, vectorLookAndFeelEnabled = TRUE) - ) - } - if (functionType == "pwExpDist") { - cmd <- paste0(cmd, ", kappa = ", designPlan$kappa) - } - cmd <- paste0(cmd, ")") - if (multiplyByHazardRatio) { - cmd <- paste0(cmd, " * ", designPlan$hazardRatio[1]) - } - return(cmd) -} - -# Cumulative Distribution Function / Survival function -.plotSurvivalFunction <- function(designPlan, ..., designMaster, type = c(13, 14), main = NA_character_, - xlab = NA_character_, ylab = NA_character_, palette = "Set1", - legendPosition = NA_integer_, showSource = FALSE, - designPlanName = NA_character_, plotSettings = NULL) { - startTime <- Sys.time() - if (is.null(designPlan$piecewiseSurvivalTime) || - length(designPlan$piecewiseSurvivalTime) == 0) { - stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'piecewiseSurvivalTime' must be specified") - } - - type <- type[1] - if (!(type %in% c(13, 14))) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' must be 13 or 14") - } - - lambda1 <- designPlan[["lambda1"]] - lambda2 <- designPlan[["lambda2"]] - if (is.null(lambda2) || length(lambda2) == 0) { - stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'lambda2' must be specified") - } - - if (is.null(designPlan$kappa) || length(designPlan$kappa) == 0) { - stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'kappa' must be specified") - } - - if (is.null(designPlan$hazardRatio) || length(designPlan$hazardRatio) == 0) { - stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'hazardRatio' must be specified") - } - - piecewiseSurvivalEnabled <- designPlan$.piecewiseSurvivalTime$piecewiseSurvivalEnabled - - if (is.na(main)) { - if (type == 13) { - main <- PlotSubTitleItems(title = "Cumulative Distribution Function") - } else { - main <- PlotSubTitleItems(title = "Survival Function") - } - .addPlotSubTitleItems(designPlan, designMaster, main, type) - if (!piecewiseSurvivalEnabled) { - if (designPlan$.piecewiseSurvivalTime$.isLambdaBased(minNumberOfLambdas = 1)) { - main$add("lambda", round(designPlan$lambda1[1], 4), 1) - main$add("lambda", round(designPlan$lambda2, 4), 2) - } else { - main$add("pi", round(designPlan$pi1[1], 3), 1) - main$add("pi", round(designPlan$pi2, 3), 2) - } - } else if (length(designPlan$hazardRatio) == 1) { - main$add("Hazard Ratio", round(designPlan$hazardRatio[1], 3)) - } - } - - if (!piecewiseSurvivalEnabled || (length(designPlan$piecewiseSurvivalTime) == 1 && - designPlan$piecewiseSurvivalTime[1] == 0)) { - timeTo <- max(designPlan$analysisTime[designMaster$kMax, ]) - } else { - timeTo <- max(designPlan$piecewiseSurvivalTime) - } - if (is.na(timeTo) || !is.numeric(timeTo) || is.infinite(timeTo)) { - # warning("Unable to determine upper bound of time values", call. = FALSE) - timeTo <- 0 - } - - timeTo <- timeTo + 10 - by <- timeTo / 1000 - timeValues <- seq(from = 0, to = timeTo, by = by) - - data <- data.frame( - time = timeValues, - lambdaGroup1 = rep(-1, length(timeValues)), - lambdaGroup2 = rep(-1, length(timeValues)), - survival1 = rep(-1, length(timeValues)), - survival2 = rep(-1, length(timeValues)), - survivalGroup1 = rep(-1, length(timeValues)), - survivalGroup2 = rep(-1, length(timeValues)) - ) - - signPrefix <- ifelse(type == 13, "", "-") - if (piecewiseSurvivalEnabled) { - data$survival2 <- .getPiecewiseExponentialDistribution( - timeValues, - lambda2, designPlan$piecewiseSurvivalTime, designPlan$kappa - ) - - yParameterNames <- .getSurvivalFunctionPlotCommand( - "pwExpDist", - timeValues, lambda2, designPlan, type, piecewiseSurvivalEnabled - ) - - if (!is.null(lambda1) && !all(is.na(lambda1)) && - length(lambda1) == length(lambda2)) { - data$survival1 <- .getPiecewiseExponentialDistribution( - timeValues, - lambda1, designPlan$piecewiseSurvivalTime, designPlan$kappa - ) - yParameterNames <- c( - yParameterNames, - .getSurvivalFunctionPlotCommand( - "pwExpDist", - timeValues, lambda1, designPlan, type, piecewiseSurvivalEnabled - ) - ) - } else { - .warnInCaseOfUnusedValuesForPlottingSurvival(designPlan$hazardRatio) - data$survival1 <- data$survival2 * designPlan$hazardRatio[1] - yParameterNames <- c( - yParameterNames, - .getSurvivalFunctionPlotCommand("pwExpDist", timeValues, lambda2, - designPlan, type, piecewiseSurvivalEnabled, - multiplyByHazardRatio = TRUE - ) - ) - } - - yParameterNames <- c( - yParameterNames, - .getSurvivalFunctionPlotCommand( - "lambdaStep", - timeValues, lambda2, designPlan, type, piecewiseSurvivalEnabled - ) - ) - if (!is.null(lambda1) && !all(is.na(lambda1)) && - length(lambda1) == length(lambda2)) { - yParameterNames <- c( - yParameterNames, - .getSurvivalFunctionPlotCommand( - "lambdaStep", - timeValues, lambda1, designPlan, type, piecewiseSurvivalEnabled - ) - ) - } else { - yParameterNames <- c( - yParameterNames, - .getSurvivalFunctionPlotCommand("lambdaStep", timeValues, lambda2, - designPlan, type, piecewiseSurvivalEnabled, - multiplyByHazardRatio = TRUE - ) - ) - } - } else { - if (designPlan$.piecewiseSurvivalTime$.isLambdaBased(minNumberOfLambdas = 1)) { - if (length(designPlan$lambda1) > 1) { - lambda1 <- designPlan$lambda1[1] - warning("Only the first 'lambda1' (", round(lambda1, 4), - ") was used for plotting", - call. = FALSE - ) - } - } else { - .warnInCaseOfUnusedValuesForPlottingRates(designPlan$pi1) - } - - if (!is.na(designPlan$pi1[1]) && !is.na(designPlan$pi2) && !is.na(designPlan$eventTime)) { - lambda2 <- (-log(1 - designPlan$pi2))^(1 / designPlan$kappa) / designPlan$eventTime - lambda1 <- (-log(1 - designPlan$pi1[1]))^(1 / designPlan$kappa) / designPlan$eventTime - } - - data$survival2 <- .getPiecewiseExponentialDistribution( - timeValues, - lambda2, 0, designPlan$kappa - ) - data$survival1 <- .getPiecewiseExponentialDistribution( - timeValues, - lambda1, 0, designPlan$kappa - ) - - yParameterNames <- .getSurvivalFunctionPlotCommand( - "pwExpDist", - timeValues, lambda2, designPlan, type, piecewiseSurvivalEnabled - ) - yParameterNames <- c( - yParameterNames, - .getSurvivalFunctionPlotCommand( - "pwExpDist", - timeValues, lambda1, designPlan, type, piecewiseSurvivalEnabled - ) - ) - yParameterNames <- c( - yParameterNames, - .getSurvivalFunctionPlotCommand( - "lambdaStep", - timeValues, lambda2, designPlan, type, piecewiseSurvivalEnabled - ) - ) - yParameterNames <- c( - yParameterNames, - .getSurvivalFunctionPlotCommand( - "lambdaStep", timeValues, lambda1, - designPlan, type, piecewiseSurvivalEnabled - ) - ) - } - - # two groups: 1 = treatment, 2 = control - if (type == 14) { - data$survival1 <- 1 - data$survival1 - data$survival2 <- 1 - data$survival2 - } - - if (piecewiseSurvivalEnabled) { - data$lambdaGroup2 <- .getLambdaStepFunction( - timeValues, - designPlan$piecewiseSurvivalTime, lambda2 - ) - if (length(lambda1) == 1) { - if (!is.na(lambda1)) { - data$lambdaGroup1 <- rep(lambda1, length(data$lambdaGroup2)) - } else { - data$lambdaGroup1 <- data$lambdaGroup2 * designPlan$hazardRatio[1] - } - } else { - data$lambdaGroup1 <- .getLambdaStepFunction( - timeValues, - designPlan$piecewiseSurvivalTime, lambda1 - ) - } - } else { - data$lambdaGroup2 <- .getLambdaStepFunction(timeValues, 0, lambda2) - data$lambdaGroup1 <- .getLambdaStepFunction(timeValues, 0, lambda1) - } - - scalingBaseValues1 <- na.omit(c(data$survival1, data$survival2)) - scalingBaseValues2 <- na.omit(c(data$lambdaGroup1, data$lambdaGroup2)) - scalingFactor <- 1 - if (length(scalingBaseValues1) > 0 && length(scalingBaseValues2) > 0) { - scalingFactor <- max(scalingBaseValues1) / max(.getNextHigherValue(scalingBaseValues2)) - } - data2 <- data.frame( - categories = c( - rep("Treatm. piecew. exp.", nrow(data)), - rep("Control piecew. exp.", nrow(data)), - rep("Treatm. piecew. lambda", nrow(data)), - rep("Control piecew. lambda", nrow(data)) - ), - xValues = rep(data$time, 4), - yValues = c( - data$survival1, - data$survival2, - data$lambdaGroup1 * scalingFactor, - data$lambdaGroup2 * scalingFactor - ) - ) - - if (is.na(legendPosition)) { - if (type == 13) { - legendPosition <- C_POSITION_LEFT_TOP - } else { - legendPosition <- C_POSITION_RIGHT_TOP - } - } - - if (is.na(palette) || palette == "Set1") { - palette <- "Paired" - } - - if (type == 13) { - yAxisLabel1 <- "Cumulative Distribution Function" - } else { - yAxisLabel1 <- "Survival Function" - } - - srcCmd <- .showPlotSourceInformation( - objectName = designPlanName, - xParameterName = "time", - yParameterNames = yParameterNames, - showSource = showSource, - xValues = timeValues - ) - if (!is.null(srcCmd)) { - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(srcCmd)) - } - return(srcCmd) - } - - if (is.null(plotSettings)) { - plotSettings <- designPlan$.plotSettings - } - - return(.plotDataFrame(data2, - mainTitle = main, - xlab = xlab, ylab = ylab, xAxisLabel = "Time", - yAxisLabel1 = yAxisLabel1, yAxisLabel2 = "Lambda", - plotPointsEnabled = FALSE, legendTitle = NA_character_, - legendPosition = legendPosition, scalingFactor1 = 1, - scalingFactor2 = scalingFactor, palette = palette, sided = designMaster$sided, - plotSettings = plotSettings - )) -} - -.warnInCaseOfUnusedValuesForPlottingMeans <- function(alternative) { - if (length(alternative) > 1) { - warning("Only the first 'alternative' (", round(alternative[1], 3), - ") was used for plotting", - call. = FALSE - ) - return(list(title = "alternative", value = alternative[1], subscript = NA_character_)) - } - return(NULL) -} - -.warnInCaseOfUnusedValuesForPlottingRates <- function(pi1) { - if (length(pi1) > 1) { - warning("Only the first 'pi1' (", round(pi1[1], 3), - ") was used for plotting", - call. = FALSE - ) - return(list(title = "pi", value = pi1[1], subscript = "1")) - } - return(NULL) -} - -.warnInCaseOfUnusedValuesForPlottingSurvival <- function(hazardRatio) { - if (length(hazardRatio) > 1) { - warning("Only the first 'hazardRatio' (", round(hazardRatio[1], 3), - ") was used for plotting", - call. = FALSE - ) - return(list(title = "hazardRatio", value = hazardRatio[1], subscript = NA_character_)) - } - return(NULL) -} - -.warnInCaseOfUnusedValuesForPlotting <- function(designPlan) { - if (.isTrialDesignPlanMeans(designPlan) && designPlan$.isSampleSizeObject()) { - return(.warnInCaseOfUnusedValuesForPlottingMeans(designPlan$alternative)) - } - if (.isTrialDesignPlanRates(designPlan) && designPlan$.isSampleSizeObject()) { - return(.warnInCaseOfUnusedValuesForPlottingRates(designPlan$pi1)) - } - if (.isTrialDesignPlanSurvival(designPlan) && designPlan$.isSampleSizeObject()) { - return(.warnInCaseOfUnusedValuesForPlottingSurvival(designPlan$hazardRatio)) - } - return(NULL) -} - -#' -#' @title -#' Trial Design Plan Plotting -#' -#' @param x The trial design plan, obtained from \cr -#' \code{\link[=getSampleSizeMeans]{getSampleSizeMeans()}}, \cr -#' \code{\link[=getSampleSizeRates]{getSampleSizeRates()}}, \cr -#' \code{\link[=getSampleSizeSurvival]{getSampleSizeSurvival()}}, \cr -#' \code{\link[=getPowerMeans]{getPowerMeans()}}, \cr -#' \code{\link[=getPowerRates]{getPowerRates()}} or \cr -#' \code{\link[=getPowerSurvival]{getPowerSurvival()}}. -#' @param y Not available for this kind of plot (is only defined to be compatible to the generic plot function). -#' @param main The main title. -#' @param xlab The x-axis label. -#' @param ylab The y-axis label. -#' @inheritParams param_palette -#' @inheritParams param_theta -#' @inheritParams param_plotPointsEnabled -#' @inheritParams param_showSource -#' @inheritParams param_plotSettings -#' @inheritParams param_legendPosition -#' @inheritParams param_grid -#' @param type The plot type (default = \code{1}). The following plot types are available: -#' \itemize{ -#' \item \code{1}: creates a 'Boundaries' plot -#' \item \code{2}: creates a 'Boundaries Effect Scale' plot -#' \item \code{3}: creates a 'Boundaries p Values Scale' plot -#' \item \code{4}: creates a 'Error Spending' plot -#' \item \code{5}: creates a 'Sample Size' or 'Overall Power and Early Stopping' plot -#' \item \code{6}: creates a 'Number of Events' or 'Sample Size' plot -#' \item \code{7}: creates an 'Overall Power' plot -#' \item \code{8}: creates an 'Overall Early Stopping' plot -#' \item \code{9}: creates an 'Expected Number of Events' or 'Expected Sample Size' plot -#' \item \code{10}: creates a 'Study Duration' plot -#' \item \code{11}: creates an 'Expected Number of Subjects' plot -#' \item \code{12}: creates an 'Analysis Times' plot -#' \item \code{13}: creates a 'Cumulative Distribution Function' plot -#' \item \code{14}: creates a 'Survival Function' plot -#' \item \code{"all"}: creates all available plots and returns it as a grid plot or list -#' } -#' @inheritParams param_three_dots_plot -#' -#' @description -#' Plots a trial design plan. -#' -#' @details -#' Generic function to plot all kinds of trial design plans. -#' -#' @examples -#' \dontrun{ -#' if (require(ggplot2)) plot(getSampleSizeMeans()) -#' } -#' -#' @template return_object_ggplot -#' -#' @export -#' -plot.TrialDesignPlanR6 <- function(x, y, ..., main = NA_character_, - xlab = NA_character_, ylab = NA_character_, - type = ifelse(x$.design$kMax == 1, 5L, 1L), palette = "Set1", - theta = seq(-1, 1, 0.01), plotPointsEnabled = NA, - legendPosition = NA_integer_, showSource = FALSE, - grid = 1, plotSettings = NULL) { - fCall <- match.call(expand.dots = FALSE) - designPlanName <- deparse(fCall$x) - .assertGgplotIsInstalled() - .assertIsSingleInteger(grid, "grid", validateType = FALSE) - - nMax <- list(...)[["nMax"]] - if (!is.null(nMax)) { - warning( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'nMax' (", nMax, - ") will be ignored because it will be taken from design plan" - ) - } - - typeNumbers <- .getPlotTypeNumber(type, x) - if (is.null(plotSettings)) { - plotSettings <- .getGridPlotSettings(x, typeNumbers, grid) - } - p <- NULL - plotList <- list() - for (typeNumber in typeNumbers) { - p <- .plotTrialDesignPlan( - designPlan = x, - main = main, xlab = xlab, ylab = ylab, type = typeNumber, - palette = palette, theta = theta, plotPointsEnabled = plotPointsEnabled, - legendPosition = .getGridLegendPosition(legendPosition, typeNumbers, grid), - showSource = showSource, designPlanName = designPlanName, - plotSettings = plotSettings, ... - ) - .printPlotShowSourceSeparator(showSource, typeNumber, typeNumbers) - if (length(typeNumbers) > 1) { - caption <- .getPlotCaption(x, typeNumber, stopIfNotFound = TRUE) - plotList[[caption]] <- p - } - } - if (length(typeNumbers) == 1) { - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(p)) - } - - return(p) - } - - if (length(plotList) == 0) { - message("No plots available for the specified design plan for ", x$.toString()) - } - - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(plotList)) - } - - return(.createPlotResultObject(plotList, grid)) -} diff --git a/R/class_design_power_and_asn.R b/R/class_design_power_and_asn.R index 9ef8775a..537681bc 100644 --- a/R/class_design_power_and_asn.R +++ b/R/class_design_power_and_asn.R @@ -50,64 +50,64 @@ #' #' @importFrom methods new #' -PowerAndAverageSampleNumberResult <- setRefClass("PowerAndAverageSampleNumberResult", - contains = "ParameterSet", - fields = list( - .design = "ANY", - nMax = "numeric", - theta = "numeric", - averageSampleNumber = "numeric", - calculatedPower = "numeric", - overallEarlyStop = "numeric", - earlyStop = "matrix", - overallReject = "numeric", - rejectPerStage = "matrix", - overallFutility = "numeric", - futilityPerStage = "matrix" - ), - methods = list( +PowerAndAverageSampleNumberResultR6 <- R6Class("PowerAndAverageSampleNumberResultR6", + inherit = ParameterSetR6, + public = list( + .design = NULL, + nMax = NULL, + theta = NULL, + averageSampleNumber = NULL, + calculatedPower = NULL, + overallEarlyStop = NULL, + earlyStop = NULL, + overallReject = NULL, + rejectPerStage = NULL, + overallFutility = NULL, + futilityPerStage = NULL, initialize = function(design, theta = seq(-1, 1, 0.05), nMax = 100L, ...) { - callSuper(.design = design, theta = theta, nMax = nMax, ...) - theta <<- .assertIsValidThetaRange(thetaRange = theta, thetaAutoSeqEnabled = FALSE) - .initPowerAndAverageSampleNumber() - .parameterNames <<- .getParameterNames(design = design) - .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS - }, - clone = function() { - return(PowerAndAverageSampleNumberResult(design = .self$.design, theta = .self$theta, nMax = .self$nMax)) + super$initialize(...) + + self$.design <- design + self$theta <- theta + self$nMax <- nMax + + self$theta <- .assertIsValidThetaRange(thetaRange = theta, thetaAutoSeqEnabled = FALSE) + self$.initPowerAndAverageSampleNumber() + self$.parameterNames <- .getParameterNames(design = design) + self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS }, show = function(showType = 1, digits = NA_integer_) { - .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) }, .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { "Method for automatically printing a power and average sample size (ASN) result" - .resetCat() + self$.resetCat() if (showType == 2) { - callSuper(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) } else { - .cat("Power and average sample size (ASN):\n\n", + self$.cat("Power and average sample size (ASN):\n\n", heading = 1, consoleOutputEnabled = consoleOutputEnabled ) - .showParametersOfOneGroup(.getUserDefinedParameters(), "User defined parameters", + self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled ) - .showParametersOfOneGroup(.getDefaultParameters(), "Default parameters", + self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled ) - .showParametersOfOneGroup(.getGeneratedParameters(), "Output", + self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Output", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled ) - .showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - if (.design$kMax > 1) { - .cat("Legend:\n", + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + if (self$.design$kMax > 1) { + self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled ) - if (.design$kMax > 1) { - .cat(" [k]: values at stage k\n", consoleOutputEnabled = consoleOutputEnabled) + if (self$.design$kMax > 1) { + self$.cat(" [k]: values at stage k\n", consoleOutputEnabled = consoleOutputEnabled) } - .cat("\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) } } }, @@ -116,72 +116,72 @@ PowerAndAverageSampleNumberResult <- setRefClass("PowerAndAverageSampleNumberRes return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) }, .initPowerAndAverageSampleNumber = function() { - .assertIsTrialDesignInverseNormalOrGroupSequential(.design) - .assertIsValidSidedParameter(.design$sided) + .assertIsTrialDesignInverseNormalOrGroupSequential(self$.design) + .assertIsValidSidedParameter(self$.design$sided) - if (nMax <= 0) { + if (self$nMax <= 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'nMax' must be an integer > 0") } - .setParameterType("nMax", ifelse(nMax == C_NA_MAX_DEFAULT, C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) + self$.setParameterType("nMax", ifelse(self$nMax == C_NA_MAX_DEFAULT, C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) - thetaIsDefault <- length(theta) == length(C_POWER_ASN_THETA_DEFAULT) && - sum(theta == C_POWER_ASN_THETA_DEFAULT) == length(theta) - .setParameterType("theta", ifelse(thetaIsDefault, C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) + thetaIsDefault <- length(self$theta) == length(C_POWER_ASN_THETA_DEFAULT) && + sum(self$theta == C_POWER_ASN_THETA_DEFAULT) == length(self$theta) + self$.setParameterType("theta", ifelse(thetaIsDefault, C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) - kMax <- .design$kMax + kMax <- self$.design$kMax # initialization - numberOfThetas <- length(theta) + numberOfThetas <- length(self$theta) - averageSampleNumber <<- rep(NA_real_, numberOfThetas) - .setParameterType("averageSampleNumber", C_PARAM_GENERATED) + self$averageSampleNumber <- rep(NA_real_, numberOfThetas) + self$.setParameterType("averageSampleNumber", C_PARAM_GENERATED) - calculatedPower <<- rep(NA_real_, numberOfThetas) - .setParameterType("calculatedPower", C_PARAM_GENERATED) + self$calculatedPower <- rep(NA_real_, numberOfThetas) + self$.setParameterType("calculatedPower", C_PARAM_GENERATED) - earlyStop <<- matrix(NA_real_, kMax, numberOfThetas) - .setParameterType("earlyStop", C_PARAM_GENERATED) + self$earlyStop <- matrix(NA_real_, kMax, numberOfThetas) + self$.setParameterType("earlyStop", C_PARAM_GENERATED) - rejectPerStage <<- matrix(NA_real_, kMax, numberOfThetas) - .setParameterType("rejectPerStage", C_PARAM_GENERATED) + self$rejectPerStage <- matrix(NA_real_, kMax, numberOfThetas) + self$.setParameterType("rejectPerStage", C_PARAM_GENERATED) - futilityPerStage <<- matrix(NA_real_, kMax - 1, numberOfThetas) - .setParameterType("futilityPerStage", C_PARAM_GENERATED) + self$futilityPerStage <- matrix(NA_real_, kMax - 1, numberOfThetas) + self$.setParameterType("futilityPerStage", C_PARAM_GENERATED) rowNames <- paste("stage =", c(1:kMax)) - rownames(earlyStop) <<- rowNames - rownames(rejectPerStage) <<- rowNames + rownames(self$earlyStop) <- rowNames + rownames(self$rejectPerStage) <- rowNames if (kMax > 1) { - rownames(futilityPerStage) <<- rowNames[1:(kMax - 1)] + rownames(self$futilityPerStage) <- rowNames[1:(kMax - 1)] } for (i in 1:numberOfThetas) { - result <- .getPowerAndAverageSampleNumber(theta = theta[i]) + result <- self$.getPowerAndAverageSampleNumber(theta = self$theta[i]) - averageSampleNumber[i] <<- result$averageSampleNumber - calculatedPower[i] <<- result$calculatedPower - earlyStop[1:(kMax - 1), i] <<- result$earlyStop[1:(kMax - 1)] - rejectPerStage[, i] <<- result$rejectPerStage[1:kMax] - futilityPerStage[, i] <<- result$futilityPerStage[1:(kMax - 1)] + self$averageSampleNumber[i] <- result$averageSampleNumber + self$calculatedPower[i] <- result$calculatedPower + self$earlyStop[1:(kMax - 1), i] <- result$earlyStop[1:(kMax - 1)] + self$rejectPerStage[, i] <- result$rejectPerStage[1:kMax] + self$futilityPerStage[, i] <- result$futilityPerStage[1:(kMax - 1)] } - overallEarlyStop <<- .getOverallParameter(earlyStop) - .setParameterType("overallEarlyStop", C_PARAM_GENERATED) + self$overallEarlyStop <- self$.getOverallParameter(self$earlyStop) + self$.setParameterType("overallEarlyStop", C_PARAM_GENERATED) - overallReject <<- .getOverallParameter(rejectPerStage) - .setParameterType("overallReject", C_PARAM_GENERATED) + self$overallReject <- self$.getOverallParameter(self$rejectPerStage) + self$.setParameterType("overallReject", C_PARAM_GENERATED) - overallFutility <<- .getOverallParameter(futilityPerStage) - .setParameterType("overallFutility", C_PARAM_GENERATED) + self$overallFutility <- self$.getOverallParameter(self$futilityPerStage) + self$.setParameterType("overallFutility", C_PARAM_GENERATED) }, .getPowerAndAverageSampleNumber = function(theta) { - kMax <- .design$kMax - futilityBounds <- .design$futilityBounds - informationRates <- .design$informationRates - criticalValues <- .design$criticalValues - sided <- .design$sided - delayedInformation <- .design$delayedInformation + kMax <- self$.design$kMax + futilityBounds <- self$.design$futilityBounds + informationRates <- self$.design$informationRates + criticalValues <- self$.design$criticalValues + sided <- self$.design$sided + delayedInformation <- self$.design$delayedInformation .earlyStop <- rep(NA_real_, kMax) .futilityPerStage <- rep(NA_real_, kMax) @@ -189,52 +189,52 @@ PowerAndAverageSampleNumberResult <- setRefClass("PowerAndAverageSampleNumberRes if (!any(is.na(delayedInformation))) { contRegionLower <- futilityBounds contRegionUpper <- criticalValues - decisionCriticalValues <- .design$decisionCriticalValues + decisionCriticalValues <- self$.design$decisionCriticalValues probs <- .calculateDecisionProbabilities( - sqrtShift = sqrt(nMax) * theta, + sqrtShift = sqrt(self$nMax) * theta, informationRates, delayedInformation, contRegionUpper, contRegionLower, decisionCriticalValues ) - .averageSampleNumber <- nMax - sum(probs$stoppingProbabilities * - (informationRates[kMax] - delayedInformation - informationRates[1:(kMax - 1)]) * nMax) + .averageSampleNumber <- self$nMax - sum(probs$stoppingProbabilities * + (informationRates[kMax] - delayedInformation - informationRates[1:(kMax - 1)]) * self$nMax) .calculatedPower <- probs$power[kMax] .rejectPerStage <- probs$rejectionProbabilities .earlyStop <- probs$stoppingProbabilities .futilityPerStage <- probs$futilityProbabilities } else { if (sided == 2) { - if (.design$typeOfDesign == C_TYPE_OF_DESIGN_PT || !is.null(.design$typeBetaSpending) && .design$typeBetaSpending != "none") { + if (self$.design$typeOfDesign == C_TYPE_OF_DESIGN_PT || !is.null(self$.design$typeBetaSpending) && self$.design$typeBetaSpending != "none") { futilityBounds[is.na(futilityBounds)] <- 0 decisionMatrix <- matrix(c( - -criticalValues - theta * sqrt(nMax * informationRates), - c(-futilityBounds - theta * sqrt(nMax * informationRates[1:(kMax - 1)]), 0), - c(futilityBounds - theta * sqrt(nMax * informationRates[1:(kMax - 1)]), 0), - criticalValues - theta * sqrt(nMax * informationRates) + -criticalValues - theta * sqrt(self$nMax * informationRates), + c(-futilityBounds - theta * sqrt(self$nMax * informationRates[1:(kMax - 1)]), 0), + c(futilityBounds - theta * sqrt(self$nMax * informationRates[1:(kMax - 1)]), 0), + criticalValues - theta * sqrt(self$nMax * informationRates) ), nrow = 4, byrow = TRUE) } else { decisionMatrix <- matrix(c( - -criticalValues - theta * sqrt(nMax * informationRates), - criticalValues - theta * sqrt(nMax * informationRates) + -criticalValues - theta * sqrt(self$nMax * informationRates), + criticalValues - theta * sqrt(self$nMax * informationRates) ), nrow = 2, byrow = TRUE) } } else { - shiftedFutilityBounds <- futilityBounds - theta * sqrt(nMax * informationRates[1:(kMax - 1)]) + shiftedFutilityBounds <- futilityBounds - theta * sqrt(self$nMax * informationRates[1:(kMax - 1)]) shiftedFutilityBounds[futilityBounds <= C_FUTILITY_BOUNDS_DEFAULT] <- C_FUTILITY_BOUNDS_DEFAULT decisionMatrix <- matrix(c( shiftedFutilityBounds, C_FUTILITY_BOUNDS_DEFAULT, - criticalValues - theta * sqrt(nMax * informationRates) + criticalValues - theta * sqrt(self$nMax * informationRates) ), nrow = 2, byrow = TRUE) } probs <- .getGroupSequentialProbabilities(decisionMatrix, informationRates) if (nrow(probs) == 3) { - .averageSampleNumber <- nMax - sum((probs[3, 1:(kMax - 1)] - probs[2, 1:(kMax - 1)] + probs[1, 1:(kMax - 1)]) * - (informationRates[kMax] - informationRates[1:(kMax - 1)]) * nMax) + .averageSampleNumber <- self$nMax - sum((probs[3, 1:(kMax - 1)] - probs[2, 1:(kMax - 1)] + probs[1, 1:(kMax - 1)]) * + (informationRates[kMax] - informationRates[1:(kMax - 1)]) * self$nMax) } else { - .averageSampleNumber <- nMax - sum((probs[5, 1:(kMax - 1)] - + .averageSampleNumber <- self$nMax - sum((probs[5, 1:(kMax - 1)] - probs[4, 1:(kMax - 1)] + probs[3, 1:(kMax - 1)] - probs[2, 1:(kMax - 1)] + probs[1, 1:(kMax - 1)]) * - (informationRates[kMax] - informationRates[1:(kMax - 1)]) * nMax) + (informationRates[kMax] - informationRates[1:(kMax - 1)]) * self$nMax) } if (sided == 2) { @@ -253,7 +253,7 @@ PowerAndAverageSampleNumberResult <- setRefClass("PowerAndAverageSampleNumberRes .rejectPerStage <- probs[3, 1:kMax] - probs[2, 1:kMax] if (kMax > 1) { .futilityPerStage <- probs[1, 1:(kMax - 1)] - .rejectPerStage <- .getNoEarlyEfficacyZeroCorrectedValues(.design, .rejectPerStage) + .rejectPerStage <- .getNoEarlyEfficacyZeroCorrectedValues(self$.design, .rejectPerStage) } } @@ -277,7 +277,7 @@ PowerAndAverageSampleNumberResult <- setRefClass("PowerAndAverageSampleNumberRes }, .getOverallParameter = function(parameter) { if (is.null(parameter) || length(parameter) == 0) { - return(rep(NA_real_, length(theta))) + return(rep(NA_real_, length(self$theta))) } overallParameter <- parameter @@ -314,7 +314,7 @@ PowerAndAverageSampleNumberResult <- setRefClass("PowerAndAverageSampleNumberRes #' #' @keywords internal #' -as.data.frame.PowerAndAverageSampleNumberResult <- function(x, row.names = NULL, +as.data.frame.PowerAndAverageSampleNumberResultR6 <- function(x, row.names = NULL, optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ...) { parameterNames <- x$.getVisibleFieldNames() parameterNames <- parameterNames[parameterNames != "nMax"] diff --git a/R/class_design_power_and_asn_r6.R b/R/class_design_power_and_asn_r6.R deleted file mode 100644 index 537681bc..00000000 --- a/R/class_design_power_and_asn_r6.R +++ /dev/null @@ -1,329 +0,0 @@ -## | -## | *Power and average sample number result classes* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | rpact package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File version: $Revision: 7126 $ -## | Last changed: $Date: 2023-06-23 14:26:39 +0200 (Fr, 23 Jun 2023) $ -## | Last changed by: $Author: pahlke $ -## | - - -#' -#' @name PowerAndAverageSampleNumberResult -#' -#' @title -#' Power and Average Sample Number Result -#' -#' @description -#' Class for power and average sample number (ASN) results. -#' -#' @template field_nMax -#' @template field_theta -#' @template field_averageSampleNumber -#' @template field_calculatedPower -#' @template field_overallEarlyStop -#' @template field_earlyStop -#' @template field_overallReject -#' @template field_rejectPerStage -#' @template field_overallFutility -#' @template field_futilityPerStage -#' -#' @details -#' This object cannot be created directly; use \code{\link[=getPowerAndAverageSampleNumber]{getPowerAndAverageSampleNumber()}} -#' with suitable arguments to create it. -#' -#' @include class_core_parameter_set.R -#' @include class_design.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -PowerAndAverageSampleNumberResultR6 <- R6Class("PowerAndAverageSampleNumberResultR6", - inherit = ParameterSetR6, - public = list( - .design = NULL, - nMax = NULL, - theta = NULL, - averageSampleNumber = NULL, - calculatedPower = NULL, - overallEarlyStop = NULL, - earlyStop = NULL, - overallReject = NULL, - rejectPerStage = NULL, - overallFutility = NULL, - futilityPerStage = NULL, - initialize = function(design, theta = seq(-1, 1, 0.05), nMax = 100L, ...) { - super$initialize(...) - - self$.design <- design - self$theta <- theta - self$nMax <- nMax - - self$theta <- .assertIsValidThetaRange(thetaRange = theta, thetaAutoSeqEnabled = FALSE) - self$.initPowerAndAverageSampleNumber() - self$.parameterNames <- .getParameterNames(design = design) - self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS - }, - show = function(showType = 1, digits = NA_integer_) { - self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) - }, - .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { - "Method for automatically printing a power and average sample size (ASN) result" - self$.resetCat() - if (showType == 2) { - super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) - } else { - self$.cat("Power and average sample size (ASN):\n\n", - heading = 1, - consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Output", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - if (self$.design$kMax > 1) { - self$.cat("Legend:\n", - heading = 2, - consoleOutputEnabled = consoleOutputEnabled - ) - if (self$.design$kMax > 1) { - self$.cat(" [k]: values at stage k\n", consoleOutputEnabled = consoleOutputEnabled) - } - self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) - } - } - }, - .toString = function(startWithUpperCase = FALSE) { - s <- "power and average sample size (ASN)" - return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) - }, - .initPowerAndAverageSampleNumber = function() { - .assertIsTrialDesignInverseNormalOrGroupSequential(self$.design) - .assertIsValidSidedParameter(self$.design$sided) - - if (self$nMax <= 0) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'nMax' must be an integer > 0") - } - - self$.setParameterType("nMax", ifelse(self$nMax == C_NA_MAX_DEFAULT, C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) - - thetaIsDefault <- length(self$theta) == length(C_POWER_ASN_THETA_DEFAULT) && - sum(self$theta == C_POWER_ASN_THETA_DEFAULT) == length(self$theta) - self$.setParameterType("theta", ifelse(thetaIsDefault, C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) - - kMax <- self$.design$kMax - - # initialization - numberOfThetas <- length(self$theta) - - self$averageSampleNumber <- rep(NA_real_, numberOfThetas) - self$.setParameterType("averageSampleNumber", C_PARAM_GENERATED) - - self$calculatedPower <- rep(NA_real_, numberOfThetas) - self$.setParameterType("calculatedPower", C_PARAM_GENERATED) - - self$earlyStop <- matrix(NA_real_, kMax, numberOfThetas) - self$.setParameterType("earlyStop", C_PARAM_GENERATED) - - self$rejectPerStage <- matrix(NA_real_, kMax, numberOfThetas) - self$.setParameterType("rejectPerStage", C_PARAM_GENERATED) - - self$futilityPerStage <- matrix(NA_real_, kMax - 1, numberOfThetas) - self$.setParameterType("futilityPerStage", C_PARAM_GENERATED) - - rowNames <- paste("stage =", c(1:kMax)) - rownames(self$earlyStop) <- rowNames - rownames(self$rejectPerStage) <- rowNames - if (kMax > 1) { - rownames(self$futilityPerStage) <- rowNames[1:(kMax - 1)] - } - - for (i in 1:numberOfThetas) { - result <- self$.getPowerAndAverageSampleNumber(theta = self$theta[i]) - - self$averageSampleNumber[i] <- result$averageSampleNumber - self$calculatedPower[i] <- result$calculatedPower - self$earlyStop[1:(kMax - 1), i] <- result$earlyStop[1:(kMax - 1)] - self$rejectPerStage[, i] <- result$rejectPerStage[1:kMax] - self$futilityPerStage[, i] <- result$futilityPerStage[1:(kMax - 1)] - } - - self$overallEarlyStop <- self$.getOverallParameter(self$earlyStop) - self$.setParameterType("overallEarlyStop", C_PARAM_GENERATED) - - self$overallReject <- self$.getOverallParameter(self$rejectPerStage) - self$.setParameterType("overallReject", C_PARAM_GENERATED) - - self$overallFutility <- self$.getOverallParameter(self$futilityPerStage) - self$.setParameterType("overallFutility", C_PARAM_GENERATED) - }, - .getPowerAndAverageSampleNumber = function(theta) { - kMax <- self$.design$kMax - futilityBounds <- self$.design$futilityBounds - informationRates <- self$.design$informationRates - criticalValues <- self$.design$criticalValues - sided <- self$.design$sided - delayedInformation <- self$.design$delayedInformation - - .earlyStop <- rep(NA_real_, kMax) - .futilityPerStage <- rep(NA_real_, kMax) - - if (!any(is.na(delayedInformation))) { - contRegionLower <- futilityBounds - contRegionUpper <- criticalValues - decisionCriticalValues <- self$.design$decisionCriticalValues - probs <- .calculateDecisionProbabilities( - sqrtShift = sqrt(self$nMax) * theta, - informationRates, delayedInformation, contRegionUpper, contRegionLower, decisionCriticalValues - ) - - .averageSampleNumber <- self$nMax - sum(probs$stoppingProbabilities * - (informationRates[kMax] - delayedInformation - informationRates[1:(kMax - 1)]) * self$nMax) - .calculatedPower <- probs$power[kMax] - .rejectPerStage <- probs$rejectionProbabilities - .earlyStop <- probs$stoppingProbabilities - .futilityPerStage <- probs$futilityProbabilities - } else { - if (sided == 2) { - if (self$.design$typeOfDesign == C_TYPE_OF_DESIGN_PT || !is.null(self$.design$typeBetaSpending) && self$.design$typeBetaSpending != "none") { - futilityBounds[is.na(futilityBounds)] <- 0 - decisionMatrix <- matrix(c( - -criticalValues - theta * sqrt(self$nMax * informationRates), - c(-futilityBounds - theta * sqrt(self$nMax * informationRates[1:(kMax - 1)]), 0), - c(futilityBounds - theta * sqrt(self$nMax * informationRates[1:(kMax - 1)]), 0), - criticalValues - theta * sqrt(self$nMax * informationRates) - ), nrow = 4, byrow = TRUE) - } else { - decisionMatrix <- matrix(c( - -criticalValues - theta * sqrt(self$nMax * informationRates), - criticalValues - theta * sqrt(self$nMax * informationRates) - ), nrow = 2, byrow = TRUE) - } - } else { - shiftedFutilityBounds <- futilityBounds - theta * sqrt(self$nMax * informationRates[1:(kMax - 1)]) - shiftedFutilityBounds[futilityBounds <= C_FUTILITY_BOUNDS_DEFAULT] <- C_FUTILITY_BOUNDS_DEFAULT - decisionMatrix <- matrix(c( - shiftedFutilityBounds, C_FUTILITY_BOUNDS_DEFAULT, - criticalValues - theta * sqrt(self$nMax * informationRates) - ), nrow = 2, byrow = TRUE) - } - - probs <- .getGroupSequentialProbabilities(decisionMatrix, informationRates) - - if (nrow(probs) == 3) { - .averageSampleNumber <- self$nMax - sum((probs[3, 1:(kMax - 1)] - probs[2, 1:(kMax - 1)] + probs[1, 1:(kMax - 1)]) * - (informationRates[kMax] - informationRates[1:(kMax - 1)]) * self$nMax) - } else { - .averageSampleNumber <- self$nMax - sum((probs[5, 1:(kMax - 1)] - - probs[4, 1:(kMax - 1)] + probs[3, 1:(kMax - 1)] - probs[2, 1:(kMax - 1)] + probs[1, 1:(kMax - 1)]) * - (informationRates[kMax] - informationRates[1:(kMax - 1)]) * self$nMax) - } - - if (sided == 2) { - if (nrow(probs) == 3) { - .calculatedPower <- sum(probs[3, 1:kMax] - probs[2, 1:kMax] + probs[1, 1:kMax]) - .rejectPerStage <- probs[3, 1:kMax] - probs[2, 1:kMax] + probs[1, 1:kMax] - } else { - .calculatedPower <- sum(probs[5, 1:kMax] - probs[4, 1:kMax] + probs[1, 1:kMax]) - .rejectPerStage <- probs[5, 1:kMax] - probs[4, 1:kMax] + probs[1, 1:kMax] - if (kMax > 1) { - .futilityPerStage <- probs[3, 1:kMax] - probs[2, 1:kMax] - } - } - } else { - .calculatedPower <- sum(probs[3, 1:kMax] - probs[2, 1:kMax]) - .rejectPerStage <- probs[3, 1:kMax] - probs[2, 1:kMax] - if (kMax > 1) { - .futilityPerStage <- probs[1, 1:(kMax - 1)] - .rejectPerStage <- .getNoEarlyEfficacyZeroCorrectedValues(self$.design, .rejectPerStage) - } - } - - if (kMax > 1) { - if (nrow(probs) == 3) { - .earlyStop <- probs[3, 1:(kMax - 1)] - probs[2, 1:(kMax - 1)] + probs[1, 1:(kMax - 1)] - } else { - .earlyStop <- probs[5, 1:(kMax - 1)] - probs[4, 1:(kMax - 1)] + probs[3, 1:(kMax - 1)] - - probs[2, 1:(kMax - 1)] + probs[1, 1:(kMax - 1)] - } - } - } - - return(list( - averageSampleNumber = .averageSampleNumber, - calculatedPower = .calculatedPower, - earlyStop = .earlyStop, - rejectPerStage = .rejectPerStage, - futilityPerStage = .futilityPerStage - )) - }, - .getOverallParameter = function(parameter) { - if (is.null(parameter) || length(parameter) == 0) { - return(rep(NA_real_, length(self$theta))) - } - - overallParameter <- parameter - overallParameter[is.na(overallParameter)] <- 0 - overallParameter <- colSums(overallParameter) - return(overallParameter) - } - ) -) - -#' -#' @title -#' Coerce Power And Average Sample Number Result to a Data Frame -#' -#' @description -#' Returns the \code{\link{PowerAndAverageSampleNumberResult}} as data frame. -#' -#' @param x A \code{\link{PowerAndAverageSampleNumberResult}} object. -#' @inheritParams param_niceColumnNamesEnabled -#' @inheritParams param_includeAllParameters -#' @inheritParams param_three_dots -#' -#' @details -#' Coerces the \code{\link{PowerAndAverageSampleNumberResult}} object to a data frame. -#' -#' @template return_dataframe -#' -#' @examples -#' data <- as.data.frame(getPowerAndAverageSampleNumber(getDesignGroupSequential())) -#' head(data) -#' dim(data) -#' -#' @export -#' -#' @keywords internal -#' -as.data.frame.PowerAndAverageSampleNumberResultR6 <- function(x, row.names = NULL, - optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ...) { - parameterNames <- x$.getVisibleFieldNames() - parameterNames <- parameterNames[parameterNames != "nMax"] - dataFrame <- .getAsDataFrame( - parameterSet = x, - parameterNames = parameterNames, - niceColumnNamesEnabled = niceColumnNamesEnabled, - includeAllParameters = includeAllParameters, - tableColumnNames = .getTableColumnNames(design = x$.design) - ) - return(dataFrame) -} diff --git a/R/class_design_r6.R b/R/class_design_r6.R deleted file mode 100644 index 88c899cc..00000000 --- a/R/class_design_r6.R +++ /dev/null @@ -1,1251 +0,0 @@ -library("R6") -## | -## | *Trial design classes* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | rpact package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File version: $Revision: 7126 $ -## | Last changed: $Date: 2023-06-23 14:26:39 +0200 (Fr, 23 Jun 2023) $ -## | Last changed by: $Author: pahlke $ -## | - - -#' @include f_core_constants.R -#' @include f_core_plot.R -#' @include f_core_utilities.R -NULL - -#' -#' @name TrialDesign -#' -#' @title -#' Basic Trial Design -#' -#' @description -#' Basic class for trial designs. -#' -#' @template field_kMax -#' @template field_alpha -#' @template field_stages -#' @template field_informationRates -#' @template field_userAlphaSpending -#' @template field_criticalValues -#' @template field_stageLevels -#' @template field_alphaSpent -#' @template field_bindingFutility -#' @template field_tolerance -#' -#' @details -#' \code{TrialDesign} is the basic class for -#' \itemize{ -#' \item \code{\link{TrialDesignFisher}}, -#' \item \code{\link{TrialDesignGroupSequential}}, -#' \item \code{\link{TrialDesignInverseNormal}}, and -#' \item \code{\link{TrialDesignConditionalDunnett}}. -#' } -#' -#' @include class_core_parameter_set.R -#' @include class_core_plot_settings.R -#' @include f_core_constants.R -#' @include f_core_plot.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -TrialDesignR6 <- R6Class("TrialDesignR6", - inherit = ParameterSetR6, - public = list( - .plotSettings = NULL, - kMax = NULL, - alpha = NULL, - stages = NULL, - informationRates = NULL, - userAlphaSpending = NULL, - criticalValues = NULL, - stageLevels = NULL, - alphaSpent = NULL, - bindingFutility = NULL, - tolerance = NULL, - initialize = function(..., - kMax = NA_integer_, - alpha = NA_real_, - informationRates = NA_real_, - userAlphaSpending = NA_real_, - criticalValues = NA_real_, - stageLevels = NA_real_, - alphaSpent = NA_real_, - bindingFutility = NA, - tolerance = 1e-06 # C_ANALYSIS_TOLERANCE_DEFAULT - ) { - - self$kMax <- kMax #NEW - self$alpha <- alpha - self$informationRates <- informationRates - self$userAlphaSpending <- userAlphaSpending - self$criticalValues <- criticalValues - self$stageLevels <- stageLevels - self$alphaSpent <- alphaSpent - self$bindingFutility <- bindingFutility - self$tolerance <- tolerance - super$initialize(...) - - self$.plotSettings <- PlotSettingsR6$new() - - if (inherits(self, "TrialDesignConditionalDunnettR6")) { - self$.parameterNames <- C_PARAMETER_NAMES - } else { - self$.parameterNames <- self$.getSubListByNames(.getParameterNames(design = self), c(#TODO - "stages", - "kMax", - "alpha", - "informationRates", - "userAlphaSpending", - "criticalValues", - "stageLevels", - "alphaSpent", - "bindingFutility", - "tolerance" - )) - } - - self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS - - self$.initStages() - }, - show = function(showType = 1, digits = NA_integer_) { - self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) - }, - .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { - "Method for automatically printing trial design objects" - self$.resetCat() - if (showType == 3) { - .createSummary(self, digits = digits)$.show(#TODO should not work - showType = 1, - digits = digits, consoleOutputEnabled = consoleOutputEnabled - ) - } else if (showType == 2) { - super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) - } else { - self$.cat("Design parameters and output of ", self$.toString(), ":\n\n", - heading = 1, - consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(self$.getDerivedParameters(), "Derived from user defined parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Output", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - } - }, - .toString = function(startWithUpperCase = FALSE) { - s <- "unknown trial design" - if (.isTrialDesignGroupSequential(self)) {#TODO - s <- "group sequential design" - } else if (.isTrialDesignInverseNormal(self)) {#TODO - s <- "inverse normal combination test design" - } else if (.isTrialDesignFisher(self)) {#TODO - s <- "Fisher's combination test design" - } else if (.isTrialDesignConditionalDunnett(self)) {#TODO - s <- "conditional Dunnett test design" - } - return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) - }, - .initStages = function() { - if (length(self$kMax) == 1 && !is.na(self$kMax) && self$kMax > 0) { - self$stages <- c(1L:self$kMax) - if (self$kMax == C_KMAX_DEFAULT) { - self$.setParameterType("stages", C_PARAM_DEFAULT_VALUE) - } else { - type <- self$.getParameterType("kMax")#TODO - self$.setParameterType("stages", ifelse(type != C_PARAM_TYPE_UNKNOWN, type, C_PARAM_USER_DEFINED)) - } - } else { - self$.setParameterType("stages", C_PARAM_NOT_APPLICABLE) - } - }, - .isDelayedResponseDesign = function() { - return((inherits(self, "TrialDesignGroupSequentialR6") || inherits(self, "TrialDesignInverseNormalR6")) && - self$kMax > 1 && - !is.null(self[["delayedInformation"]]) &&#TODO - !any(is.na(self$delayedInformation)) && any(self$delayedInformation > 0)) - } - ) -) - -#' -#' @name TrialDesignCharacteristics -#' -#' @title -#' Trial Design Characteristics -#' -#' @description -#' Class for trial design characteristics. -#' -#' @template field_nFixed -#' @template field_shift -#' @template field_inflationFactor -#' @template field_stages -#' @template field_information -#' @template field_power -#' @template field_rejectionProbabilities -#' @template field_futilityProbabilities -#' @template field_averageSampleNumber1 -#' @template field_averageSampleNumber01 -#' @template field_averageSampleNumber0 -#' -#' @details -#' \code{TrialDesignCharacteristics} contains all fields required to collect the characteristics of a design. -#' This object should not be created directly; use \code{getDesignCharacteristics} -#' with suitable arguments to create it. -#' -#' @seealso \code{\link{getDesignCharacteristics}} for getting the design characteristics. -#' -#' @include class_core_parameter_set.R -#' @include f_core_constants.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -TrialDesignCharacteristicsR6 <- R6Class("TrialDesignCharacteristicsR6", - inherit = ParameterSetR6, - public = list( - .design = NULL, - .probs = NULL, - nFixed = NULL, - shift = NULL, - inflationFactor = NULL, - stages = NULL, - information = NULL, - power = NULL, - rejectionProbabilities = NULL, # efficacy probabilities - futilityProbabilities = NULL, - averageSampleNumber1 = NULL, - averageSampleNumber01 = NULL, - averageSampleNumber0 = NULL, - initialize = function(design, ...) { - - self$.design <- design - self$.parameterNames <- .getParameterNames(design = design) - self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS - self$.parameterFormatFunctions[["nFixed"]] <- ".formatProbabilities" - super$initialize(...)#TODO init vars? - self$.initStages() - }, - show = function(showType = 1, digits = NA_integer_) { - self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) - }, - .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { - "Method for automatically printing trial design characteristics objects" - self$.resetCat() - if (showType == 2) { - super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) - } else { - self$.showParametersOfOneGroup(self$.getGeneratedParameters(), - title = self$.toString(startWithUpperCase = TRUE), - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - } - }, - .initStages = function() { - if (!is.na(self$.design$kMax) && self$.design$kMax > 0) { - self$stages <- c(1L:self$.design$kMax) - if (self$.design$kMax == C_KMAX_DEFAULT) { - self$.setParameterType("stages", C_PARAM_DEFAULT_VALUE) - } else { - self$.setParameterType("stages", C_PARAM_USER_DEFINED) - } - } else { - self$.setParameterType("stages", C_PARAM_NOT_APPLICABLE) - } - }, - .toString = function(startWithUpperCase = FALSE) { - if (self$.design$.isDelayedResponseDesign()) { - prefix <- "delayed response" - if (startWithUpperCase) { - prefix <- .firstCharacterToUpperCase(prefix) - } - return(paste(prefix, self$.design$.toString(startWithUpperCase = FALSE), "characteristics")) - } - - return(paste(self$.design$.toString(startWithUpperCase = startWithUpperCase), "characteristics")) - } - ) -) - -#' -#' @title -#' Trial Design Characteristics Printing -#' -#' @param x The trial design characteristics object. -#' @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}) -#' @param showDesign Show the design print output above the design characteristics, default is \code{TRUE}. -#' @inheritParams param_three_dots_plot -#' -#' @description -#' Prints the design characteristics object. -#' -#' @details -#' Generic function to print all kinds of design characteristics. -#' -#' @export -#' -print.TrialDesignCharacteristicsR6 <- function(x, ..., markdown = FALSE, showDesign = TRUE) { - if (showDesign) { - print.ParameterSetR6(x$.design, ..., markdown = markdown) - } - print.ParameterSetR6(x, ..., markdown = markdown) -} - -#' -#' @title -#' Coerce TrialDesignCharacteristics to a Data Frame -#' -#' @description -#' Returns the \code{TrialDesignCharacteristics} as data frame. -#' -#' @param x A \code{\link{TrialDesignCharacteristics}} object. -#' @inheritParams param_niceColumnNamesEnabled -#' @inheritParams param_includeAllParameters -#' @inheritParams param_three_dots -#' -#' @details -#' Each element of the \code{\link{TrialDesignCharacteristics}} is converted to a column in the data frame. -#' -#' @template return_dataframe -#' -#' @examples -#' as.data.frame(getDesignCharacteristics(getDesignGroupSequential())) -#' -#' @export -#' -#' @keywords internal -#' -as.data.frame.TrialDesignCharacteristicsR6 <- function(x, row.names = NULL, - optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ...) { - if (x$.design$kMax > 1) { - parameterNamesToBeExcluded <- c("nFixed", "shift") - } else { - parameterNamesToBeExcluded <- c("inflationFactor") - } - return(.getAsDataFrame( - parameterSet = x, - parameterNames = parameterNamesToBeExcluded, - niceColumnNamesEnabled = niceColumnNamesEnabled, - includeAllParameters = includeAllParameters, - handleParameterNamesAsToBeExcluded = TRUE, - tableColumnNames = .getTableColumnNames(design = x$.design) - )) -} - -#' -#' @name TrialDesignFisher -#' -#' @title -#' Fisher Design -#' -#' @description -#' Trial design for Fisher's combination test. -#' -#' @template field_kMax -#' @template field_alpha -#' @template field_stages -#' @template field_informationRates -#' @template field_userAlphaSpending -#' @template field_criticalValues -#' @template field_stageLevels -#' @template field_alphaSpent -#' @template field_bindingFutility -#' @template field_tolerance -#' @template field_method -#' @template field_alpha0Vec -#' @template field_scale -#' @template field_nonStochasticCurtailment -#' @template field_sided -#' @template field_simAlpha -#' @template field_iterations -#' @template field_seed -#' -#' @details -#' This object should not be created directly; use \code{\link{getDesignFisher}} -#' with suitable arguments to create a Fisher combination test design. -#' -#' @seealso \code{\link{getDesignFisher}} for creating a Fisher combination test design. -#' -#' @include class_core_parameter_set.R -#' @include class_core_plot_settings.R -#' @include f_core_constants.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -TrialDesignFisherR6 <- R6Class("TrialDesignFisherR6", - inherit = TrialDesignR6, - public = list( - method = NULL, - alpha0Vec = NULL, - scale = NULL, - nonStochasticCurtailment = NULL, - sided = NULL, - simAlpha = NULL, - iterations = NULL, - seed = NULL, - initialize = function(..., - method = NA_character_, - alpha0Vec = NA_real_, - scale = NA_real_, - nonStochasticCurtailment = FALSE, - sided = as.integer(C_SIDED_DEFAULT), - simAlpha = NA_real_, - iterations = 0L, - seed = NA_real_, - tolerance = C_ANALYSIS_TOLERANCE_FISHER_DEFAULT) { - - self$method <- method - self$alpha0Vec <- alpha0Vec - self$scale <- scale - self$nonStochasticCurtailment <- nonStochasticCurtailment - self$sided <- sided - self$simAlpha <- simAlpha - self$iterations <- iterations - self$seed <- seed - self$tolerance <- tolerance - super$initialize(...) - - self$.parameterNames <- c(self$.parameterNames, self$.getSubListByNames( - .getParameterNames(design = self), c( - "method", - "alpha0Vec", - "scale", - "nonStochasticCurtailment", - "sided", - "simAlpha", - "iterations", - "seed" - ) - )) - - self$.parameterFormatFunctions$criticalValues <- ".formatCriticalValuesFisher" - - self$.initParameterTypes() - self$.setParameterType("iterations", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("seed", C_PARAM_NOT_APPLICABLE) - self$.initStages() - }, - hasChanged = function(kMax, alpha, sided, method, informationRates, alpha0Vec, userAlphaSpending, bindingFutility) { - informationRatesTemp <- informationRates - if (any(is.na(informationRatesTemp))) { - informationRatesTemp <- .getInformationRatesDefault(kMax) - } - alpha0VecTemp <- alpha0Vec[1:(kMax - 1)] - if (any(is.na(alpha0VecTemp))) { - alpha0VecTemp <- rep(C_FUTILITY_BOUNDS_DEFAULT, kMax - 1) - } - - if (!identical(kMax, self$kMax)) { - return(TRUE) - } - if (!identical(alpha, self$alpha)) { - return(TRUE) - } - if (!identical(sided, self$sided)) { - return(TRUE) - } - if (!identical(method, self$method)) { - return(TRUE) - } - if (!identical(informationRatesTemp, self$informationRates)) { - return(TRUE) - } - if (!identical(alpha0VecTemp, self$alpha0Vec)) { - return(TRUE) - } - if (!identical(userAlphaSpending, self$userAlphaSpending)) { - return(TRUE) - } - if (!identical(bindingFutility, self$bindingFutility)) { - return(TRUE) - } - return(FALSE) - }, - - # Defines the order of the parameter output - .getParametersToShow = function() { - return(c( - "method", - "kMax", - "stages", - "informationRates", - "alpha", - "alpha0Vec", - "bindingFutility", - "sided", - "tolerance", - "iterations", - "seed", - "alphaSpent", - "userAlphaSpending", - "criticalValues", - "stageLevels", - "scale", - "simAlpha", - "nonStochasticCurtailment" - )) - } - ) -) - -#' -#' @name TrialDesignInverseNormal -#' -#' @title -#' Inverse Normal Design -#' -#' @description -#' Trial design for inverse normal method. -#' -#' @template field_kMax -#' @template field_alpha -#' @template field_stages -#' @template field_informationRates -#' @template field_userAlphaSpending -#' @template field_criticalValues -#' @template field_stageLevels -#' @template field_alphaSpent -#' @template field_bindingFutility -#' @template field_tolerance -#' @template field_typeOfDesign -#' @template field_beta -#' @template field_deltaWT -#' @template field_deltaPT1 -#' @template field_deltaPT0 -#' @template field_futilityBounds -#' @template field_gammaA -#' @template field_gammaB -#' @template field_optimizationCriterion -#' @template field_sided -#' @template field_betaSpent -#' @template field_typeBetaSpending -#' @template field_userBetaSpending -#' @template field_power -#' @template field_twoSidedPower -#' @template field_constantBoundsHP -#' @template field_betaAdjustment -#' @template field_delayedInformation -#' @template field_decisionCriticalValues -#' @template field_reversalProbabilities -#' -#' @details -#' This object should not be created directly; use \code{\link[=getDesignInverseNormal]{getDesignInverseNormal()}} -#' with suitable arguments to create a inverse normal design. -#' -#' @seealso \code{\link[=getDesignInverseNormal]{getDesignInverseNormal()}} for creating a inverse normal design. -#' -#' @include class_core_parameter_set.R -#' @include class_core_plot_settings.R -#' @include f_core_constants.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -TrialDesignInverseNormalR6 <- R6Class("TrialDesignInverseNormalR6", - inherit = TrialDesignR6, - public = list( - typeOfDesign = NULL, - beta = NULL, - deltaWT = NULL, - deltaPT1 = NULL, - deltaPT0 = NULL, - futilityBounds = NULL, - gammaA = NULL, - gammaB = NULL, - optimizationCriterion = NULL, - sided = NULL, - betaSpent = NULL, - typeBetaSpending = NULL, - userBetaSpending = NULL, - power = NULL, - twoSidedPower = NULL, - constantBoundsHP = NULL, - betaAdjustment = NULL, - delayedInformation = NULL, - decisionCriticalValues = NULL, - reversalProbabilities = NULL, - initialize = function(..., - beta = C_BETA_DEFAULT, - betaSpent = NA_real_, - sided = C_SIDED_DEFAULT, - futilityBounds = NA_real_, - typeOfDesign = C_DEFAULT_TYPE_OF_DESIGN, - deltaWT = NA_real_, - deltaPT1 = NA_real_, - deltaPT0 = NA_real_, - optimizationCriterion = C_OPTIMIZATION_CRITERION_DEFAULT, - gammaA = NA_real_, - gammaB = NA_real_, - typeBetaSpending = C_TYPE_OF_DESIGN_BS_NONE, - userBetaSpending = NA_real_, - power = NA_real_, - twoSidedPower = C_TWO_SIDED_POWER_DEFAULT, - constantBoundsHP = NA_real_, - betaAdjustment = TRUE, # impl as constant - delayedInformation = NA_real_) { - - - self$beta <- beta - self$betaSpent <- betaSpent - self$sided <- sided - self$futilityBounds <- futilityBounds - self$typeOfDesign <- typeOfDesign - self$deltaWT <- deltaWT - self$deltaPT1 <- deltaPT1 - self$deltaPT0 <- deltaPT0 - self$optimizationCriterion <- optimizationCriterion - self$gammaA <- gammaA - self$gammaB <- gammaB - self$typeBetaSpending <- typeBetaSpending - self$userBetaSpending <- userBetaSpending - self$power <- power - self$twoSidedPower <- twoSidedPower - self$constantBoundsHP <- constantBoundsHP - self$betaAdjustment <- betaAdjustment - self$delayedInformation <- delayedInformation - super$initialize(...) - self$.initParameterNames() - self$.parameterFormatFunctions$criticalValues <- ".formatCriticalValues" - self$.initParameterTypes() - self$.initStages() - - self$.setParameterType("betaAdjustment", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("delayedInformation", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("decisionCriticalValues", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("reversalProbabilities", C_PARAM_NOT_APPLICABLE) - - }, - .initParameterNames = function() { - self$.parameterNames <- c(self$.parameterNames, self$.getSubListByNames( - .getParameterNames(design = self), c( - "beta", - "betaSpent", - "sided", - "futilityBounds", - "typeOfDesign", - "deltaWT", - "deltaPT1", - "deltaPT0", - "optimizationCriterion", - "gammaA", - "gammaB", - "typeBetaSpending", - "userBetaSpending", - "power", - "twoSidedPower", - "constantBoundsHP", - "betaAdjustment", - "delayedInformation", - "decisionCriticalValues", - "reversalProbabilities" - ) - )) - }, - .formatComparisonResult = function(x) { - if (is.null(x) || length(x) == 0 || !is.numeric(x)) { - return(x) - } - - s <- sprintf("%.9f", x) - s <- sub("\\.0+", "", s) - return(s) - }, - .pasteComparisonResult = function(name, newValue, oldValue) { - return(paste0( - name, "_new = ", .arrayToString(.formatComparisonResult(newValue)), " (", .getClassName(newValue), "), ", - name, "_old = ", .arrayToString(.formatComparisonResult(oldValue)), " (", .getClassName(oldValue), ")" - )) - }, - hasChanged = function(..., - kMax, - alpha, - beta, - sided, - typeOfDesign, - deltaWT, - deltaPT1, - deltaPT0, - informationRates, - futilityBounds, - optimizationCriterion, - typeBetaSpending, - gammaA, - gammaB, - bindingFutility, - userAlphaSpending, - userBetaSpending, - twoSidedPower, - constantBoundsHP, - betaAdjustment = TRUE, - delayedInformation = NA_real_) { - informationRatesTemp <- informationRates - if (any(is.na(informationRatesTemp))) { - informationRatesTemp <- .getInformationRatesDefault(kMax) - } - futilityBoundsTemp <- futilityBounds[1:(kMax - 1)] - if (any(is.na(futilityBoundsTemp))) { - futilityBoundsTemp <- rep(C_FUTILITY_BOUNDS_DEFAULT, kMax - 1) - } - - if (!identical(kMax, self$kMax)) { - return(self$.pasteComparisonResult("kMax", kMax, self$kMax)) - } - if (!identical(alpha, self$alpha)) { - return(self$.pasteComparisonResult("alpha", alpha, self$alpha)) - } - if (!identical(beta, self$beta)) { - return(self$.pasteComparisonResult("beta", beta, self$beta)) - } - if (!identical(sided, self$sided)) { - return(self$.pasteComparisonResult("sided", sided, self$sided)) - } - if (!identical(twoSidedPower, self$twoSidedPower)) { - return(self$.pasteComparisonResult("twoSidedPower", twoSidedPower, self$twoSidedPower)) - } - if (kMax == 1) { - return(FALSE) - } - - if (!identical(betaAdjustment, self$betaAdjustment)) { - return(self$.pasteComparisonResult("betaAdjustment", betaAdjustment, self$betaAdjustment)) - } - if (!identical(delayedInformation, self$delayedInformation)) { - return(self$.pasteComparisonResult("delayedInformation", delayedInformation, self$delayedInformation)) - } - if (!identical(typeOfDesign, self$typeOfDesign)) { - return(self$.pasteComparisonResult("typeOfDesign", typeOfDesign, self$typeOfDesign)) - } - if (typeOfDesign == C_TYPE_OF_DESIGN_WT) { - if (!identical(deltaWT, self$deltaWT)) { - return(self$.pasteComparisonResult("deltaWT", deltaWT, self$deltaWT)) - } - } - if (typeOfDesign == C_TYPE_OF_DESIGN_PT) { - if (!identical(deltaPT1, self$deltaPT1)) { - return(self$.pasteComparisonResult("deltaPT1", deltaPT1, self$deltaPT1)) - } - if (!identical(deltaPT0, self$deltaPT0)) { - return(self$.pasteComparisonResult("deltaPT0", deltaPT0, self$deltaPT0)) - } - } - if (!identical(informationRatesTemp, self$informationRates)) { - return(self$.pasteComparisonResult("informationRates", informationRatesTemp, self$informationRates)) - } - if (self$.getParameterType("futilityBounds") != C_PARAM_GENERATED && - (!grepl("^as.*", typeOfDesign) || typeBetaSpending == C_TYPE_OF_DESIGN_BS_NONE) && - !identical(futilityBoundsTemp, self$futilityBounds)) { - return(self$.pasteComparisonResult("futilityBounds", futilityBoundsTemp, self$futilityBounds)) - } - if (!identical(optimizationCriterion, self$optimizationCriterion)) { - return(self$.pasteComparisonResult("optimizationCriterion", optimizationCriterion, self$optimizationCriterion)) - } - if (!identical(typeBetaSpending, self$typeBetaSpending)) { - return(self$.pasteComparisonResult("typeBetaSpending", typeBetaSpending, self$typeBetaSpending)) - } - if (!identical(gammaA, self$gammaA)) { - return(self$.pasteComparisonResult("gammaA", gammaA, self$gammaA)) - } - if (!identical(gammaB, self$gammaB)) {#TODO - return(self$.pasteComparisonResult("gammaB", gammaB, self$gammaB)) - } - if ((typeOfDesign == C_TYPE_OF_DESIGN_PT && !identical(bindingFutility, self$bindingFutility)) || - (!identical(bindingFutility, self$bindingFutility) && - self$.getParameterType("futilityBounds") != C_PARAM_NOT_APPLICABLE && - (sided == 1 || !grepl("^as.*", typeOfDesign) || typeBetaSpending == C_TYPE_OF_DESIGN_BS_NONE) && - (any(na.omit(futilityBounds) > -6) || any(na.omit(self$futilityBounds) > -6)) - )) { - return(self$.pasteComparisonResult("bindingFutility", bindingFutility, self$bindingFutility)) - } - if (!identical(userAlphaSpending, self$userAlphaSpending)) { - return(self$.pasteComparisonResult("userAlphaSpending", userAlphaSpending, self$userAlphaSpending)) - } - if (!identical(userBetaSpending, self$userBetaSpending)) { - return(self$.pasteComparisonResult("userBetaSpending", userBetaSpending, self$userBetaSpending)) - } - if (!identical(twoSidedPower, self$twoSidedPower)) { - return(self$.pasteComparisonResult("twoSidedPower", twoSidedPower, self$twoSidedPower)) - } - if (typeOfDesign == C_TYPE_OF_DESIGN_HP) { - if (!identical(constantBoundsHP, self$constantBoundsHP)) { - return(self$.pasteComparisonResult("constantBoundsHP", constantBoundsHP, self$constantBoundsHP)) - } - } - return(FALSE) - }, - - # Defines the order of the parameter output - .getParametersToShow = function() { - return(c( - "typeOfDesign", - "kMax", - "stages", - "informationRates", - "alpha", - "beta", - "power", - "twoSidedPower", - "deltaWT", - "deltaPT1", - "deltaPT0", - "futilityBounds", - "bindingFutility", - "constantBoundsHP", - "gammaA", - "gammaB", - "optimizationCriterion", - "sided", - "betaAdjustment", - "delayedInformation", - "tolerance", - "alphaSpent", - "userAlphaSpending", - "betaSpent", - "typeBetaSpending", - "userBetaSpending", - "criticalValues", - "stageLevels", - "decisionCriticalValues", - "reversalProbabilities" - )) - } - ) -) - -#' -#' @name TrialDesignGroupSequential -#' -#' @title -#' Group Sequential Design -#' -#' @description -#' Trial design for group sequential design. -#' -#' @template field_kMax -#' @template field_alpha -#' @template field_stages -#' @template field_informationRates -#' @template field_userAlphaSpending -#' @template field_criticalValues -#' @template field_stageLevels -#' @template field_alphaSpent -#' @template field_bindingFutility -#' @template field_tolerance -#' @template field_typeOfDesign -#' @template field_beta -#' @template field_deltaWT -#' @template field_deltaPT1 -#' @template field_deltaPT0 -#' @template field_futilityBounds -#' @template field_gammaA -#' @template field_gammaB -#' @template field_optimizationCriterion -#' @template field_sided -#' @template field_betaSpent -#' @template field_typeBetaSpending -#' @template field_userBetaSpending -#' @template field_power -#' @template field_twoSidedPower -#' @template field_constantBoundsHP -#' @template field_betaAdjustment -#' @template field_delayedInformation -#' @template field_decisionCriticalValues -#' @template field_reversalProbabilities -#' -#' @details -#' This object should not be created directly; use \code{\link[=getDesignGroupSequential]{getDesignGroupSequential()}} -#' with suitable arguments to create a group sequential design. -#' -#' @seealso \code{\link[=getDesignGroupSequential]{getDesignGroupSequential()}} for creating a group sequential design. -#' -#' @include class_core_parameter_set.R -#' @include class_core_plot_settings.R -#' @include f_core_constants.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -TrialDesignGroupSequentialR6 <- R6Class("TrialDesignGroupSequentialR6", - inherit = TrialDesignInverseNormalR6, - public = list( - initialize = function(...) { - self$.parameterFormatFunctions$criticalValues <- ".formatCriticalValues" - super$initialize(...) - self$.initStages() - }, - show = function(showType = 1, digits = NA_integer_) { - "Method for automatically printing trial design objects" - super$show(showType = showType, digits = digits) - } - ) -) - -#' -#' @name TrialDesignConditionalDunnett -#' -#' @title -#' Conditional Dunnett Design -#' -#' @description -#' Trial design for conditional Dunnett tests. -#' -#' @template field_kMax -#' @template field_alpha -#' @template field_stages -#' @template field_informationRates -#' @template field_userAlphaSpending -#' @template field_criticalValues -#' @template field_stageLevels -#' @template field_alphaSpent -#' @template field_bindingFutility -#' @template field_tolerance -#' @template field_informationAtInterim -#' @template field_secondStageConditioning -#' @template field_sided -#' -#' @details -#' This object should not be created directly; use \code{\link{getDesignConditionalDunnett}} -#' with suitable arguments to create a conditional Dunnett test design. -#' -#' @include class_core_parameter_set.R -#' @include class_core_plot_settings.R -#' @include f_core_constants.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -#' @seealso \code{\link{getDesignConditionalDunnett}} for creating a conditional Dunnett test design. -#' -TrialDesignConditionalDunnettR6 <- R6Class("TrialDesignConditionalDunnettR6", - inherit = TrialDesignR6, - public = list( - informationAtInterim = NULL, - secondStageConditioning = NULL, - sided = NULL, - initialize = function(...) { - super$initialize(...)#TODO - - notApplicableParameters <- c( - "kMax", - "stages", - "informationRates", - "userAlphaSpending", - "criticalValues", - "stageLevels", - "alphaSpent", - "bindingFutility", - "tolerance" - ) - for (notApplicableParameter in notApplicableParameters) { - self$.setParameterType(notApplicableParameter, C_PARAM_NOT_APPLICABLE) - } - self$.setParameterType("alpha", ifelse( - identical(alpha, C_ALPHA_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED#TODO - )) - self$.setParameterType("informationAtInterim", ifelse( - identical(informationAtInterim, 0.5), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED#TODO - )) - self$.setParameterType("secondStageConditioning", ifelse( - identical(secondStageConditioning, TRUE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED#TODO - )) - - self$kMax <- 2L - self$sided <- 1L - - self$.initStages() - }, - show = function(showType = 1, digits = NA_integer_) { - "Method for automatically printing trial design objects" - super$show(showType = showType, digits = digits) - } - ) -) - -#' -#' @title -#' Get Design Conditional Dunnett Test -#' -#' @description -#' Defines the design to perform an analysis with the conditional Dunnett test. -#' -#' @inheritParams param_alpha -#' @param informationAtInterim The information to be expected at interim, default is \code{informationAtInterim = 0.5}. -#' @param secondStageConditioning The way the second stage p-values are calculated within the closed system of hypotheses. -#' If \code{secondStageConditioning = FALSE} is specified, the unconditional adjusted p-values are used, otherwise -#' conditional adjusted p-values are calculated, default is \code{secondStageConditioning = TRUE} -#' (for details, see Koenig et al., 2008). -#' -#' @details -#' For performing the conditional Dunnett test the design must be defined through this function. -#' You can define the information fraction and the way of how to compute the second stage -#' p-values only in the design definition, and not in the analysis call.\cr -#' See \code{\link[=getClosedConditionalDunnettTestResults]{getClosedConditionalDunnettTestResults()}} -#' for an example and Koenig et al. (2008) and -#' Wassmer & Brannath (2016), chapter 11 for details of the test procedure. -#' -#' @template return_object_trial_design -#' @template how_to_get_help_for_generics -#' -#' @family design functions -#' -#' @export -#' -getDesignConditionalDunnett <- function(alpha = 0.025, # C_ALPHA_DEFAULT - informationAtInterim = 0.5, secondStageConditioning = TRUE) { - .assertIsValidAlpha(alpha) - .assertIsSingleNumber(informationAtInterim, "informationAtInterim") - .assertIsInOpenInterval(informationAtInterim, "informationAtInterim", 0, 1) - return(TrialDesignConditionalDunnettR6$new( - alpha = alpha, - informationAtInterim = informationAtInterim, - secondStageConditioning = secondStageConditioning - )) -} - -#' -#' @title -#' Trial Design Plotting -#' -#' @description -#' Plots a trial design. -#' -#' @details -#' Generic function to plot a trial design. -#' -#' @param x The trial design, obtained from \cr -#' \code{\link[=getDesignGroupSequential]{getDesignGroupSequential()}}, \cr -#' \code{\link[=getDesignInverseNormal]{getDesignInverseNormal()}} or \cr -#' \code{\link[=getDesignFisher]{getDesignFisher()}}. -#' @param y Not available for this kind of plot (is only defined to be compatible to the generic plot function). -#' @param main The main title. -#' @param xlab The x-axis label. -#' @param ylab The y-axis label. -#' @inheritParams param_palette -#' @inheritParams param_theta -#' @inheritParams param_nMax -#' @inheritParams param_plotPointsEnabled -#' @inheritParams param_showSource -#' @inheritParams param_plotSettings -#' @inheritParams param_legendPosition -#' @inheritParams param_grid -#' @param type The plot type (default = \code{1}). The following plot types are available: -#' \itemize{ -#' \item \code{1}: creates a 'Boundaries' plot -#' \item \code{3}: creates a 'Stage Levels' plot -#' \item \code{4}: creates a 'Error Spending' plot -#' \item \code{5}: creates a 'Power and Early Stopping' plot -#' \item \code{6}: creates an 'Average Sample Size and Power / Early Stop' plot -#' \item \code{7}: creates an 'Power' plot -#' \item \code{8}: creates an 'Early Stopping' plot -#' \item \code{9}: creates an 'Average Sample Size' plot -#' \item \code{"all"}: creates all available plots and returns it as a grid plot or list -#' } -#' @inheritParams param_three_dots_plot -#' -#' @details -#' Generic function to plot a trial design. -#' -#' Note that \code{\link[=param_nMax]{nMax}} is not an argument that it passed to \code{ggplot2}. -#' Rather, the underlying calculations (e.g. power for different theta's or average sample size) are based -#' on calls to function \code{\link[=getPowerAndAverageSampleNumber]{getPowerAndAverageSampleNumber()}} -#' which has argument \code{\link[=param_nMax]{nMax}}. -#' I.e., \code{\link[=param_nMax]{nMax}} is not an argument to ggplot2 but to -#' \code{\link[=getPowerAndAverageSampleNumber]{getPowerAndAverageSampleNumber()}} -#' which is called prior to plotting. -#' -#' @seealso \code{\link[=plot.TrialDesignSet]{plot()}} to compare different designs or design parameters visual. -#' -#' @template return_object_ggplot -#' -#' @examples -#' \dontrun{ -#' design <- getDesignInverseNormal( -#' kMax = 3, alpha = 0.025, -#' typeOfDesign = "asKD", gammaA = 2, -#' informationRates = c(0.2, 0.7, 1), -#' typeBetaSpending = "bsOF" -#' ) -#' if (require(ggplot2)) { -#' plot(design) # default: type = 1 -#' } -#' } -#' -#' @export -#' -plot.TrialDesignR6 <- function(x, y, ..., main = NA_character_, - xlab = NA_character_, ylab = NA_character_, type = 1L, palette = "Set1", - theta = seq(-1, 1, 0.01), nMax = NA_integer_, plotPointsEnabled = NA, - legendPosition = NA_integer_, showSource = FALSE, - grid = 1, plotSettings = NULL) { - fCall <- match.call(expand.dots = FALSE) - designName <- deparse(fCall$x) - .assertGgplotIsInstalled() - .assertIsSingleInteger(grid, "grid", validateType = FALSE) - typeNumbers <- .getPlotTypeNumber(type, x) - if (is.null(plotSettings)) { - plotSettings <- .getGridPlotSettings(x, typeNumbers, grid) - } - p <- NULL - plotList <- list() - for (typeNumber in typeNumbers) { - p <- .plotTrialDesign( - x = x, y = y, main = main, - xlab = xlab, ylab = ylab, type = typeNumber, palette = palette, - theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, - legendPosition = .getGridLegendPosition(legendPosition, typeNumbers, grid), - showSource = showSource, designName = designName, - plotSettings = plotSettings, ... - ) - .printPlotShowSourceSeparator(showSource, typeNumber, typeNumbers) - if (length(typeNumbers) > 1) { - caption <- .getPlotCaption(x, typeNumber, stopIfNotFound = TRUE) - plotList[[caption]] <- p - } - } - if (length(typeNumbers) == 1) { - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(p)) - } - - return(p) - } - - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(plotList)) - } - - return(.createPlotResultObject(plotList, grid)) -} - -#' @rdname plot.TrialDesign -#' @export -plot.TrialDesignCharacteristicsR6 <- function(x, y, ...) { - plot(x = x$.design, y = y, ...) -} - -.plotTrialDesign <- function(..., x, y, main, - xlab, ylab, type, palette, - theta, nMax, plotPointsEnabled, - legendPosition, showSource, designName, plotSettings = NULL) {#TODO - .assertGgplotIsInstalled() - - .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) - if (any(.isTrialDesignFisher(x)) && !(type %in% c(1, 3, 4))) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'type' (", type, ") is not allowed for Fisher designs; must be 1, 3 or 4" - ) - } - - .warnInCaseOfUnknownArguments( - functionName = "plot", - ignore = c("xlim", "ylim", "companyAnnotationEnabled", "variedParameters"), ... - ) - - if ((type < 5 || type > 9) && !identical(theta, seq(-1, 1, 0.01))) { - warning("'theta' (", .reconstructSequenceCommand(theta), ") will be ignored for plot type ", type, call. = FALSE) - } - - if (!missing(y) && !is.null(y) && length(y) == 1 && inherits(y, "TrialDesign")) { - args <- list(...) - variedParameters <- args[["variedParameters"]] - if (is.null(variedParameters)) { - if (.isTrialDesignInverseNormalOrGroupSequential(x) && - .isTrialDesignInverseNormalOrGroupSequential(y) && - x$typeOfDesign != y$typeOfDesign) { - variedParameters <- "typeOfDesign" - } else { - stop( - C_EXCEPTION_TYPE_MISSING_ARGUMENT, - "'variedParameters' needs to be specified, e.g., variedParameters = \"typeOfDesign\"" - ) - } - } - designSet <- getDesignSet(designs = c(x, y), variedParameters = variedParameters) - } else { - designSet <- TrialDesignSetR6$new(design = x, singleDesign = TRUE) - if (!is.null(plotSettings)) { - designSet$.plotSettings <- plotSettings - } - } - - .plotTrialDesignSet( - x = designSet, y = y, main = main, xlab = xlab, ylab = ylab, type = type, - palette = palette, theta = theta, nMax = nMax, - plotPointsEnabled = plotPointsEnabled, legendPosition = legendPosition, - showSource = showSource, designSetName = designName, ... - ) -} - -#' -#' @title -#' Coerce TrialDesign to a Data Frame -#' -#' @description -#' Returns the \code{TrialDesign} as data frame. -#' -#' @param x A \code{\link{TrialDesign}} object. -#' @inheritParams param_niceColumnNamesEnabled -#' @inheritParams param_includeAllParameters -#' @inheritParams param_three_dots -#' -#' @details -#' Each element of the \code{\link{TrialDesign}} is converted to a column in the data frame. -#' -#' @template return_dataframe -#' -#' @examples -#' as.data.frame(getDesignGroupSequential()) -#' -#' @export -#' -#' @keywords internal -#' -as.data.frame.TrialDesignR6 <- function(x, row.names = NULL, - optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ...) { - .assertIsTrialDesign(x) - - if (includeAllParameters) { - parameterNames <- NULL - } else { - parameterNames <- x$.getParametersToShow() - } - return(.getAsDataFrame( - parameterSet = x, - parameterNames = parameterNames, - niceColumnNamesEnabled = niceColumnNamesEnabled, - includeAllParameters = includeAllParameters, - tableColumnNames = .getTableColumnNames(design = x) - )) -} diff --git a/R/class_design_set.R b/R/class_design_set.R index 8f748907..1578415a 100644 --- a/R/class_design_set.R +++ b/R/class_design_set.R @@ -22,44 +22,7 @@ #' @include f_core_utilities.R NULL -#' -#' @title -#' Trial Design Set Summary -#' -#' @description -#' Displays a summary of \code{\link{ParameterSet}} object. -#' -#' @param object A \code{\link{ParameterSet}} object. -#' @inheritParams param_digits -#' @inheritParams param_three_dots -#' -#' @details -#' Summarizes the trial designs. -#' -#' @template details_summary -#' -#' @template return_object_summary -#' @template how_to_get_help_for_generics -#' -#' @export -#' -#' @keywords internal -#' -summary.TrialDesignSet <- function(object, ..., type = 1, digits = NA_integer_) { - .warnInCaseOfUnknownArguments(functionName = "summary.TrialDesignSet", ...) - .assertIsTrialDesignSet(object) - if (object$isEmpty()) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "cannot create summary because the design set is empty") - } - - summaries <- list() - for (design in object$designs) { - s <- .createSummary(design, digits = digits) - summaries <- c(summaries, s) - } - return(summaries) -} #' #' @name TrialDesignSet @@ -89,60 +52,58 @@ summary.TrialDesignSet <- function(object, ..., type = 1, digits = NA_integer_) #' #' @importFrom methods new #' -TrialDesignSet <- setRefClass("TrialDesignSet", - contains = "FieldSet", - fields = list( - .plotSettings = "ANY", - designs = "list", - variedParameters = "character" - ), - methods = list( +TrialDesignSetR6 <- R6Class("TrialDesignSetR6", + inherit = FieldSetR6, + public = list( + .plotSettings = NULL, + designs = NULL, + variedParameters = NULL, # # @param ... 'designs' OR 'design' and one or more design parameters, e.g., deltaWT = c(0.1, 0.3, 0.4) # initialize = function(...) { - .plotSettings <<- PlotSettingsR6$new() - designs <<- list() - variedParameters <<- character(0) + self$.plotSettings <- PlotSettingsR6$new() + self$designs <- list() + self$variedParameters <- character(0) if (length(list(...)) > 0) { - add(...) + self$add(...) } - if (length(designs) > 0) { - masterDesign <- designs[[1]] - if (inherits(masterDesign, "ParameterSet")) { - .self$.plotSettings <<- masterDesign$.plotSettings + if (length(self$designs) > 0) { + masterDesign <- self$designs[[1]] + if (inherits(masterDesign, "ParameterSet") || inherits(masterDesign, "ParameterSetR6")) { + self$.plotSettings <- masterDesign$.plotSettings } } }, getPlotSettings = function() { - return(.plotSettings) + return(self$.plotSettings) }, show = function(showType = 1, digits = NA_integer_) { - .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) }, .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { "Method for automatically printing trial design sets" - .resetCat() - .cat("Trial design set with ", length(designs), " designs\n\n", + self$.resetCat() + self$.cat("Trial design set with ", length(self$designs), " designs\n\n", heading = 1, consoleOutputEnabled = consoleOutputEnabled ) - for (design in designs) { + for (design in self$designs) { design$.show(showType = showType, consoleOutputEnabled = consoleOutputEnabled) } }, isEmpty = function() { - return(length(designs) == 0) + return(length(self$designs) == 0) }, getSize = function() { - return(length(designs)) + return(length(self$designs)) }, getDesignMaster = function() { - if (length(designs) == 0) { + if (length(self$designs) == 0) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "no design master defined") } - return(designs[[1]]) + return(self$designs[[1]]) }, .validateDesignsArgument = function(designsToAdd, args) { if (!is.list(designsToAdd)) { @@ -176,7 +137,7 @@ TrialDesignSet <- setRefClass("TrialDesignSet", varPar <- args[["variedParameters"]] if (!is.null(varPar) && length(varPar) > 0) { - variedParameters <<- c(variedParameters, varPar) + self$variedParameters <- c(self$variedParameters, varPar) } args <- args[!(names(args) %in% c("designs", "variedParameters"))] @@ -188,20 +149,20 @@ TrialDesignSet <- setRefClass("TrialDesignSet", ) } - designs <<- c(designs, designsToAddValidated) + self$designs <- c(self$designs, designsToAddValidated) }, addVariedParameters = function(varPar) { if (is.null(varPar) || !is.character(varPar)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'varPar' must be a valid character vector") } - variedParameters <<- c(variedParameters, varPar) + self$variedParameters <- c(self$variedParameters, varPar) }, .validateOptionalArguments = function(...) { args <- list(...) designsToAdd <- .getOptionalArgument(optionalArgumentName = "designs", ...) if (!is.null(designsToAdd)) { - .validateDesignsArgument(designsToAdd = designsToAdd, args = args) + self$.validateDesignsArgument(designsToAdd = designsToAdd, args = args) return(NULL) } @@ -215,7 +176,7 @@ TrialDesignSet <- setRefClass("TrialDesignSet", ) } - if (is.null(design) && optionalArgumentsDefined && length(designs) == 0) { + if (is.null(design) && optionalArgumentsDefined && length(self$designs) == 0) { stop( C_EXCEPTION_TYPE_INCOMPLETE_ARGUMENTS, "at least one design (master) must be defined in this ", @@ -224,9 +185,9 @@ TrialDesignSet <- setRefClass("TrialDesignSet", } if (!is.null(design)) { - designs <<- c(designs, design) - } else if (length(designs) > 0) { - design <- designs[[1]] # use design master + self$designs <- c(self$designs, design) + } else if (length(self$designs) > 0) { + design <- self$designs[[1]] # use design master } if (!.isTrialDesign(design)) { @@ -236,7 +197,7 @@ TrialDesignSet <- setRefClass("TrialDesignSet", ) } - .getArgumentNames(validatedDesign = design, ...) + self$.getArgumentNames(validatedDesign = design, ...) invisible(design) }, @@ -269,7 +230,7 @@ TrialDesignSet <- setRefClass("TrialDesignSet", }, add = function(...) { "Adds 'designs' OR a 'design' and/or a design parameter, e.g., deltaWT = c(0.1, 0.3, 0.4)" - design <- .validateOptionalArguments(...) + design <- self$.validateOptionalArguments(...) args <- list(...) singleDesign <- args[["singleDesign"]] @@ -278,17 +239,17 @@ TrialDesignSet <- setRefClass("TrialDesignSet", } if (!is.null(design)) { - d <- .createDesignVariants(validatedDesign = design, ...) - designs <<- c(designs, d) + d <- self$.createDesignVariants(validatedDesign = design, ...) + self$designs <- c(self$designs, d) } }, assertHaveEqualSidedValues = function() { - if (length(designs) == 0) { + if (length(self$designs) == 0) { return(invisible()) } - sided <- getDesignMaster()$sided - for (design in designs) { + sided <- self$getDesignMaster()$sided + for (design in self$designs) { if (sided != design$sided) { stop( C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, @@ -300,7 +261,7 @@ TrialDesignSet <- setRefClass("TrialDesignSet", }, .createDesignVariants = function(validatedDesign, ...) { .assertIsTrialDesign(validatedDesign) - argumentNames <- .getArgumentNames(validatedDesign = validatedDesign, ...) + argumentNames <- self$.getArgumentNames(validatedDesign = validatedDesign, ...) if (length(argumentNames) == 0) { warning("Creation of design variants stopped: no valid design parameters found", call. = FALSE) @@ -315,7 +276,7 @@ TrialDesignSet <- setRefClass("TrialDesignSet", ) } - designVariants <- .createDesignVariantsRecursive( + designVariants <- self$.createDesignVariantsRecursive( designMaster = validatedDesign, args = list(...), argumentIndex = 1, argumentNames = argumentNames ) @@ -324,11 +285,11 @@ TrialDesignSet <- setRefClass("TrialDesignSet", }, .designSettingExists = function(parameterName, parameterValue, numberOfArguments = 1, parameterNameBefore = NULL, parameterValueBefore = NULL) { - if (length(designs) == 0) { + if (length(self$designs) == 0) { return(FALSE) } - for (design in designs) { + for (design in self$designs) { if (!is.null(parameterNameBefore) && !is.null(parameterValueBefore)) { if (design[[parameterNameBefore]] == parameterValueBefore && design[[parameterName]] == parameterValue) { @@ -350,11 +311,11 @@ TrialDesignSet <- setRefClass("TrialDesignSet", designVariants <- list() argumentName <- argumentNames[argumentIndex] - variedParameters <<- unique(c(variedParameters, argumentName)) + self$variedParameters <- unique(c(self$variedParameters, argumentName)) argumentValues <- args[[argumentName]] for (argumentValue in argumentValues) { - if (.designSettingExists(argumentName, argumentValue, + if (self$.designSettingExists(argumentName, argumentValue, numberOfArguments = length(argumentNames), parameterNameBefore, parameterValueBefore )) { @@ -370,7 +331,7 @@ TrialDesignSet <- setRefClass("TrialDesignSet", ), call. = FALSE) } } else { - designMaster2 <- .createDesignVariant( + designMaster2 <- self$.createDesignVariant( designMaster = designMaster, argumentName = argumentName, argumentValue = argumentValue ) @@ -385,7 +346,7 @@ TrialDesignSet <- setRefClass("TrialDesignSet", } designVariants <- c(designVariants, designMaster2) } - designCopies2 <- .createDesignVariantsRecursive( + designCopies2 <- self$.createDesignVariantsRecursive( designMaster = designMaster2, args = args, argumentIndex = argumentIndex + 1, argumentNames = argumentNames, parameterNameBefore = argumentName, parameterValueBefore = argumentValue @@ -468,41 +429,120 @@ TrialDesignSet <- setRefClass("TrialDesignSet", ) ) -#' #' @title -#' Access Trial Design by Index +#' Get Design Set #' #' @description -#' Function to the \code{TrialDesign} at position \code{i} in a \code{TrialDesignSet} object. +#' Creates a trial design set object and returns it. +#' +#' @param ... \code{designs} or \code{design} and one or more design parameters, e.g., \code{deltaWT = c(0.1, 0.3, 0.4)}. +#' \itemize{ +#' \item \code{design} The master design (optional, you need to specify an +#' additional parameter that shall be varied). +#' \item \code{designs} The designs to compare (optional, you need to specify the variable \code{variedParameters}). +#' } #' #' @details -#' Can be used to iterate over all designs in a design set. +#' Specify a master design and one or more design parameters or a list of designs. +#' +#' @return Returns a \code{\link{TrialDesignSet}} object. +#' The following generics (R generic functions) are available for this result object: +#' \itemize{ +#' \item \code{\link[=names.TrialDesignSet]{names}} to obtain the field names, +#' \item \code{\link[=length.TrialDesignSet]{length}} to obtain the number of design, +#' \item \code{\link[=print.FieldSet]{print()}} to print the object, +#' \item \code{\link[=summary.TrialDesignSet]{summary()}} to display a summary of the object, +#' \item \code{\link[=plot.TrialDesignSet]{plot()}} to plot the object, +#' \item \code{\link[=as.data.frame.TrialDesignSet]{as.data.frame()}} to coerce the object to a \code{\link[base]{data.frame}}, +#' \item \code{\link[=as.matrix.FieldSet]{as.matrix()}} to coerce the object to a \code{\link[base]{matrix}}. +#' } +#' @template how_to_get_help_for_generics #' #' @examples -#' designSet <- getDesignSet(design = getDesignFisher(), alpha = c(0.01, 0.05)) -#' for (i in 1:length(designSet)) { -#' print(designSet[i]$alpha) +#' # Example 1 +#' design <- getDesignGroupSequential( +#' alpha = 0.05, kMax = 6, +#' sided = 2, typeOfDesign = "WT", deltaWT = 0.1 +#' ) +#' designSet <- getDesignSet() +#' designSet$add(design = design, deltaWT = c(0.3, 0.4)) +#' \dontrun{ +#' if (require(ggplot2)) plot(designSet, type = 1) +#' } +#' +#' # Example 2 (shorter script) +#' design <- getDesignGroupSequential( +#' alpha = 0.05, kMax = 6, +#' sided = 2, typeOfDesign = "WT", deltaWT = 0.1 +#' ) +#' designSet <- getDesignSet(design = design, deltaWT = c(0.3, 0.4)) +#' \dontrun{ +#' if (require(ggplot2)) plot(designSet, type = 1) +#' } +#' +#' # Example 3 (use of designs instead of design) +#' d1 <- getDesignGroupSequential( +#' alpha = 0.05, kMax = 2, +#' sided = 1, beta = 0.2, typeOfDesign = "asHSD", +#' gammaA = 0.5, typeBetaSpending = "bsHSD", gammaB = 0.5 +#' ) +#' d2 <- getDesignGroupSequential( +#' alpha = 0.05, kMax = 4, +#' sided = 1, beta = 0.2, typeOfDesign = "asP", +#' typeBetaSpending = "bsP" +#' ) +#' designSet <- getDesignSet( +#' designs = c(d1, d2), +#' variedParameters = c("typeOfDesign", "kMax") +#' ) +#' \dontrun{ +#' if (require(ggplot2)) plot(designSet, type = 8, nMax = 20) #' } #' #' @export #' +getDesignSet <- function(...) { + return(TrialDesignSetR6$new(...)) +} + +#' +#' @title +#' Trial Design Set Summary +#' +#' @description +#' Displays a summary of \code{\link{ParameterSet}} object. +#' +#' @param object A \code{\link{ParameterSet}} object. +#' @inheritParams param_digits +#' @inheritParams param_three_dots +#' +#' @details +#' Summarizes the trial designs. +#' +#' @template details_summary +#' +#' @template return_object_summary +#' @template how_to_get_help_for_generics +#' +#' @export +#' #' @keywords internal #' -setMethod( - "[", "TrialDesignSet", - function(x, i, j = NA_character_, ...) { - if (length(x$designs) == 0) { - return(NULL) - } +summary.TrialDesignSetR6 <- function(object, ..., type = 1, digits = NA_integer_) { + .warnInCaseOfUnknownArguments(functionName = "summary.TrialDesignSetR6", ...) - design <- x$designs[[i]] - if (!missing(j) && !is.na(j) && is.character(j)) { - return(design[[j]]) - } + .assertIsTrialDesignSet(object)#TODO + if (object$isEmpty()) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "cannot create summary because the design set is empty") + } - return(design) + summaries <- list() + for (design in object$designs) { + s <- .createSummary(design, digits = digits) + summaries <- c(summaries, s) } -) + return(summaries) +} #' #' @title @@ -526,7 +566,7 @@ setMethod( #' #' @keywords internal #' -names.TrialDesignSet <- function(x) { +names.TrialDesignSetR6 <- function(x) { return(x$.getVisibleFieldNames()) } @@ -553,7 +593,7 @@ names.TrialDesignSet <- function(x) { #' #' @keywords internal #' -length.TrialDesignSet <- function(x) { +length.TrialDesignSetR6 <- function(x) { return(length(x$designs)) } @@ -586,7 +626,7 @@ length.TrialDesignSet <- function(x) { #' #' @keywords internal #' -as.data.frame.TrialDesignSet <- function(x, row.names = NULL, +as.data.frame.TrialDesignSetR6 <- function(x, row.names = NULL, optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, addPowerAndAverageSampleNumber = FALSE, theta = seq(-1, 1, 0.02), nMax = NA_integer_, ...) { .assertIsTrialDesignSet(x) @@ -722,7 +762,7 @@ as.data.frame.TrialDesignSet <- function(x, row.names = NULL, #' #' @export #' -plot.TrialDesignSet <- function(x, y, ..., type = 1L, main = NA_character_, +plot.TrialDesignSetR6 <- function(x, y, ..., type = 1L, main = NA_character_, xlab = NA_character_, ylab = NA_character_, palette = "Set1", theta = seq(-1, 1, 0.02), nMax = NA_integer_, plotPointsEnabled = NA, legendPosition = NA_integer_, showSource = FALSE, @@ -757,4 +797,187 @@ plot.TrialDesignSet <- function(x, y, ..., type = 1L, main = NA_character_, } return(.createPlotResultObject(plotList, grid)) -} \ No newline at end of file +} + +.plotTrialDesignSet <- function(..., x, y, type = 1L, main = NA_character_, + xlab = NA_character_, ylab = NA_character_, palette = "Set1", + theta = seq(-1, 1, 0.02), nMax = NA_integer_, plotPointsEnabled = NA, + legendPosition = NA_integer_, showSource = FALSE, + designSetName = NA_character_, plotSettings = NULL) { + .assertGgplotIsInstalled() + if (!is.call(main) && !isS4(main)) { + .assertIsSingleCharacter(main, "main", naAllowed = TRUE) + } + .assertIsSingleCharacter(xlab, "xlab", naAllowed = TRUE) + .assertIsSingleCharacter(ylab, "ylab", naAllowed = TRUE) + .assertIsSingleCharacter(palette, "palette", naAllowed = TRUE) + theta <- .assertIsValidThetaRange(thetaRange = theta) + .assertIsSingleNumber(nMax, "nMax", naAllowed = TRUE) + .assertIsInClosedInterval(nMax, "nMax", lower = 1L, upper = 1e10) + .assertIsSingleLogical(plotPointsEnabled, "plotPointsEnabled", naAllowed = TRUE) + .assertIsValidLegendPosition(legendPosition) + .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) + + parameterSet <- x + designMaster <- parameterSet$getDesignMaster() + .assertIsTrialDesign(designMaster) + + if (type == 1) { + main <- if (!is.call(main) && !isS4(main) && is.na(main)) "Boundaries" else main + xParameterName <- "informationRates" + yParameterNames <- "criticalValues" + + if (designMaster$sided == 1 || (.isTrialDesignInverseNormalOrGroupSequential(designMaster) && + (designMaster$typeOfDesign == C_TYPE_OF_DESIGN_PT || grepl("^bs", designMaster$typeBetaSpending)))) { + if (.isTrialDesignWithValidFutilityBounds(designMaster)) { + yParameterNames <- c("futilityBounds", yParameterNames) + } + if (.isTrialDesignWithValidAlpha0Vec(designMaster)) { + yParameterNames <- c("alpha0Vec", yParameterNames) + } + } + } else if (type == 2) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "designs with undefined endpoint do not support plot type 2") + } else if (type == 3) { + main <- if (!is.call(main) && !isS4(main) && is.na(main)) "Stage Levels" else main + xParameterName <- "informationRates" + yParameterNames <- "stageLevels" + } else if (type == 4) { + main <- if (!is.call(main) && !isS4(main) && is.na(main)) "Error Spending" else main + xParameterName <- "informationRates" + yParameterNames <- c("alphaSpent") + if (!.isTrialDesignFisher(designMaster) && + designMaster$typeBetaSpending != C_TYPE_OF_DESIGN_BS_NONE) { + yParameterNames <- c(yParameterNames, "betaSpent") + palette <- "Paired" + } + plotPointsEnabled <- ifelse(is.na(plotPointsEnabled), FALSE, plotPointsEnabled) + } else if (type == 5) { + if (!is.call(main) && !isS4(main) && is.na(main)) { + main <- PlotSubTitleItems(title = "Power and Early Stopping") + main$add("N", nMax, "max") + } + xParameterName <- "theta" + yParameterNames <- c("overallEarlyStop", "calculatedPower") + } else if (type == 6) { + if (!is.call(main) && !isS4(main) && is.na(main)) { + main <- PlotSubTitleItems(title = "Average Sample Size and Power / Early Stop") + main$add("N", nMax, "max") + } + xParameterName <- "theta" + yParameterNames <- c("averageSampleNumber", "overallEarlyStop", "calculatedPower") + } else if (type == 7) { + if (!is.call(main) && !isS4(main) && is.na(main)) { + main <- PlotSubTitleItems(title = "Power") + main$add("N", nMax, "max") + } + xParameterName <- "theta" + yParameterNames <- "calculatedPower" + } else if (type == 8) { + if (!is.call(main) && !isS4(main) && is.na(main)) { + main <- PlotSubTitleItems(title = "Early Stopping") + main$add("N", nMax, "max") + } + xParameterName <- "theta" + yParameterNames <- "overallEarlyStop" + } else if (type == 9) { + if (!is.call(main) && !isS4(main) && is.na(main)) { + main <- PlotSubTitleItems(title = "Average Sample Size") + main$add("N", nMax, "max") + } + xParameterName <- "theta" + yParameterNames <- "averageSampleNumber" + } else { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is not allowed; must be 1, 2, ..., 9") + } + + if (type >= 5 && type <= 9) { + designSetName <- paste0( + "getPowerAndAverageSampleNumber(", designSetName, + ", theta = ", .reconstructSequenceCommand(theta), ", nMax = ", nMax, ")" + ) + } + + xValues <- NA_real_ + if (xParameterName == "theta") { + xValues <- theta + } + srcCmd <- .showPlotSourceInformation( + objectName = designSetName, + xParameterName = xParameterName, + yParameterNames = yParameterNames, + nMax = nMax, + type = type, + showSource = showSource, + xValues = xValues + ) + if (!is.null(srcCmd)) { + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(srcCmd)) + } + return(srcCmd) + } + + p <- .plotParameterSet( + parameterSet = parameterSet, designMaster = designMaster, + xParameterName = xParameterName, + yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, + palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, + legendPosition = legendPosition, plotSettings = plotSettings # , ... + ) + + p <- .addDecistionCriticalValuesToPlot(p = p, designMaster = designMaster, type = type, nMax = nMax) + + return(p) +} + +.addDecistionCriticalValuesToPlot <- function(p, designMaster, type, nMax = NA_integer_) { + if (type != 1 || !.isTrialDesignInverseNormalOrGroupSequential(designMaster)) { + return(p) + } + + data <- as.data.frame(designMaster) + xyNames <- c("delayedInformationRates", "decisionCriticalValues") + if (!all(xyNames %in% colnames(data))) { + return(p) + } + + data <- unique(na.omit(data[, xyNames])) + data$legend <- rep("Decision critical value", nrow(data)) + + if (!is.na(nMax) && nMax > 1) { + data$delayedInformationRates <- data$delayedInformationRates * nMax + tryCatch( + { + data$delayedInformationRates <- as.numeric(.formatSampleSizes(data$delayedInformationRates)) + }, + error = function(e) { + warning("Failed to format delayed information rates on x-axis: ", e$message) + } + ) + } + + plotSettings <- designMaster$.plotSettings + p <- p + ggplot2::geom_point( + data = data, + mapping = ggplot2::aes( + x = .data[["delayedInformationRates"]], + y = .data[["decisionCriticalValues"]], + colour = .data[["legend"]] + ), + size = plotSettings$scaleSize(plotSettings$pointSize, TRUE), + shape = 4, stroke = 1.25, show.legend = FALSE + ) + + for (i in 1:nrow(data)) { + label <- paste0("(", round(data[i, 1], 3), ", ", round(data[i, 2], 3), ")") + p <- p + ggplot2::annotate("text", + x = data[i, 1], y = data[i, 2], + label = label, vjust = plotSettings$scaleSize(3.0), + size = plotSettings$scaleSize(2.5) + ) + } + + try(suppressWarnings(suppressMessages(p <- p + ggplot2::scale_color_manual(values = c("#4daf4a", "#377eb8", "#e41a1c"))))) + return(p) +} diff --git a/R/class_design_set_r6.R b/R/class_design_set_r6.R deleted file mode 100644 index 1578415a..00000000 --- a/R/class_design_set_r6.R +++ /dev/null @@ -1,983 +0,0 @@ -## | -## | *Trial design set classes* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | rpact package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File version: $Revision: 7126 $ -## | Last changed: $Date: 2023-06-23 14:26:39 +0200 (Fr, 23 Jun 2023) $ -## | Last changed by: $Author: pahlke $ -## | - -#' @include f_core_plot.R -#' @include f_core_utilities.R -NULL - - - -#' -#' @name TrialDesignSet -#' -#' @title -#' Class for trial design sets. -#' -#' @description -#' \code{TrialDesignSet} is a class for creating a collection of different trial designs. -#' -#' @template field_designs -#' @template field_design -#' @template field_variedParameters -#' -#' @details -#' This object cannot be created directly; better use \code{\link[=getDesignSet]{getDesignSet()}} -#' with suitable arguments to create a set of designs. -#' -#' @seealso \code{\link[=getDesignSet]{getDesignSet()}} -#' -#' @include class_core_parameter_set.R -#' @include class_core_plot_settings.R -#' @include f_core_plot.R -#' @include f_logger.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -TrialDesignSetR6 <- R6Class("TrialDesignSetR6", - inherit = FieldSetR6, - public = list( - .plotSettings = NULL, - designs = NULL, - variedParameters = NULL, - # - # @param ... 'designs' OR 'design' and one or more design parameters, e.g., deltaWT = c(0.1, 0.3, 0.4) - # - initialize = function(...) { - self$.plotSettings <- PlotSettingsR6$new() - self$designs <- list() - self$variedParameters <- character(0) - if (length(list(...)) > 0) { - self$add(...) - } - if (length(self$designs) > 0) { - masterDesign <- self$designs[[1]] - if (inherits(masterDesign, "ParameterSet") || inherits(masterDesign, "ParameterSetR6")) { - self$.plotSettings <- masterDesign$.plotSettings - } - } - }, - getPlotSettings = function() { - return(self$.plotSettings) - }, - show = function(showType = 1, digits = NA_integer_) { - self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) - }, - .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { - "Method for automatically printing trial design sets" - self$.resetCat() - self$.cat("Trial design set with ", length(self$designs), " designs\n\n", - heading = 1, - consoleOutputEnabled = consoleOutputEnabled - ) - for (design in self$designs) { - design$.show(showType = showType, consoleOutputEnabled = consoleOutputEnabled) - } - }, - isEmpty = function() { - return(length(self$designs) == 0) - }, - getSize = function() { - return(length(self$designs)) - }, - getDesignMaster = function() { - if (length(self$designs) == 0) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "no design master defined") - } - - return(self$designs[[1]]) - }, - .validateDesignsArgument = function(designsToAdd, args) { - if (!is.list(designsToAdd)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'designsToAdd' must be a list") - } - - if (length(designsToAdd) == 0) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'designsToAdd' must be not empty") - } - - designsToAddValidated <- list() - for (d in designsToAdd) { - if (.isTrialDesign(d)) { - designsToAddValidated <- c(designsToAddValidated, d) - } else { - parentDesign <- d[[".design"]] - if (is.null(parentDesign)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'designsToAdd' must be a list of trial designs (found '", .getClassName(d), "')" - ) - } - - warning("Only the parent design of ", .getClassName(d), - " was added to trial design set", - call. = FALSE - ) - designsToAddValidated <- c(designsToAddValidated, parentDesign) - } - } - - varPar <- args[["variedParameters"]] - if (!is.null(varPar) && length(varPar) > 0) { - self$variedParameters <- c(self$variedParameters, varPar) - } - - args <- args[!(names(args) %in% c("designs", "variedParameters"))] - if (length(args) > 0) { - warning("Argument", ifelse(length(args) > 1, "s", ""), " ", - .arrayToString(args, encapsulate = TRUE), " will be ignored ", - "because for 'designs' only argument 'variedParameters' will be respected", - call. = FALSE - ) - } - - self$designs <- c(self$designs, designsToAddValidated) - }, - addVariedParameters = function(varPar) { - if (is.null(varPar) || !is.character(varPar)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'varPar' must be a valid character vector") - } - - self$variedParameters <- c(self$variedParameters, varPar) - }, - .validateOptionalArguments = function(...) { - args <- list(...) - designsToAdd <- .getOptionalArgument(optionalArgumentName = "designs", ...) - if (!is.null(designsToAdd)) { - self$.validateDesignsArgument(designsToAdd = designsToAdd, args = args) - return(NULL) - } - - design <- .getOptionalArgument(optionalArgumentName = "design", ...) - optionalArgumentsDefined <- (length(args) > 0) - if (is.null(design) && !optionalArgumentsDefined) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "please specify a 'design' to add and/or a design parameter, ", - "e.g., deltaWT = c(0.1, 0.3, 0.4)" - ) - } - - if (is.null(design) && optionalArgumentsDefined && length(self$designs) == 0) { - stop( - C_EXCEPTION_TYPE_INCOMPLETE_ARGUMENTS, - "at least one design (master) must be defined in this ", - "design set to respect any design parameters" - ) - } - - if (!is.null(design)) { - self$designs <- c(self$designs, design) - } else if (length(self$designs) > 0) { - design <- self$designs[[1]] # use design master - } - - if (!.isTrialDesign(design)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'design' (", .getClassName(design), ") must be an instance of class 'TrialDesign'" - ) - } - - self$.getArgumentNames(validatedDesign = design, ...) - - invisible(design) - }, - .getArgumentNames = function(validatedDesign, ...) { - args <- list(...) - if (length(args) == 0) { - return(character(0)) - } - - argumentNames <- names(args) - if (length(argumentNames) == 0) { - warning("No argument names available for ", paste(args, collapse = ", "), call. = FALSE) - return(character(0)) - } - - argumentNames <- argumentNames[nchar(argumentNames) != 0] - argumentNames <- argumentNames[!(argumentNames %in% c("design", "designs", "singleDesign"))] - - visibleFieldNames <- validatedDesign$.getVisibleFieldNames() - for (arg in argumentNames) { - if (!(arg %in% visibleFieldNames)) { - stop(sprintf(paste0( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, - "'%s' does not contain a field with name '%s'" - ), .getClassName(validatedDesign), arg)) - } - } - - invisible(argumentNames) - }, - add = function(...) { - "Adds 'designs' OR a 'design' and/or a design parameter, e.g., deltaWT = c(0.1, 0.3, 0.4)" - design <- self$.validateOptionalArguments(...) - - args <- list(...) - singleDesign <- args[["singleDesign"]] - if (!is.null(singleDesign) && is.logical(singleDesign) && singleDesign) { - return(invisible()) - } - - if (!is.null(design)) { - d <- self$.createDesignVariants(validatedDesign = design, ...) - self$designs <- c(self$designs, d) - } - }, - assertHaveEqualSidedValues = function() { - if (length(self$designs) == 0) { - return(invisible()) - } - - sided <- self$getDesignMaster()$sided - for (design in self$designs) { - if (sided != design$sided) { - stop( - C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, - "designs have different directions of alternative (design master is ", - ifelse(sided == 1, "one", "two"), " sided)" - ) - } - } - }, - .createDesignVariants = function(validatedDesign, ...) { - .assertIsTrialDesign(validatedDesign) - argumentNames <- self$.getArgumentNames(validatedDesign = validatedDesign, ...) - - if (length(argumentNames) == 0) { - warning("Creation of design variants stopped: no valid design parameters found", call. = FALSE) - return(list()) - } - - if (length(argumentNames) > 2) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "too many arguments (", .arrayToString(argumentNames, encapsulate = TRUE), - "): up to 2 design parameters are allowed" - ) - } - - designVariants <- self$.createDesignVariantsRecursive( - designMaster = validatedDesign, - args = list(...), argumentIndex = 1, argumentNames = argumentNames - ) - - return(designVariants) - }, - .designSettingExists = function(parameterName, parameterValue, numberOfArguments = 1, - parameterNameBefore = NULL, parameterValueBefore = NULL) { - if (length(self$designs) == 0) { - return(FALSE) - } - - for (design in self$designs) { - if (!is.null(parameterNameBefore) && !is.null(parameterValueBefore)) { - if (design[[parameterNameBefore]] == parameterValueBefore && - design[[parameterName]] == parameterValue) { - return(TRUE) - } - } else if (numberOfArguments == 1) { - if (design[[parameterName]] == parameterValue) { - return(TRUE) - } - } - } - return(FALSE) - }, - .createDesignVariantsRecursive = function(designMaster, args, argumentIndex, argumentNames, - parameterNameBefore = NULL, parameterValueBefore = NULL) { - if (argumentIndex > length(argumentNames)) { - return(list()) - } - - designVariants <- list() - argumentName <- argumentNames[argumentIndex] - self$variedParameters <- unique(c(self$variedParameters, argumentName)) - argumentValues <- args[[argumentName]] - - for (argumentValue in argumentValues) { - if (self$.designSettingExists(argumentName, argumentValue, - numberOfArguments = length(argumentNames), - parameterNameBefore, parameterValueBefore - )) { - if (!is.null(parameterNameBefore) && !is.null(parameterValueBefore)) { - warning(sprintf( - "Argument ignored: there exists already a design with %s = %s (%s = %s)", - argumentName, argumentValue, parameterNameBefore, parameterValueBefore - ), call. = FALSE) - } else { - warning(sprintf( - "Argument ignored: there exists already a design with %s = %s", - argumentName, argumentValue - ), call. = FALSE) - } - } else { - designMaster2 <- self$.createDesignVariant( - designMaster = designMaster, - argumentName = argumentName, argumentValue = argumentValue - ) - if (argumentIndex == length(argumentNames)) { - if (is.null(parameterNameBefore) || is.null(parameterValueBefore)) { - .logDebug("Create design variant %s = %s", argumentName, argumentValue) - } else { - .logDebug( - "Create design variant %s = %s (%s = %s)", argumentName, argumentValue, - parameterNameBefore, parameterValueBefore - ) - } - designVariants <- c(designVariants, designMaster2) - } - designCopies2 <- self$.createDesignVariantsRecursive( - designMaster = designMaster2, - args = args, argumentIndex = argumentIndex + 1, argumentNames = argumentNames, - parameterNameBefore = argumentName, parameterValueBefore = argumentValue - ) - if (length(designCopies2) > 0) { - designVariants <- c(designVariants, designCopies2) - } - } - } - - return(designVariants) - }, - .createDesignVariant = function(designMaster, argumentName, argumentValue) { - if (.isTrialDesignGroupSequential(designMaster)) { - defaultValues <- .getDesignGroupSequentialDefaultValues() - } else if (.isTrialDesignInverseNormal(designMaster)) { - defaultValues <- .getDesignInverseNormalDefaultValues() - } else if (.isTrialDesignFisher(designMaster)) { - defaultValues <- .getDesignFisherDefaultValues() - } - - for (userDefinedParamName in designMaster$.getUserDefinedParameters()) { - defaultValues[[userDefinedParamName]] <- designMaster[[userDefinedParamName]] - } - defaultValues[[argumentName]] <- argumentValue - - if (.isTrialDesignGroupSequential(designMaster)) { - result <- getDesignGroupSequential( - kMax = defaultValues$kMax, - alpha = defaultValues$alpha, - beta = defaultValues$beta, - sided = defaultValues$sided, - informationRates = defaultValues$informationRates, - futilityBounds = defaultValues$futilityBounds, - typeOfDesign = defaultValues$typeOfDesign, - deltaWT = defaultValues$deltaWT, - optimizationCriterion = defaultValues$optimizationCriterion, - gammaA = defaultValues$gammaA, - typeBetaSpending = defaultValues$typeBetaSpending, - userAlphaSpending = defaultValues$userAlphaSpending, - userBetaSpending = defaultValues$userBetaSpending, - gammaB = defaultValues$gammaB, - tolerance = defaultValues$tolerance - ) - } else if (.isTrialDesignInverseNormal(designMaster)) { - result <- getDesignInverseNormal( - kMax = defaultValues$kMax, - alpha = defaultValues$alpha, - beta = defaultValues$beta, - sided = defaultValues$sided, - informationRates = defaultValues$informationRates, - futilityBounds = defaultValues$futilityBounds, - typeOfDesign = defaultValues$typeOfDesign, - deltaWT = defaultValues$deltaWT, - optimizationCriterion = defaultValues$optimizationCriterion, - gammaA = defaultValues$gammaA, - typeBetaSpending = defaultValues$typeBetaSpending, - userAlphaSpending = defaultValues$userAlphaSpending, - userBetaSpending = defaultValues$userBetaSpending, - gammaB = defaultValues$gammaB, - tolerance = defaultValues$tolerance - ) - } else if (.isTrialDesignFisher(designMaster)) { - result <- getDesignFisher( - kMax = defaultValues$kMax, - alpha = defaultValues$alpha, - method = defaultValues$method, - userAlphaSpending = defaultValues$userAlphaSpending, - informationRates = defaultValues$informationRates, - alpha0Vec = defaultValues$alpha0Vec, - sided = defaultValues$sided, - tolerance = defaultValues$tolerance, - iterations = defaultValues$iterations, - seed = defaultValues$seed - ) - } - result$.plotSettings <- designMaster$.plotSettings - return(result) - } - ) -) - -#' @title -#' Get Design Set -#' -#' @description -#' Creates a trial design set object and returns it. -#' -#' @param ... \code{designs} or \code{design} and one or more design parameters, e.g., \code{deltaWT = c(0.1, 0.3, 0.4)}. -#' \itemize{ -#' \item \code{design} The master design (optional, you need to specify an -#' additional parameter that shall be varied). -#' \item \code{designs} The designs to compare (optional, you need to specify the variable \code{variedParameters}). -#' } -#' -#' @details -#' Specify a master design and one or more design parameters or a list of designs. -#' -#' @return Returns a \code{\link{TrialDesignSet}} object. -#' The following generics (R generic functions) are available for this result object: -#' \itemize{ -#' \item \code{\link[=names.TrialDesignSet]{names}} to obtain the field names, -#' \item \code{\link[=length.TrialDesignSet]{length}} to obtain the number of design, -#' \item \code{\link[=print.FieldSet]{print()}} to print the object, -#' \item \code{\link[=summary.TrialDesignSet]{summary()}} to display a summary of the object, -#' \item \code{\link[=plot.TrialDesignSet]{plot()}} to plot the object, -#' \item \code{\link[=as.data.frame.TrialDesignSet]{as.data.frame()}} to coerce the object to a \code{\link[base]{data.frame}}, -#' \item \code{\link[=as.matrix.FieldSet]{as.matrix()}} to coerce the object to a \code{\link[base]{matrix}}. -#' } -#' @template how_to_get_help_for_generics -#' -#' @examples -#' # Example 1 -#' design <- getDesignGroupSequential( -#' alpha = 0.05, kMax = 6, -#' sided = 2, typeOfDesign = "WT", deltaWT = 0.1 -#' ) -#' designSet <- getDesignSet() -#' designSet$add(design = design, deltaWT = c(0.3, 0.4)) -#' \dontrun{ -#' if (require(ggplot2)) plot(designSet, type = 1) -#' } -#' -#' # Example 2 (shorter script) -#' design <- getDesignGroupSequential( -#' alpha = 0.05, kMax = 6, -#' sided = 2, typeOfDesign = "WT", deltaWT = 0.1 -#' ) -#' designSet <- getDesignSet(design = design, deltaWT = c(0.3, 0.4)) -#' \dontrun{ -#' if (require(ggplot2)) plot(designSet, type = 1) -#' } -#' -#' # Example 3 (use of designs instead of design) -#' d1 <- getDesignGroupSequential( -#' alpha = 0.05, kMax = 2, -#' sided = 1, beta = 0.2, typeOfDesign = "asHSD", -#' gammaA = 0.5, typeBetaSpending = "bsHSD", gammaB = 0.5 -#' ) -#' d2 <- getDesignGroupSequential( -#' alpha = 0.05, kMax = 4, -#' sided = 1, beta = 0.2, typeOfDesign = "asP", -#' typeBetaSpending = "bsP" -#' ) -#' designSet <- getDesignSet( -#' designs = c(d1, d2), -#' variedParameters = c("typeOfDesign", "kMax") -#' ) -#' \dontrun{ -#' if (require(ggplot2)) plot(designSet, type = 8, nMax = 20) -#' } -#' -#' @export -#' -getDesignSet <- function(...) { - return(TrialDesignSetR6$new(...)) -} - -#' -#' @title -#' Trial Design Set Summary -#' -#' @description -#' Displays a summary of \code{\link{ParameterSet}} object. -#' -#' @param object A \code{\link{ParameterSet}} object. -#' @inheritParams param_digits -#' @inheritParams param_three_dots -#' -#' @details -#' Summarizes the trial designs. -#' -#' @template details_summary -#' -#' @template return_object_summary -#' @template how_to_get_help_for_generics -#' -#' @export -#' -#' @keywords internal -#' -summary.TrialDesignSetR6 <- function(object, ..., type = 1, digits = NA_integer_) { - .warnInCaseOfUnknownArguments(functionName = "summary.TrialDesignSetR6", ...) - - .assertIsTrialDesignSet(object)#TODO - if (object$isEmpty()) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "cannot create summary because the design set is empty") - } - - summaries <- list() - for (design in object$designs) { - s <- .createSummary(design, digits = digits) - summaries <- c(summaries, s) - } - return(summaries) -} - -#' -#' @title -#' Names of a Trial Design Set Object -#' -#' @description -#' Function to get the names of a \code{\link{TrialDesignSet}} object. -#' -#' @param x A \code{\link{TrialDesignSet}} object. -#' -#' @details -#' Returns the names of a design set that can be accessed by the user. -#' -#' @template return_names -#' -#' @examples -#' designSet <- getDesignSet(design = getDesignGroupSequential(), alpha = c(0.01, 0.05)) -#' names(designSet) -#' -#' @export -#' -#' @keywords internal -#' -names.TrialDesignSetR6 <- function(x) { - return(x$.getVisibleFieldNames()) -} - -#' -#' @title -#' Length of Trial Design Set -#' -#' @description -#' Returns the number of designs in a \code{TrialDesignSet}. -#' -#' @param x A \code{\link{TrialDesignSet}} object. -#' -#' @details -#' Is helpful for iteration over all designs in a design set. -#' -#' @return Returns a non-negative \code{\link[base]{integer}} of length 1 -#' representing the number of design in the \code{TrialDesignSet}. -#' -#' @examples -#' designSet <- getDesignSet(design = getDesignGroupSequential(), alpha = c(0.01, 0.05)) -#' length(designSet) -#' -#' @export -#' -#' @keywords internal -#' -length.TrialDesignSetR6 <- function(x) { - return(length(x$designs)) -} - -#' -#' @title -#' Coerce Trial Design Set to a Data Frame -#' -#' @description -#' Returns the \code{TrialDesignSet} as data frame. -#' -#' @param x A \code{\link{TrialDesignSet}} object. -#' @inheritParams param_niceColumnNamesEnabled -#' @inheritParams param_includeAllParameters -#' @param addPowerAndAverageSampleNumber If \code{TRUE}, power and average sample size will -#' be added to data frame, default is \code{FALSE}. -#' @inheritParams param_theta -#' @inheritParams param_nMax -#' @inheritParams param_three_dots -#' -#' @details -#' Coerces the design set to a data frame. -#' -#' @template return_dataframe -#' -#' @examples -#' designSet <- getDesignSet(design = getDesignGroupSequential(), alpha = c(0.01, 0.05)) -#' as.data.frame(designSet) -#' -#' @export -#' -#' @keywords internal -#' -as.data.frame.TrialDesignSetR6 <- function(x, row.names = NULL, - optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, - addPowerAndAverageSampleNumber = FALSE, theta = seq(-1, 1, 0.02), nMax = NA_integer_, ...) { - .assertIsTrialDesignSet(x) - if (x$isEmpty()) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "cannot create data.frame because the design set is empty") - } - - fCall <- match.call(expand.dots = FALSE) - theta <- .assertIsValidThetaRange(thetaRange = theta, thetaAutoSeqEnabled = (as.character(fCall$theta)[1] != "seq")) - - if (addPowerAndAverageSampleNumber) { - .assertAssociatedArgumentsAreDefined( - addPowerAndAverageSampleNumber = addPowerAndAverageSampleNumber, - theta = theta, nMax = nMax - ) - } - - fisherDesignEnabled <- .isTrialDesignFisher(x$getDesignMaster()) - dataFrame <- NULL - for (design in x$designs) { - if (fisherDesignEnabled != .isTrialDesignFisher(design)) { - stop( - C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, "all trial designs must be from the same type ", - "('", .getClassName(x$designs[[1]]), "' != '", .getClassName(design), ")'" - ) - } - - suppressWarnings(df <- as.data.frame(design, - niceColumnNamesEnabled = niceColumnNamesEnabled, - includeAllParameters = includeAllParameters - )) - - if (.isTrialDesignWithValidFutilityBounds(design)) { - futilityBoundsName <- "futilityBounds" - if (niceColumnNamesEnabled) { - futilityBoundsName <- .getTableColumnNames(design = design)[["futilityBounds"]] - } - - kMax <- design$kMax - df[[futilityBoundsName]][kMax] <- design$criticalValues[kMax] - } - if (.isTrialDesignWithValidAlpha0Vec(design)) { - alpha0VecName <- "alpha0Vec" - if (niceColumnNamesEnabled) { - alpha0VecName <- .getTableColumnNames(design = design)[["alpha0Vec"]] - } - - kMax <- design$kMax - df[[alpha0VecName]][kMax] <- design$criticalValues[kMax] - } - - if (addPowerAndAverageSampleNumber) { - results <- PowerAndAverageSampleNumberResultR6$new(design, theta = theta, nMax = nMax) - suppressWarnings(df2 <- as.data.frame(results, - niceColumnNamesEnabled = niceColumnNamesEnabled, - includeAllParameters = includeAllParameters - )) - df <- merge(df, df2, all.y = TRUE) - } - if (is.null(dataFrame)) { - if (niceColumnNamesEnabled) { - dataFrame <- cbind("Design number" = rep(1, nrow(df)), df) - } else { - dataFrame <- cbind(designNumber = rep(1, nrow(df)), df) - } - } else { - if (niceColumnNamesEnabled) { - df <- cbind("Design number" = rep(max(dataFrame$"Design number") + 1, nrow(df)), df) - } else { - df <- cbind(designNumber = rep(max(dataFrame$designNumber) + 1, nrow(df)), df) - } - dataFrame <- rbind(dataFrame, df) - } - } - - return(dataFrame) -} - -#' -#' @title -#' Trial Design Set Plotting -#' -#' @description -#' Plots a trial design set. -#' -#' @param x The trial design set, obtained from \code{\link[=getDesignSet]{getDesignSet()}}. -#' @param y Not available for this kind of plot (is only defined to be compatible to the generic plot function). -#' @param main The main title. -#' @param xlab The x-axis label. -#' @param ylab The y-axis label. -#' @inheritParams param_palette -#' @inheritParams param_theta -#' @inheritParams param_nMax -#' @inheritParams param_plotPointsEnabled -#' @inheritParams param_showSource -#' @inheritParams param_plotSettings -#' @inheritParams param_legendPosition -#' @inheritParams param_grid -#' @param type The plot type (default = \code{1}). The following plot types are available: -#' \itemize{ -#' \item \code{1}: creates a 'Boundaries' plot -#' \item \code{3}: creates a 'Stage Levels' plot -#' \item \code{4}: creates a 'Error Spending' plot -#' \item \code{5}: creates a 'Power and Early Stopping' plot -#' \item \code{6}: creates an 'Average Sample Size and Power / Early Stop' plot -#' \item \code{7}: creates an 'Power' plot -#' \item \code{8}: creates an 'Early Stopping' plot -#' \item \code{9}: creates an 'Average Sample Size' plot -#' \item \code{"all"}: creates all available plots and returns it as a grid plot or list -#' } -#' @inheritParams param_three_dots_plot -#' -#' @details -#' Generic function to plot a trial design set. -#' Is, e.g., useful to compare different designs or design parameters visual. -#' -#' @template return_object_ggplot -#' -#' @examples -#' \dontrun{ -#' design <- getDesignInverseNormal( -#' kMax = 3, alpha = 0.025, -#' typeOfDesign = "asKD", gammaA = 2, -#' informationRates = c(0.2, 0.7, 1), typeBetaSpending = "bsOF" -#' ) -#' -#' # Create a set of designs based on the master design defined above -#' # and varied parameter 'gammaA' -#' designSet <- getDesignSet(design = design, gammaA = 4) -#' -#' if (require(ggplot2)) plot(designSet, type = 1, legendPosition = 6) -#' } -#' -#' @export -#' -plot.TrialDesignSetR6 <- function(x, y, ..., type = 1L, main = NA_character_, - xlab = NA_character_, ylab = NA_character_, palette = "Set1", - theta = seq(-1, 1, 0.02), nMax = NA_integer_, plotPointsEnabled = NA, - legendPosition = NA_integer_, showSource = FALSE, - grid = 1, plotSettings = NULL) { - fCall <- match.call(expand.dots = FALSE) - designSetName <- deparse(fCall$x) - .assertGgplotIsInstalled() - .assertIsSingleInteger(grid, "grid", validateType = FALSE) - typeNumbers <- .getPlotTypeNumber(type, x) - if (is.null(plotSettings)) { - plotSettings <- .getGridPlotSettings(x, typeNumbers, grid) - } - p <- NULL - plotList <- list() - for (typeNumber in typeNumbers) { - p <- .plotTrialDesignSet( - x = x, y = y, type = typeNumber, main = main, - xlab = xlab, ylab = ylab, palette = palette, - theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, - legendPosition = .getGridLegendPosition(legendPosition, typeNumbers, grid), - showSource = showSource, designSetName = designSetName, - plotSettings = plotSettings, ... - ) - .printPlotShowSourceSeparator(showSource, typeNumber, typeNumbers) - if (length(typeNumbers) > 1) { - caption <- .getPlotCaption(x, typeNumber, stopIfNotFound = TRUE) - plotList[[caption]] <- p - } - } - if (length(typeNumbers) == 1) { - return(p) - } - - return(.createPlotResultObject(plotList, grid)) -} - -.plotTrialDesignSet <- function(..., x, y, type = 1L, main = NA_character_, - xlab = NA_character_, ylab = NA_character_, palette = "Set1", - theta = seq(-1, 1, 0.02), nMax = NA_integer_, plotPointsEnabled = NA, - legendPosition = NA_integer_, showSource = FALSE, - designSetName = NA_character_, plotSettings = NULL) { - .assertGgplotIsInstalled() - if (!is.call(main) && !isS4(main)) { - .assertIsSingleCharacter(main, "main", naAllowed = TRUE) - } - .assertIsSingleCharacter(xlab, "xlab", naAllowed = TRUE) - .assertIsSingleCharacter(ylab, "ylab", naAllowed = TRUE) - .assertIsSingleCharacter(palette, "palette", naAllowed = TRUE) - theta <- .assertIsValidThetaRange(thetaRange = theta) - .assertIsSingleNumber(nMax, "nMax", naAllowed = TRUE) - .assertIsInClosedInterval(nMax, "nMax", lower = 1L, upper = 1e10) - .assertIsSingleLogical(plotPointsEnabled, "plotPointsEnabled", naAllowed = TRUE) - .assertIsValidLegendPosition(legendPosition) - .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) - - parameterSet <- x - designMaster <- parameterSet$getDesignMaster() - .assertIsTrialDesign(designMaster) - - if (type == 1) { - main <- if (!is.call(main) && !isS4(main) && is.na(main)) "Boundaries" else main - xParameterName <- "informationRates" - yParameterNames <- "criticalValues" - - if (designMaster$sided == 1 || (.isTrialDesignInverseNormalOrGroupSequential(designMaster) && - (designMaster$typeOfDesign == C_TYPE_OF_DESIGN_PT || grepl("^bs", designMaster$typeBetaSpending)))) { - if (.isTrialDesignWithValidFutilityBounds(designMaster)) { - yParameterNames <- c("futilityBounds", yParameterNames) - } - if (.isTrialDesignWithValidAlpha0Vec(designMaster)) { - yParameterNames <- c("alpha0Vec", yParameterNames) - } - } - } else if (type == 2) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "designs with undefined endpoint do not support plot type 2") - } else if (type == 3) { - main <- if (!is.call(main) && !isS4(main) && is.na(main)) "Stage Levels" else main - xParameterName <- "informationRates" - yParameterNames <- "stageLevels" - } else if (type == 4) { - main <- if (!is.call(main) && !isS4(main) && is.na(main)) "Error Spending" else main - xParameterName <- "informationRates" - yParameterNames <- c("alphaSpent") - if (!.isTrialDesignFisher(designMaster) && - designMaster$typeBetaSpending != C_TYPE_OF_DESIGN_BS_NONE) { - yParameterNames <- c(yParameterNames, "betaSpent") - palette <- "Paired" - } - plotPointsEnabled <- ifelse(is.na(plotPointsEnabled), FALSE, plotPointsEnabled) - } else if (type == 5) { - if (!is.call(main) && !isS4(main) && is.na(main)) { - main <- PlotSubTitleItems(title = "Power and Early Stopping") - main$add("N", nMax, "max") - } - xParameterName <- "theta" - yParameterNames <- c("overallEarlyStop", "calculatedPower") - } else if (type == 6) { - if (!is.call(main) && !isS4(main) && is.na(main)) { - main <- PlotSubTitleItems(title = "Average Sample Size and Power / Early Stop") - main$add("N", nMax, "max") - } - xParameterName <- "theta" - yParameterNames <- c("averageSampleNumber", "overallEarlyStop", "calculatedPower") - } else if (type == 7) { - if (!is.call(main) && !isS4(main) && is.na(main)) { - main <- PlotSubTitleItems(title = "Power") - main$add("N", nMax, "max") - } - xParameterName <- "theta" - yParameterNames <- "calculatedPower" - } else if (type == 8) { - if (!is.call(main) && !isS4(main) && is.na(main)) { - main <- PlotSubTitleItems(title = "Early Stopping") - main$add("N", nMax, "max") - } - xParameterName <- "theta" - yParameterNames <- "overallEarlyStop" - } else if (type == 9) { - if (!is.call(main) && !isS4(main) && is.na(main)) { - main <- PlotSubTitleItems(title = "Average Sample Size") - main$add("N", nMax, "max") - } - xParameterName <- "theta" - yParameterNames <- "averageSampleNumber" - } else { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is not allowed; must be 1, 2, ..., 9") - } - - if (type >= 5 && type <= 9) { - designSetName <- paste0( - "getPowerAndAverageSampleNumber(", designSetName, - ", theta = ", .reconstructSequenceCommand(theta), ", nMax = ", nMax, ")" - ) - } - - xValues <- NA_real_ - if (xParameterName == "theta") { - xValues <- theta - } - srcCmd <- .showPlotSourceInformation( - objectName = designSetName, - xParameterName = xParameterName, - yParameterNames = yParameterNames, - nMax = nMax, - type = type, - showSource = showSource, - xValues = xValues - ) - if (!is.null(srcCmd)) { - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(srcCmd)) - } - return(srcCmd) - } - - p <- .plotParameterSet( - parameterSet = parameterSet, designMaster = designMaster, - xParameterName = xParameterName, - yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, - palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, - legendPosition = legendPosition, plotSettings = plotSettings # , ... - ) - - p <- .addDecistionCriticalValuesToPlot(p = p, designMaster = designMaster, type = type, nMax = nMax) - - return(p) -} - -.addDecistionCriticalValuesToPlot <- function(p, designMaster, type, nMax = NA_integer_) { - if (type != 1 || !.isTrialDesignInverseNormalOrGroupSequential(designMaster)) { - return(p) - } - - data <- as.data.frame(designMaster) - xyNames <- c("delayedInformationRates", "decisionCriticalValues") - if (!all(xyNames %in% colnames(data))) { - return(p) - } - - data <- unique(na.omit(data[, xyNames])) - data$legend <- rep("Decision critical value", nrow(data)) - - if (!is.na(nMax) && nMax > 1) { - data$delayedInformationRates <- data$delayedInformationRates * nMax - tryCatch( - { - data$delayedInformationRates <- as.numeric(.formatSampleSizes(data$delayedInformationRates)) - }, - error = function(e) { - warning("Failed to format delayed information rates on x-axis: ", e$message) - } - ) - } - - plotSettings <- designMaster$.plotSettings - p <- p + ggplot2::geom_point( - data = data, - mapping = ggplot2::aes( - x = .data[["delayedInformationRates"]], - y = .data[["decisionCriticalValues"]], - colour = .data[["legend"]] - ), - size = plotSettings$scaleSize(plotSettings$pointSize, TRUE), - shape = 4, stroke = 1.25, show.legend = FALSE - ) - - for (i in 1:nrow(data)) { - label <- paste0("(", round(data[i, 1], 3), ", ", round(data[i, 2], 3), ")") - p <- p + ggplot2::annotate("text", - x = data[i, 1], y = data[i, 2], - label = label, vjust = plotSettings$scaleSize(3.0), - size = plotSettings$scaleSize(2.5) - ) - } - - try(suppressWarnings(suppressMessages(p <- p + ggplot2::scale_color_manual(values = c("#4daf4a", "#377eb8", "#e41a1c"))))) - return(p) -} diff --git a/R/class_event_probabilities.R b/R/class_event_probabilities.R index fbbac416..83399b60 100644 --- a/R/class_event_probabilities.R +++ b/R/class_event_probabilities.R @@ -56,71 +56,101 @@ #' #' @keywords internal #' -EventProbabilities <- setRefClass("EventProbabilities", - contains = "ParameterSet", - fields = list( - .piecewiseSurvivalTime = "ANY", - .accrualTime = "ANY", - .plotSettings = "ANY", - time = "numeric", - accrualTime = "numeric", - accrualIntensity = "numeric", - kappa = "numeric", - piecewiseSurvivalTime = "numeric", - lambda1 = "numeric", - lambda2 = "numeric", - allocationRatioPlanned = "numeric", - hazardRatio = "numeric", - dropoutRate1 = "numeric", - dropoutRate2 = "numeric", - dropoutTime = "numeric", - maxNumberOfSubjects = "numeric", - overallEventProbabilities = "numeric", # deprecated - cumulativeEventProbabilities = "numeric", - eventProbabilities1 = "numeric", - eventProbabilities2 = "numeric" - ), - methods = list( - initialize = function(...) { - callSuper(...) - .plotSettings <<- PlotSettingsR6$new() - .parameterNames <<- C_PARAMETER_NAMES - .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS - .setParameterType("overallEventProbabilities", C_PARAM_NOT_APPLICABLE) # deprecated +EventProbabilitiesR6 <- R6Class("EventProbabilitiesR6", + inherit = ParameterSetR6, + public = list( + .piecewiseSurvivalTime = NULL, + .accrualTime = NULL, + .plotSettings = NULL, + time = NULL, + accrualTime = NULL, + accrualIntensity = NULL, + kappa = NULL, + piecewiseSurvivalTime = NULL, + lambda1 = NULL, + lambda2 = NULL, + allocationRatioPlanned = NULL, + hazardRatio = NULL, + dropoutRate1 = NULL, + dropoutRate2 = NULL, + dropoutTime = NULL, + maxNumberOfSubjects = NULL, + overallEventProbabilities = NULL, # deprecated + cumulativeEventProbabilities = NULL, + eventProbabilities1 = NULL, + eventProbabilities2 = NULL, + initialize = function(..., .piecewiseSurvivalTime = NULL, + .accrualTime = NULL, + time = NULL, + accrualTime = NULL, + accrualIntensity = NULL, + kappa = NULL, + piecewiseSurvivalTime = NULL, + lambda1 = NULL, + lambda2 = NULL, + allocationRatioPlanned = NULL, + hazardRatio = NULL, + dropoutRate1 = NULL, + dropoutRate2 = NULL, + dropoutTime = NULL, + maxNumberOfSubjects = NULL) { + self$.piecewiseSurvivalTime <- .piecewiseSurvivalTime + self$.accrualTime <- .accrualTime + self$time <- time + self$accrualTime <- accrualTime + self$accrualIntensity <- accrualIntensity + self$kappa <- kappa + self$piecewiseSurvivalTime <- piecewiseSurvivalTime + self$lambda1 <- lambda1 + self$lambda2 <- lambda2 + self$allocationRatioPlanned <- allocationRatioPlanned + self$hazardRatio <- hazardRatio + self$dropoutRate1 <- dropoutRate1 + self$dropoutRate2 <- dropoutRate2 + self$dropoutTime <- dropoutTime + self$maxNumberOfSubjects <- maxNumberOfSubjects + + #TODO callSuper(...) + super$initialize() + + self$.plotSettings <- PlotSettingsR6$new() + self$.parameterNames <- C_PARAMETER_NAMES + self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS + self$.setParameterType("overallEventProbabilities", C_PARAM_NOT_APPLICABLE) # deprecated }, getPlotSettings = function() { - return(.plotSettings) + return(self$.plotSettings) }, show = function(showType = 1, digits = NA_integer_) { - .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) }, .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { "Method for automatically printing event probabilities objects" - .resetCat() + self$.resetCat() if (showType == 2) { - callSuper(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) } else { - .cat("Event probabilities at given time:\n\n", + self$.cat("Event probabilities at given time:\n\n", heading = 1, consoleOutputEnabled = consoleOutputEnabled ) - .showParametersOfOneGroup(.getUserDefinedParameters(), "User defined parameters", + self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled ) - .showParametersOfOneGroup(.getDefaultParameters(), "Default parameters", + self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled ) - .showParametersOfOneGroup(.getGeneratedParameters(), "Time and output", + self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Time and output", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled ) - .showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - .cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) - .cat(" (i): values of treatment arm i\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" (i): values of treatment arm i\n", consoleOutputEnabled = consoleOutputEnabled) - .cat("\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) } } ) @@ -152,54 +182,66 @@ EventProbabilities <- setRefClass("EventProbabilities", #' #' @keywords internal #' -NumberOfSubjects <- setRefClass("NumberOfSubjects", - contains = "ParameterSet", - fields = list( - .accrualTime = "ANY", - .plotSettings = "ANY", - time = "numeric", - accrualTime = "numeric", - accrualIntensity = "numeric", - maxNumberOfSubjects = "numeric", - numberOfSubjects = "numeric" - ), - methods = list( - initialize = function(...) { - callSuper(...) - .plotSettings <<- PlotSettingsR6$new() - .parameterNames <<- C_PARAMETER_NAMES - .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS +NumberOfSubjectsR6 <- R6Class("NumberOfSubjectsR6", + inherit = ParameterSetR6, + public = list( + .accrualTime = NULL, + .plotSettings = NULL, + time = NULL, + accrualTime = NULL, + accrualIntensity = NULL, + maxNumberOfSubjects = NULL, + numberOfSubjects = NULL, + initialize = function(..., accrualSetup = NULL, + time = NULL, + accrualTime = NULL, + accrualIntensity = NULL, + maxNumberOfSubjects = NULL, + numberOfSubjects = NULL) { + self$.accrualTime <- accrualSetup + self$time <- time + self$accrualTime <- accrualTime + self$accrualIntensity <- accrualIntensity + self$maxNumberOfSubjects <- maxNumberOfSubjects + self$numberOfSubjects <- numberOfSubjects + + #TODO callSuper(...) + super$initialize() + + self$.plotSettings <- PlotSettingsR6$new() + self$.parameterNames <- C_PARAMETER_NAMES + self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS }, getPlotSettings = function() { - return(.plotSettings) + return(self$.plotSettings) }, show = function(showType = 1, digits = NA_integer_) { - .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) }, .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { "Method for automatically printing number of subjects objects" - .resetCat() + self$.resetCat() if (showType == 2) { - callSuper(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) } else { - .cat("Number of recruited subjects at given time:\n\n", + self$.cat("Number of recruited subjects at given time:\n\n", heading = 1, consoleOutputEnabled = consoleOutputEnabled ) - .showParametersOfOneGroup(.getUserDefinedParameters(), "User defined parameters", + self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled ) - .showParametersOfOneGroup(.getDefaultParameters(), "Default parameters", + self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled ) - .showParametersOfOneGroup(.getGeneratedParameters(), "Time and output", + self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Time and output", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled ) - .showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - .cat("\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) } } ) @@ -237,7 +279,7 @@ NumberOfSubjects <- setRefClass("NumberOfSubjects", #' #' @export #' -plot.EventProbabilities <- function(x, y, ..., +plot.EventProbabilitiesR6 <- function(x, y, ..., allocationRatioPlanned = x$allocationRatioPlanned, main = NA_character_, xlab = NA_character_, ylab = NA_character_, type = 1L, legendTitle = NA_character_, palette = "Set1", @@ -253,7 +295,7 @@ plot.EventProbabilities <- function(x, y, ..., # .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) numberOfSubjectsObject <- NULL - if (!missing(y) && inherits(y, "NumberOfSubjects")) { + if (!missing(y) && inherits(y, "NumberOfSubjectsR6")) { numberOfSubjectsObject <- y yObjectName <- deparse(fCall$y) } @@ -413,7 +455,7 @@ plot.EventProbabilities <- function(x, y, ..., #' #' @export #' -plot.NumberOfSubjects <- function(x, y, ..., +plot.NumberOfSubjectsR6 <- function(x, y, ..., allocationRatioPlanned = NA_real_, main = NA_character_, xlab = NA_character_, ylab = NA_character_, type = 1L, legendTitle = NA_character_, palette = "Set1", @@ -424,8 +466,8 @@ plot.NumberOfSubjects <- function(x, y, ..., # .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) - if (!missing(y) && inherits(y, "EventProbabilities")) { - return(plot.EventProbabilities( + if (!missing(y) && inherits(y, "EventProbabilitiesR6")) { + return(plot.EventProbabilitiesR6( x = y, y = x, allocationRatioPlanned = ifelse(is.na(allocationRatioPlanned), y$allocationRatioPlanned, allocationRatioPlanned), main = main, xlab = xlab, ylab = ylab, type = type, diff --git a/R/class_event_probabilities_r6.R b/R/class_event_probabilities_r6.R deleted file mode 100644 index 83399b60..00000000 --- a/R/class_event_probabilities_r6.R +++ /dev/null @@ -1,533 +0,0 @@ -## | -## | *Event probabilities classes* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | rpact package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File version: $Revision: 7126 $ -## | Last changed: $Date: 2023-06-23 14:26:39 +0200 (Fr, 23 Jun 2023) $ -## | Last changed by: $Author: pahlke $ -## | - -#' -#' @name EventProbabilities -#' -#' @title -#' Event Probabilities -#' -#' @template field_time -#' @template field_accrualTime -#' @template field_accrualIntensity -#' @template field_kappa -#' @template field_piecewiseSurvivalTime -#' @template field_lambda1 -#' @template field_lambda2 -#' @template field_allocationRatioPlanned -#' @template field_hazardRatio -#' @template field_dropoutRate1 -#' @template field_dropoutRate2 -#' @template field_dropoutTime -#' @template field_maxNumberOfSubjects -#' @template field_overallEventProbabilities -#' @template field_cumulativeEventProbabilities -#' @template field_eventProbabilities1 -#' @template field_eventProbabilities2 -#' -#' @description -#' Class for the definition of event probabilities. -#' -#' @details -#' \code{EventProbabilities} is a class for the definition of event probabilities. -#' -#' @importFrom methods new -#' -#' @include f_core_constants.R -#' @include class_core_parameter_set.R -#' @include class_time.R -#' -#' @keywords internal -#' -EventProbabilitiesR6 <- R6Class("EventProbabilitiesR6", - inherit = ParameterSetR6, - public = list( - .piecewiseSurvivalTime = NULL, - .accrualTime = NULL, - .plotSettings = NULL, - time = NULL, - accrualTime = NULL, - accrualIntensity = NULL, - kappa = NULL, - piecewiseSurvivalTime = NULL, - lambda1 = NULL, - lambda2 = NULL, - allocationRatioPlanned = NULL, - hazardRatio = NULL, - dropoutRate1 = NULL, - dropoutRate2 = NULL, - dropoutTime = NULL, - maxNumberOfSubjects = NULL, - overallEventProbabilities = NULL, # deprecated - cumulativeEventProbabilities = NULL, - eventProbabilities1 = NULL, - eventProbabilities2 = NULL, - initialize = function(..., .piecewiseSurvivalTime = NULL, - .accrualTime = NULL, - time = NULL, - accrualTime = NULL, - accrualIntensity = NULL, - kappa = NULL, - piecewiseSurvivalTime = NULL, - lambda1 = NULL, - lambda2 = NULL, - allocationRatioPlanned = NULL, - hazardRatio = NULL, - dropoutRate1 = NULL, - dropoutRate2 = NULL, - dropoutTime = NULL, - maxNumberOfSubjects = NULL) { - self$.piecewiseSurvivalTime <- .piecewiseSurvivalTime - self$.accrualTime <- .accrualTime - self$time <- time - self$accrualTime <- accrualTime - self$accrualIntensity <- accrualIntensity - self$kappa <- kappa - self$piecewiseSurvivalTime <- piecewiseSurvivalTime - self$lambda1 <- lambda1 - self$lambda2 <- lambda2 - self$allocationRatioPlanned <- allocationRatioPlanned - self$hazardRatio <- hazardRatio - self$dropoutRate1 <- dropoutRate1 - self$dropoutRate2 <- dropoutRate2 - self$dropoutTime <- dropoutTime - self$maxNumberOfSubjects <- maxNumberOfSubjects - - #TODO callSuper(...) - super$initialize() - - self$.plotSettings <- PlotSettingsR6$new() - self$.parameterNames <- C_PARAMETER_NAMES - self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS - self$.setParameterType("overallEventProbabilities", C_PARAM_NOT_APPLICABLE) # deprecated - }, - getPlotSettings = function() { - return(self$.plotSettings) - }, - show = function(showType = 1, digits = NA_integer_) { - self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) - }, - .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { - "Method for automatically printing event probabilities objects" - self$.resetCat() - if (showType == 2) { - super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) - } else { - self$.cat("Event probabilities at given time:\n\n", - heading = 1, - consoleOutputEnabled = consoleOutputEnabled - ) - - self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Time and output", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - - self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - - self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) - self$.cat(" (i): values of treatment arm i\n", consoleOutputEnabled = consoleOutputEnabled) - - self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) - } - } - ) -) - -#' -#' @name NumberOfSubjects -#' -#' @title -#' Number Of Subjects -#' -#' @description -#' Class for the definition of number of subjects results. -#' -#' @template field_time -#' @template field_accrualTime -#' @template field_accrualIntensity -#' @template field_maxNumberOfSubjects -#' @template field_numberOfSubjects -#' -#' @details -#' \code{NumberOfSubjects} is a class for the definition of number of subjects results. -#' -#' @importFrom methods new -#' -#' @include f_core_constants.R -#' @include class_core_parameter_set.R -#' @include class_time.R -#' -#' @keywords internal -#' -NumberOfSubjectsR6 <- R6Class("NumberOfSubjectsR6", - inherit = ParameterSetR6, - public = list( - .accrualTime = NULL, - .plotSettings = NULL, - time = NULL, - accrualTime = NULL, - accrualIntensity = NULL, - maxNumberOfSubjects = NULL, - numberOfSubjects = NULL, - initialize = function(..., accrualSetup = NULL, - time = NULL, - accrualTime = NULL, - accrualIntensity = NULL, - maxNumberOfSubjects = NULL, - numberOfSubjects = NULL) { - self$.accrualTime <- accrualSetup - self$time <- time - self$accrualTime <- accrualTime - self$accrualIntensity <- accrualIntensity - self$maxNumberOfSubjects <- maxNumberOfSubjects - self$numberOfSubjects <- numberOfSubjects - - #TODO callSuper(...) - super$initialize() - - self$.plotSettings <- PlotSettingsR6$new() - self$.parameterNames <- C_PARAMETER_NAMES - self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS - }, - getPlotSettings = function() { - return(self$.plotSettings) - }, - show = function(showType = 1, digits = NA_integer_) { - self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) - }, - .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { - "Method for automatically printing number of subjects objects" - self$.resetCat() - if (showType == 2) { - super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) - } else { - self$.cat("Number of recruited subjects at given time:\n\n", - heading = 1, - consoleOutputEnabled = consoleOutputEnabled - ) - - self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Time and output", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - - self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - - self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) - } - } - ) -) - -#' -#' @title -#' Event Probabilities Plotting -#' -#' @description -#' Plots an object that inherits from class \code{\link{EventProbabilities}}. -#' -#' @details -#' Generic function to plot an event probabilities object. -#' -#' @param x The object that inherits from \code{\link{EventProbabilities}}. -#' @param y An optional object that inherits from \code{\link{NumberOfSubjects}}. -#' @inheritParams param_allocationRatioPlanned -#' @param main The main title. -#' @param xlab The x-axis label. -#' @param ylab The y-axis label. -#' @param type The plot type (default = 1). Note that at the moment only one type is available. -#' @param legendTitle The legend title, default is \code{""}. -#' @inheritParams param_palette -#' @inheritParams param_plotPointsEnabled -#' @inheritParams param_showSource -#' @inheritParams param_plotSettings -#' @inheritParams param_legendPosition -#' @inheritParams param_three_dots_plot -#' -#' @details -#' Generic function to plot a parameter set. -#' -#' @template return_object_ggplot -#' -#' @export -#' -plot.EventProbabilitiesR6 <- function(x, y, ..., - allocationRatioPlanned = x$allocationRatioPlanned, - main = NA_character_, xlab = NA_character_, ylab = NA_character_, type = 1L, - legendTitle = NA_character_, palette = "Set1", - plotPointsEnabled = NA, legendPosition = NA_integer_, showSource = FALSE, - plotSettings = NULL) { - fCall <- match.call(expand.dots = FALSE) - xObjectName <- deparse(fCall$x) - yObjectName <- NA_character_ - - .assertGgplotIsInstalled() - .assertIsValidLegendPosition(legendPosition) - .assertIsValidAllocationRatioPlanned(allocationRatioPlanned, 2L) - # .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) - - numberOfSubjectsObject <- NULL - if (!missing(y) && inherits(y, "NumberOfSubjectsR6")) { - numberOfSubjectsObject <- y - yObjectName <- deparse(fCall$y) - } - - maxNumberOfSubjects <- 1 - maxNumberOfSubjects1 <- 1 - maxNumberOfSubjects2 <- 1 - - maxNumberOfSubjectsToUse <- NA_integer_ - if (!is.null(numberOfSubjectsObject)) { - maxNumberOfSubjectsToUse <- numberOfSubjectsObject$maxNumberOfSubjects - } - - if (is.na(maxNumberOfSubjectsToUse)) { - maxNumberOfSubjectsToUse <- x$maxNumberOfSubjects - } else if (!is.na(x$maxNumberOfSubjects) && x$maxNumberOfSubjects != maxNumberOfSubjectsToUse) { - stop("'x' (EventProbabilities) and 'y' (NumberOfSubjects) must have the same 'maxNumberOfSubjects' defined") - } - - if (!is.na(maxNumberOfSubjectsToUse)) { - maxNumberOfSubjects <- maxNumberOfSubjectsToUse - maxNumberOfSubjects1 <- .getNumberOfSubjects1(maxNumberOfSubjects, allocationRatioPlanned) - maxNumberOfSubjects2 <- .getNumberOfSubjects2(maxNumberOfSubjects, allocationRatioPlanned) - } - - if (is.na(maxNumberOfSubjectsToUse)) { - mainDefault <- "Event Probabilities" - } else { - mainDefault <- ifelse(!is.null(numberOfSubjectsObject), - "Number of subjects and expected number of events", - "Expected number of events" - ) - } - main <- ifelse(is.na(main), mainDefault, main) - if (!is.null(numberOfSubjectsObject)) { - ylabDefault <- "Number of subjects/events" - } else { - ylabDefault <- ifelse(is.na(maxNumberOfSubjectsToUse), - "Event probabilities", "Expected number of events" - ) - } - ylab <- ifelse(is.na(ylab), ylabDefault, ylab) - data <- data.frame( - xValues = c(x$time, x$time, x$time), - yValues = c( - x$cumulativeEventProbabilities * maxNumberOfSubjects, # cumulative - x$eventProbabilities1 * maxNumberOfSubjects1, # treatment - x$eventProbabilities2 * maxNumberOfSubjects2 # control - ), - categories = c( - rep("Overall", length(x$time)), - rep("Treatment", length(x$time)), - rep("Control", length(x$time)) - ) - ) - data$categories <- factor(data$categories, levels = c("Overall", "Treatment", "Control")) - - if (!is.null(numberOfSubjectsObject)) { - data <- rbind( - data, - data.frame( - xValues = numberOfSubjectsObject$time, - yValues = numberOfSubjectsObject$numberOfSubjects, - categories = "Number of subjects" - ) - ) - } - - if (is.na(legendPosition)) { - legendPosition <- C_POSITION_LEFT_TOP - } - if (is.na(legendTitle)) { - legendTitle <- "" - } - - srcCmd <- .showPlotSourceInformation( - objectName = xObjectName, - xParameterName = "time", - yParameterNames = c("cumulativeEventProbabilities", "eventProbabilities1", "eventProbabilities2"), - type = type, - showSource = showSource - ) - if (!is.na(yObjectName)) { - srcCmd2 <- .showPlotSourceInformation( - objectName = yObjectName, - xParameterName = "time", - yParameterNames = "numberOfSubjects", - type = type, - showSource = showSource - ) - if (is.list(srcCmd)) { - if (!is.null(srcCmd2[["y"]])) { - if (identical(x[["time"]], y[["time"]])) { - srcCmd$y <- c(srcCmd$y, srcCmd2$y) - } else { - srcCmd$x2 <- srcCmd2[["x"]] - srcCmd$y2 <- srcCmd2$y - } - } - } else { - srcCmd <- c(srcCmd, srcCmd2) - } - } - if (!is.null(srcCmd)) { - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(srcCmd)) - } - return(srcCmd) - } - - if (is.null(plotSettings)) { - plotSettings <- x$.plotSettings - } - - return(.plotDataFrame(data, - mainTitle = main, - xlab = xlab, ylab = ylab, xAxisLabel = "Time", - yAxisLabel1 = NA_character_, yAxisLabel2 = NA_character_, - palette = palette, plotPointsEnabled = plotPointsEnabled, - legendTitle = legendTitle, - legendPosition = legendPosition, scalingFactor1 = 1, scalingFactor2 = 1, - addPowerAndAverageSampleNumber = FALSE, mirrorModeEnabled = FALSE, - ratioEnabled = FALSE, plotSettings = plotSettings, sided = 1, ... - )) -} - -#' -#' @title -#' Number Of Subjects Plotting -#' -#' @description -#' Plots an object that inherits from class \code{\link{NumberOfSubjects}}. -#' -#' @details -#' Generic function to plot an "number of subjects" object. -#' -#' @param x The object that inherits from \code{\link{NumberOfSubjects}}. -#' @param y An optional object that inherits from \code{\link{EventProbabilities}}. -#' @param allocationRatioPlanned The planned allocation ratio \code{n1 / n2} for a two treatment groups -#' design, default is \code{1}. Will be ignored if \code{y} is undefined. -#' @param main The main title. -#' @param xlab The x-axis label. -#' @param ylab The y-axis label. -#' @param type The plot type (default = 1). Note that at the moment only one type is available. -#' @param legendTitle The legend title, default is \code{""}. -#' @inheritParams param_palette -#' @inheritParams param_plotPointsEnabled -#' @inheritParams param_showSource -#' @inheritParams param_plotSettings -#' @inheritParams param_legendPosition -#' @inheritParams param_three_dots_plot -#' -#' @details -#' Generic function to plot a parameter set. -#' -#' @template return_object_ggplot -#' -#' @export -#' -plot.NumberOfSubjectsR6 <- function(x, y, ..., - allocationRatioPlanned = NA_real_, - main = NA_character_, xlab = NA_character_, ylab = NA_character_, type = 1L, - legendTitle = NA_character_, palette = "Set1", - plotPointsEnabled = NA, legendPosition = NA_integer_, showSource = FALSE, - plotSettings = NULL) { - fCall <- match.call(expand.dots = FALSE) - objectName <- deparse(fCall$x) - - # .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) - - if (!missing(y) && inherits(y, "EventProbabilitiesR6")) { - return(plot.EventProbabilitiesR6( - x = y, y = x, - allocationRatioPlanned = ifelse(is.na(allocationRatioPlanned), y$allocationRatioPlanned, allocationRatioPlanned), - main = main, xlab = xlab, ylab = ylab, type = type, - legendTitle = legendTitle, palette = palette, - plotPointsEnabled = plotPointsEnabled, legendPosition = legendPosition, - showSource = showSource, plotSettings = plotSettings, ... - )) - } - - if (!is.na(allocationRatioPlanned)) { - warning("'allocationRatioPlanned' (", allocationRatioPlanned, - ") will be ignored because 'y' is undefined (for more information see ?plot.NumberOfSubjects)", - call. = FALSE - ) - } - - .assertGgplotIsInstalled() - .assertIsValidLegendPosition(legendPosition) - - main <- ifelse(is.na(main), "Number of Subjects", main) - ylab <- ifelse(is.na(ylab), "Number of subjects", ylab) - data <- data.frame( - xValues = x$time, - yValues = x$numberOfSubjects, - categories = "Number of subjects" - ) - - if (is.na(legendPosition)) { - legendPosition <- -1 - } - if (is.na(legendTitle)) { - legendTitle <- "" - } - - srcCmd <- .showPlotSourceInformation( - objectName = objectName, - xParameterName = "time", - yParameterNames = "numberOfSubjects", - type = type, - showSource = showSource - ) - if (!is.null(srcCmd)) { - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(srcCmd)) - } - return(srcCmd) - } - - if (is.null(plotSettings)) { - plotSettings <- x$.plotSettings - } - - return(.plotDataFrame(data, - mainTitle = main, - xlab = xlab, ylab = ylab, xAxisLabel = "Time", - yAxisLabel1 = NA_character_, yAxisLabel2 = NA_character_, - palette = palette, plotPointsEnabled = plotPointsEnabled, - legendTitle = legendTitle, - legendPosition = legendPosition, scalingFactor1 = 1, scalingFactor2 = 1, - addPowerAndAverageSampleNumber = FALSE, mirrorModeEnabled = FALSE, - ratioEnabled = FALSE, plotSettings = plotSettings, sided = 1, ... - )) -} diff --git a/R/class_performance_score.R b/R/class_performance_score.R index 140ea3d2..6430692b 100644 --- a/R/class_performance_score.R +++ b/R/class_performance_score.R @@ -41,43 +41,41 @@ #' #' @importFrom methods new #' -PerformanceScore <- setRefClass("PerformanceScore", - contains = "ParameterSet", - fields = list( - .simulationResults = "ANY", - .plotSettings = "ANY", - .alternative = "numeric", - locationSampleSize = "numeric", - variationSampleSize = "numeric", - subscoreSampleSize = "numeric", - locationConditionalPower = "numeric", - variationConditionalPower = "numeric", - subscoreConditionalPower = "numeric", - performanceScore = "numeric" - ), - methods = list( +PerformanceScoreR6 <- R6Class("PerformanceScoreR6", + inherit = ParameterSetR6, + public = list( + .simulationResults = NULL, + .plotSettings = NULL, + .alternative = NULL, + locationSampleSize = NULL, + variationSampleSize = NULL, + subscoreSampleSize = NULL, + locationConditionalPower = NULL, + variationConditionalPower = NULL, + subscoreConditionalPower = NULL, + performanceScore = NULL, initialize = function(simulationResults, ...) { - callSuper(.simulationResults = simulationResults, ...) - - .plotSettings <<- PlotSettingsR6$new() - .parameterNames <<- C_PARAMETER_NAMES - .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS + super$initialize(...) + self$.simulationResults <- simulationResults + self$.plotSettings <- PlotSettingsR6$new() + self$.parameterNames <- C_PARAMETER_NAMES + self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS }, .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { "Method for automatically printing performance score objects" - .resetCat() - if (!is.null(.simulationResults)) { - .simulationResults$.show( + self$.resetCat() + if (!is.null(self$.simulationResults)) { + self$.simulationResults$.show( showType = showType, digits = digits, showStatistics = FALSE, consoleOutputEnabled = consoleOutputEnabled, - performanceScore = .self + performanceScore = self ) } }, show = function(showType = 1, digits = NA_integer_) { - .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) } ) ) diff --git a/R/class_performance_score_r6.R b/R/class_performance_score_r6.R deleted file mode 100644 index 6430692b..00000000 --- a/R/class_performance_score_r6.R +++ /dev/null @@ -1,81 +0,0 @@ -## | -## | *Performance score classes* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | rpact package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File version: $Revision: 7148 $ -## | Last changed: $Date: 2023-07-03 15:50:22 +0200 (Mo, 03 Jul 2023) $ -## | Last changed by: $Author: pahlke $ -## | - -#' -#' @name PerformanceScore -#' -#' @title -#' Performance Score -#' -#' @description -#' Contains the conditional performance score, its sub-scores and components according to -#' Herrmann et al. (2020) for a given simulation result. -#' -#' @details -#' Use \link{getPerformanceScore} to calculate the performance score. -#' -#' @include f_core_constants.R -#' @include f_core_assertions.R -#' @include f_core_plot.R -#' @include class_core_parameter_set.R -#' @include class_simulation_results.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -PerformanceScoreR6 <- R6Class("PerformanceScoreR6", - inherit = ParameterSetR6, - public = list( - .simulationResults = NULL, - .plotSettings = NULL, - .alternative = NULL, - locationSampleSize = NULL, - variationSampleSize = NULL, - subscoreSampleSize = NULL, - locationConditionalPower = NULL, - variationConditionalPower = NULL, - subscoreConditionalPower = NULL, - performanceScore = NULL, - initialize = function(simulationResults, ...) { - super$initialize(...) - self$.simulationResults <- simulationResults - self$.plotSettings <- PlotSettingsR6$new() - self$.parameterNames <- C_PARAMETER_NAMES - self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS - }, - .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { - "Method for automatically printing performance score objects" - self$.resetCat() - if (!is.null(self$.simulationResults)) { - self$.simulationResults$.show( - showType = showType, - digits = digits, - showStatistics = FALSE, - consoleOutputEnabled = consoleOutputEnabled, - performanceScore = self - ) - } - }, - show = function(showType = 1, digits = NA_integer_) { - self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) - } - ) -) diff --git a/R/class_simulation_results.R b/R/class_simulation_results.R index 234bd116..0bc177df 100644 --- a/R/class_simulation_results.R +++ b/R/class_simulation_results.R @@ -39,9 +39,9 @@ NULL #' #' @keywords internal #' -names.SimulationResults <- function(x) { +names.SimulationResultsR6 <- function(x) { namesToShow <- c(".design", ".data", ".rawData") - if (inherits(x, "SimulationResultsSurvival")) { + if (inherits(x, "SimulationResultsSurvival") || inherits(x, "SimulationResultsSurvivalR6")) { namesToShow <- c(namesToShow, ".piecewiseSurvivalTime", ".accrualTime") } namesToShow <- c(namesToShow, x$.getVisibleFieldNames()) @@ -86,39 +86,39 @@ names.SimulationResults <- function(x) { #' #' @importFrom methods new #' -SimulationResults <- setRefClass("SimulationResults", - contains = "ParameterSet", - fields = list( - .plotSettings = "ANY", - .design = "ANY", - .data = "data.frame", - .rawData = "data.frame", - .showStatistics = "logical", - maxNumberOfIterations = "integer", - seed = "numeric", - allocationRatioPlanned = "numeric", - conditionalPower = "numeric", - iterations = "matrix", - futilityPerStage = "matrix", - futilityStop = "numeric" - ), - methods = list( +SimulationResultsR6 <- R6Class("SimulationResultsR6", + inherit = ParameterSetR6, + public = list( + .plotSettings = NULL, + .design = NULL, + .data = NULL, + .rawData = NULL, + .showStatistics = NULL, + maxNumberOfIterations = NULL, + seed = NULL, + allocationRatioPlanned = NULL, + conditionalPower = NULL, + iterations = NULL, + futilityPerStage = NULL, + futilityStop = NULL, initialize = function(design, ..., showStatistics = FALSE) { - callSuper(.design = design, .showStatistics = showStatistics, ...) + super$initialize(...) + self$.design <- design + self$.showStatistics <- showStatistics - .plotSettings <<- PlotSettingsR6$new() - .parameterNames <<- .getParameterNames(design = design, designPlan = .self) - .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS + self$.plotSettings <- PlotSettingsR6$new() + self$.parameterNames <- .getParameterNames(design = design, designPlan = self) + self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS }, getPlotSettings = function() { - return(.plotSettings) + return(self$.plotSettings) }, setShowStatistics = function(showStatistics) { .assertIsSingleLogical(showStatistics, "showStatistics") - .showStatistics <<- showStatistics + self$.showStatistics <- showStatistics }, show = function(showType = 1, digits = NA_integer_, showStatistics = FALSE) { - .show( + self$.show( showType = showType, digits = digits, showStatistics = showStatistics, consoleOutputEnabled = TRUE ) @@ -127,14 +127,14 @@ SimulationResults <- setRefClass("SimulationResults", showStatistics = FALSE, consoleOutputEnabled = TRUE, performanceScore = NULL) { "Method for automatically printing simulation result objects" - .resetCat() + self$.resetCat() if (showType == 3) { - .createSummary(.self, digits = digits)$.show( + .createSummary(self, digits = digits)$.show( showType = 1, digits = digits, consoleOutputEnabled = consoleOutputEnabled ) } else if (showType == 2) { - callSuper(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) } else { if (is.null(showStatistics) || length(showStatistics) != 1) { stop( @@ -145,59 +145,59 @@ SimulationResults <- setRefClass("SimulationResults", } if (!is.character(showStatistics) || showStatistics != "exclusive") { - .cat(.toString(startWithUpperCase = TRUE), ":\n\n", + self$.cat(self$.toString(startWithUpperCase = TRUE), ":\n\n", heading = 1, consoleOutputEnabled = consoleOutputEnabled ) - .showParametersOfOneGroup(.getDesignParametersToShow(.self), "Design parameters", + self$.showParametersOfOneGroup(.getDesignParametersToShow(self), "Design parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled ) - userDefinedParameters <- .getUserDefinedParameters() - if (inherits(.self, "SimulationResultsSurvival") && - .self$.piecewiseSurvivalTime$delayedResponseEnabled) { + userDefinedParameters <- self$.getUserDefinedParameters() + if ((inherits(self, "SimulationResultsSurvival") || inherits(self, "SimulationResultsSurvivalR6")) && + self$.piecewiseSurvivalTime$delayedResponseEnabled) { userDefinedParameters <- c( userDefinedParameters, ".piecewiseSurvivalTime$delayedResponseEnabled" ) } - .showParametersOfOneGroup(userDefinedParameters, "User defined parameters", + self$.showParametersOfOneGroup(userDefinedParameters, "User defined parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled ) - derivedParameters <- .getDerivedParameters() + derivedParameters <- self$.getDerivedParameters() if (length(derivedParameters) > 0) { - .showParametersOfOneGroup(derivedParameters, "Derived from user defined parameters", + self$.showParametersOfOneGroup(derivedParameters, "Derived from user defined parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled ) } - .showParametersOfOneGroup(.getDefaultParameters(), "Default parameters", + self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled ) - .showParametersOfOneGroup(.getGeneratedParameters(), "Results", + self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Results", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled ) - .showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) } ## statistics of simulated data - if (isTRUE(showStatistics) || .showStatistics || + if (isTRUE(showStatistics) || self$.showStatistics || (is.character(showStatistics) && showStatistics == "exclusive")) { - .cat("Simulated data:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) + self$.cat("Simulated data:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) params <- c() - if (inherits(.self, "SimulationResultsMeans")) { + if (inherits(self, "SimulationResultsMeans") || inherits(self, "SimulationResultsMeansR6")) { params <- c( "effectMeasure", "numberOfSubjects", "testStatistic" ) - } else if (inherits(.self, "SimulationResultsRates")) { + } else if (inherits(self, "SimulationResultsRates") || inherits(self, "SimulationResultsRatesR6")) { params <- c( "effectMeasure", "numberOfSubjects", "testStatistic" ) - } else if (inherits(.self, "SimulationResultsSurvival")) { + } else if (inherits(self, "SimulationResultsSurvival") || inherits(self, "SimulationResultsSurvivalR6")) { params <- c( "effectMeasure", "analysisTime", @@ -209,8 +209,8 @@ SimulationResults <- setRefClass("SimulationResults", "logRankStatistic", "hazardRatioEstimateLR" ) - } else if (inherits(.self, "SimulationResultsMultiArmMeans") || - inherits(.self, "SimulationResultsMultiArmRates")) { + } else if (inherits(self, "SimulationResultsMultiArmMeans") || inherits(self, "SimulationResultsMultiArmMeansR6") || + inherits(self, "SimulationResultsMultiArmRates") || inherits(self, "SimulationResultsMultiArmRatesR6")) { params <- c( "effectMeasure", "subjectsActiveArm", @@ -220,8 +220,8 @@ SimulationResults <- setRefClass("SimulationResults", "successStop", "futilityPerStage" ) - } else if (inherits(.self, "SimulationResultsEnrichmentMeans") || - inherits(.self, "SimulationResultsEnrichmentRates")) { + } else if (inherits(self, "SimulationResultsEnrichmentMeans") || inherits(self, "SimulationResultsEnrichmentMeansR6") || + inherits(self, "SimulationResultsEnrichmentRates") || inherits(self, "SimulationResultsEnrichmentRatesR6")) { params <- c( "effectMeasure", "subjectsPopulation", @@ -231,8 +231,8 @@ SimulationResults <- setRefClass("SimulationResults", "successStop", "futilityPerStage" ) - } else if (inherits(.self, "SimulationResultsMultiArmSurvival") || - inherits(.self, "SimulationResultsEnrichmentSurvival")) { + } else if (inherits(self, "SimulationResultsMultiArmSurvival") || inherits(self, "SimulationResultsMultiArmSurvivalR6") || + inherits(self, "SimulationResultsEnrichmentSurvival") || inherits(self, "SimulationResultsEnrichmentSurvivalR6")) { params <- c( "effectMeasure", "numberOfEvents", @@ -245,22 +245,22 @@ SimulationResults <- setRefClass("SimulationResults", ) } - if (!is.null(.self[["conditionalPowerAchieved"]]) && - !all(is.na(conditionalPowerAchieved)) && - any(!is.na(conditionalPowerAchieved)) && - any(na.omit(conditionalPowerAchieved) != 0)) { + if (!is.null(self[["conditionalPowerAchieved"]]) && + !all(is.na(self$conditionalPowerAchieved)) && + any(!is.na(self$conditionalPowerAchieved)) && + any(na.omit(self$conditionalPowerAchieved) != 0)) { params <- c(params, "conditionalPowerAchieved") } - stages <- sort(unique(.self$.data$stageNumber)) + stages <- sort(unique(self$.data$stageNumber)) - variedParameterName1 <- .getVariedParameterName(1) - variedParameterName2 <- .getVariedParameterName(2) - parameterValues1 <- .getVariedParameterValues(variedParameterName1) - parameterValues2 <- .getVariedParameterValues(variedParameterName2) + variedParameterName1 <- self$.getVariedParameterName(1) + variedParameterName2 <- self$.getVariedParameterName(2) + parameterValues1 <- self$.getVariedParameterValues(variedParameterName1) + parameterValues2 <- self$.getVariedParameterValues(variedParameterName2) for (parameterName in params) { - paramCaption <- .parameterNames[[parameterName]] + paramCaption <- self$.parameterNames[[parameterName]] if (is.null(paramCaption)) { paramCaption <- paste0("%", parameterName, "%") } @@ -269,7 +269,7 @@ SimulationResults <- setRefClass("SimulationResults", for (parameterValue2 in parameterValues2) { for (stage in stages) { if (length(parameterValues1) > 1) { - .catStatisticsLine( + self$.catStatisticsLine( stage = stage, parameterName = parameterName, paramCaption = paramCaption, @@ -280,7 +280,7 @@ SimulationResults <- setRefClass("SimulationResults", consoleOutputEnabled = consoleOutputEnabled ) } else { - .catStatisticsLine( + self$.catStatisticsLine( stage = stage, parameterName = parameterName, paramCaption = paramCaption, @@ -293,7 +293,7 @@ SimulationResults <- setRefClass("SimulationResults", } if (parameterName == "subjectsActiveArm" && variedParameterName2 == "armNumber") { parameterName2 <- "subjectsControlArm" - paramCaption2 <- .parameterNames[[parameterName2]] + paramCaption2 <- self$.parameterNames[[parameterName2]] if (is.null(paramCaption2)) { paramCaption2 <- paste0("%", parameterName2, "%") } @@ -312,12 +312,12 @@ SimulationResults <- setRefClass("SimulationResults", } } } - .cat("\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) } - twoGroupsEnabled <- !inherits(.self, "SimulationResultsMeans") - multiArmSurvivalEnabled <- inherits(.self, "SimulationResultsMultiArmSurvival") - enrichmentEnabled <- grepl("SimulationResultsEnrichment", .getClassName(.self)) + twoGroupsEnabled <- !(inherits(self, "SimulationResultsMeans") || inherits(self, "SimulationResultsMeansR6")) + multiArmSurvivalEnabled <- inherits(self, "SimulationResultsMultiArmSurvival") || inherits(self, "SimulationResultsMultiArmSurvivalR6") + enrichmentEnabled <- grepl("SimulationResultsEnrichment", .getClassName(self)) if (!is.null(performanceScore)) { performanceScore$.showParametersOfOneGroup( @@ -327,60 +327,60 @@ SimulationResults <- setRefClass("SimulationResults", performanceScore$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) } - if (.design$kMax > 1 || twoGroupsEnabled || multiArmSurvivalEnabled) { - .cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) + if (self$.design$kMax > 1 || twoGroupsEnabled || multiArmSurvivalEnabled) { + self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) if (multiArmSurvivalEnabled) { - .cat(" (i): values of treatment arm i compared to control\n", consoleOutputEnabled = consoleOutputEnabled) - .cat(" {j}: values of treatment arm j\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" (i): values of treatment arm i compared to control\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" {j}: values of treatment arm j\n", consoleOutputEnabled = consoleOutputEnabled) } else if (enrichmentEnabled) { - matrixName <- .getSimulationEnrichmentEffectMatrixName(.self) - if (nrow(.self$effectList[[matrixName]]) > 1) { - .cat(" (i): results of situation i\n", consoleOutputEnabled = consoleOutputEnabled) + matrixName <- .getSimulationEnrichmentEffectMatrixName(self) + if (nrow(self$effectList[[matrixName]]) > 1) { + self$.cat(" (i): results of situation i\n", consoleOutputEnabled = consoleOutputEnabled) } } else if (twoGroupsEnabled) { - .cat(" (i): values of treatment arm i\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" (i): values of treatment arm i\n", consoleOutputEnabled = consoleOutputEnabled) } - if (.design$kMax > 1) { - .cat(" [k]: values at stage k\n", consoleOutputEnabled = consoleOutputEnabled) + if (self$.design$kMax > 1) { + self$.cat(" [k]: values at stage k\n", consoleOutputEnabled = consoleOutputEnabled) } if (enrichmentEnabled) { - if (length(.self$effectList$subGroups) > 1) { - .cat(paste0(" S[i]: population i\n"), consoleOutputEnabled = consoleOutputEnabled) + if (length(self$effectList$subGroups) > 1) { + self$.cat(paste0(" S[i]: population i\n"), consoleOutputEnabled = consoleOutputEnabled) } - .cat(paste0(" F: full population\n"), consoleOutputEnabled = consoleOutputEnabled) - if (length(.self$effectList$subGroups) > 1) { - .cat(paste0(" R: remaining population\n"), consoleOutputEnabled = consoleOutputEnabled) + self$.cat(paste0(" F: full population\n"), consoleOutputEnabled = consoleOutputEnabled) + if (length(self$effectList$subGroups) > 1) { + self$.cat(paste0(" R: remaining population\n"), consoleOutputEnabled = consoleOutputEnabled) } } - .cat("\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) } } }, .getVariedParameterName = function(number = 1) { if (number == 2) { - if (!inherits(.self, "SimulationResultsMeans") && - !inherits(.self, "SimulationResultsRates") && - !inherits(.self, "SimulationResultsSurvival") && - grepl("MultiArm", .getClassName(.self))) { + if (!(inherits(self, "SimulationResultsMeans") || inherits(self, "SimulationResultsMeansR6")) && + !(inherits(self, "SimulationResultsRates") || inherits(self, "SimulationResultsRatesR6")) && + !(inherits(self, "SimulationResultsSurvival") || inherits(self, "SimulationResultsSurvivalR6")) && + grepl("MultiArm", .getClassName(self))) { return("armNumber") } return(NA_character_) } variedParameterName1 <- NA_character_ - if (inherits(.self, "SimulationResultsMeans")) { + if (inherits(self, "SimulationResultsMeans") || inherits(self, "SimulationResultsMeansR6")) { variedParameterName1 <- "alternative" - } else if (inherits(.self, "SimulationResultsRates") || inherits(.self, "SimulationResultsSurvival")) { + } else if (inherits(self, "SimulationResultsRates") || inherits(self, "SimulationResultsRatesR6") || inherits(self, "SimulationResultsSurvival") || inherits(self, "SimulationResultsSurvivalR6")) { variedParameterName1 <- "pi1" - } else if (grepl("MultiArm", .getClassName(.self))) { - if (inherits(.self, "SimulationResultsMultiArmMeans")) { + } else if (grepl("MultiArm", .getClassName(self))) { + if (inherits(self, "SimulationResultsMultiArmMeans") || inherits(self, "SimulationResultsMultiArmMeansR6")) { variedParameterName1 <- "muMax" - } else if (inherits(.self, "SimulationResultsMultiArmRates")) { + } else if (inherits(self, "SimulationResultsMultiArmRates") || inherits(self, "SimulationResultsMultiArmRatesR6")) { variedParameterName1 <- "piMax" - } else if (inherits(.self, "SimulationResultsMultiArmSurvival")) { + } else if (inherits(self, "SimulationResultsMultiArmSurvival") || inherits(self, "SimulationResultsMultiArmSurvivalR6")) { variedParameterName1 <- "omegaMax" } } @@ -391,7 +391,7 @@ SimulationResults <- setRefClass("SimulationResults", return(NA_real_) } - parameterValues <- .self$.data[[variedParameterName]] + parameterValues <- self$.data[[variedParameterName]] if (is.null(parameterValues)) { return(NA_real_) } @@ -419,34 +419,34 @@ SimulationResults <- setRefClass("SimulationResults", postfix <- "" if (!is.na(parameterValue1)) { if (!all(is.na(parameterValue2))) { - postfix <- paste0(postfix, .getVariedParameterValueString( + postfix <- paste0(postfix, self$.getVariedParameterValueString( variedParameterName1, parameterValue1 )) if (parameterName != "subjectsControlArm") { - postfix <- paste0(postfix, .getVariedParameterValueString( + postfix <- paste0(postfix, self$.getVariedParameterValueString( variedParameterName2, parameterValue2 )) } - paramValue <- .self$.data[[parameterName]][ - .self$.data$stageNumber == stage & - .self$.data[[variedParameterName1]] == parameterValue1 & - .self$.data[[variedParameterName2]] %in% parameterValue2 + paramValue <- self$.data[[parameterName]][ + self$.data$stageNumber == stage & + self$.data[[variedParameterName1]] == parameterValue1 & + self$.data[[variedParameterName2]] %in% parameterValue2 ] } else { - postfix <- paste0(postfix, .getVariedParameterValueString( + postfix <- paste0(postfix, self$.getVariedParameterValueString( variedParameterName1, parameterValue1 )) - paramValue <- .self$.data[[parameterName]][ - .self$.data$stageNumber == stage & - .self$.data[[variedParameterName1]] == parameterValue1 + paramValue <- self$.data[[parameterName]][ + self$.data$stageNumber == stage & + self$.data[[variedParameterName1]] == parameterValue1 ] } } else { - paramValue <- .self$.data[[parameterName]][ - .self$.data$stageNumber == stage + paramValue <- self$.data[[parameterName]][ + self$.data$stageNumber == stage ] } - if (.design$kMax > 1) { + if (self$.design$kMax > 1) { postfix <- paste0(postfix, " [", stage, "]") } @@ -456,7 +456,7 @@ SimulationResults <- setRefClass("SimulationResults", variableNameFormatted <- .getFormattedVariableName( name = paramCaption, - n = .getNChar(), prefix = "", postfix = postfix + n = self$.getNChar(), prefix = "", postfix = postfix ) if (!is.null(paramValue)) { @@ -472,39 +472,39 @@ SimulationResults <- setRefClass("SimulationResults", } output <- paste(variableNameFormatted, paramValueFormatted, "\n") if (!grepl(": median \\[range\\]: NA \\[NA - NA\\]", output)) { - .cat(output, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(output, consoleOutputEnabled = consoleOutputEnabled) } } }, .toString = function(startWithUpperCase = FALSE) { s <- "simulation of" - if (grepl("MultiArm", .getClassName(.self)) && !is.null(.self[["activeArms"]]) && .self$activeArms > 1) { + if (grepl("MultiArm", .getClassName(self)) && !is.null(self[["activeArms"]]) && self$activeArms > 1) { s <- paste(s, "multi-arm") } - if (grepl("Enrichment", .getClassName(.self)) && !is.null(.self[["populations"]]) && .self$populations > 1) { + if (grepl("Enrichment", .getClassName(self)) && !is.null(self[["populations"]]) && self$populations > 1) { s <- paste(s, "enrichment") } - if (inherits(.self, "SimulationResultsBaseMeans")) { + if (inherits(self, "SimulationResultsBaseMeans") || inherits(self, "SimulationResultsBaseMeansR6")) { s <- paste(s, "means") - } else if (inherits(.self, "SimulationResultsBaseRates")) { + } else if (inherits(self, "SimulationResultsBaseRates") || inherits(self, "SimulationResultsBaseRatesR6")) { s <- paste(s, "rates") - } else if (inherits(.self, "SimulationResultsBaseSurvival")) { + } else if (inherits(self, "SimulationResultsBaseSurvival") || inherits(self, "SimulationResultsBaseSurvivalR6")) { s <- paste(s, "survival data") } else { s <- paste(s, "results") } - if (.design$kMax > 1) { - if (.isTrialDesignGroupSequential(.design)) { + if (self$.design$kMax > 1) { + if (.isTrialDesignGroupSequential(self$.design)) { s <- paste(s, "(group sequential design)") - } else if (.isTrialDesignInverseNormal(.design)) { + } else if (.isTrialDesignInverseNormal(self$.design)) { s <- paste(s, "(inverse normal combination test design)") - } else if (.isTrialDesignFisher(.design)) { + } else if (.isTrialDesignFisher(self$.design)) { s <- paste(s, "(Fisher's combination test design)") - } else if (.isTrialDesignConditionalDunnett(.design)) { + } else if (.isTrialDesignConditionalDunnett(self$.design)) { s <- paste(s, "(conditional Dunnett design)") } } else { @@ -513,7 +513,7 @@ SimulationResults <- setRefClass("SimulationResults", return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) }, .getParametersToShow = function() { - parametersToShow <- .getVisibleFieldNames() + parametersToShow <- self$.getVisibleFieldNames() y <- c( "eventsPerStage", "overallEventsPerStage", @@ -524,7 +524,7 @@ SimulationResults <- setRefClass("SimulationResults", "rejectedArmsPerStage", "rejectedPopulationsPerStage" ) - if (.design$kMax > 2) { + if (self$.design$kMax > 2) { y <- c(y, "futilityStop") } y <- c( @@ -549,29 +549,27 @@ SimulationResults <- setRefClass("SimulationResults", return(FALSE) }, getRawDataResults = function(maxNumberOfIterations = NA_integer_) { - return(.getSimulationParametersFromRawData(.self$.data, - variantName = .getVariedParameterName(), + return(.getSimulationParametersFromRawData(self$.data, + variantName = self$.getVariedParameterName(), maxNumberOfIterations = maxNumberOfIterations )) } ) ) -SimulationResultsBaseMeans <- setRefClass("SimulationResultsBaseMeans", - contains = "SimulationResults", - fields = list( - stDev = "numeric", - plannedSubjects = "numeric", - minNumberOfSubjectsPerStage = "numeric", - maxNumberOfSubjectsPerStage = "numeric", - thetaH1 = "numeric", - stDevH1 = "numeric", - calcSubjectsFunction = "ANY", - expectedNumberOfSubjects = "numeric" - ), - methods = list( +SimulationResultsBaseMeansR6 <- R6Class("SimulationResultsBaseMeansR6", + inherit = SimulationResultsR6, + public = list( + stDev =NULL, + plannedSubjects =NULL, + minNumberOfSubjectsPerStage =NULL, + maxNumberOfSubjectsPerStage =NULL, + thetaH1 =NULL, + stDevH1 =NULL, + calcSubjectsFunction =NULL, + expectedNumberOfSubjects =NULL, initialize = function(design, ...) { - callSuper(design = design, ...) + super$initialize(design = design, ...) generatedParams <- c( "iterations", "expectedNumberOfSubjects", @@ -585,7 +583,7 @@ SimulationResultsBaseMeans <- setRefClass("SimulationResultsBaseMeans", generatedParams <- c(generatedParams, "futilityStop") } for (generatedParam in generatedParams) { - .setParameterType(generatedParam, C_PARAM_GENERATED) + self$.setParameterType(generatedParam, C_PARAM_GENERATED) } } ) @@ -649,25 +647,23 @@ SimulationResultsBaseMeans <- setRefClass("SimulationResultsBaseMeans", #' #' @importFrom methods new #' -SimulationResultsMeans <- setRefClass("SimulationResultsMeans", - contains = "SimulationResultsBaseMeans", - fields = list( - meanRatio = "logical", - thetaH0 = "numeric", - normalApproximation = "logical", - alternative = "numeric", - groups = "integer", - directionUpper = "logical", - effect = "numeric", - earlyStop = "numeric", - sampleSizes = "matrix", - overallReject = "numeric", # = rejectedArmsPerStage in multi-arm - rejectPerStage = "matrix", - conditionalPowerAchieved = "matrix" - ), - methods = list( +SimulationResultsMeansR6 <- R6Class("SimulationResultsMeansR6", + inherit = SimulationResultsBaseMeansR6, + public = list( + meanRatio =NULL, + thetaH0 =NULL, + normalApproximation =NULL, + alternative =NULL, + groups =NULL, + directionUpper =NULL, + effect =NULL, + earlyStop =NULL, + sampleSizes =NULL, + overallReject =NULL, # = rejectedArmsPerStage in multi-arm + rejectPerStage =NULL, + conditionalPowerAchieved =NULL, initialize = function(design, ...) { - callSuper(design = design, ...) + super$initialize(design = design, ...) } ) ) @@ -735,36 +731,34 @@ SimulationResultsMeans <- setRefClass("SimulationResultsMeans", #' #' @importFrom methods new #' -SimulationResultsMultiArmMeans <- setRefClass("SimulationResultsMultiArmMeans", - contains = "SimulationResultsBaseMeans", - fields = list( - activeArms = "integer", - effectMatrix = "matrix", - typeOfShape = "character", - muMaxVector = "numeric", - gED50 = "numeric", - slope = "numeric", - intersectionTest = "character", - adaptations = "logical", - typeOfSelection = "character", - effectMeasure = "character", - successCriterion = "character", - epsilonValue = "numeric", - rValue = "numeric", - threshold = "numeric", - selectArmsFunction = "function", - earlyStop = "matrix", - selectedArms = "array", - numberOfActiveArms = "matrix", - rejectAtLeastOne = "numeric", - rejectedArmsPerStage = "array", - successPerStage = "matrix", - sampleSizes = "array", - conditionalPowerAchieved = "matrix" - ), - methods = list( +SimulationResultsMultiArmMeansR6 <- R6Class("SimulationResultsMultiArmMeansR6", + inherit = SimulationResultsBaseMeansR6, + public = list( + activeArms = NULL, + effectMatrix = NULL, + typeOfShape = NULL, + muMaxVector = NULL, + gED50 = NULL, + slope = NULL, + intersectionTest = NULL, + adaptations = NULL, + typeOfSelection = NULL, + effectMeasure = NULL, + successCriterion = NULL, + epsilonValue = NULL, + rValue = NULL, + threshold = NULL, + selectArmsFunction = NULL, + earlyStop = NULL, + selectedArms = NULL, + numberOfActiveArms = NULL, + rejectAtLeastOne = NULL, + rejectedArmsPerStage = NULL, + successPerStage = NULL, + sampleSizes = NULL, + conditionalPowerAchieved = matrix(), initialize = function(design, ...) { - callSuper(design = design, ...) + super$initialize(design = design, ...) for (generatedParam in c( "rejectAtLeastOne", @@ -773,25 +767,23 @@ SimulationResultsMultiArmMeans <- setRefClass("SimulationResultsMultiArmMeans", "rejectedArmsPerStage", "successPerStage" )) { - .setParameterType(generatedParam, C_PARAM_GENERATED) + self$.setParameterType(generatedParam, C_PARAM_GENERATED) } } ) ) -SimulationResultsBaseRates <- setRefClass("SimulationResultsBaseRates", - contains = "SimulationResults", - fields = list( - directionUpper = "logical", - plannedSubjects = "numeric", - minNumberOfSubjectsPerStage = "numeric", - maxNumberOfSubjectsPerStage = "numeric", - calcSubjectsFunction = "ANY", - expectedNumberOfSubjects = "numeric" - ), - methods = list( +SimulationResultsBaseRatesR6 <- R6Class("SimulationResultsBaseRatesR6", + inherit = SimulationResultsR6, + public = list( + directionUpper = NULL, + plannedSubjects = NULL, + minNumberOfSubjectsPerStage = NULL, + maxNumberOfSubjectsPerStage = NULL, + calcSubjectsFunction = NULL, + expectedNumberOfSubjects = NULL, initialize = function(design, ...) { - callSuper(design = design, ...) + super$initialize(design = design, ...) generatedParams <- c( "iterations", "expectedNumberOfSubjects", @@ -805,7 +797,7 @@ SimulationResultsBaseRates <- setRefClass("SimulationResultsBaseRates", generatedParams <- c(generatedParams, "futilityStop") } for (generatedParam in generatedParams) { - .setParameterType(generatedParam, C_PARAM_GENERATED) + self$.setParameterType(generatedParam, C_PARAM_GENERATED) } } ) @@ -870,28 +862,26 @@ SimulationResultsBaseRates <- setRefClass("SimulationResultsBaseRates", #' #' @importFrom methods new #' -SimulationResultsRates <- setRefClass("SimulationResultsRates", - contains = "SimulationResultsBaseRates", - fields = list( - riskRatio = "logical", - thetaH0 = "numeric", - normalApproximation = "logical", - pi1 = "numeric", - pi2 = "numeric", - groups = "integer", - directionUpper = "logical", - pi1H1 = "numeric", - pi2H1 = "numeric", - effect = "numeric", - earlyStop = "numeric", - sampleSizes = "matrix", - overallReject = "numeric", - rejectPerStage = "matrix", - conditionalPowerAchieved = "matrix" - ), - methods = list( +SimulationResultsRatesR6 <- R6Class("SimulationResultsRatesR6", + inherit = SimulationResultsBaseRatesR6, + public = list( + riskRatio = NULL, + thetaH0 = NULL, + normalApproximation = NULL, + pi1 = NULL, + pi2 = NULL, + groups = NULL, + #directionUpper = NULL, + pi1H1 = NULL, + pi2H1 = NULL, + effect = NULL, + earlyStop = NULL, + sampleSizes = NULL, + overallReject = NULL, + rejectPerStage = NULL, + conditionalPowerAchieved = matrix(), initialize = function(design, ...) { - callSuper(design = design, ...) + super$initialize(design = design, ...) generatedParams <- c( "effect", "iterations", @@ -909,7 +899,7 @@ SimulationResultsRates <- setRefClass("SimulationResultsRates", generatedParams <- c(generatedParams, "futilityStop") } for (generatedParam in generatedParams) { - .setParameterType(generatedParam, C_PARAM_GENERATED) + self$.setParameterType(generatedParam, C_PARAM_GENERATED) } } ) @@ -979,39 +969,37 @@ SimulationResultsRates <- setRefClass("SimulationResultsRates", #' #' @importFrom methods new #' -SimulationResultsMultiArmRates <- setRefClass("SimulationResultsMultiArmRates", - contains = "SimulationResultsBaseRates", - fields = list( - activeArms = "integer", - effectMatrix = "matrix", - typeOfShape = "character", - piMaxVector = "numeric", - piControl = "numeric", - piTreatmentsH1 = "numeric", - piControlH1 = "numeric", - gED50 = "numeric", - slope = "numeric", - intersectionTest = "character", - adaptations = "logical", - typeOfSelection = "character", - effectMeasure = "character", - successCriterion = "character", - epsilonValue = "numeric", - rValue = "numeric", - threshold = "numeric", - selectArmsFunction = "function", - earlyStop = "matrix", - selectedArms = "array", - numberOfActiveArms = "matrix", - rejectAtLeastOne = "numeric", - rejectedArmsPerStage = "array", - successPerStage = "matrix", - sampleSizes = "array", - conditionalPowerAchieved = "matrix" - ), - methods = list( +SimulationResultsMultiArmRatesR6 <- R6Class("SimulationResultsMultiArmRatesR6", + inherit = SimulationResultsBaseRatesR6, + public = list( + activeArms = NULL, + effectMatrix = NULL, + typeOfShape = NULL, + piMaxVector = NULL, + piControl = NULL, + piTreatmentsH1 = NULL, + piControlH1 = NULL, + gED50 = NULL, + slope = NULL, + intersectionTest = NULL, + adaptations = NULL, + typeOfSelection = NULL, + effectMeasure = NULL, + successCriterion = NULL, + epsilonValue = NULL, + rValue = NULL, + threshold = NULL, + selectArmsFunction = NULL, + earlyStop = NULL, + selectedArms = NULL, + numberOfActiveArms = NULL, + rejectAtLeastOne = NULL, + rejectedArmsPerStage = NULL, + successPerStage = NULL, + sampleSizes = NULL, + conditionalPowerAchieved = matrix(), initialize = function(design, ...) { - callSuper(design = design, ...) + super$initialize(design = design, ...) for (generatedParam in c( "rejectAtLeastOne", @@ -1020,26 +1008,25 @@ SimulationResultsMultiArmRates <- setRefClass("SimulationResultsMultiArmRates", "rejectedArmsPerStage", "successPerStage" )) { - .setParameterType(generatedParam, C_PARAM_GENERATED) + self$.setParameterType(generatedParam, C_PARAM_GENERATED) } } ) ) -SimulationResultsBaseSurvival <- setRefClass("SimulationResultsBaseSurvival", - contains = "SimulationResults", - fields = list( - directionUpper = "logical", - plannedEvents = "numeric", - minNumberOfEventsPerStage = "numeric", - maxNumberOfEventsPerStage = "numeric", - thetaH1 = "numeric", - calcEventsFunction = "ANY", - expectedNumberOfEvents = "numeric" - ), - methods = list( +SimulationResultsBaseSurvivalR6 <- R6Class("SimulationResultsBaseSurvivalR6", + inherit = SimulationResultsR6, + public = list( + directionUpper = NULL, + plannedEvents = NULL, + minNumberOfEventsPerStage = NULL, + maxNumberOfEventsPerStage = NULL, + thetaH1 = NULL, + calcEventsFunction = NULL, + expectedNumberOfEvents = NULL, + conditionalPowerAchieved = matrix(), #TODO remove? initialize = function(design, ...) { - callSuper(design = design, ...) + super$initialize(design = design, ...) generatedParams <- c( "iterations", "expectedNumberOfEvents", @@ -1053,7 +1040,7 @@ SimulationResultsBaseSurvival <- setRefClass("SimulationResultsBaseSurvival", generatedParams <- c(generatedParams, "futilityStop") } for (generatedParam in generatedParams) { - .setParameterType(generatedParam, C_PARAM_GENERATED) + self$.setParameterType(generatedParam, C_PARAM_GENERATED) } } ) @@ -1135,47 +1122,45 @@ SimulationResultsBaseSurvival <- setRefClass("SimulationResultsBaseSurvival", #' #' @importFrom methods new #' -SimulationResultsSurvival <- setRefClass("SimulationResultsSurvival", - contains = "SimulationResultsBaseSurvival", - fields = list( - .piecewiseSurvivalTime = "ANY", - .accrualTime = "ANY", - pi1 = "numeric", - pi2 = "numeric", - median1 = "numeric", - median2 = "numeric", - maxNumberOfSubjects = "numeric", - accrualTime = "numeric", - accrualIntensity = "numeric", - dropoutRate1 = "numeric", - dropoutRate2 = "numeric", - dropoutTime = "numeric", - eventTime = "numeric", - thetaH0 = "numeric", - allocation1 = "numeric", - allocation2 = "numeric", - kappa = "numeric", - piecewiseSurvivalTime = "numeric", - lambda1 = "numeric", - lambda2 = "numeric", - earlyStop = "numeric", - hazardRatio = "numeric", - analysisTime = "matrix", - studyDuration = "numeric", - eventsNotAchieved = "matrix", - numberOfSubjects = "matrix", - numberOfSubjects1 = "matrix", - numberOfSubjects2 = "matrix", - eventsPerStage = "matrix", - overallEventsPerStage = "matrix", - expectedNumberOfSubjects = "numeric", - rejectPerStage = "matrix", - overallReject = "numeric", - conditionalPowerAchieved = "matrix" - ), - methods = list( +SimulationResultsSurvivalR6 <- R6Class("SimulationResultsSurvivalR6", + inherit = SimulationResultsBaseSurvivalR6, + public = list( + .piecewiseSurvivalTime = NULL, + .accrualTime = NULL, + pi1 = NULL, + pi2 = NULL, + median1 = NULL, + median2 = NULL, + maxNumberOfSubjects = NULL, + accrualTime = NULL, + accrualIntensity = NULL, + dropoutRate1 = NULL, + dropoutRate2 = NULL, + dropoutTime = NULL, + eventTime = NULL, + thetaH0 = NULL, + allocation1 = NULL, + allocation2 = NULL, + kappa = NULL, + piecewiseSurvivalTime = NULL, + lambda1 = NULL, + lambda2 = NULL, + earlyStop = NULL, + hazardRatio = NULL, + analysisTime = NULL, + studyDuration = NULL, + eventsNotAchieved = NULL, + numberOfSubjects = NULL, + numberOfSubjects1 = NULL, + numberOfSubjects2 = NULL, + eventsPerStage = NULL, + overallEventsPerStage = NULL, + expectedNumberOfSubjects = NULL, + rejectPerStage = NULL, + overallReject = NULL, + conditionalPowerAchieved = matrix(), initialize = function(design, ...) { - callSuper(design = design, ...) + super$initialize(design = design, ...) generatedParams <- c( "hazardRatio", "iterations", @@ -1197,12 +1182,12 @@ SimulationResultsSurvival <- setRefClass("SimulationResultsSurvival", generatedParams <- c(generatedParams, "futilityStop") } for (generatedParam in generatedParams) { - .setParameterType(generatedParam, C_PARAM_GENERATED) + self$.setParameterType(generatedParam, C_PARAM_GENERATED) } - .setParameterType("numberOfSubjects1", C_PARAM_NOT_APPLICABLE) - .setParameterType("numberOfSubjects2", C_PARAM_NOT_APPLICABLE) - .setParameterType("median1", C_PARAM_NOT_APPLICABLE) - .setParameterType("median2", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("numberOfSubjects1", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("numberOfSubjects2", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("median1", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("median2", C_PARAM_NOT_APPLICABLE) } ) ) @@ -1265,38 +1250,36 @@ SimulationResultsSurvival <- setRefClass("SimulationResultsSurvival", #' #' @importFrom methods new #' -SimulationResultsMultiArmSurvival <- setRefClass("SimulationResultsMultiArmSurvival", - contains = "SimulationResultsBaseSurvival", - fields = list( - activeArms = "integer", - effectMatrix = "matrix", - typeOfShape = "character", - omegaMaxVector = "numeric", - gED50 = "numeric", - slope = "numeric", - intersectionTest = "character", - adaptations = "logical", - typeOfSelection = "character", - effectMeasure = "character", - successCriterion = "character", - epsilonValue = "numeric", - rValue = "numeric", - threshold = "numeric", - selectArmsFunction = "function", - correlationComputation = "character", - earlyStop = "matrix", - selectedArms = "array", - numberOfActiveArms = "matrix", - rejectAtLeastOne = "numeric", - rejectedArmsPerStage = "array", - successPerStage = "matrix", - eventsPerStage = "array", - singleNumberOfEventsPerStage = "array", - conditionalPowerAchieved = "matrix" - ), - methods = list( +SimulationResultsMultiArmSurvivalR6 <- R6Class("SimulationResultsMultiArmSurvivalR6", + inherit = SimulationResultsBaseSurvivalR6, + public = list( + activeArms = NULL, + effectMatrix = NULL, + typeOfShape = NULL, + omegaMaxVector = NULL, + gED50 = NULL, + slope = NULL, + intersectionTest = NULL, + adaptations = NULL, + typeOfSelection = NULL, + effectMeasure = NULL, + successCriterion = NULL, + epsilonValue = NULL, + rValue = NULL, + threshold = NULL, + selectArmsFunction = NULL, + correlationComputation = NULL, + earlyStop = NULL, + selectedArms = NULL, + numberOfActiveArms = NULL, + rejectAtLeastOne = NULL, + rejectedArmsPerStage = NULL, + successPerStage = NULL, + eventsPerStage = NULL, + singleNumberOfEventsPerStage = NULL, + conditionalPowerAchieved = matrix(), initialize = function(design, ...) { - callSuper(design = design, ...) + super$initialize(design = design, ...) for (generatedParam in c( "rejectAtLeastOne", @@ -1305,7 +1288,7 @@ SimulationResultsMultiArmSurvival <- setRefClass("SimulationResultsMultiArmSurvi "rejectedArmsPerStage", "successPerStage" )) { - .setParameterType(generatedParam, C_PARAM_GENERATED) + self$.setParameterType(generatedParam, C_PARAM_GENERATED) } } ) @@ -1371,33 +1354,31 @@ SimulationResultsMultiArmSurvival <- setRefClass("SimulationResultsMultiArmSurvi #' #' @importFrom methods new #' -SimulationResultsEnrichmentMeans <- setRefClass("SimulationResultsEnrichmentMeans", - contains = "SimulationResultsBaseMeans", - fields = list( - populations = "integer", - effectList = "list", - intersectionTest = "character", - stratifiedAnalysis = "logical", - adaptations = "logical", - typeOfSelection = "character", - effectMeasure = "character", - successCriterion = "character", - epsilonValue = "numeric", - rValue = "numeric", - threshold = "numeric", - selectPopulationsFunction = "function", - earlyStop = "matrix", - selectedPopulations = "array", - numberOfPopulations = "matrix", - rejectAtLeastOne = "numeric", - rejectedPopulationsPerStage = "array", - successPerStage = "matrix", - sampleSizes = "array", - conditionalPowerAchieved = "matrix" - ), - methods = list( +SimulationResultsEnrichmentMeansR6 <- R6Class("SimulationResultsEnrichmentMeansR6", + inherit = SimulationResultsBaseMeansR6, + public = list( + populations = NULL, + effectList = NULL, + intersectionTest = NULL, + stratifiedAnalysis = NULL, + adaptations = NULL, + typeOfSelection = NULL, + effectMeasure = NULL, + successCriterion = NULL, + epsilonValue = NULL, + rValue = NULL, + threshold = NULL, + selectPopulationsFunction = NULL, + earlyStop = NULL, + selectedPopulations = NULL, + numberOfPopulations = NULL, + rejectAtLeastOne = NULL, + rejectedPopulationsPerStage = NULL, + successPerStage = NULL, + sampleSizes = NULL, + conditionalPowerAchieved = matrix(), initialize = function(design, ...) { - callSuper(design = design, ...) + super$initialize(design = design, ...) for (generatedParam in c( "rejectAtLeastOne", @@ -1406,7 +1387,7 @@ SimulationResultsEnrichmentMeans <- setRefClass("SimulationResultsEnrichmentMean "rejectedPopulationsPerStage", "successPerStage" )) { - .setParameterType(generatedParam, C_PARAM_GENERATED) + self$.setParameterType(generatedParam, C_PARAM_GENERATED) } } ) @@ -1472,35 +1453,33 @@ SimulationResultsEnrichmentMeans <- setRefClass("SimulationResultsEnrichmentMean #' #' @importFrom methods new #' -SimulationResultsEnrichmentRates <- setRefClass("SimulationResultsEnrichmentRates", - contains = "SimulationResultsBaseRates", - fields = list( - populations = "integer", - effectList = "list", - intersectionTest = "character", - stratifiedAnalysis = "logical", - adaptations = "logical", - piTreatmentH1 = "numeric", - piControlH1 = "numeric", - typeOfSelection = "character", - effectMeasure = "character", - successCriterion = "character", - epsilonValue = "numeric", - rValue = "numeric", - threshold = "numeric", - selectPopulationsFunction = "function", - earlyStop = "matrix", - selectedPopulations = "array", - numberOfPopulations = "matrix", - rejectAtLeastOne = "numeric", - rejectedPopulationsPerStage = "array", - successPerStage = "matrix", - sampleSizes = "array", - conditionalPowerAchieved = "matrix" - ), - methods = list( +SimulationResultsEnrichmentRatesR6 <- R6Class("SimulationResultsEnrichmentRatesR6", + inherit = SimulationResultsBaseRatesR6, + public = list( + populations = NULL, + effectList = NULL, + intersectionTest = NULL, + stratifiedAnalysis = NULL, + adaptations = NULL, + piTreatmentH1 = NULL, + piControlH1 = NULL, + typeOfSelection = NULL, + effectMeasure = NULL, + successCriterion = NULL, + epsilonValue = NULL, + rValue = NULL, + threshold = NULL, + selectPopulationsFunction = NULL, + earlyStop = NULL, + selectedPopulations = NULL, + numberOfPopulations = NULL, + rejectAtLeastOne = NULL, + rejectedPopulationsPerStage = NULL, + successPerStage = NULL, + sampleSizes = NULL, + conditionalPowerAchieved = matrix(), initialize = function(design, ...) { - callSuper(design = design, ...) + super$initialize(design = design, ...) for (generatedParam in c( "rejectAtLeastOne", @@ -1509,7 +1488,7 @@ SimulationResultsEnrichmentRates <- setRefClass("SimulationResultsEnrichmentRate "rejectedPopulationsPerStage", "successPerStage" )) { - .setParameterType(generatedParam, C_PARAM_GENERATED) + self$.setParameterType(generatedParam, C_PARAM_GENERATED) } } ) @@ -1576,35 +1555,33 @@ SimulationResultsEnrichmentRates <- setRefClass("SimulationResultsEnrichmentRate #' #' @importFrom methods new #' -SimulationResultsEnrichmentSurvival <- setRefClass("SimulationResultsEnrichmentSurvival", - contains = "SimulationResultsBaseSurvival", - fields = list( - populations = "integer", - effectList = "list", - intersectionTest = "character", - stratifiedAnalysis = "logical", - adaptations = "logical", - typeOfSelection = "character", - effectMeasure = "character", - successCriterion = "character", - epsilonValue = "numeric", - rValue = "numeric", - threshold = "numeric", - selectPopulationsFunction = "function", - correlationComputation = "character", - earlyStop = "matrix", - selectedPopulations = "array", - numberOfPopulations = "matrix", - rejectAtLeastOne = "numeric", - rejectedPopulationsPerStage = "array", - successPerStage = "matrix", - eventsPerStage = "array", - singleNumberOfEventsPerStage = "array", - conditionalPowerAchieved = "matrix" - ), - methods = list( +SimulationResultsEnrichmentSurvivalR6 <- R6Class("SimulationResultsEnrichmentSurvivalR6", + inherit = SimulationResultsBaseSurvivalR6, + public = list( + populations = NULL, + effectList = NULL, + intersectionTest = NULL, + stratifiedAnalysis = NULL, + adaptations = NULL, + typeOfSelection = NULL, + effectMeasure = NULL, + successCriterion = NULL, + epsilonValue = NULL, + rValue = NULL, + threshold = NULL, + selectPopulationsFunction = NULL, + correlationComputation = NULL, + earlyStop = NULL, + selectedPopulations = NULL, + numberOfPopulations = NULL, + rejectAtLeastOne = NULL, + rejectedPopulationsPerStage = NULL, + successPerStage = NULL, + eventsPerStage = NULL, + singleNumberOfEventsPerStage = NULL, + conditionalPowerAchieved = matrix(), initialize = function(design, ...) { - callSuper(design = design, ...) + super$initialize(design = design, ...) for (generatedParam in c( "rejectAtLeastOne", @@ -1613,14 +1590,14 @@ SimulationResultsEnrichmentSurvival <- setRefClass("SimulationResultsEnrichmentS "rejectedPopulationsPerStage", "successPerStage" )) { - .setParameterType(generatedParam, C_PARAM_GENERATED) + self$.setParameterType(generatedParam, C_PARAM_GENERATED) } } ) ) .assertIsValidVariedParameterVectorForSimulationResultsPlotting <- function(simulationResults, plotType) { - if (inherits(simulationResults, "SimulationResultsMeans")) { + if (inherits(simulationResults, "SimulationResultsMeans") || inherits(simulationResults, "SimulationResultsMeansR6")) { if (is.null(simulationResults$alternative) || any(is.na(simulationResults$alternative)) || length(simulationResults$alternative) <= 1) { @@ -1629,7 +1606,7 @@ SimulationResultsEnrichmentSurvival <- setRefClass("SimulationResultsEnrichmentS " is only available if 'alternative' with length > 1 is defined" ) } - } else if (inherits(simulationResults, "SimulationResultsRates")) { + } else if (inherits(simulationResults, "SimulationResultsRates") || inherits(simulationResults, "SimulationResultsRatesR6")) { if (is.null(simulationResults$pi1) || any(is.na(simulationResults$pi1)) || length(simulationResults$pi1) <= 1) { @@ -1638,7 +1615,7 @@ SimulationResultsEnrichmentSurvival <- setRefClass("SimulationResultsEnrichmentS " is only available if 'pi1' with length > 1 is defined" ) } - } else if (inherits(simulationResults, "SimulationResultsSurvival")) { + } else if (inherits(simulationResults, "SimulationResultsSurvival") || inherits(simulationResults, "SimulationResultsSurvivalR6")) { if (is.null(simulationResults$hazardRatio) || any(is.na(simulationResults$hazardRatio)) || length(simulationResults$hazardRatio) <= 1) { @@ -2559,7 +2536,7 @@ SimulationResultsEnrichmentSurvival <- setRefClass("SimulationResultsEnrichmentS #' #' @export #' -plot.SimulationResults <- function(x, y, ..., main = NA_character_, +plot.SimulationResultsR6 <- function(x, y, ..., main = NA_character_, xlab = NA_character_, ylab = NA_character_, type = 1L, palette = "Set1", theta = seq(-1, 1, 0.01), plotPointsEnabled = NA, legendPosition = NA_integer_, showSource = FALSE, @@ -2623,7 +2600,7 @@ plot.SimulationResults <- function(x, y, ..., main = NA_character_, #' #' @keywords internal #' -print.SimulationResults <- function(x, ..., showStatistics = FALSE, markdown = FALSE) { +print.SimulationResultsR6 <- function(x, ..., showStatistics = FALSE, markdown = FALSE) { if (markdown) { x$.catMarkdownText(showStatistics = showStatistics) return(invisible(x)) @@ -2697,7 +2674,7 @@ print.SimulationResults <- function(x, ..., showStatistics = FALSE, markdown = F #' @export #' getData <- function(x) { - if (!inherits(x, "SimulationResults")) { # or 'Dataset' + if (!(inherits(x, "SimulationResults") || inherits(x, "SimulationResultsR6"))) { # or 'Dataset' stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'x' must be a 'SimulationResults' object; for example, use getSimulationMeans() to create one" @@ -2709,7 +2686,7 @@ getData <- function(x) { #' @rdname getData #' @export -getData.SimulationResults <- function(x) { +getData.SimulationResultsR6 <- function(x) { return(x$.data) } @@ -2840,7 +2817,7 @@ getData.SimulationResults <- function(x) { #' @export #' getRawData <- function(x, aggregate = FALSE) { - if (!inherits(x, "SimulationResultsSurvival")) { + if (!(inherits(x, "SimulationResultsSurvival") || inherits(x, "SimulationResultsSurvivalR6"))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'x' must be a 'SimulationResultsSurvival' object; use getSimulationSurvival() to create one" diff --git a/R/class_simulation_results_r6.R b/R/class_simulation_results_r6.R deleted file mode 100644 index 0bc177df..00000000 --- a/R/class_simulation_results_r6.R +++ /dev/null @@ -1,2842 +0,0 @@ -## | -## | *Simulation result classes* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | rpact package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File version: $Revision: 7274 $ -## | Last changed: $Date: 2023-09-07 10:58:29 +0200 (Do, 07 Sep 2023) $ -## | Last changed by: $Author: pahlke $ -## | - -#' @include f_core_utilities.R -NULL - -#' -#' @title -#' Names of a Simulation Results Object -#' -#' @description -#' Function to get the names of a \code{\link{SimulationResults}} object. -#' -#' @param x A \code{\link{SimulationResults}} object created by \code{getSimulationResults[MultiArm/Enrichment][Means/Rates/Survival]}. -#' -#' @details -#' Returns the names of a simulation results that can be accessed by the user. -#' -#' @template return_names -#' -#' @export -#' -#' @keywords internal -#' -names.SimulationResultsR6 <- function(x) { - namesToShow <- c(".design", ".data", ".rawData") - if (inherits(x, "SimulationResultsSurvival") || inherits(x, "SimulationResultsSurvivalR6")) { - namesToShow <- c(namesToShow, ".piecewiseSurvivalTime", ".accrualTime") - } - namesToShow <- c(namesToShow, x$.getVisibleFieldNames()) - return(namesToShow) -} - -#' -#' @name SimulationResults -#' -#' @title -#' Class for Simulation Results -#' -#' @description -#' A class for simulation results. -#' -#' @template field_seed -#' @template field_iterations -#' -#' @details -#' \code{SimulationResults} is the basic class for -#' \itemize{ -#' \item \code{\link{SimulationResultsMeans}}, -#' \item \code{\link{SimulationResultsRates}}, -#' \item \code{\link{SimulationResultsSurvival}}, -#' \item \code{\link{SimulationResultsMultiArmMeans}}, -#' \item \code{\link{SimulationResultsMultiArmRates}}, -#' \item \code{\link{SimulationResultsMultiArmSurvival}}, -#' \item \code{\link{SimulationResultsEnrichmentMeans}}, -#' \item \code{\link{SimulationResultsEnrichmentRates}}, and -#' \item \code{\link{SimulationResultsEnrichmentSurvival}}. -#' } -#' -#' @include class_core_parameter_set.R -#' @include class_core_plot_settings.R -#' @include class_design.R -#' @include f_core_constants.R -#' @include class_time.R -#' @include f_simulation_base_survival.R -#' @include f_simulation_utilities.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -SimulationResultsR6 <- R6Class("SimulationResultsR6", - inherit = ParameterSetR6, - public = list( - .plotSettings = NULL, - .design = NULL, - .data = NULL, - .rawData = NULL, - .showStatistics = NULL, - maxNumberOfIterations = NULL, - seed = NULL, - allocationRatioPlanned = NULL, - conditionalPower = NULL, - iterations = NULL, - futilityPerStage = NULL, - futilityStop = NULL, - initialize = function(design, ..., showStatistics = FALSE) { - super$initialize(...) - self$.design <- design - self$.showStatistics <- showStatistics - - self$.plotSettings <- PlotSettingsR6$new() - self$.parameterNames <- .getParameterNames(design = design, designPlan = self) - self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS - }, - getPlotSettings = function() { - return(self$.plotSettings) - }, - setShowStatistics = function(showStatistics) { - .assertIsSingleLogical(showStatistics, "showStatistics") - self$.showStatistics <- showStatistics - }, - show = function(showType = 1, digits = NA_integer_, showStatistics = FALSE) { - self$.show( - showType = showType, digits = digits, showStatistics = showStatistics, - consoleOutputEnabled = TRUE - ) - }, - .show = function(..., showType = 1, digits = NA_integer_, - showStatistics = FALSE, consoleOutputEnabled = TRUE, performanceScore = NULL) { - "Method for automatically printing simulation result objects" - - self$.resetCat() - if (showType == 3) { - .createSummary(self, digits = digits)$.show( - showType = 1, - digits = digits, consoleOutputEnabled = consoleOutputEnabled - ) - } else if (showType == 2) { - super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) - } else { - if (is.null(showStatistics) || length(showStatistics) != 1) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'showStatistics' (", .arrayToString(showStatistics), - ") must be a single logical or character" - ) - } - - if (!is.character(showStatistics) || showStatistics != "exclusive") { - self$.cat(self$.toString(startWithUpperCase = TRUE), ":\n\n", - heading = 1, - consoleOutputEnabled = consoleOutputEnabled - ) - - self$.showParametersOfOneGroup(.getDesignParametersToShow(self), "Design parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - - userDefinedParameters <- self$.getUserDefinedParameters() - if ((inherits(self, "SimulationResultsSurvival") || inherits(self, "SimulationResultsSurvivalR6")) && - self$.piecewiseSurvivalTime$delayedResponseEnabled) { - userDefinedParameters <- c( - userDefinedParameters, - ".piecewiseSurvivalTime$delayedResponseEnabled" - ) - } - self$.showParametersOfOneGroup(userDefinedParameters, "User defined parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - derivedParameters <- self$.getDerivedParameters() - if (length(derivedParameters) > 0) { - self$.showParametersOfOneGroup(derivedParameters, "Derived from user defined parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - } - self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Results", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - } - - ## statistics of simulated data - if (isTRUE(showStatistics) || self$.showStatistics || - (is.character(showStatistics) && showStatistics == "exclusive")) { - self$.cat("Simulated data:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) - params <- c() - if (inherits(self, "SimulationResultsMeans") || inherits(self, "SimulationResultsMeansR6")) { - params <- c( - "effectMeasure", - "numberOfSubjects", - "testStatistic" - ) - } else if (inherits(self, "SimulationResultsRates") || inherits(self, "SimulationResultsRatesR6")) { - params <- c( - "effectMeasure", - "numberOfSubjects", - "testStatistic" - ) - } else if (inherits(self, "SimulationResultsSurvival") || inherits(self, "SimulationResultsSurvivalR6")) { - params <- c( - "effectMeasure", - "analysisTime", - "numberOfSubjects", - "eventsPerStage1", - "eventsPerStage2", - "eventsPerStage", - "testStatistic", - "logRankStatistic", - "hazardRatioEstimateLR" - ) - } else if (inherits(self, "SimulationResultsMultiArmMeans") || inherits(self, "SimulationResultsMultiArmMeansR6") || - inherits(self, "SimulationResultsMultiArmRates") || inherits(self, "SimulationResultsMultiArmRatesR6")) { - params <- c( - "effectMeasure", - "subjectsActiveArm", - "testStatistic", - "conditionalCriticalValue", - "rejectPerStage", - "successStop", - "futilityPerStage" - ) - } else if (inherits(self, "SimulationResultsEnrichmentMeans") || inherits(self, "SimulationResultsEnrichmentMeansR6") || - inherits(self, "SimulationResultsEnrichmentRates") || inherits(self, "SimulationResultsEnrichmentRatesR6")) { - params <- c( - "effectMeasure", - "subjectsPopulation", - "testStatistic", - "conditionalCriticalValue", - "rejectPerStage", - "successStop", - "futilityPerStage" - ) - } else if (inherits(self, "SimulationResultsMultiArmSurvival") || inherits(self, "SimulationResultsMultiArmSurvivalR6") || - inherits(self, "SimulationResultsEnrichmentSurvival") || inherits(self, "SimulationResultsEnrichmentSurvivalR6")) { - params <- c( - "effectMeasure", - "numberOfEvents", - "singleNumberOfEventsPerStage", - "testStatistic", - "conditionalCriticalValue", - "rejectPerStage", - "successStop", - "futilityPerStage" - ) - } - - if (!is.null(self[["conditionalPowerAchieved"]]) && - !all(is.na(self$conditionalPowerAchieved)) && - any(!is.na(self$conditionalPowerAchieved)) && - any(na.omit(self$conditionalPowerAchieved) != 0)) { - params <- c(params, "conditionalPowerAchieved") - } - - stages <- sort(unique(self$.data$stageNumber)) - - variedParameterName1 <- self$.getVariedParameterName(1) - variedParameterName2 <- self$.getVariedParameterName(2) - parameterValues1 <- self$.getVariedParameterValues(variedParameterName1) - parameterValues2 <- self$.getVariedParameterValues(variedParameterName2) - - for (parameterName in params) { - paramCaption <- self$.parameterNames[[parameterName]] - if (is.null(paramCaption)) { - paramCaption <- paste0("%", parameterName, "%") - } - - for (parameterValue1 in parameterValues1) { - for (parameterValue2 in parameterValues2) { - for (stage in stages) { - if (length(parameterValues1) > 1) { - self$.catStatisticsLine( - stage = stage, - parameterName = parameterName, - paramCaption = paramCaption, - parameterValue1 = parameterValue1, - variedParameterName1 = variedParameterName1, - parameterValue2 = parameterValue2, - variedParameterName2 = variedParameterName2, - consoleOutputEnabled = consoleOutputEnabled - ) - } else { - self$.catStatisticsLine( - stage = stage, - parameterName = parameterName, - paramCaption = paramCaption, - parameterValue1 = parameterValue2, - variedParameterName1 = variedParameterName2, - consoleOutputEnabled = consoleOutputEnabled - ) - } - } - } - if (parameterName == "subjectsActiveArm" && variedParameterName2 == "armNumber") { - parameterName2 <- "subjectsControlArm" - paramCaption2 <- self$.parameterNames[[parameterName2]] - if (is.null(paramCaption2)) { - paramCaption2 <- paste0("%", parameterName2, "%") - } - for (stage in stages) { - .catStatisticsLine( - stage = stage, - parameterName = parameterName2, - paramCaption = paramCaption2, - parameterValue1 = parameterValue1, - variedParameterName1 = variedParameterName1, - parameterValue2 = unique(parameterValues2), - variedParameterName2 = variedParameterName2, - consoleOutputEnabled = consoleOutputEnabled - ) - } - } - } - } - self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) - } - - twoGroupsEnabled <- !(inherits(self, "SimulationResultsMeans") || inherits(self, "SimulationResultsMeansR6")) - multiArmSurvivalEnabled <- inherits(self, "SimulationResultsMultiArmSurvival") || inherits(self, "SimulationResultsMultiArmSurvivalR6") - enrichmentEnabled <- grepl("SimulationResultsEnrichment", .getClassName(self)) - - if (!is.null(performanceScore)) { - performanceScore$.showParametersOfOneGroup( - performanceScore$.getGeneratedParameters(), "Performance", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - performanceScore$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - } - - if (self$.design$kMax > 1 || twoGroupsEnabled || multiArmSurvivalEnabled) { - self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) - - if (multiArmSurvivalEnabled) { - self$.cat(" (i): values of treatment arm i compared to control\n", consoleOutputEnabled = consoleOutputEnabled) - self$.cat(" {j}: values of treatment arm j\n", consoleOutputEnabled = consoleOutputEnabled) - } else if (enrichmentEnabled) { - matrixName <- .getSimulationEnrichmentEffectMatrixName(self) - if (nrow(self$effectList[[matrixName]]) > 1) { - self$.cat(" (i): results of situation i\n", consoleOutputEnabled = consoleOutputEnabled) - } - } else if (twoGroupsEnabled) { - self$.cat(" (i): values of treatment arm i\n", consoleOutputEnabled = consoleOutputEnabled) - } - if (self$.design$kMax > 1) { - self$.cat(" [k]: values at stage k\n", consoleOutputEnabled = consoleOutputEnabled) - } - - if (enrichmentEnabled) { - if (length(self$effectList$subGroups) > 1) { - self$.cat(paste0(" S[i]: population i\n"), consoleOutputEnabled = consoleOutputEnabled) - } - self$.cat(paste0(" F: full population\n"), consoleOutputEnabled = consoleOutputEnabled) - if (length(self$effectList$subGroups) > 1) { - self$.cat(paste0(" R: remaining population\n"), consoleOutputEnabled = consoleOutputEnabled) - } - } - - self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) - } - } - }, - .getVariedParameterName = function(number = 1) { - if (number == 2) { - if (!(inherits(self, "SimulationResultsMeans") || inherits(self, "SimulationResultsMeansR6")) && - !(inherits(self, "SimulationResultsRates") || inherits(self, "SimulationResultsRatesR6")) && - !(inherits(self, "SimulationResultsSurvival") || inherits(self, "SimulationResultsSurvivalR6")) && - grepl("MultiArm", .getClassName(self))) { - return("armNumber") - } - return(NA_character_) - } - - variedParameterName1 <- NA_character_ - if (inherits(self, "SimulationResultsMeans") || inherits(self, "SimulationResultsMeansR6")) { - variedParameterName1 <- "alternative" - } else if (inherits(self, "SimulationResultsRates") || inherits(self, "SimulationResultsRatesR6") || inherits(self, "SimulationResultsSurvival") || inherits(self, "SimulationResultsSurvivalR6")) { - variedParameterName1 <- "pi1" - } else if (grepl("MultiArm", .getClassName(self))) { - if (inherits(self, "SimulationResultsMultiArmMeans") || inherits(self, "SimulationResultsMultiArmMeansR6")) { - variedParameterName1 <- "muMax" - } else if (inherits(self, "SimulationResultsMultiArmRates") || inherits(self, "SimulationResultsMultiArmRatesR6")) { - variedParameterName1 <- "piMax" - } else if (inherits(self, "SimulationResultsMultiArmSurvival") || inherits(self, "SimulationResultsMultiArmSurvivalR6")) { - variedParameterName1 <- "omegaMax" - } - } - return(variedParameterName1) - }, - .getVariedParameterValues = function(variedParameterName) { - if (is.na(variedParameterName)) { - return(NA_real_) - } - - parameterValues <- self$.data[[variedParameterName]] - if (is.null(parameterValues)) { - return(NA_real_) - } - - parameterValues <- unique(parameterValues) - if (length(parameterValues) > 1 && !any(is.na(parameterValues))) { - parameterValues <- sort(parameterValues) - } - return(parameterValues) - }, - .getVariedParameterValueString = function(variedParameterName, parameterValue) { - if (variedParameterName %in% c("armNumber")) { - return(paste0(" (", parameterValue[1], ")")) - } - variedParameterName <- sub("Max$", "_max", variedParameterName) - return(paste0(", ", variedParameterName, " = ", round(parameterValue[1], 4))) - }, - .catStatisticsLine = function(..., stage, parameterName, paramCaption, - parameterValue1, variedParameterName1, parameterValue2 = NA_real_, - variedParameterName2 = NA_character_, consoleOutputEnabled = TRUE) { - if (stage == 1 && parameterName == "conditionalPowerAchieved") { - return(invisible()) - } - - postfix <- "" - if (!is.na(parameterValue1)) { - if (!all(is.na(parameterValue2))) { - postfix <- paste0(postfix, self$.getVariedParameterValueString( - variedParameterName1, parameterValue1 - )) - if (parameterName != "subjectsControlArm") { - postfix <- paste0(postfix, self$.getVariedParameterValueString( - variedParameterName2, parameterValue2 - )) - } - paramValue <- self$.data[[parameterName]][ - self$.data$stageNumber == stage & - self$.data[[variedParameterName1]] == parameterValue1 & - self$.data[[variedParameterName2]] %in% parameterValue2 - ] - } else { - postfix <- paste0(postfix, self$.getVariedParameterValueString( - variedParameterName1, parameterValue1 - )) - paramValue <- self$.data[[parameterName]][ - self$.data$stageNumber == stage & - self$.data[[variedParameterName1]] == parameterValue1 - ] - } - } else { - paramValue <- self$.data[[parameterName]][ - self$.data$stageNumber == stage - ] - } - if (self$.design$kMax > 1) { - postfix <- paste0(postfix, " [", stage, "]") - } - - if (!consoleOutputEnabled) { - paramCaption <- paste0("*", paramCaption, "*") - } - - variableNameFormatted <- .getFormattedVariableName( - name = paramCaption, - n = self$.getNChar(), prefix = "", postfix = postfix - ) - - if (!is.null(paramValue)) { - paramValue <- stats::na.omit(paramValue) - if (length(paramValue) > 0 && is.numeric(paramValue)) { - paramValueFormatted <- paste0( - "median [range]: ", round(stats::median(paramValue), 3), - " [", paste(round(base::range(paramValue), 3), collapse = " - "), "]; ", - "mean +/-sd: ", round(base::mean(paramValue), 3), " +/-", round(stats::sd(paramValue), 3) - ) - } else { - paramValueFormatted <- "median [range]: NA [NA - NA]; mean +/sd: NA +/-NA" - } - output <- paste(variableNameFormatted, paramValueFormatted, "\n") - if (!grepl(": median \\[range\\]: NA \\[NA - NA\\]", output)) { - self$.cat(output, consoleOutputEnabled = consoleOutputEnabled) - } - } - }, - .toString = function(startWithUpperCase = FALSE) { - s <- "simulation of" - - if (grepl("MultiArm", .getClassName(self)) && !is.null(self[["activeArms"]]) && self$activeArms > 1) { - s <- paste(s, "multi-arm") - } - - if (grepl("Enrichment", .getClassName(self)) && !is.null(self[["populations"]]) && self$populations > 1) { - s <- paste(s, "enrichment") - } - - if (inherits(self, "SimulationResultsBaseMeans") || inherits(self, "SimulationResultsBaseMeansR6")) { - s <- paste(s, "means") - } else if (inherits(self, "SimulationResultsBaseRates") || inherits(self, "SimulationResultsBaseRatesR6")) { - s <- paste(s, "rates") - } else if (inherits(self, "SimulationResultsBaseSurvival") || inherits(self, "SimulationResultsBaseSurvivalR6")) { - s <- paste(s, "survival data") - } else { - s <- paste(s, "results") - } - - if (self$.design$kMax > 1) { - if (.isTrialDesignGroupSequential(self$.design)) { - s <- paste(s, "(group sequential design)") - } else if (.isTrialDesignInverseNormal(self$.design)) { - s <- paste(s, "(inverse normal combination test design)") - } else if (.isTrialDesignFisher(self$.design)) { - s <- paste(s, "(Fisher's combination test design)") - } else if (.isTrialDesignConditionalDunnett(self$.design)) { - s <- paste(s, "(conditional Dunnett design)") - } - } else { - s <- paste(s, "(fixed sample size design)") - } - return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) - }, - .getParametersToShow = function() { - parametersToShow <- self$.getVisibleFieldNames() - y <- c( - "eventsPerStage", - "overallEventsPerStage", - "iterations", - "overallReject", # base - "rejectAtLeastOne", - "rejectPerStage", - "rejectedArmsPerStage", - "rejectedPopulationsPerStage" - ) - if (self$.design$kMax > 2) { - y <- c(y, "futilityStop") - } - y <- c( - y, - "futilityPerStage", - "earlyStop", # base - "successPerStage", - "selectedArms", - "selectedPopulations", - "numberOfActiveArms", - "numberOfPopulations", - "expectedNumberOfSubjects", - "expectedNumberOfEvents", - "sampleSizes", - "singleNumberOfEventsPerStage", - "conditionalPowerAchieved" # base - ) - parametersToShow <- c(parametersToShow[!(parametersToShow %in% y)], y[y %in% parametersToShow]) - return(parametersToShow) - }, - .isSampleSizeObject = function() { - return(FALSE) - }, - getRawDataResults = function(maxNumberOfIterations = NA_integer_) { - return(.getSimulationParametersFromRawData(self$.data, - variantName = self$.getVariedParameterName(), - maxNumberOfIterations = maxNumberOfIterations - )) - } - ) -) - -SimulationResultsBaseMeansR6 <- R6Class("SimulationResultsBaseMeansR6", - inherit = SimulationResultsR6, - public = list( - stDev =NULL, - plannedSubjects =NULL, - minNumberOfSubjectsPerStage =NULL, - maxNumberOfSubjectsPerStage =NULL, - thetaH1 =NULL, - stDevH1 =NULL, - calcSubjectsFunction =NULL, - expectedNumberOfSubjects =NULL, - initialize = function(design, ...) { - super$initialize(design = design, ...) - generatedParams <- c( - "iterations", - "expectedNumberOfSubjects", - "sampleSizes", - "overallReject", - "rejectPerStage", - "futilityPerStage", - "earlyStop" - ) - if (design$kMax > 2) { - generatedParams <- c(generatedParams, "futilityStop") - } - for (generatedParam in generatedParams) { - self$.setParameterType(generatedParam, C_PARAM_GENERATED) - } - } - ) -) - -#' -#' @name SimulationResultsMeans -#' -#' @title -#' Class for Simulation Results Means -#' -#' @description -#' A class for simulation results means. -#' -#' @template field_maxNumberOfIterations -#' @template field_seed -#' @template field_allocationRatioPlanned -#' @template field_conditionalPower -#' @template field_iterations -#' @template field_futilityPerStage -#' @template field_futilityStop -#' @template field_stDev -#' @template field_plannedSubjects -#' @template field_minNumberOfSubjectsPerStage -#' @template field_maxNumberOfSubjectsPerStage -#' @template field_thetaH1 -#' @template field_stDevH1 -#' @template field_calcSubjectsFunction -#' @template field_expectedNumberOfSubjects -#' @template field_meanRatio -#' @template field_thetaH0 -#' @template field_normalApproximation -#' @template field_alternative -#' @template field_groups -#' @template field_directionUpper -#' @template field_effect -#' @template field_earlyStop -#' @template field_sampleSizes -#' @template field_overallReject -#' @template field_rejectPerStage -#' @template field_conditionalPowerAchieved -#' -#' @details -#' Use \code{\link[=getSimulationMeans]{getSimulationMeans()}} to create an object of this type. -#' -#' \code{SimulationResultsMeans} is the basic class for -#' \itemize{ -#' \item \code{\link{SimulationResultsMeans}}, -#' \item \code{\link{SimulationResultsMultiArmMeans}}, and -#' \item \code{\link{SimulationResultsEnrichmentMeans}}. -#' } -#' -#' @include class_core_parameter_set.R -#' @include class_core_plot_settings.R -#' @include class_design.R -#' @include f_core_constants.R -#' @include class_time.R -#' @include f_simulation_base_survival.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -SimulationResultsMeansR6 <- R6Class("SimulationResultsMeansR6", - inherit = SimulationResultsBaseMeansR6, - public = list( - meanRatio =NULL, - thetaH0 =NULL, - normalApproximation =NULL, - alternative =NULL, - groups =NULL, - directionUpper =NULL, - effect =NULL, - earlyStop =NULL, - sampleSizes =NULL, - overallReject =NULL, # = rejectedArmsPerStage in multi-arm - rejectPerStage =NULL, - conditionalPowerAchieved =NULL, - initialize = function(design, ...) { - super$initialize(design = design, ...) - } - ) -) - - -#' -#' @name SimulationResultsMultiArmMeans -#' -#' @title -#' Class for Simulation Results Multi-Arm Means -#' -#' @description -#' A class for simulation results means in multi-arm designs. -#' -#' @template field_maxNumberOfIterations -#' @template field_seed -#' @template field_allocationRatioPlanned -#' @template field_conditionalPower -#' @template field_iterations -#' @template field_futilityPerStage -#' @template field_futilityStop -#' @template field_stDev -#' @template field_plannedSubjects -#' @template field_minNumberOfSubjectsPerStage -#' @template field_maxNumberOfSubjectsPerStage -#' @template field_thetaH1 -#' @template field_stDevH1 -#' @template field_calcSubjectsFunction -#' @template field_expectedNumberOfSubjects -#' @template field_activeArms -#' @template field_effectMatrix -#' @template field_typeOfShape -#' @template field_muMaxVector -#' @template field_gED50 -#' @template field_slope -#' @template field_intersectionTest -#' @template field_adaptations -#' @template field_typeOfSelection -#' @template field_effectMeasure -#' @template field_successCriterion -#' @template field_epsilonValue -#' @template field_rValue -#' @template field_threshold -#' @template field_selectArmsFunction -#' @template field_earlyStop -#' @template field_selectedArms -#' @template field_numberOfActiveArms -#' @template field_rejectAtLeastOne -#' @template field_rejectedArmsPerStage -#' @template field_successPerStage -#' @template field_sampleSizes -#' @template field_conditionalPowerAchieved -#' -#' @details -#' Use \code{\link[=getSimulationMultiArmMeans]{getSimulationMultiArmMeans()}} to create an object of this type. -#' -#' @include class_core_parameter_set.R -#' @include class_core_plot_settings.R -#' @include class_design.R -#' @include f_core_constants.R -#' @include class_time.R -#' @include f_simulation_base_survival.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -SimulationResultsMultiArmMeansR6 <- R6Class("SimulationResultsMultiArmMeansR6", - inherit = SimulationResultsBaseMeansR6, - public = list( - activeArms = NULL, - effectMatrix = NULL, - typeOfShape = NULL, - muMaxVector = NULL, - gED50 = NULL, - slope = NULL, - intersectionTest = NULL, - adaptations = NULL, - typeOfSelection = NULL, - effectMeasure = NULL, - successCriterion = NULL, - epsilonValue = NULL, - rValue = NULL, - threshold = NULL, - selectArmsFunction = NULL, - earlyStop = NULL, - selectedArms = NULL, - numberOfActiveArms = NULL, - rejectAtLeastOne = NULL, - rejectedArmsPerStage = NULL, - successPerStage = NULL, - sampleSizes = NULL, - conditionalPowerAchieved = matrix(), - initialize = function(design, ...) { - super$initialize(design = design, ...) - - for (generatedParam in c( - "rejectAtLeastOne", - "selectedArms", - "numberOfActiveArms", - "rejectedArmsPerStage", - "successPerStage" - )) { - self$.setParameterType(generatedParam, C_PARAM_GENERATED) - } - } - ) -) - -SimulationResultsBaseRatesR6 <- R6Class("SimulationResultsBaseRatesR6", - inherit = SimulationResultsR6, - public = list( - directionUpper = NULL, - plannedSubjects = NULL, - minNumberOfSubjectsPerStage = NULL, - maxNumberOfSubjectsPerStage = NULL, - calcSubjectsFunction = NULL, - expectedNumberOfSubjects = NULL, - initialize = function(design, ...) { - super$initialize(design = design, ...) - generatedParams <- c( - "iterations", - "expectedNumberOfSubjects", - "sampleSizes", - "overallReject", - "rejectPerStage", - "futilityPerStage", - "earlyStop" - ) - if (design$kMax > 2) { - generatedParams <- c(generatedParams, "futilityStop") - } - for (generatedParam in generatedParams) { - self$.setParameterType(generatedParam, C_PARAM_GENERATED) - } - } - ) -) - - -#' -#' @name SimulationResultsRates -#' -#' @title -#' Class for Simulation Results Rates -#' -#' @description -#' A class for simulation results rates. -#' -#' @template field_maxNumberOfIterations -#' @template field_seed -#' @template field_allocationRatioPlanned -#' @template field_conditionalPower -#' @template field_iterations -#' @template field_futilityPerStage -#' @template field_futilityStop -#' @template field_directionUpper -#' @template field_plannedSubjects -#' @template field_maxNumberOfSubjects -#' @template field_calcSubjectsFunction -#' @template field_expectedNumberOfSubjects -#' @template field_riskRatio -#' @template field_thetaH0 -#' @template field_normalApproximation -#' @template field_pi1 -#' @template field_pi2 -#' @template field_groups -#' @template field_pi1H1 -#' @template field_pi2H1 -#' @template field_effect -#' @template field_earlyStop -#' @template field_sampleSizes -#' @template field_overallReject -#' @template field_rejectPerStage -#' @template field_conditionalPowerAchieved -#' -#' -#' @details -#' Use \code{\link[=getSimulationRates]{getSimulationRates()}} to create an object of this type. -#' -#' \code{SimulationResultsRates} is the basic class for -#' \itemize{ -#' \item \code{\link{SimulationResultsRates}}, -#' \item \code{\link{SimulationResultsMultiArmRates}}, and -#' \item \code{\link{SimulationResultsEnrichmentRates}}. -#' } -#' -#' @include class_core_parameter_set.R -#' @include class_core_plot_settings.R -#' @include class_design.R -#' @include f_core_constants.R -#' @include class_time.R -#' @include f_simulation_base_survival.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -SimulationResultsRatesR6 <- R6Class("SimulationResultsRatesR6", - inherit = SimulationResultsBaseRatesR6, - public = list( - riskRatio = NULL, - thetaH0 = NULL, - normalApproximation = NULL, - pi1 = NULL, - pi2 = NULL, - groups = NULL, - #directionUpper = NULL, - pi1H1 = NULL, - pi2H1 = NULL, - effect = NULL, - earlyStop = NULL, - sampleSizes = NULL, - overallReject = NULL, - rejectPerStage = NULL, - conditionalPowerAchieved = matrix(), - initialize = function(design, ...) { - super$initialize(design = design, ...) - generatedParams <- c( - "effect", - "iterations", - "sampleSizes", - "eventsNotAchieved", - "expectedNumberOfSubjects", - "overallReject", - "rejectPerStage", - "futilityPerStage", - "earlyStop", - "analysisTime", - "studyDuration" - ) - if (design$kMax > 2) { - generatedParams <- c(generatedParams, "futilityStop") - } - for (generatedParam in generatedParams) { - self$.setParameterType(generatedParam, C_PARAM_GENERATED) - } - } - ) -) - - -#' -#' @name SimulationResultsMultiArmRates -#' -#' @title -#' Class for Simulation Results Multi-Arm Rates -#' -#' @description -#' A class for simulation results rates in multi-arm designs. -#' -#' @template field_maxNumberOfIterations -#' @template field_seed -#' @template field_allocationRatioPlanned -#' @template field_conditionalPower -#' @template field_iterations -#' @template field_futilityPerStage -#' @template field_futilityStop -#' @template field_directionUpper -#' @template field_plannedSubjects -#' @template field_maxNumberOfSubjects -#' @template field_calcSubjectsFunction -#' @template field_expectedNumberOfSubjects -#' @template field_activeArms -#' @template field_effectMatrix -#' @template field_typeOfShape -#' @template field_piMaxVector -#' @template field_piControl -#' @template field_piH1 -#' @template field_piControlH1 -#' @template field_gED50 -#' @template field_slope -#' @template field_intersectionTest -#' @template field_adaptations -#' @template field_typeOfSelection -#' @template field_effectMeasure -#' @template field_successCriterion -#' @template field_epsilonValue -#' @template field_rValue -#' @template field_threshold -#' @template field_selectArmsFunction -#' @template field_earlyStop -#' @template field_selectedArms -#' @template field_numberOfActiveArms -#' @template field_rejectAtLeastOne -#' @template field_rejectedArmsPerStage -#' @template field_successPerStage -#' @template field_sampleSizes -#' @template field_conditionalPowerAchieved -#' -#' -#' @details -#' Use \code{\link[=getSimulationMultiArmRates]{getSimulationMultiArmRates()}} to create an object of this type. -#' -#' @include class_core_parameter_set.R -#' @include class_core_plot_settings.R -#' @include class_design.R -#' @include f_core_constants.R -#' @include class_time.R -#' @include f_simulation_base_survival.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -SimulationResultsMultiArmRatesR6 <- R6Class("SimulationResultsMultiArmRatesR6", - inherit = SimulationResultsBaseRatesR6, - public = list( - activeArms = NULL, - effectMatrix = NULL, - typeOfShape = NULL, - piMaxVector = NULL, - piControl = NULL, - piTreatmentsH1 = NULL, - piControlH1 = NULL, - gED50 = NULL, - slope = NULL, - intersectionTest = NULL, - adaptations = NULL, - typeOfSelection = NULL, - effectMeasure = NULL, - successCriterion = NULL, - epsilonValue = NULL, - rValue = NULL, - threshold = NULL, - selectArmsFunction = NULL, - earlyStop = NULL, - selectedArms = NULL, - numberOfActiveArms = NULL, - rejectAtLeastOne = NULL, - rejectedArmsPerStage = NULL, - successPerStage = NULL, - sampleSizes = NULL, - conditionalPowerAchieved = matrix(), - initialize = function(design, ...) { - super$initialize(design = design, ...) - - for (generatedParam in c( - "rejectAtLeastOne", - "selectedArms", - "numberOfActiveArms", - "rejectedArmsPerStage", - "successPerStage" - )) { - self$.setParameterType(generatedParam, C_PARAM_GENERATED) - } - } - ) -) - -SimulationResultsBaseSurvivalR6 <- R6Class("SimulationResultsBaseSurvivalR6", - inherit = SimulationResultsR6, - public = list( - directionUpper = NULL, - plannedEvents = NULL, - minNumberOfEventsPerStage = NULL, - maxNumberOfEventsPerStage = NULL, - thetaH1 = NULL, - calcEventsFunction = NULL, - expectedNumberOfEvents = NULL, - conditionalPowerAchieved = matrix(), #TODO remove? - initialize = function(design, ...) { - super$initialize(design = design, ...) - generatedParams <- c( - "iterations", - "expectedNumberOfEvents", - "eventsPerStage", - "overallReject", - "rejectPerStage", - "futilityPerStage", - "earlyStop" - ) - if (design$kMax > 2) { - generatedParams <- c(generatedParams, "futilityStop") - } - for (generatedParam in generatedParams) { - self$.setParameterType(generatedParam, C_PARAM_GENERATED) - } - } - ) -) - -#' -#' @name SimulationResultsSurvival -#' -#' @title -#' Class for Simulation Results Survival -#' -#' @description -#' A class for simulation results survival. -#' -#' @template field_maxNumberOfIterations -#' @template field_seed -#' @template field_allocationRatioPlanned -#' @template field_conditionalPower -#' @template field_iterations -#' @template field_futilityPerStage -#' @template field_futilityStop -#' @template field_directionUpper -#' @template field_plannedEvents -#' @template field_minNumberOfEventsPerStage -#' @template field_maxNumberOfEventsPerStage -#' @template field_thetaH1 -#' @template field_calcEventsFunction -#' @template field_expectedNumberOfEvents -#' @template field_pi1_survival -#' @template field_pi2_survival -#' @template field_median1 -#' @template field_median2 -#' @template field_maxNumberOfSubjects -#' @template field_accrualTime -#' @template field_accrualIntensity -#' @template field_dropoutRate1 -#' @template field_dropoutRate2 -#' @template field_dropoutTime -#' @template field_eventTime -#' @template field_thetaH0 -#' @template field_allocation1 -#' @template field_allocation2 -#' @template field_kappa -#' @template field_piecewiseSurvivalTime -#' @template field_lambda1 -#' @template field_lambda2 -#' @template field_earlyStop -#' @template field_hazardRatio -#' @template field_studyDuration -#' @template field_eventsNotAchieved -#' @template field_numberOfSubjects -#' @template field_numberOfSubjects1 -#' @template field_numberOfSubjects2 -#' @template field_eventsPerStage -#' @template field_overallEventsPerStage -#' @template field_expectedNumberOfSubjects -#' @template field_rejectPerStage -#' @template field_overallReject -#' @template field_conditionalPowerAchieved -#' -#' @details -#' Use \code{\link[=getSimulationSurvival]{getSimulationSurvival()}} to create an object of this type. -#' -#' \code{SimulationResultsSurvival} is the basic class for -#' \itemize{ -#' \item \code{\link{SimulationResultsSurvival}}, -#' \item \code{\link{SimulationResultsMultiArmSurvival}}, and -#' \item \code{\link{SimulationResultsEnrichmentSurvival}}. -#' } -#' -#' @include class_core_parameter_set.R -#' @include class_core_plot_settings.R -#' @include class_design.R -#' @include f_core_constants.R -#' @include class_time.R -#' @include f_simulation_base_survival.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -SimulationResultsSurvivalR6 <- R6Class("SimulationResultsSurvivalR6", - inherit = SimulationResultsBaseSurvivalR6, - public = list( - .piecewiseSurvivalTime = NULL, - .accrualTime = NULL, - pi1 = NULL, - pi2 = NULL, - median1 = NULL, - median2 = NULL, - maxNumberOfSubjects = NULL, - accrualTime = NULL, - accrualIntensity = NULL, - dropoutRate1 = NULL, - dropoutRate2 = NULL, - dropoutTime = NULL, - eventTime = NULL, - thetaH0 = NULL, - allocation1 = NULL, - allocation2 = NULL, - kappa = NULL, - piecewiseSurvivalTime = NULL, - lambda1 = NULL, - lambda2 = NULL, - earlyStop = NULL, - hazardRatio = NULL, - analysisTime = NULL, - studyDuration = NULL, - eventsNotAchieved = NULL, - numberOfSubjects = NULL, - numberOfSubjects1 = NULL, - numberOfSubjects2 = NULL, - eventsPerStage = NULL, - overallEventsPerStage = NULL, - expectedNumberOfSubjects = NULL, - rejectPerStage = NULL, - overallReject = NULL, - conditionalPowerAchieved = matrix(), - initialize = function(design, ...) { - super$initialize(design = design, ...) - generatedParams <- c( - "hazardRatio", - "iterations", - "eventsPerStage", - "singleNumberOfEventsPerStage", - "expectedNumberOfEvents", - "eventsNotAchieved", - "numberOfSubjects", - "expectedNumberOfSubjects", - "overallReject", - "rejectPerStage", - "futilityPerStage", - "earlyStop", - "analysisTime", - "studyDuration", - "allocationRatioPlanned" - ) - if (design$kMax > 2) { - generatedParams <- c(generatedParams, "futilityStop") - } - for (generatedParam in generatedParams) { - self$.setParameterType(generatedParam, C_PARAM_GENERATED) - } - self$.setParameterType("numberOfSubjects1", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("numberOfSubjects2", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("median1", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("median2", C_PARAM_NOT_APPLICABLE) - } - ) -) - -#' -#' @name SimulationResultsMultiArmSurvival -#' -#' @title -#' Class for Simulation Results Multi-Arm Survival -#' -#' @description -#' A class for simulation results survival in multi-arm designs. -#' -#' @template field_maxNumberOfIterations -#' @template field_seed -#' @template field_allocationRatioPlanned -#' @template field_conditionalPower -#' @template field_iterations -#' @template field_futilityPerStage -#' @template field_futilityStop -#' @template field_directionUpper -#' @template field_plannedEvents -#' @template field_minNumberOfEventsPerStage -#' @template field_maxNumberOfEventsPerStage -#' @template field_expectedNumberOfEvents -#' @template field_activeArms -#' @template field_effectMatrix -#' @template field_typeOfShape -#' @template field_omegaMaxVector -#' @template field_gED50 -#' @template field_slope -#' @template field_intersectionTest -#' @template field_adaptations -#' @template field_epsilonValue -#' @template field_rValue -#' @template field_threshold -#' @template field_selectArmsFunction -#' @template field_correlationComputation -#' @template field_earlyStop -#' @template field_selectedArms -#' @template field_numberOfActiveArms -#' @template field_rejectAtLeastOne -#' @template field_rejectedArmsPerStage -#' @template field_successPerStage -#' @template field_eventsPerStage -#' @template field_singleNumberOfEventsPerStage -#' @template field_conditionalPowerAchieved -#' -#' @details -#' Use \code{\link[=getSimulationMultiArmSurvival]{getSimulationMultiArmSurvival()}} to create an object of this type. -#' -#' @include class_core_parameter_set.R -#' @include class_core_plot_settings.R -#' @include class_design.R -#' @include f_core_constants.R -#' @include class_time.R -#' @include f_simulation_base_survival.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -SimulationResultsMultiArmSurvivalR6 <- R6Class("SimulationResultsMultiArmSurvivalR6", - inherit = SimulationResultsBaseSurvivalR6, - public = list( - activeArms = NULL, - effectMatrix = NULL, - typeOfShape = NULL, - omegaMaxVector = NULL, - gED50 = NULL, - slope = NULL, - intersectionTest = NULL, - adaptations = NULL, - typeOfSelection = NULL, - effectMeasure = NULL, - successCriterion = NULL, - epsilonValue = NULL, - rValue = NULL, - threshold = NULL, - selectArmsFunction = NULL, - correlationComputation = NULL, - earlyStop = NULL, - selectedArms = NULL, - numberOfActiveArms = NULL, - rejectAtLeastOne = NULL, - rejectedArmsPerStage = NULL, - successPerStage = NULL, - eventsPerStage = NULL, - singleNumberOfEventsPerStage = NULL, - conditionalPowerAchieved = matrix(), - initialize = function(design, ...) { - super$initialize(design = design, ...) - - for (generatedParam in c( - "rejectAtLeastOne", - "selectedArms", - "numberOfActiveArms", - "rejectedArmsPerStage", - "successPerStage" - )) { - self$.setParameterType(generatedParam, C_PARAM_GENERATED) - } - } - ) -) - -#' -#' @name SimulationResultsEnrichmentMeans -#' -#' @title -#' Class for Simulation Results Enrichment Means -#' -#' @description -#' A class for simulation results means in enrichment designs. -#' -#' @template field_maxNumberOfIterations -#' @template field_seed -#' @template field_allocationRatioPlanned -#' @template field_conditionalPower -#' @template field_iterations -#' @template field_futilityPerStage -#' @template field_futilityStop -#' @template field_stDev -#' @template field_plannedSubjects -#' @template field_minNumberOfSubjectsPerStage -#' @template field_maxNumberOfSubjectsPerStage -#' @template field_thetaH1 -#' @template field_stDevH1 -#' @template field_calcSubjectsFunction -#' @template field_expectedNumberOfSubjects -#' @template field_populations -#' @template field_effectList -#' @template field_intersectionTest -#' @template field_stratifiedAnalysis -#' @template field_adaptations -#' @template field_typeOfSelection -#' @template field_effectMeasure -#' @template field_successCriterion -#' @template field_epsilonValue -#' @template field_rValue -#' @template field_threshold -#' @template field_selectPopulationsFunction -#' @template field_earlyStop -#' @template field_selectedPopulations -#' @template field_numberOfPopulations -#' @template field_rejectAtLeastOne -#' @template field_rejectedPopulationsPerStage -#' @template field_successPerStage -#' @template field_sampleSizes -#' @template field_conditionalPowerAchieved -#' -#' @details -#' Use \code{\link[=getSimulationEnrichmentMeans]{getSimulationEnrichmentMeans()}} to create an object of this type. -#' -#' @include class_core_parameter_set.R -#' @include class_core_plot_settings.R -#' @include class_design.R -#' @include f_core_constants.R -#' @include class_time.R -#' @include f_simulation_base_survival.R -#' @include class_simulation_results.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -SimulationResultsEnrichmentMeansR6 <- R6Class("SimulationResultsEnrichmentMeansR6", - inherit = SimulationResultsBaseMeansR6, - public = list( - populations = NULL, - effectList = NULL, - intersectionTest = NULL, - stratifiedAnalysis = NULL, - adaptations = NULL, - typeOfSelection = NULL, - effectMeasure = NULL, - successCriterion = NULL, - epsilonValue = NULL, - rValue = NULL, - threshold = NULL, - selectPopulationsFunction = NULL, - earlyStop = NULL, - selectedPopulations = NULL, - numberOfPopulations = NULL, - rejectAtLeastOne = NULL, - rejectedPopulationsPerStage = NULL, - successPerStage = NULL, - sampleSizes = NULL, - conditionalPowerAchieved = matrix(), - initialize = function(design, ...) { - super$initialize(design = design, ...) - - for (generatedParam in c( - "rejectAtLeastOne", - "selectedPopulations", - "numberOfPopulations", - "rejectedPopulationsPerStage", - "successPerStage" - )) { - self$.setParameterType(generatedParam, C_PARAM_GENERATED) - } - } - ) -) - -#' -#' @name SimulationResultsEnrichmentRates -#' -#' @title -#' Class for Simulation Results Enrichment Rates -#' -#' @description -#' A class for simulation results rates in enrichment designs. -#' -#' @template field_maxNumberOfIterations -#' @template field_seed -#' @template field_allocationRatioPlanned -#' @template field_conditionalPower -#' @template field_iterations -#' @template field_futilityPerStage -#' @template field_futilityStop -#' @template field_directionUpper -#' @template field_plannedSubjects -#' @template field_minNumberOfSubjectsPerStage -#' @template field_maxNumberOfSubjectsPerStage -#' @template field_calcSubjectsFunction -#' @template field_expectedNumberOfSubjects -#' @template field_populations -#' @template field_effectList -#' @template field_intersectionTest -#' @template field_stratifiedAnalysis -#' @template field_adaptations -#' @template field_piTreatmentH1 -#' @template field_piControlH1 -#' @template field_typeOfSelection -#' @template field_effectMeasure -#' @template field_successCriterion -#' @template field_epsilonValue -#' @template field_rValue -#' @template field_threshold -#' @template field_selectPopulationsFunction -#' @template field_earlyStop -#' @template field_selectedPopulations -#' @template field_numberOfPopulations -#' @template field_rejectAtLeastOne -#' @template field_rejectedPopulationsPerStage -#' @template field_successPerStage -#' @template field_sampleSizes -#' @template field_conditionalPowerAchieved -#' -#' @details -#' Use \code{\link[=getSimulationEnrichmentRates]{getSimulationEnrichmentRates()}} to create an object of this type. -#' -#' @include class_core_parameter_set.R -#' @include class_core_plot_settings.R -#' @include class_design.R -#' @include f_core_constants.R -#' @include class_time.R -#' @include f_simulation_base_survival.R -#' @include class_simulation_results.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -SimulationResultsEnrichmentRatesR6 <- R6Class("SimulationResultsEnrichmentRatesR6", - inherit = SimulationResultsBaseRatesR6, - public = list( - populations = NULL, - effectList = NULL, - intersectionTest = NULL, - stratifiedAnalysis = NULL, - adaptations = NULL, - piTreatmentH1 = NULL, - piControlH1 = NULL, - typeOfSelection = NULL, - effectMeasure = NULL, - successCriterion = NULL, - epsilonValue = NULL, - rValue = NULL, - threshold = NULL, - selectPopulationsFunction = NULL, - earlyStop = NULL, - selectedPopulations = NULL, - numberOfPopulations = NULL, - rejectAtLeastOne = NULL, - rejectedPopulationsPerStage = NULL, - successPerStage = NULL, - sampleSizes = NULL, - conditionalPowerAchieved = matrix(), - initialize = function(design, ...) { - super$initialize(design = design, ...) - - for (generatedParam in c( - "rejectAtLeastOne", - "selectedPopulations", - "numberOfPopulations", - "rejectedPopulationsPerStage", - "successPerStage" - )) { - self$.setParameterType(generatedParam, C_PARAM_GENERATED) - } - } - ) -) - -#' -#' @name SimulationResultsEnrichmentSurvival -#' -#' @title -#' Class for Simulation Results Enrichment Survival -#' -#' @description -#' A class for simulation results survival in enrichment designs. -#' -#' @template field_maxNumberOfIterations -#' @template field_seed -#' @template field_allocationRatioPlanned -#' @template field_conditionalPower -#' @template field_iterations -#' @template field_futilityPerStage -#' @template field_futilityStop -#' @template field_directionUpper -#' @template field_plannedSubjects -#' @template field_minNumberOfSubjectsPerStage -#' @template field_maxNumberOfSubjectsPerStage -#' @template field_thetaH1_survival -#' @template field_calcEventsFunction -#' @template field_expectedNumberOfEvents -#' @template field_populations -#' @template field_effectList -#' @template field_intersectionTest -#' @template field_stratifiedAnalysis -#' @template field_adaptations -#' @template field_typeOfSelection -#' @template field_effectMeasure -#' @template field_successCriterion -#' @template field_epsilonValue -#' @template field_rValue -#' @template field_threshold -#' @template field_selectPopulationsFunction -#' @template field_correlationComputation -#' @template field_earlyStop -#' @template field_selectedPopulations -#' @template field_numberOfPopulations -#' @template field_rejectAtLeastOne -#' @template field_rejectedPopulationsPerStage -#' @template field_successPerStage -#' @template field_eventsPerStage -#' @template field_singleNumberOfEventsPerStage -#' @template field_conditionalPowerAchieved -#' -#' @details -#' Use \code{\link[=getSimulationEnrichmentSurvival]{getSimulationEnrichmentSurvival()}} to create an object of this type. -#' -#' @include class_core_parameter_set.R -#' @include class_core_plot_settings.R -#' @include class_design.R -#' @include f_core_constants.R -#' @include class_time.R -#' @include f_simulation_base_survival.R -#' @include class_simulation_results.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -SimulationResultsEnrichmentSurvivalR6 <- R6Class("SimulationResultsEnrichmentSurvivalR6", - inherit = SimulationResultsBaseSurvivalR6, - public = list( - populations = NULL, - effectList = NULL, - intersectionTest = NULL, - stratifiedAnalysis = NULL, - adaptations = NULL, - typeOfSelection = NULL, - effectMeasure = NULL, - successCriterion = NULL, - epsilonValue = NULL, - rValue = NULL, - threshold = NULL, - selectPopulationsFunction = NULL, - correlationComputation = NULL, - earlyStop = NULL, - selectedPopulations = NULL, - numberOfPopulations = NULL, - rejectAtLeastOne = NULL, - rejectedPopulationsPerStage = NULL, - successPerStage = NULL, - eventsPerStage = NULL, - singleNumberOfEventsPerStage = NULL, - conditionalPowerAchieved = matrix(), - initialize = function(design, ...) { - super$initialize(design = design, ...) - - for (generatedParam in c( - "rejectAtLeastOne", - "selectedPopulations", - "numberOfPopulations", - "rejectedPopulationsPerStage", - "successPerStage" - )) { - self$.setParameterType(generatedParam, C_PARAM_GENERATED) - } - } - ) -) - -.assertIsValidVariedParameterVectorForSimulationResultsPlotting <- function(simulationResults, plotType) { - if (inherits(simulationResults, "SimulationResultsMeans") || inherits(simulationResults, "SimulationResultsMeansR6")) { - if (is.null(simulationResults$alternative) || - any(is.na(simulationResults$alternative)) || - length(simulationResults$alternative) <= 1) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "plot type ", plotType, - " is only available if 'alternative' with length > 1 is defined" - ) - } - } else if (inherits(simulationResults, "SimulationResultsRates") || inherits(simulationResults, "SimulationResultsRatesR6")) { - if (is.null(simulationResults$pi1) || - any(is.na(simulationResults$pi1)) || - length(simulationResults$pi1) <= 1) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "plot type ", plotType, - " is only available if 'pi1' with length > 1 is defined" - ) - } - } else if (inherits(simulationResults, "SimulationResultsSurvival") || inherits(simulationResults, "SimulationResultsSurvivalR6")) { - if (is.null(simulationResults$hazardRatio) || - any(is.na(simulationResults$hazardRatio)) || - length(simulationResults$hazardRatio) <= 1) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "plot type ", plotType, - " is only available if 'hazardRatio' with length > 1 is defined or derived" - ) - } - if (length(simulationResults$hazardRatio) != length(simulationResults$overallReject)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "plot type ", plotType, - " is not available for piecewise survival (only type 13 and 14)" - ) - } - } -} - -.getSimulationPlotXAxisParameterName <- function(simulationResults, - showSource = FALSE, simulationResultsName = NA_character_) { - if (grepl("SimulationResultsEnrichment", .getClassName(simulationResults))) { - effectDataList <- .getSimulationEnrichmentEffectData(simulationResults) - if (ncol(effectDataList$effectData) == 1) { - if (!isFALSE(showSource)) { - return(paste0(simulationResultsName, "$effectList$", effectDataList$effectMatrixName, "[, 1]")) - } - - return(sub("s$", "", effectDataList$effectMatrixName)) - } - - if (!isFALSE(showSource)) { - numberOfSituations <- nrow(simulationResults$effectList[[effectDataList$effectMatrixName]]) - return(paste0("c(1:", numberOfSituations, ")")) - } - - return("situation") - } - - survivalEnabled <- grepl("Survival", .getClassName(simulationResults)) - meansEnabled <- grepl("Means", .getClassName(simulationResults)) - if (grepl("MultiArm", .getClassName(simulationResults))) { - if (!isFALSE(showSource)) { - gMax <- nrow(simulationResults$effectMatrix) - return(paste0(simulationResultsName, "$effectMatrix[", gMax, ", ]")) - } - - return("effectMatrix") - } - - if (grepl("Survival", .getClassName(simulationResults))) { - return("hazardRatio") - } - - return("effect") -} - -.getSimulationPlotXAxisLabel <- function(simulationResults, xlab = NULL) { - if (grepl("SimulationResultsEnrichment", .getClassName(simulationResults))) { - effectDataList <- .getSimulationEnrichmentEffectData(simulationResults) - if (ncol(effectDataList$effectData) == 1) { - xLabel <- simulationResults$.parameterNames[[effectDataList$effectMatrixName]] - return(sub("s$", "", xLabel)) - } - - return("Situation") - } - - multiArmEnabled <- grepl("MultiArm", .getClassName(simulationResults)) - userDefinedEffectMatrix <- multiArmEnabled && simulationResults$.getParameterType("effectMatrix") == C_PARAM_USER_DEFINED - if (!is.null(xlab) && !is.na(xlab)) { - return(xlab) - } - - if (!multiArmEnabled) { - return("Effect") - } - - return(ifelse(userDefinedEffectMatrix, "Effect Matrix Row", "Maximum Effect")) -} - -.getPowerAndStoppingProbabilities <- function(simulationResults, xValues, parameters) { - yParameterNames <- c() - - if ("expectedNumberOfEvents" %in% parameters) { - yParameterNames <- c(yParameterNames, "expectedNumberOfEvents") - } - if ("expectedNumberOfSubjects" %in% parameters) { - yParameterNames <- c(yParameterNames, "expectedNumberOfSubjects") - } - if ("rejectAtLeastOne" %in% parameters) { - yParameterNames <- c(yParameterNames, "rejectAtLeastOne") - } - if ("futilityStop" %in% parameters) { - yParameterNames <- c(yParameterNames, "futilityStop") - } - - yParameterNamesSrc <- yParameterNames - - data <- NULL - for (yParameterName in yParameterNames) { - category <- simulationResults$.parameterNames[[yParameterName]] - part <- data.frame( - categories = rep(category, length(xValues)), - xValues = xValues, - yValues = simulationResults[[yParameterName]] - ) - if (is.null(data)) { - data <- part - } else { - data <- rbind(data, part) - } - } - - if ("earlyStop" %in% parameters) { - yParameterNames <- c(yParameterNames, "earlyStop") - - maxEarlyStoppingStages <- nrow(simulationResults$earlyStop) - for (k in 1:maxEarlyStoppingStages) { - category <- "Early stop" - if (maxEarlyStoppingStages > 1) { - category <- paste0(category, ", stage ", k) - } - part <- data.frame( - categories = rep(category, ncol(simulationResults$earlyStop)), - xValues = xValues, - yValues = simulationResults$earlyStop[k, ] - ) - data <- rbind(data, part) - yParameterNamesSrc <- c(yParameterNamesSrc, paste0("earlyStop[", k, ", ]")) - } - } - - return(list( - data = data, - yParameterNames = yParameterNames, - yParameterNamesSrc = yParameterNamesSrc - )) -} - -.plotSimulationResults <- function(simulationResults, designMaster, type = 5L, main = NA_character_, - xlab = NA_character_, ylab = NA_character_, palette = "Set1", - theta = seq(-1, 1, 0.02), plotPointsEnabled = NA, - legendPosition = NA_integer_, showSource = FALSE, - simulationResultsName = NA_character_, plotSettings = NULL, ...) { - .assertGgplotIsInstalled() - .assertIsSimulationResults(simulationResults) - .assertIsValidLegendPosition(legendPosition) - .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) - theta <- .assertIsValidThetaRange(thetaRange = theta) - - if (is.null(plotSettings)) { - plotSettings <- simulationResults$.plotSettings - } - - survivalEnabled <- grepl("Survival", .getClassName(simulationResults)) - meansEnabled <- grepl("Means", .getClassName(simulationResults)) - multiArmEnabled <- grepl("MultiArm", .getClassName(simulationResults)) - enrichmentEnabled <- grepl("Enrichment", .getClassName(simulationResults)) - userDefinedEffectMatrix <- multiArmEnabled && simulationResults$.getParameterType("effectMatrix") == C_PARAM_USER_DEFINED - - gMax <- NA_integer_ - if (multiArmEnabled || enrichmentEnabled) { - gMax <- ifelse(multiArmEnabled, - simulationResults$activeArms, - simulationResults$populations - ) - } - - if (survivalEnabled) { - nMax <- simulationResults$expectedNumberOfEvents[1] # use first value for plotting - } else { - nMax <- simulationResults$expectedNumberOfSubjects[1] # use first value for plotting - } - - if (type %in% c(1:3) && !multiArmEnabled && !enrichmentEnabled) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, - ") is not available for non-multi-arm/non-enrichment simulation results (type must be > 3)" - ) - } - - if ((!survivalEnabled || multiArmEnabled || enrichmentEnabled) && type %in% c(10:14)) { - if (multiArmEnabled || enrichmentEnabled) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, - ") is only available for non-multi-arm/non-enrichment survival simulation results" - ) - } else { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, - ") is only available for survival simulation results" - ) - } - } - - variedParameters <- logical(0) - - if (is.na(plotPointsEnabled)) { - plotPointsEnabled <- userDefinedEffectMatrix - } - - showSourceHint <- "" - - discreteXAxis <- FALSE - effectData <- NULL - xValues <- NA_integer_ - if (multiArmEnabled) { - effectData <- simulationResults$effectMatrix - effectDataParamName <- paste0("effectMatrix", "[", gMax, ", ]") - xParameterNameSrc <- paste0(simulationResultsName, "$", effectDataParamName) - xValues <- effectData[gMax, ] - } else { - if (enrichmentEnabled) { - effectDataList <- .getSimulationEnrichmentEffectData(simulationResults) - xValues <- effectDataList$xValues - discreteXAxis <- effectDataList$discreteXAxis - if (length(xValues) <= 1) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "2 ore more situations must be specifed in ", - sQuote(paste0("effectList$", effectDataList$effectMatrixName)) - ) - } - } - - xParameterNameSrc <- .getSimulationPlotXAxisParameterName(simulationResults, - showSource = showSource, simulationResultsName = simulationResultsName - ) - } - - armCaption <- ifelse(enrichmentEnabled, "Population", "Arm") - armsCaption <- paste0(armCaption, "s") - - srcCmd <- NULL - if (type == 1) { # Multi-arm, Overall Success - .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) - if (is.na(main)) { - main <- PlotSubTitleItems(title = "Overall Success") - .addPlotSubTitleItems(simulationResults, designMaster, main, type) - } - - data <- data.frame( - xValues = xValues, - yValues = colSums(simulationResults$successPerStage) - ) - if (userDefinedEffectMatrix) { - data$xValues <- 1:nrow(data) - } - - legendPosition <- ifelse(is.na(legendPosition), C_POSITION_LEFT_CENTER, legendPosition) - - srcCmd <- .showPlotSourceInformation( - objectName = simulationResultsName, - xParameterName = xParameterNameSrc, - yParameterNames = paste0("colSums(", simulationResultsName, "$successPerStage)"), - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - if (!is.null(srcCmd)) { - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(srcCmd)) - } - return(srcCmd) - } - - return(.plotDataFrame(data, - mainTitle = main, - xlab = NA_character_, ylab = NA_character_, - xAxisLabel = .getSimulationPlotXAxisLabel(simulationResults), - yAxisLabel1 = "Overall Success", - yAxisLabel2 = NA_character_, - plotPointsEnabled = plotPointsEnabled, legendTitle = NA_character_, - legendPosition = legendPosition, sided = designMaster$sided, - palette = palette, plotSettings = plotSettings, - discreteXAxis = discreteXAxis - )) - } else if (type == 2) { # Multi-arm, Success per Stage - .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) - if (is.na(main)) { - main <- PlotSubTitleItems(title = "Success per Stage") - .addPlotSubTitleItems(simulationResults, designMaster, main, type) - } - - yParameterNamesSrc <- c() - data <- NULL - if (designMaster$kMax > 1) { - for (k in 1:designMaster$kMax) { - part <- data.frame( - categories = rep(k, length(xValues)), - xValues = xValues, - yValues = simulationResults$successPerStage[k, ] - ) - if (userDefinedEffectMatrix) { - part$xValues <- 1:nrow(part) - } - if (is.null(data)) { - data <- part - } else { - data <- rbind(data, part) - } - yParameterNamesSrc <- c(yParameterNamesSrc, paste0("successPerStage[", k, ", ]")) - } - } else { - data <- data.frame( - xValues = xValues, - yValues = simulationResults$successPerStage[1, ] - ) - if (userDefinedEffectMatrix) { - data$xValues <- 1:nrow(data) - } - yParameterNamesSrc <- c(yParameterNamesSrc, "successPerStage[1, ]") - } - - legendPosition <- ifelse(is.na(legendPosition), C_POSITION_LEFT_TOP, legendPosition) - - srcCmd <- .showPlotSourceInformation( - objectName = simulationResultsName, - xParameterName = xParameterNameSrc, - yParameterNames = yParameterNamesSrc, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - if (!is.null(srcCmd)) { - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(srcCmd)) - } - return(srcCmd) - } - - return(.plotDataFrame(data, - mainTitle = main, - xlab = NA_character_, ylab = NA_character_, - xAxisLabel = .getSimulationPlotXAxisLabel(simulationResults), - yAxisLabel1 = "Success", - yAxisLabel2 = NA_character_, - plotPointsEnabled = plotPointsEnabled, legendTitle = "Stage", - legendPosition = legendPosition, sided = designMaster$sided, - palette = palette, plotSettings = plotSettings, - discreteXAxis = discreteXAxis - )) - } else if (type == 3) { # Multi-arm, Selected Arms/Populations per Stage - - .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) - if (is.na(main)) { - main <- PlotSubTitleItems(title = paste0("Selected ", armsCaption, " per Stage")) - .addPlotSubTitleItems(simulationResults, designMaster, main, type) - } - - selectedDataParamName <- ifelse(multiArmEnabled, "selectedArms", "selectedPopulations") - selectedData <- simulationResults[[selectedDataParamName]] - - yParameterNamesSrc <- c() - data <- NULL - if (designMaster$kMax > 1) { - for (g in 1:gMax) { - for (k in 2:designMaster$kMax) { - stages <- rep(k, length(xValues)) - - populationCaption <- g - if (enrichmentEnabled) { - populationCaption <- ifelse(g == gMax, "F", paste0("S", g)) - } - - part <- data.frame( - categories = ifelse(designMaster$kMax > 2, - paste0(populationCaption, ", ", stages), populationCaption - ), - xValues = xValues, - yValues = selectedData[k, , g] - ) - if (userDefinedEffectMatrix) { - part$xValues <- 1:nrow(part) - } - if (is.null(data)) { - data <- part - } else { - data <- rbind(data, part) - } - yParameterNamesSrc <- c(yParameterNamesSrc, paste0(selectedDataParamName, "[", k, ", , ", g, "]")) - } - } - } else { - for (g in 1:gMax) { - part <- data.frame( - categories = g, - xValues = xValues, - yValues = selectedData[1, , g] - ) - if (userDefinedEffectMatrix) { - data$xValues <- 1:nrow(data) - } - if (is.null(data)) { - data <- part - } else { - data <- rbind(data, part) - } - yParameterNamesSrc <- c(yParameterNamesSrc, paste0(selectedDataParamName, "[1, , ", g, "]")) - } - } - - legendPosition <- ifelse(is.na(legendPosition), C_POSITION_LEFT_TOP, legendPosition) - - srcCmd <- .showPlotSourceInformation( - objectName = simulationResultsName, - xParameterName = xParameterNameSrc, - yParameterNames = yParameterNamesSrc, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - if (!is.null(srcCmd)) { - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(srcCmd)) - } - return(srcCmd) - } - - legendTitle <- ifelse(gMax > 1, - ifelse(designMaster$kMax > 2, paste0(armCaption, ", Stage"), armCaption), - ifelse(designMaster$kMax > 2, "Stage", armCaption) - ) - return(.plotDataFrame(data, - mainTitle = main, - xlab = NA_character_, ylab = NA_character_, - xAxisLabel = .getSimulationPlotXAxisLabel(simulationResults), - yAxisLabel1 = paste0("Selected ", armsCaption), - yAxisLabel2 = NA_character_, - plotPointsEnabled = plotPointsEnabled, - legendTitle = legendTitle, - legendPosition = legendPosition, sided = designMaster$sided, - palette = palette, plotSettings = plotSettings, - discreteXAxis = discreteXAxis - )) - } else if (type == 4) { # Multi-arm, Rejected Arms/Populations per Stage - .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) - if (is.na(main)) { - main <- PlotSubTitleItems(title = ifelse(!multiArmEnabled, - "Reject per Stage", - ifelse(designMaster$kMax > 1, - paste0("Rejected ", armsCaption, " per Stage"), paste0("Rejected ", armsCaption) - ) - )) - .addPlotSubTitleItems(simulationResults, designMaster, main, type) - } - - yParameterNamesSrc <- c() - data <- NULL - if (multiArmEnabled || enrichmentEnabled) { - rejectedDataParamName <- ifelse(multiArmEnabled, "rejectedArmsPerStage", "rejectedPopulationsPerStage") - rejectedData <- simulationResults[[rejectedDataParamName]] - if (designMaster$kMax > 1) { - for (g in 1:gMax) { - for (k in 1:designMaster$kMax) { - stages <- rep(k, length(xValues)) - populationCaption <- g - if (enrichmentEnabled) { - populationCaption <- ifelse(g == gMax, "F", paste0("S", g)) - } - part <- data.frame( - categories = ifelse(gMax > 1, paste0(populationCaption, ", ", stages), stages), - xValues = xValues, - yValues = rejectedData[k, , g] - ) - if (userDefinedEffectMatrix) { - part$xValues <- 1:nrow(part) - } - if (is.null(data)) { - data <- part - } else { - data <- rbind(data, part) - } - yParameterNamesSrc <- c(yParameterNamesSrc, paste0(rejectedDataParamName, "[", k, ", , ", g, "]")) - } - } - } else { - for (g in 1:gMax) { - part <- data.frame( - categories = g, - xValues = xValues, - yValues = rejectedData[1, , g] - ) - if (userDefinedEffectMatrix) { - part$xValues <- 1:nrow(part) - } - if (is.null(data)) { - data <- part - } else { - data <- rbind(data, part) - } - yParameterNamesSrc <- c(yParameterNamesSrc, paste0(rejectedDataParamName, "[1, , ", g, "]")) - } - } - } else { - xParameterName <- .getSimulationPlotXAxisParameterName(simulationResults) - if (designMaster$kMax > 1) { - for (k in 1:designMaster$kMax) { - part <- data.frame( - categories = k, - xValues = simulationResults[[xParameterName]], - yValues = simulationResults$rejectPerStage[k, ] - ) - if (userDefinedEffectMatrix) { - part$xValues <- 1:nrow(part) - } - if (is.null(data)) { - data <- part - } else { - data <- rbind(data, part) - } - yParameterNamesSrc <- c(yParameterNamesSrc, paste0("rejectPerStage[", k, ", ]")) - } - } else { - data <- data.frame( - xValues = simulationResults[[xParameterName]], - yValues = simulationResults$rejectPerStage[1, ] - ) - if (userDefinedEffectMatrix) { - data$xValues <- 1:nrow(data) - } - yParameterNamesSrc <- c(yParameterNamesSrc, "rejectPerStage[1, ]") - } - } - - legendPosition <- ifelse(is.na(legendPosition), C_POSITION_LEFT_TOP, legendPosition) - - srcCmd <- .showPlotSourceInformation( - objectName = simulationResultsName, - xParameterName = xParameterNameSrc, - yParameterNames = yParameterNamesSrc, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - if (!is.null(srcCmd)) { - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(srcCmd)) - } - return(srcCmd) - } - - palette <- NULL - - legendTitle <- "Stage" - if (multiArmEnabled) { - legendTitle <- ifelse(designMaster$kMax > 1, paste0(armCaption, ", Stage"), armCaption) - } else if (enrichmentEnabled) { - legendTitle <- ifelse(gMax > 1, paste0(armCaption, ", Stage"), "Stage") - } - yAxisLabel1 <- ifelse(.isMultiArmSimulationResults(simulationResults), - paste0("Rejected ", armsCaption), "Rejection Probability" - ) - return(.plotDataFrame(data, - mainTitle = main, - xlab = NA_character_, ylab = NA_character_, - xAxisLabel = .getSimulationPlotXAxisLabel(simulationResults), - yAxisLabel1 = yAxisLabel1, - yAxisLabel2 = NA_character_, - plotPointsEnabled = plotPointsEnabled, - legendTitle = legendTitle, - legendPosition = legendPosition, sided = designMaster$sided, - palette = palette, plotSettings = plotSettings, - discreteXAxis = discreteXAxis - )) - } else if (type == 5) { # Power and Stopping Probabilities - - .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) - - if (is.na(main)) { - main <- PlotSubTitleItems(title = ifelse(designMaster$kMax == 1, - "Overall Power", "Overall Power and Early Stopping" - )) - .addPlotSubTitleItems(simulationResults, designMaster, main, type) - } - - xParameterName <- .getSimulationPlotXAxisParameterName(simulationResults) - - if ((multiArmEnabled || enrichmentEnabled) && designMaster$kMax > 1) { - powerAndStoppingProbabilities <- .getPowerAndStoppingProbabilities(simulationResults, - xValues = xValues, - parameters = c("rejectAtLeastOne", "futilityStop", "earlyStop") - ) - data <- powerAndStoppingProbabilities$data - yParameterNames <- powerAndStoppingProbabilities$yParameterNames - yParameterNamesSrc <- powerAndStoppingProbabilities$yParameterNamesSrc - } else { - yParameterNames <- ifelse(multiArmEnabled || enrichmentEnabled, "rejectAtLeastOne", "overallReject") - if (designMaster$kMax > 1) { - if (!multiArmEnabled && !enrichmentEnabled) { - yParameterNames <- c(yParameterNames, "earlyStop") - } - yParameterNames <- c(yParameterNames, "futilityStop") - } - yParameterNamesSrc <- yParameterNames - } - - xlab <- .getSimulationPlotXAxisLabel(simulationResults, xlab) - ylab <- ifelse(is.na(ylab), "", ylab) - legendPosition <- ifelse(is.na(legendPosition), C_POSITION_LEFT_TOP, legendPosition) - - srcCmd <- .showPlotSourceInformation( - objectName = simulationResultsName, - xParameterName = xParameterNameSrc, - yParameterNames = yParameterNamesSrc, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - if (!is.null(srcCmd)) { - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(srcCmd)) - } - return(srcCmd) - } - - if ((multiArmEnabled || enrichmentEnabled) && designMaster$kMax > 1) { - return(.plotDataFrame(data, - mainTitle = main, - xlab = xlab, ylab = ylab, - xAxisLabel = .getSimulationPlotXAxisLabel(simulationResults), - yAxisLabel1 = NA_character_, - yAxisLabel2 = NA_character_, - plotPointsEnabled = plotPointsEnabled, - legendTitle = NA_character_, - legendPosition = legendPosition, sided = designMaster$sided, - palette = palette, plotSettings = plotSettings, - discreteXAxis = discreteXAxis - )) - } else { - if (is.null(list(...)[["ylim"]])) { - ylim <- c(0, 1) - return(.plotParameterSet( - parameterSet = simulationResults, designMaster = designMaster, - xParameterName = xParameterName, - yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, - palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, - legendPosition = legendPosition, variedParameters = variedParameters, - qnormAlphaLineEnabled = FALSE, yAxisScalingEnabled = FALSE, - plotSettings = plotSettings, ylim = ylim # , ... - )) # ratioEnabled = TRUE - } else { - return(.plotParameterSet( - parameterSet = simulationResults, designMaster = designMaster, - xParameterName = xParameterName, - yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, - palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, - legendPosition = legendPosition, variedParameters = variedParameters, - qnormAlphaLineEnabled = FALSE, yAxisScalingEnabled = FALSE, - plotSettings = plotSettings # , ... - )) - } - } - } else if (type == 6) { # Average Sample Size / Average Event Number - .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) - - if (is.na(main)) { - titlePart <- paste0("Expected ", ifelse(survivalEnabled, "Number of Events", "Number of Subjects")) - main <- PlotSubTitleItems(title = paste0( - titlePart, - ifelse(designMaster$kMax == 1, "", paste0( - " and Power", - ifelse(multiArmEnabled, "", " / Early Stop") - )) - )) - .addPlotSubTitleItems(simulationResults, designMaster, main, type) - } - - xParameterName <- .getSimulationPlotXAxisParameterName(simulationResults) - yParameterNames <- ifelse(survivalEnabled, "expectedNumberOfEvents", "expectedNumberOfSubjects") - if (designMaster$kMax > 1) { - if (multiArmEnabled || enrichmentEnabled) { - yParameterNames <- c(yParameterNames, "rejectAtLeastOne") - } else { - yParameterNames <- c(yParameterNames, "overallReject") - } - yParameterNames <- c(yParameterNames, "earlyStop") - } - - xlab <- .getSimulationPlotXAxisLabel(simulationResults, xlab) - legendPosition <- ifelse(is.na(legendPosition), C_POSITION_LEFT_CENTER, legendPosition) - srcCmd <- .showPlotSourceInformation( - objectName = simulationResultsName, - xParameterName = xParameterNameSrc, - yParameterNames = yParameterNames, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - } else if (type == 7) { - .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) - if (is.na(main)) { - main <- PlotSubTitleItems(title = "Overall Power") - .addPlotSubTitleItems(simulationResults, designMaster, main, type) - } - - xParameterName <- .getSimulationPlotXAxisParameterName(simulationResults) - yParameterNames <- ifelse(multiArmEnabled || enrichmentEnabled, "rejectAtLeastOne", "overallReject") - xlab <- .getSimulationPlotXAxisLabel(simulationResults, xlab) - legendPosition <- ifelse(is.na(legendPosition), C_POSITION_RIGHT_CENTER, legendPosition) - srcCmd <- .showPlotSourceInformation( - objectName = simulationResultsName, - xParameterName = xParameterNameSrc, - yParameterNames = yParameterNames, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - } else if (type == 8) { - if (designMaster$kMax == 1) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "plot type 8 (Early Stopping) is not available for 'kMax' = 1") - } - - .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) - - futilityStopEnabled <- !is.null(simulationResults[["futilityStop"]]) && - !all(na.omit(simulationResults$futilityStop) == 0) - - if (is.na(main)) { - main <- PlotSubTitleItems(title = paste0( - "Overall Early Stopping", - ifelse(futilityStopEnabled, " and Futility Stopping", "") - )) - .addPlotSubTitleItems(simulationResults, designMaster, main, type) - } - - xParameterName <- .getSimulationPlotXAxisParameterName(simulationResults) - yParameterNames <- c("earlyStop") - if (futilityStopEnabled) { - yParameterNames <- c(yParameterNames, "futilityStop") - } - xlab <- .getSimulationPlotXAxisLabel(simulationResults, xlab) - legendPosition <- ifelse(is.na(legendPosition), C_POSITION_LEFT_CENTER, legendPosition) - srcCmd <- .showPlotSourceInformation( - objectName = simulationResultsName, - xParameterName = xParameterNameSrc, - yParameterNames = yParameterNames, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - } else if (type == 9) { - .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) - - if (is.na(main)) { - main <- PlotSubTitleItems(title = ifelse(survivalEnabled, - "Expected Number of Events", "Expected Number of Subjects" - )) - .addPlotSubTitleItems(simulationResults, designMaster, main, type) - } - - xParameterName <- .getSimulationPlotXAxisParameterName(simulationResults) - yParameterNames <- ifelse(survivalEnabled, "expectedNumberOfEvents", "expectedNumberOfSubjects") - xlab <- .getSimulationPlotXAxisLabel(simulationResults, xlab) - srcCmd <- .showPlotSourceInformation( - objectName = simulationResultsName, - xParameterName = xParameterNameSrc, - yParameterNames = yParameterNames, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - } else if (type == 10) { # Study Duration - .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) - if (is.na(main)) { - main <- PlotSubTitleItems(title = "Study Duration") - .addPlotSubTitleItems(simulationResults, designMaster, main, type) - } - xParameterName <- "hazardRatio" - yParameterNames <- "studyDuration" - srcCmd <- .showPlotSourceInformation( - objectName = simulationResultsName, - xParameterName = xParameterName, - yParameterNames = yParameterNames, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - } else if (type == 11) { - .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) - if (is.na(main)) { - main <- PlotSubTitleItems(title = "Expected Number of Subjects") - .addPlotSubTitleItems(simulationResults, designMaster, main, type) - } - xParameterName <- "hazardRatio" - yParameterNames <- "expectedNumberOfSubjects" - srcCmd <- .showPlotSourceInformation( - objectName = simulationResultsName, - xParameterName = xParameterName, - yParameterNames = yParameterNames, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - } else if (type == 12) { # Analysis Time - .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) - if (is.na(main)) { - main <- PlotSubTitleItems(title = "Analysis Time") - .addPlotSubTitleItems(simulationResults, designMaster, main, type) - } - - xParameterName <- "hazardRatio" - yParameterNames <- "analysisTime" - yParameterNamesSrc <- c() - for (i in 1:nrow(simulationResults[["analysisTime"]])) { - yParameterNamesSrc <- c(yParameterNamesSrc, paste0("analysisTime[", i, ", ]")) - } - - data <- NULL - for (k in 1:designMaster$kMax) { - part <- data.frame( - categories = rep(k, length(simulationResults$hazardRatio)), - xValues = simulationResults$hazardRatio, - yValues = simulationResults$analysisTime[k, ] - ) - if (is.null(data)) { - data <- part - } else { - data <- rbind(data, part) - } - } - - if (is.na(legendPosition)) { - legendPosition <- C_POSITION_LEFT_CENTER - } - - srcCmd <- .showPlotSourceInformation( - objectName = simulationResultsName, - xParameterName = xParameterName, - yParameterNames = yParameterNamesSrc, - hint = showSourceHint, nMax = nMax, - type = type, showSource = showSource - ) - if (!is.null(srcCmd)) { - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(srcCmd)) - } - return(srcCmd) - } - - return(.plotDataFrame(data, - mainTitle = main, - xlab = NA_character_, ylab = NA_character_, xAxisLabel = "Hazard Ratio", - yAxisLabel1 = "Analysis Time", yAxisLabel2 = NA_character_, - plotPointsEnabled = TRUE, legendTitle = "Stage", - legendPosition = legendPosition, sided = designMaster$sided, plotSettings = plotSettings, - discreteXAxis = discreteXAxis - )) - } else if (type == 13 || type == 14) { # Cumulative Distribution Function / Survival function - return(.plotSurvivalFunction(simulationResults, - designMaster = designMaster, type = type, main = main, - xlab = xlab, ylab = ylab, palette = palette, - legendPosition = legendPosition, designPlanName = simulationResultsName, - showSource = showSource, plotSettings = plotSettings - )) - } else { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is not allowed; must be 5, 6, ..., 14") - } - - if (!is.null(srcCmd)) { - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(srcCmd)) - } - return(srcCmd) - } - - return(.plotParameterSet( - parameterSet = simulationResults, designMaster = designMaster, - xParameterName = xParameterName, - yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, - palette = palette, theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, - legendPosition = legendPosition, variedParameters = variedParameters, - qnormAlphaLineEnabled = (type != 2), ratioEnabled = TRUE, plotSettings = plotSettings # , ... - )) -} - -#' -#' @title -#' Simulation Results Plotting -#' -#' @param x The simulation results, obtained from \cr -#' \code{\link[=getSimulationSurvival]{getSimulationSurvival()}}. -#' @param y Not available for this kind of plot (is only defined to be compatible to the generic plot function). -#' @param main The main title. -#' @param xlab The x-axis label. -#' @param ylab The y-axis label. -#' @inheritParams param_palette -#' @inheritParams param_theta -#' @inheritParams param_plotPointsEnabled -#' @inheritParams param_showSource -#' @inheritParams param_plotSettings -#' @inheritParams param_legendPosition -#' @inheritParams param_grid -#' @param type The plot type (default = \code{1}). The following plot types are available: -#' \itemize{ -#' \item \code{1}: creates a 'Overall Success' plot (multi-arm and enrichment only) -#' \item \code{2}: creates a 'Success per Stage' plot (multi-arm and enrichment only) -#' \item \code{3}: creates a 'Selected Arms per Stage' plot (multi-arm and enrichment only) -#' \item \code{4}: creates a 'Reject per Stage' or 'Rejected Arms per Stage' plot -#' \item \code{5}: creates a 'Overall Power and Early Stopping' plot -#' \item \code{6}: creates a 'Expected Number of Subjects and Power / Early Stop' or -#' 'Expected Number of Events and Power / Early Stop' plot -#' \item \code{7}: creates an 'Overall Power' plot -#' \item \code{8}: creates an 'Overall Early Stopping' plot -#' \item \code{9}: creates an 'Expected Sample Size' or 'Expected Number of Events' plot -#' \item \code{10}: creates a 'Study Duration' plot (non-multi-arm and non-enrichment survival only) -#' \item \code{11}: creates an 'Expected Number of Subjects' plot (non-multi-arm and non-enrichment survival only) -#' \item \code{12}: creates an 'Analysis Times' plot (non-multi-arm and non-enrichment survival only) -#' \item \code{13}: creates a 'Cumulative Distribution Function' plot (non-multi-arm and non-enrichment survival only) -#' \item \code{14}: creates a 'Survival Function' plot (non-multi-arm and non-enrichment survival only) -#' \item \code{"all"}: creates all available plots and returns it as a grid plot or list -#' } -#' @inheritParams param_three_dots_plot -#' -#' @description -#' Plots simulation results. -#' -#' @details -#' Generic function to plot all kinds of simulation results. -#' -#' @template return_object_ggplot -#' -#' @examples -#' \dontrun{ -#' results <- getSimulationMeans( -#' alternative = 0:4, stDev = 5, -#' plannedSubjects = 40, maxNumberOfIterations = 1000 -#' ) -#' plot(results, type = 5) -#' } -#' -#' @export -#' -plot.SimulationResultsR6 <- function(x, y, ..., main = NA_character_, - xlab = NA_character_, ylab = NA_character_, type = 1L, palette = "Set1", - theta = seq(-1, 1, 0.01), plotPointsEnabled = NA, - legendPosition = NA_integer_, showSource = FALSE, - grid = 1, plotSettings = NULL) { - fCall <- match.call(expand.dots = FALSE) - simulationResultsName <- deparse(fCall$x) - .assertGgplotIsInstalled() - .assertIsSingleInteger(grid, "grid", validateType = FALSE) - typeNumbers <- .getPlotTypeNumber(type, x) - if (is.null(plotSettings)) { - plotSettings <- .getGridPlotSettings(x, typeNumbers, grid) - } - p <- NULL - plotList <- list() - for (typeNumber in typeNumbers) { - p <- .plotSimulationResults( - simulationResults = x, designMaster = x$.design, - main = main, xlab = xlab, ylab = ylab, type = typeNumber, - palette = palette, theta = theta, plotPointsEnabled = plotPointsEnabled, - legendPosition = .getGridLegendPosition(legendPosition, typeNumbers, grid), - showSource = showSource, simulationResultsName = simulationResultsName, - plotSettings = plotSettings, ... - ) - .printPlotShowSourceSeparator(showSource, typeNumber, typeNumbers) - if (length(typeNumbers) > 1) { - caption <- .getPlotCaption(x, typeNumber, stopIfNotFound = TRUE) - plotList[[caption]] <- p - } - } - if (length(typeNumbers) == 1) { - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(p)) - } - - return(p) - } - - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(plotList)) - } - - return(.createPlotResultObject(plotList, grid)) -} - -#' -#' @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.SimulationResultsR6 <- function(x, ..., showStatistics = FALSE, markdown = FALSE) { - if (markdown) { - x$.catMarkdownText(showStatistics = showStatistics) - return(invisible(x)) - } - - x$show(showStatistics = showStatistics) - invisible(x) -} - -#' -#' @title -#' Get Simulation Data -#' -#' @description -#' Returns the aggregated simulation data. -#' -#' @param x A \code{\link{SimulationResults}} object created by \code{\link[=getSimulationMeans]{getSimulationMeans()}},\cr -#' \code{\link[=getSimulationRates]{getSimulationRates()}}, \code{\link[=getSimulationSurvival]{getSimulationSurvival()}}, \code{\link[=getSimulationMultiArmMeans]{getSimulationMultiArmMeans()}},\cr -#' \code{\link[=getSimulationMultiArmRates]{getSimulationMultiArmRates()}}, or \code{\link[=getSimulationMultiArmSurvival]{getSimulationMultiArmSurvival()}}. -#' -#' @details -#' This function can be used to get the aggregated simulated data from an simulation results -#' object, for example, obtained by \code{\link[=getSimulationSurvival]{getSimulationSurvival()}}. -#' In this case, the data frame contains the following columns: -#' \enumerate{ -#' \item \code{iterationNumber}: The number of the simulation iteration. -#' \item \code{stageNumber}: The stage. -#' \item \code{pi1}: The assumed or derived event rate in the treatment group. -#' \item \code{pi2}: The assumed or derived event rate in the control group. -#' \item \code{hazardRatio}: The hazard ratio under consideration (if available). -#' \item \code{analysisTime}: The analysis time. -#' \item \code{numberOfSubjects}: The number of subjects under consideration when the -#' (interim) analysis takes place. -#' \item \code{eventsPerStage1}: The observed number of events per stage -#' in treatment group 1. -#' \item \code{eventsPerStage2}: The observed number of events per stage -#' in treatment group 2. -#' \item \code{eventsPerStage}: The observed number of events per stage -#' in both treatment groups. -#' \item \code{rejectPerStage}: 1 if null hypothesis can be rejected, 0 otherwise. -#' \item \code{eventsNotAchieved}: 1 if number of events could not be reached with -#' observed number of subjects, 0 otherwise. -#' \item \code{futilityPerStage}: 1 if study should be stopped for futility, 0 otherwise. -#' \item \code{testStatistic}: The test statistic that is used for the test decision, -#' depends on which design was chosen (group sequential, inverse normal, -#' or Fisher combination test)' -#' \item \code{logRankStatistic}: Z-score statistic which corresponds to a one-sided -#' log-rank test at considered stage. -#' \item \code{conditionalPowerAchieved}: The conditional power for the subsequent stage of the trial for -#' selected sample size and effect. The effect is either estimated from the data or can be -#' user defined with \code{thetaH1} or \code{pi1H1} and \code{pi2H1}. -#' \item \code{trialStop}: \code{TRUE} if study should be stopped for efficacy or futility or final stage, \code{FALSE} otherwise. -#' \item \code{hazardRatioEstimateLR}: The estimated hazard ratio, derived from the -#' log-rank statistic. -#' } -#' A subset of variables is provided for \code{\link[=getSimulationMeans]{getSimulationMeans()}}, \code{\link[=getSimulationRates]{getSimulationRates()}}, \code{\link[=getSimulationMultiArmMeans]{getSimulationMultiArmMeans()}},\cr -#' \code{\link[=getSimulationMultiArmRates]{getSimulationMultiArmRates()}}, or \code{\link[=getSimulationMultiArmSurvival]{getSimulationMultiArmSurvival()}}. -#' -#' @template return_dataframe -#' -#' @examples -#' results <- getSimulationSurvival( -#' pi1 = seq(0.3, 0.6, 0.1), pi2 = 0.3, eventTime = 12, -#' accrualTime = 24, plannedEvents = 40, maxNumberOfSubjects = 200, -#' maxNumberOfIterations = 50 -#' ) -#' data <- getData(results) -#' head(data) -#' dim(data) -#' -#' @export -#' -getData <- function(x) { - if (!(inherits(x, "SimulationResults") || inherits(x, "SimulationResultsR6"))) { # or 'Dataset' - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'x' must be a 'SimulationResults' object; for example, use getSimulationMeans() to create one" - ) - } - - return(x$.data) -} - -#' @rdname getData -#' @export -getData.SimulationResultsR6 <- function(x) { - return(x$.data) -} - -.getAggregatedDataByIterationNumber <- function(rawData, iterationNumber, pi1 = NA_real_) { - if (!is.na(pi1)) { - if (is.null(rawData[["pi1"]])) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'rawData' does not contains a 'pi1' column") - } - subData <- rawData[rawData$iterationNumber == iterationNumber & rawData$pi1 == pi1, ] - if (nrow(subData) == 0) { - return(NULL) - } - } else { - subData <- rawData[rawData$iterationNumber == iterationNumber, ] - } - - eventsPerStage1 <- sum(subData$event[subData$treatmentGroup == 1]) - eventsPerStage2 <- sum(subData$event[subData$treatmentGroup == 2]) - - result <- data.frame( - iterationNumber = iterationNumber, - pi1 = pi1, - stageNumber = subData$stopStage[1], - analysisTime = max(subData$observationTime), - numberOfSubjects = nrow(subData), - eventsPerStage1 = eventsPerStage1, - eventsPerStage2 = eventsPerStage2, - eventsPerStage = eventsPerStage1 + eventsPerStage2 - ) - - if (is.na(pi1)) { - result <- result[, colnames(result) != "pi1"] - } - - return(result) -} - -.getAggregatedData <- function(rawData) { - iterationNumbers <- sort(unique(rawData$iterationNumber)) - pi1Vec <- rawData[["pi1"]] - if (!is.null(pi1Vec)) { - pi1Vec <- sort(unique(na.omit(rawData$pi1))) - } - - data <- NULL - if (!is.null(pi1Vec) && length(pi1Vec) > 0) { - for (iterationNumber in iterationNumbers) { - for (pi1 in pi1Vec) { - row <- .getAggregatedDataByIterationNumber(rawData, iterationNumber, pi1) - if (!is.null(row)) { - if (is.null(data)) { - data <- row - } else { - data <- rbind(data, row) - } - } - } - } - } else { - for (iterationNumber in iterationNumbers) { - row <- .getAggregatedDataByIterationNumber(rawData, iterationNumber) - if (!is.null(row)) { - if (is.null(data)) { - data <- row - } else { - data <- rbind(data, row) - } - } - } - } - return(data) -} - -#' -#' @title -#' Get Simulation Raw Data for Survival -#' -#' @description -#' Returns the raw survival data which was generated for simulation. -#' -#' @param x A \code{\link{SimulationResults}} object created by \code{\link[=getSimulationSurvival]{getSimulationSurvival()}}. -#' @param aggregate Logical. If \code{TRUE} the raw data will be aggregated similar to -#' the result of \code{\link[=getData]{getData()}}, default is \code{FALSE}. -#' -#' @details -#' This function works only if \code{\link[=getSimulationSurvival]{getSimulationSurvival()}} was called with a \cr -#' \code{maxNumberOfRawDatasetsPerStage} > 0 (default is \code{0}). -#' -#' This function can be used to get the simulated raw data from a simulation results -#' object obtained by \code{\link[=getSimulationSurvival]{getSimulationSurvival()}}. Note that \code{\link[=getSimulationSurvival]{getSimulationSurvival()}} -#' must called before with \code{maxNumberOfRawDatasetsPerStage} > 0. -#' The data frame contains the following columns: -#' \enumerate{ -#' \item \code{iterationNumber}: The number of the simulation iteration. -#' \item \code{stopStage}: The stage of stopping. -#' \item \code{subjectId}: The subject id (increasing number 1, 2, 3, ...) -#' \item \code{accrualTime}: The accrual time, i.e., the time when the subject entered the trial. -#' \item \code{treatmentGroup}: The treatment group number (1 or 2). -#' \item \code{survivalTime}: The survival time of the subject. -#' \item \code{dropoutTime}: The dropout time of the subject (may be \code{NA}). -#' \item \code{observationTime}: The specific observation time. -#' \item \code{timeUnderObservation}: The time under observation is defined as follows:\cr -#' if (event == TRUE) {\cr -#' timeUnderObservation <- survivalTime;\cr -#' } else if (dropoutEvent == TRUE) {\cr -#' timeUnderObservation <- dropoutTime;\cr -#' } else {\cr -#' timeUnderObservation <- observationTime - accrualTime;\cr -#' } -#' \item \code{event}: \code{TRUE} if an event occurred; \code{FALSE} otherwise. -#' \item \code{dropoutEvent}: \code{TRUE} if an dropout event occurred; \code{FALSE} otherwise. -#' } -#' -#' @template return_dataframe -#' -#' @examples -#' \dontrun{ -#' results <- getSimulationSurvival( -#' pi1 = seq(0.3, 0.6, 0.1), pi2 = 0.3, eventTime = 12, -#' accrualTime = 24, plannedEvents = 40, maxNumberOfSubjects = 200, -#' maxNumberOfIterations = 50, maxNumberOfRawDatasetsPerStage = 5 -#' ) -#' rawData <- getRawData(results) -#' head(rawData) -#' dim(rawData) -#' } -#' -#' @export -#' -getRawData <- function(x, aggregate = FALSE) { - if (!(inherits(x, "SimulationResultsSurvival") || inherits(x, "SimulationResultsSurvivalR6"))) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'x' must be a 'SimulationResultsSurvival' object; use getSimulationSurvival() to create one" - ) - } - - rawData <- x$.rawData - if (is.null(rawData) || ncol(rawData) == 0 || nrow(rawData) == 0) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "simulation results contain no raw data; ", - "choose a 'maxNumberOfRawDatasetsPerStage' > 0, e.g., ", - "getSimulationSurvival(..., maxNumberOfRawDatasetsPerStage = 1)" - ) - } - - if (!aggregate) { - return(rawData) - } - - return(.getAggregatedData(rawData)) -} diff --git a/R/class_summary.R b/R/class_summary.R index c9821c54..e4e6aa41 100644 --- a/R/class_summary.R +++ b/R/class_summary.R @@ -23,20 +23,20 @@ NULL -SummaryItem <- setRefClass("SummaryItem", - fields = list( - title = "character", - values = "character", - legendEntry = "list" - ), - methods = list( +SummaryItemR6 <- R6Class("SummaryItemR6", + public = list( + title = NULL, + values = NULL, + legendEntry = NULL, initialize = function(title = NA_character_, values = NA_character_, ...) { - callSuper(title = title, values = values, ...) - if (!is.null(legendEntry) && length(legendEntry) > 0) { - if (is.null(names(legendEntry))) { + self$title <- title + self$values <- values + #callSuper(...) TODO LEGENDENTRyy + if (!is.null(self$legendEntry) && length(self$legendEntry) > 0) { + if (is.null(names(self$legendEntry))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("legendEntry"), " must be a named list") } - for (l in legendEntry) { + for (l in self$legendEntry) { if (length(l) == 0) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("legendEntry"), " must be not empty") } @@ -44,11 +44,11 @@ SummaryItem <- setRefClass("SummaryItem", } }, show = function() { - cat(title, "=", values, "\n") + cat(self$title, "=", self$values, "\n") }, toList = function() { result <- list() - result[[title]] <- values + result[[self$title]] <- self$values } ) ) @@ -72,7 +72,7 @@ SummaryItem <- setRefClass("SummaryItem", #' #' @export #' -plot.SummaryFactory <- function(x, y, ..., showSummary = FALSE) { +plot.SummaryFactoryR6 <- function(x, y, ..., showSummary = FALSE) { fCall <- match.call(expand.dots = FALSE) if (isTRUE(showSummary) || .isSummaryPipe(fCall)) { markdown <- .getOptionalArgument("markdown", ..., optionalArgumentDefaultValue = NA) @@ -114,7 +114,7 @@ plot.SummaryFactory <- function(x, y, ..., showSummary = FALSE) { #' #' @export #' -knit_print.SummaryFactory <- function(x, ...) { +knit_print.SummaryFactoryR6 <- function(x, ...) { result <- paste0(utils::capture.output(x$.catMarkdownText()), collapse = "\n") if (isTRUE(base::attr(x$object, "printObject"))) { @@ -147,7 +147,7 @@ knit_print.SummaryFactory <- function(x, ...) { #' #' @export #' -print.SummaryFactory <- function(x, ..., +print.SummaryFactoryR6 <- function(x, ..., markdown = NA, sep = "\n-----\n\n") { @@ -176,58 +176,58 @@ print.SummaryFactory <- function(x, ..., #' #' @importFrom methods new #' -SummaryFactory <- setRefClass("SummaryFactory", - contains = "ParameterSet", - fields = list( - object = "ParameterSet", - title = "character", - header = "character", - summaryItems = "list", - intervalFormat = "character", - justify = "character", - output = "character" - ), - methods = list( +SummaryFactoryR6 <- R6Class("SummaryFactoryR6", + inherit = ParameterSetR6, + public = list( + object = NULL, + title = NULL, + header = NULL, + summaryItems = NULL, + intervalFormat = NULL, + justify = NULL, + output = NULL, initialize = function(..., intervalFormat = "[%s; %s]", output = "all") { - callSuper(..., intervalFormat = intervalFormat, output = output) - summaryItems <<- list() - justify <<- getOption("rpact.summary.justify", "right") + #callSuper(...) TODO + self$intervalFormat <- intervalFormat + self$output <- output + self$summaryItems <- list() + self$justify <- getOption("rpact.summary.justify", "right") }, show = function(showType = 1, digits = NA_integer_) { - .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) }, .show = function(showType = 1, digits = NA_integer_, ..., consoleOutputEnabled = TRUE) { - if (output %in% c("all", "title")) { - if (is.null(title) || length(title) == 0) { - title <<- .createSummaryTitleObject(object) + if (self$output %in% c("all", "title")) { + if (is.null(self$title) || length(self$title) == 0) { + self$title <- .createSummaryTitleObject(self$object) } - if (!is.null(title) && length(title) == 1 && trimws(title) != "") { - .cat(title, "\n\n", + if (!is.null(self$title) && length(self$title) == 1 && trimws(self$title) != "") { + self$.cat(self$title, "\n\n", heading = 1, consoleOutputEnabled = consoleOutputEnabled ) } } - if (output %in% c("all", "overview")) { - if (is.null(header) || length(header) == 0) { - header <<- .createSummaryHeaderObject(object, .self, digits) + if (self$output %in% c("all", "overview")) { + if (is.null(self$header) || length(self$header) == 0) { + self$header <- .createSummaryHeaderObject(self$object, self, digits) } - if (!is.null(header) && length(header) == 1 && trimws(header) != "") { - .cat(header, "\n\n", + if (!is.null(self$header) && length(self$header) == 1 && trimws(self$header) != "") { + self$.cat(self$header, "\n\n", consoleOutputEnabled = consoleOutputEnabled ) } } - if (!(output %in% c("all", "body"))) { + if (!(self$output %in% c("all", "body"))) { return(invisible()) } legendEntries <- c() legendEntriesUnique <- c() summaryItemNames <- c() - for (summaryItem in summaryItems) { + for (summaryItem in self$summaryItems) { if (!is.null(summaryItem$title) && length(summaryItem$title) == 1 && !is.na(summaryItem$title)) { summaryItemNames <- c(summaryItemNames, summaryItem$title) } @@ -244,12 +244,12 @@ SummaryFactory <- setRefClass("SummaryFactory", } summaryItemNames <- paste0(format(summaryItemNames), " ") - na <- ifelse(.isDataset(object), "NA", NA_character_) + na <- ifelse(.isDataset(self$object), "NA", NA_character_) tableColumns <- 0 maxValueWidth <- 1 - if (length(summaryItems) > 0) { - for (i in 1:length(summaryItems)) { - validValues <- na.omit(summaryItems[[i]]$values) + if (length(self$summaryItems) > 0) { + for (i in 1:length(self$summaryItems)) { + validValues <- na.omit(self$summaryItems[[i]]$values) if (length(validValues) > 0) { w <- max(nchar(validValues)) maxValueWidth <- max(maxValueWidth, w) @@ -257,21 +257,21 @@ SummaryFactory <- setRefClass("SummaryFactory", } } spaceString <- paste0(rep(" ", maxValueWidth + 1), collapse = "") - for (i in 1:length(summaryItems)) { - itemTitle <- summaryItems[[i]]$title + for (i in 1:length(self$summaryItems)) { + itemTitle <- self$summaryItems[[i]]$title if (!is.null(itemTitle) && length(itemTitle) == 1 && !is.na(itemTitle)) { summaryItemName <- summaryItemNames[i] - values <- summaryItems[[i]]$values + values <- self$summaryItems[[i]]$values values <- trimws(values) indices <- !grepl("(\\])$", values) values[indices] <- paste0(values[indices], " ") - values <- format(c(spaceString, values), justify = justify)[2:(length(values) + 1)] - .cat(summaryItemName, values, "\n", + values <- format(c(spaceString, values), justify = self$justify)[2:(length(values) + 1)] + self$.cat(summaryItemName, values, "\n", tableColumns = tableColumns, consoleOutputEnabled = consoleOutputEnabled, na = na ) if (!consoleOutputEnabled && trimws(summaryItemName) == "Stage") { - .cat(rep("----- ", tableColumns), "\n", + self$.cat(rep("----- ", tableColumns), "\n", tableColumns = tableColumns, consoleOutputEnabled = consoleOutputEnabled, na = na ) @@ -281,15 +281,15 @@ SummaryFactory <- setRefClass("SummaryFactory", } if (length(legendEntries) > 0) { - .cat("\n", consoleOutputEnabled = consoleOutputEnabled) - .cat("Legend:\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat("Legend:\n", consoleOutputEnabled = consoleOutputEnabled) if (!consoleOutputEnabled) { - .cat("\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) } for (legendEntry in legendEntries) { - .cat(legendEntry, "\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat(legendEntry, "\n", consoleOutputEnabled = consoleOutputEnabled) } - .cat("\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) } }, addItem = function(title, values, legendEntry = list()) { @@ -298,7 +298,7 @@ SummaryFactory <- setRefClass("SummaryFactory", } tryCatch( { - addSummaryItem(SummaryItem(title = title, values = values, legendEntry = legendEntry)) + self$addSummaryItem(SummaryItemR6$new(title = title, values = values, legendEntry = legendEntry)) }, error = function(e) { stop( @@ -309,13 +309,13 @@ SummaryFactory <- setRefClass("SummaryFactory", ) }, addSummaryItem = function(summaryItem) { - if (!inherits(summaryItem, "SummaryItem")) { + if (!(inherits(summaryItem, "SummaryItem") || inherits(summaryItem, "SummaryItemR6"))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'summaryItem' must be an instance of class 'SummaryItem' (was '", .getClassName(summaryItem), "')" ) } - summaryItems <<- c(summaryItems, summaryItem) + self$summaryItems <- c(self$summaryItems, summaryItem) }, .getFormattedParameterValue = function(valuesToShow, valuesToShow2) { naText <- getOption("rpact.summary.na", "") @@ -332,7 +332,7 @@ SummaryFactory <- setRefClass("SummaryFactory", if (trimws(value1) == "" && trimws(value2) == "") { valuesToShow[variantIndex] <- naText } else { - valuesToShow[variantIndex] <- sprintf(intervalFormat, value1, value2) + valuesToShow[variantIndex] <- sprintf(self$intervalFormat, value1, value2) } } } else { @@ -348,7 +348,7 @@ SummaryFactory <- setRefClass("SummaryFactory", parameterCaptionSingle = parameterCaption, legendEntry = list(), enforceFirstCase = FALSE, formatRepeatedPValues = FALSE) { if (!is.null(parameterName) && length(parameterName) == 1 && - inherits(parameterSet, "ParameterSet") && + (inherits(parameterSet, "ParameterSet") || inherits(parameterSet, "ParameterSetR6")) && parameterSet$.getParameterType(parameterName) == C_PARAM_NOT_APPLICABLE) { if (.getLogicalEnvironmentVariable("RPACT_DEVELOPMENT_MODE")) { warning( @@ -408,7 +408,7 @@ SummaryFactory <- setRefClass("SummaryFactory", parameterNames <- "" numberOfVariants <- 1 numberOfStages <- ifelse(is.matrix(values), ncol(values), length(values)) - if (inherits(parameterSet, "ParameterSet")) { + if (inherits(parameterSet, "ParameterSet") || inherits(parameterSet, "ParameterSetR6")) { parameterNames <- parameterSet$.getVisibleFieldNamesOrdered() numberOfVariants <- .getMultidimensionalNumberOfVariants(parameterSet, parameterNames) numberOfStages <- parameterSet$.getMultidimensionalNumberOfStages(parameterNames) @@ -418,7 +418,7 @@ SummaryFactory <- setRefClass("SummaryFactory", if (is.null(stages) && !is.null(parameterSet[[".stageResults"]])) { stages <- parameterSet[[".stageResults"]][["stages"]] } - if (is.null(stages) && inherits(parameterSet, "ClosedCombinationTestResults")) { + if (is.null(stages) && (inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResultsR6"))) { stages <- parameterSet[[".design"]][["stages"]] } if (!is.null(stages) && length(stages) > 0) { @@ -478,9 +478,9 @@ SummaryFactory <- setRefClass("SummaryFactory", ) if (parameterName1 %in% c("piControl", "overallPiControl", "overallPooledStDevs")) { - valuesToShow <- .getInnerValues(valuesToShow, transpose = TRUE) + valuesToShow <- self$.getInnerValues(valuesToShow, transpose = TRUE) } else { - valuesToShow <- .getInnerValues(valuesToShow, transpose = transpose) + valuesToShow <- self$.getInnerValues(valuesToShow, transpose = transpose) } valuesToShow2 <- NA_real_ @@ -492,13 +492,13 @@ SummaryFactory <- setRefClass("SummaryFactory", smoothedZeroFormat = smoothedZeroFormat, formatRepeatedPValues = formatRepeatedPValues ) - valuesToShow2 <- .getInnerValues(valuesToShow2, transpose = transpose) + valuesToShow2 <- self$.getInnerValues(valuesToShow2, transpose = transpose) } - valuesToShow <- .getFormattedParameterValue(valuesToShow, valuesToShow2) - addItem(parameterCaptionSingle, valuesToShow, legendEntry) + valuesToShow <- self$.getFormattedParameterValue(valuesToShow, valuesToShow2) + self$addItem(parameterCaptionSingle, valuesToShow, legendEntry) } else { - if (!inherits(parameterSet, "ParameterSet")) { + if (!(inherits(parameterSet, "ParameterSet") || inherits(parameterSet, "ParameterSetR6"))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "for varied values 'parameterSet' must be an instance of ", @@ -511,9 +511,9 @@ SummaryFactory <- setRefClass("SummaryFactory", userDefinedEffectMatrix <- FALSE if (grepl("MultiArm|Enrichment", .getClassName(parameterSet)) || - inherits(parameterSet, "AnalysisResultsConditionalDunnett") || - inherits(parameterSet, "ClosedCombinationTestResults") || - inherits(parameterSet, "ConditionalPowerResults")) { + (inherits(parameterSet, "AnalysisResultsConditionalDunnett") || inherits(parameterSet, "AnalysisResultsConditionalDunnettR6")) || + (inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResultsR6")) || + (inherits(parameterSet, "ConditionalPowerResults") || inherits(parameterSet, "ConditionalPowerResultsR6"))) { if (grepl("SimulationResults(MultiArm|Enrichment)", .getClassName(parameterSet)) && parameterName %in% c( "rejectAtLeastOne", @@ -560,7 +560,7 @@ SummaryFactory <- setRefClass("SummaryFactory", numberOfVariants <- length(variedParameterValues) } variedParameterCaption <- tolower(variedParameterCaption) - } else if (.isEnrichmentObject(parameterSet)) { + } else if (self$.isEnrichmentObject(parameterSet)) { transposed <- TRUE variedParameterCaption <- "populations" if (parameterName1 %in% c( @@ -578,25 +578,25 @@ SummaryFactory <- setRefClass("SummaryFactory", numberOfVariants <- length(variedParameterValues) legendEntry[["S[i]"]] <- "population i" legendEntry[["F"]] <- "full population" - } else if (!inherits(parameterSet, "ClosedCombinationTestResults") || + } else if (!(inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResultsR6")) || parameterName %in% c("rejected", "separatePValues")) { - if (inherits(parameterSet, "AnalysisResultsConditionalDunnett") && + if ((inherits(parameterSet, "AnalysisResultsConditionalDunnett") || inherits(parameterSet, "AnalysisResultsConditionalDunnettR6")) && (!is.matrix(values) || ncol(values) > 1)) { transposed <- TRUE } - if (inherits(parameterSet, "ClosedCombinationTestResults") && + if ((inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResultsR6")) && parameterSet$.getParameterType("adjustedStageWisePValues") != "g" && parameterName == "separatePValues") { transposed <- TRUE } - if (inherits(parameterSet, "ClosedCombinationTestResults") && + if ((inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResultsR6")) && parameterName %in% c("rejected")) { transposed <- TRUE } - if (inherits(parameterSet, "ConditionalPowerResults") && + if ((inherits(parameterSet, "ConditionalPowerResults") || inherits(parameterSet, "ConditionalPowerResultsR6")) && parameterName %in% c("conditionalPower", "values")) { transposed <- TRUE } @@ -649,7 +649,7 @@ SummaryFactory <- setRefClass("SummaryFactory", } for (variantIndex in 1:numberOfVariants) { - colValues <- .getColumnValues(parameterName, values, variantIndex, transposed) + colValues <- self$.getColumnValues(parameterName, values, variantIndex, transposed) colValues <- .getSummaryValuesFormatted(parameterSet, parameterName1, colValues, roundDigits = roundDigits, @@ -659,7 +659,7 @@ SummaryFactory <- setRefClass("SummaryFactory", ) colValues2 <- NA_real_ if (!all(is.na(values2))) { - colValues2 <- .getColumnValues(parameterName, values2, variantIndex, transposed) + colValues2 <- self$.getColumnValues(parameterName, values2, variantIndex, transposed) colValues2 <- .getSummaryValuesFormatted(parameterSet, parameterName2, colValues2, roundDigits = roundDigits, ceilingEnabled = ceilingEnabled, cumsumEnabled = cumsumEnabled, @@ -667,28 +667,28 @@ SummaryFactory <- setRefClass("SummaryFactory", formatRepeatedPValues = formatRepeatedPValues ) } - colValues <- .getFormattedParameterValue(valuesToShow = colValues, valuesToShow2 = colValues2) + colValues <- self$.getFormattedParameterValue(valuesToShow = colValues, valuesToShow2 = colValues2) if (numberOfVariants == 1) { - addItem(parameterCaption, colValues, legendEntry) - } else if (.isEnrichmentObject(parameterSet)) { - addItem(paste0( + self$addItem(parameterCaption, colValues, legendEntry) + } else if (self$.isEnrichmentObject(parameterSet)) { + self$addItem(paste0( parameterCaption, " ", variedParameterValues[variantIndex] ), colValues, legendEntry) } else if ( (grepl("MultiArm|Enrichment", .getClassName(parameterSet)) && !grepl("Simulation", .getClassName(parameterSet))) || - inherits(parameterSet, "AnalysisResultsConditionalDunnett") || - inherits(parameterSet, "ClosedCombinationTestResults") || - inherits(parameterSet, "ConditionalPowerResults")) { + (inherits(parameterSet, "AnalysisResultsConditionalDunnett") || inherits(parameterSet, "AnalysisResultsConditionalDunnettR6")) || + (inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResultsR6")) || + (inherits(parameterSet, "ConditionalPowerResults") || inherits(parameterSet, "ConditionalPowerResultsR6"))) { spacePrefix <- ifelse(parameterCaption %in% c("pi", "lambda", "median"), "", " ") - addItem(paste0( + self$addItem(paste0( parameterCaption, spacePrefix, "(", variedParameterValues[variantIndex], ")" ), colValues, legendEntry) } else if (userDefinedEffectMatrix) { - addItem(paste0(parameterCaption, " [", variantIndex, "]"), colValues, legendEntry) + self$addItem(paste0(parameterCaption, " [", variantIndex, "]"), colValues, legendEntry) } else { if (is.matrix(variedParameterValues) && ncol(variedParameterValues) > 1) { variedParameterValuesFormatted <- @@ -696,7 +696,7 @@ SummaryFactory <- setRefClass("SummaryFactory", } else { variedParameterValuesFormatted <- variedParameterValues[variantIndex] } - addItem( + self$addItem( paste0( parameterCaption, ", ", variedParameterCaption, " = ", variedParameterValuesFormatted @@ -712,7 +712,7 @@ SummaryFactory <- setRefClass("SummaryFactory", .isEnrichmentAnalysisResults(parameterSet) || .isEnrichmentStageResults(parameterSet) || .isEnrichmentConditionalPowerResults(parameterSet) || - (inherits(parameterSet, "ClosedCombinationTestResults") && + ((inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResultsR6")) && isTRUE(parameterSet$.enrichment)) ) }, @@ -789,3 +789,2832 @@ SummaryFactory <- setRefClass("SummaryFactory", } ) ) + +.formatSummaryValues <- function(values, digits, smoothedZeroFormat = FALSE, formatRepeatedPValues = FALSE) { + if (is.na(digits)) { + digits <- 3 + } + + if (digits < 1) { + formattedValue <- as.character(values) + formattedValue[is.na(formattedValue) | trimws(formattedValue) == "NA"] <- getOption("rpact.summary.na", "") + return(formattedValue) + } + + if (sum(is.na(values)) == length(values)) { + formattedValue <- rep(getOption("rpact.summary.na", ""), length(values)) + return(formattedValue) + } + + threshold <- 10^-digits + text <- "<0." + if (digits > 1) { + for (i in 1:(digits - 1)) { + text <- paste0(text, "0") + } + } + text <- paste0(text, "1") + + if (smoothedZeroFormat) { + values[abs(values) < 1e-15] <- 0 + } + indices <- (!is.na(values) & values > 1e-10 & abs(values) < threshold) + values[!is.na(values) & !indices] <- round(values[!is.na(values) & !indices], digits) + if (sum(indices) > 0) { + values[indices] <- threshold + formattedValue <- .getFormattedValue(values, digits = digits, nsmall = digits, scientific = FALSE) + formattedValue[indices] <- text + } else { + formattedValue <- .getFormattedValue(values, digits = digits, nsmall = digits, scientific = FALSE) + formattedValue <- format(formattedValue, scientific = FALSE) + } + + if (formatRepeatedPValues) { + formattedValue[!is.na(formattedValue) & + nchar(gsub("\\D", "", (formattedValue))) > 0 & formattedValue > 0.4999] <- ">0.5" + } + + if (as.logical(getOption("rpact.summary.trim.zeroes", TRUE))) { + zeroes <- grepl("^0\\.0*$", formattedValue) + if (sum(zeroes) > 0) { + formattedValue[zeroes] <- "0" + } + } + + formattedValue[is.na(formattedValue) | trimws(formattedValue) == "NA"] <- getOption("rpact.summary.na", "") + + return(formattedValue) +} + +.getSummaryValuesFormatted <- function(fieldSet, parameterName, values, + roundDigits = NA_integer_, ceilingEnabled = FALSE, cumsumEnabled = FALSE, + smoothedZeroFormat = FALSE, formatRepeatedPValues = FALSE) { + if (!is.numeric(values)) { + return(values) + } + + if (cumsumEnabled) { + values <- cumsum(values) + } + + if (ceilingEnabled) { + values <- ceiling(values) + } else { + tryCatch( + { + formatFunctionName <- NULL + + if (!is.null(parameterName) && length(parameterName) == 1 && !is.na(parameterName)) { + if (parameterName == "futilityBounds") { + values[!is.na(values) & values <= -6] <- -Inf + } else if (parameterName %in% c("criticalValues", "decisionCriticalValue", "overallAdjustedTestStatistics")) { + design <- fieldSet + if (!.isTrialDesign(design)) { + design <- fieldSet[[".design"]] + } + if (!is.null(design) && .isTrialDesignFisher(design)) { + roundDigits <- 0 + } + } + if (!is.na(roundDigits) && roundDigits == 0) { + if (inherits(fieldSet, "Dataset") && + grepl("samplesize|event", tolower(parameterName))) { + } else { + if (inherits(fieldSet, "FieldSet") || inherits(fieldSet, "FieldSetR6")) { + formatFunctionName <- fieldSet$.parameterFormatFunctions[[parameterName]] + } + if (is.null(formatFunctionName)) { + formatFunctionName <- C_PARAMETER_FORMAT_FUNCTIONS[[parameterName]] + } + } + } + } + + if (!is.null(formatFunctionName)) { + values <- eval(call(formatFunctionName, values)) + } else { + values <- .formatSummaryValues(values, + digits = roundDigits, + smoothedZeroFormat = smoothedZeroFormat, + formatRepeatedPValues = formatRepeatedPValues + ) + } + }, + error = function(e) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to show parameter '", parameterName, "': ", e$message) + } + ) + } + + return(format(values)) +} + +.createSummaryTitleObject <- function(object) { + design <- NULL + designPlan <- NULL + if (inherits(object, "TrialDesignCharacteristics")) { + design <- object$.design + } else if (.isTrialDesignPlan(object) || inherits(object, "SimulationResults") || inherits(object, "SimulationResultsR6")) { + design <- object$.design + designPlan <- object + } else if (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) { + return(.createSummaryTitleAnalysisResults(object$.design, object)) + } else if (.isTrialDesign(object)) { + design <- object + } + if (!is.null(design)) { + return(.createSummaryTitleDesign(design, designPlan)) + } + return("") +} + +.createSummaryTitleAnalysisResults <- function(design, analysisResults) { + kMax <- design$kMax + + title <- "" + if (kMax == 1) { + title <- paste0(title, "Fixed sample analysis results") + } else { + title <- paste0(title, "Sequential analysis results with a maximum of ", kMax, " looks") + } + + if (!is.null(analysisResults)) { + if (.isMultiArmAnalysisResults(analysisResults)) { + title <- "Multi-arm analysis results for a " + } else if (.isEnrichmentAnalysisResults(analysisResults)) { + title <- "Enrichment analysis results for a " + } else { + title <- "Analysis results for a " + } + + if (grepl("Means", .getClassName(analysisResults$.dataInput))) { + title <- paste0(title, "continuous endpoint") + } else if (grepl("Rates", .getClassName(analysisResults$.dataInput))) { + title <- paste0(title, "binary endpoint") + } else if (grepl("Survival", .getClassName(analysisResults$.dataInput))) { + title <- paste0(title, "survival endpoint") + } + + if (.isMultiHypothesesAnalysisResults(analysisResults)) { + gMax <- analysisResults$.stageResults$getGMax() + if (.isMultiArmAnalysisResults(analysisResults)) { + title <- paste0(title, " (", gMax, " active arms vs. control)") + } else if (.isEnrichmentAnalysisResults(analysisResults)) { + title <- paste0(title, " (", gMax, " populations)") + } + } + } else if (kMax > 1) { + prefix <- ifelse(design$.isDelayedResponseDesign(), "delayed response ", "") + title <- .concatenateSummaryText(title, + paste0("(", prefix, design$.toString(startWithUpperCase = FALSE), ")"), + sep = " " + ) + } + + return(title) +} + +.createSummaryTitleDesign <- function(design, designPlan) { + kMax <- design$kMax + + title <- "" + if (kMax == 1) { + title <- paste0(title, "Fixed sample analysis") + } else { + title <- paste0(title, "Sequential analysis with a maximum of ", kMax, " looks") + } + if (!is.null(designPlan)) { + if (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")) { + title <- "Simulation of a " + } else if (designPlan$.isSampleSizeObject()) { + title <- "Sample size calculation for a " + } else if (designPlan$.isPowerObject()) { + title <- "Power calculation for a " + } + + if (grepl("Means", .getClassName(designPlan))) { + title <- paste0(title, "continuous endpoint") + } else if (grepl("Rates", .getClassName(designPlan))) { + title <- paste0(title, "binary endpoint") + } else if (grepl("Survival", .getClassName(designPlan))) { + title <- paste0(title, "survival endpoint") + } + + if (grepl("MultiArm", .getClassName(designPlan)) && + !is.null(designPlan[["activeArms"]]) && designPlan$activeArms > 1) { + title <- .concatenateSummaryText(title, "(multi-arm design)", sep = " ") + } else if (grepl("Enrichment", .getClassName(designPlan))) { + title <- .concatenateSummaryText(title, "(enrichment design)", sep = " ") + } + } else if (kMax > 1) { + prefix <- ifelse(design$.isDelayedResponseDesign(), "delayed response ", "") + title <- .concatenateSummaryText(title, + paste0("(", prefix, design$.toString(startWithUpperCase = FALSE), ")"), + sep = " " + ) + } + + return(title) +} + +.isRatioComparisonEnabled <- function(object) { + if (!is.null(object[["meanRatio"]]) && isTRUE(object[["meanRatio"]])) { + return(TRUE) + } + + if (!is.null(object[["riskRatio"]]) && isTRUE(object[["riskRatio"]])) { + return(TRUE) + } + + return(FALSE) +} + +.getSummaryObjectSettings <- function(object) { + multiArmEnabled <- grepl("MultiArm", .getClassName(object)) + enrichmentEnabled <- grepl("Enrichment", .getClassName(object)) + simulationEnabled <- grepl("Simulation", .getClassName(object)) + ratioEnabled <- FALSE + populations <- NA_integer_ + if ((inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) || (inherits(object, "StageResults") || inherits(object, "StageResultsR6"))) { + groups <- object$.dataInput$getNumberOfGroups() + meansEnabled <- grepl("Means", .getClassName(object$.dataInput)) + ratesEnabled <- grepl("Rates", .getClassName(object$.dataInput)) + survivalEnabled <- grepl("Survival", .getClassName(object$.dataInput)) + } else { + meansEnabled <- grepl("Means", .getClassName(object)) + ratesEnabled <- grepl("Rates", .getClassName(object)) + survivalEnabled <- grepl("Survival", .getClassName(object)) + if (simulationEnabled && multiArmEnabled) { + groups <- object$activeArms + } else if (simulationEnabled && enrichmentEnabled) { + groups <- 2 + populations <- object$populations + } else { + # for analysis multi-arm / enrichment always 2 groups are applicable + groups <- ifelse(multiArmEnabled || enrichmentEnabled || survivalEnabled, 2, object[["groups"]]) + } + ratioEnabled <- .isRatioComparisonEnabled(object) + } + + return(list( + meansEnabled = meansEnabled, + ratesEnabled = ratesEnabled, + survivalEnabled = survivalEnabled, + groups = groups, + populations = populations, + multiArmEnabled = multiArmEnabled, + enrichmentEnabled = enrichmentEnabled, + simulationEnabled = simulationEnabled, + ratioEnabled = ratioEnabled + )) +} + +.createSummaryHypothesisText <- function(object, summaryFactory) { + if (!(inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) && !(inherits(object, "TrialDesignPlan") || inherits(object, "TrialDesignPlanR6")) && + !(inherits(object, "SimulationResults") || inherits(object, "SimulationResultsR6"))) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'object' must be an instance of class 'AnalysisResults', 'TrialDesignPlan' ", + "or 'SimulationResults' (is '", .getClassName(object), "')" + ) + } + + design <- object[[".design"]] + if (is.null(design)) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'.design' must be defined in specified ", .getClassName(object)) + } + + settings <- .getSummaryObjectSettings(object) + sided <- ifelse(settings$multiArmEnabled || settings$enrichmentEnabled, 1, design$sided) + directionUpper <- object[["directionUpper"]] + if (is.null(directionUpper) || length(directionUpper) != 1 || is.na(directionUpper)) { + directionUpper <- TRUE + } + + comparisonH0 <- " = " + comparisonH1 <- NA_character_ + if ((inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) && !is.null(directionUpper)) { + comparisonH1 <- ifelse(sided == 2, " != ", ifelse(directionUpper, " > ", " < ")) + } + + if (!is.null(object[["thetaH0"]])) { + thetaH0 <- round(object$thetaH0, 3) + } else { + thetaH0 <- ifelse(settings$survivalEnabled, 1, 0) + } + + treatmentArmIndex <- ifelse(settings$groups > 1, "(i)", "(treatment)") + controlArmIndex <- ifelse(settings$groups > 1, "(i)", "(control)") + + if (settings$multiArmEnabled || settings$enrichmentEnabled) { + if ((settings$survivalEnabled) && (settings$multiArmEnabled)) { + treatmentArmIndex <- "(i)" + controlArmIndex <- "" + } else if ((settings$survivalEnabled) && (settings$enrichmentEnabled)) { + treatmentArmIndex <- "" + controlArmIndex <- "" + } else if (settings$groups == 1) { + treatmentArmIndex <- "(treatment)" + controlArmIndex <- "(control)" + } else { + if (settings$enrichmentEnabled) { + treatmentArmIndex <- "(treatment)" + } else { + treatmentArmIndex <- "(i)" + } + controlArmIndex <- "(control)" + } + } else { + if (settings$groups == 1 || settings$survivalEnabled) { + treatmentArmIndex <- "" + controlArmIndex <- "" + } else { + treatmentArmIndex <- "(1)" + controlArmIndex <- "(2)" + } + } + + value <- "?" + if (settings$meansEnabled) { + value <- "mu" + } else if (settings$ratesEnabled) { + value <- "pi" + } else if (settings$survivalEnabled) { + value <- "hazard ratio" + } + + calcSep <- ifelse(settings$ratioEnabled, " / ", " - ") + hypothesis <- "" + if (!settings$survivalEnabled && (settings$multiArmEnabled || settings$enrichmentEnabled || settings$groups == 2)) { + hypothesis <- paste0( + hypothesis, "H0: ", value, treatmentArmIndex, + calcSep, value, controlArmIndex, comparisonH0, thetaH0 + ) + if (!is.na(comparisonH1)) { + hypothesis <- paste0(hypothesis, " against ") + hypothesis <- paste0( + hypothesis, "H1: ", value, treatmentArmIndex, + calcSep, value, controlArmIndex, comparisonH1, thetaH0 + ) + } + } else { + hypothesis <- paste0(hypothesis, "H0: ", value, treatmentArmIndex, comparisonH0, thetaH0) + if (!is.na(comparisonH1)) { + hypothesis <- paste0(hypothesis, " against ") + hypothesis <- paste0(hypothesis, "H1: ", value, treatmentArmIndex, comparisonH1, thetaH0) + } + } + hypothesis <- .concatenateSummaryText( + hypothesis, + .createSummaryHypothesisPowerDirectionText(object, sided, directionUpper) + ) + return(hypothesis) +} + +.createSummaryHypothesisPowerDirectionText <- function(object, sided, directionUpper) { + if (sided == 2 || is.null(directionUpper)) { + return("") + } + + directionUpper <- unique(directionUpper) + if (length(directionUpper) != 1) { + return("") + } + + if (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) { + return("") + } + + if (.isTrialDesignPlan(object) && object$.objectType != "power") { + return("") + } + + if (directionUpper) { + return("power directed towards larger values") + } else { + return("power directed towards smaller values") + } +} + +.addSummaryLineBreak <- function(text, newLineLength) { + maxLineLength <- as.integer(getOption("rpact.summary.width", 83)) + lines <- strsplit(text, "\n", fixed = TRUE)[[1]] + lastLine <- lines[length(lines)] + if (nchar(lastLine) + newLineLength > maxLineLength) { + text <- paste0(text, "\n") + } + return(text) +} + +.concatenateSummaryText <- function(a, b, sep = ", ") { + .assertIsSingleCharacter(a, "a") + .assertIsSingleCharacter(b, "b") + if (is.na(b) || nchar(trimws(b)) == 0) { + return(a) + } + + if (a == "") { + return(b) + } + + a <- paste0(a, sep) + a <- .addSummaryLineBreak(a, nchar(b)) + return(paste0(a, b)) +} + +.createSummaryHeaderObject <- function(object, summaryFactory, digits = NA_integer_) { + if (inherits(object, "TrialDesignCharacteristics")) { + return(.createSummaryHeaderDesign(object$.design, NULL, summaryFactory)) + } + + if (.isTrialDesignPlan(object) || (inherits(object, "SimulationResults") || inherits(object, "SimulationResultsR6"))) { + return(.createSummaryHeaderDesign(object$.design, object, summaryFactory)) + } + + if (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) { + return(.createSummaryHeaderAnalysisResults(object$.design, object, summaryFactory, digits)) + } + + if (.isTrialDesign(object)) { + return(.createSummaryHeaderDesign(object, NULL, summaryFactory)) + } + + return("") +} + +.addAllocationRatioToHeader <- function(parameterSet, header, sep = ", ") { + if (!.isTrialDesignPlanSurvival(parameterSet) && !grepl("Simulation", .getClassName(parameterSet))) { + numberOfGroups <- 1 + if (inherits(parameterSet, "TrialDesignPlan") || inherits(parameterSet, "TrialDesignPlanR6")) { + numberOfGroups <- parameterSet$groups + } else if (inherits(parameterSet, "AnalysisResults") || inherits(parameterSet, "AnalysisResultsR6")) { + numberOfGroups <- parameterSet$.dataInput$getNumberOfGroups() + } + if (numberOfGroups == 1) { + return(header) + } + } + + prefix <- "" + if (!is.null(parameterSet[["optimumAllocationRatio"]]) && + length(parameterSet$optimumAllocationRatio) == 1 && + parameterSet$optimumAllocationRatio) { + if (length(unique(parameterSet$allocationRatioPlanned)) > 1) { + return(.concatenateSummaryText(header, "optimum planned allocation ratio", sep = sep)) + } + prefix <- "optimum " + } + + allocationRatioPlanned <- round(unique(parameterSet$allocationRatioPlanned), 3) + if (identical(allocationRatioPlanned, 1) && prefix == "") { + return(header) + } + + if (!all(is.na(allocationRatioPlanned))) { + return(.concatenateSummaryText(header, + paste0( + prefix, "planned allocation ratio = ", + .arrayToString(allocationRatioPlanned, vectorLookAndFeelEnabled = length(allocationRatioPlanned) > 1) + ), + sep = sep + )) + } else { + return(header) + } +} + +.createSummaryHeaderAnalysisResults <- function(design, analysisResults, summaryFactory, digits) { + digitSettings <- .getSummaryDigits(digits) + digitsGeneral <- digitSettings$digitsGeneral + + stageResults <- analysisResults$.stageResults + dataInput <- analysisResults$.dataInput + + multiArmEnabled <- .isMultiArmAnalysisResults(analysisResults) + enrichmentEnabled <- .isEnrichmentAnalysisResults(analysisResults) + multiHypothesesEnabled <- .isMultiHypothesesAnalysisResults(analysisResults) + + header <- "" + if (design$kMax == 1) { + header <- paste0(header, "Fixed sample analysis.") + } else { + header <- paste0(header, "Sequential analysis with ", design$kMax, " looks") + header <- .concatenateSummaryText(header, + paste0("(", design$.toString(startWithUpperCase = FALSE), ")."), + sep = " " + ) + } + header <- paste0(header, "\n") + + header <- paste0(header, "The results were calculated using a ") + if (stageResults$isDatasetMeans()) { + if (dataInput$getNumberOfGroups() == 1) { + header <- paste0(header, "one-sample t-test") + } else if (dataInput$getNumberOfGroups() == 2) { + header <- paste0(header, "two-sample t-test") + } else { + header <- paste0(header, "multi-arm t-test") + } + } else if (stageResults$isDatasetRates()) { + if (dataInput$getNumberOfGroups() == 1) { + header <- paste0(header, "one-sample test for rates") + } else if (dataInput$getNumberOfGroups() == 2) { + header <- paste0(header, "two-sample test for rates") + } else { + header <- paste0(header, "multi-arm test for rates") + } + } else if (stageResults$isDatasetSurvival()) { + if (dataInput$getNumberOfGroups() == 2) { + header <- paste0(header, "two-sample logrank test") + } else { + header <- paste0(header, "multi-arm logrank test") + } + } + + 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") + } else if (stageResults$intersectionTest == "Bonferroni") { + header <- .concatenateSummaryText(header, "Bonferroni intersection test") + } else if (stageResults$intersectionTest == "Simes") { + header <- .concatenateSummaryText(header, "Simes intersection test") + } else if (stageResults$intersectionTest == "Sidak") { + header <- .concatenateSummaryText(header, "Sidak intersection test") + } else if (stageResults$intersectionTest == "Hierarchical") { + header <- .concatenateSummaryText(header, "Hierarchical intersection test") + } else if (stageResults$intersectionTest == "SpiessensDebois") { + header <- .concatenateSummaryText(header, "Spiessens and Debois intersection test") + } + } + + if (!is.null(stageResults[["normalApproximation"]]) && stageResults$normalApproximation) { + header <- .concatenateSummaryText(header, "normal approximation test") + } else if (stageResults$isDatasetRates()) { + if (dataInput$getNumberOfGroups() == 1) { + header <- .concatenateSummaryText(header, "exact test") + } else { + header <- .concatenateSummaryText(header, "exact test of Fisher") + } + } else { + # header <- .concatenateSummaryText(header, "exact t test") + } + + if (stageResults$isDatasetMeans() && multiHypothesesEnabled) { + if (stageResults$varianceOption == "overallPooled") { + header <- .concatenateSummaryText(header, "overall pooled variances option") + } else if (stageResults$varianceOption == "pairwisePooled") { + header <- .concatenateSummaryText(header, "pairwise pooled variances option") + } else if (stageResults$varianceOption == "pooledFromFull") { + header <- .concatenateSummaryText(header, "pooled from full population variances option") + } else if (stageResults$varianceOption == "pooled") { + header <- .concatenateSummaryText(header, "pooled variances option") + } else if (stageResults$varianceOption == "notPooled") { + header <- .concatenateSummaryText(header, "not pooled variances option") + } + } + + if ((inherits(stageResults, "StageResultsMeans") || inherits(stageResults, "StageResultsMeansR6")) && (dataInput$getNumberOfGroups() == 2)) { + if (stageResults$equalVariances) { + header <- .concatenateSummaryText(header, "equal variances option") + } else { + header <- .concatenateSummaryText(header, "unequal variances option") + } + } + + if (.isTrialDesignConditionalDunnett(design)) { + if (design$secondStageConditioning) { + header <- .concatenateSummaryText(header, "conditional second stage p-values") + } else { + header <- .concatenateSummaryText(header, "unconditional second stage p-values") + } + } + + if (enrichmentEnabled) { + header <- .concatenateSummaryText(header, paste0( + ifelse(analysisResults$stratifiedAnalysis, "", "non-"), "stratified analysis" + )) + } + + header <- paste0(header, ".\n", .createSummaryHypothesisText(analysisResults, summaryFactory)) + + if (stageResults$isDatasetMeans()) { + header <- .getSummaryHeaderEntryAnalysisResults(header, analysisResults, + paramName1 = "thetaH1", + paramName2 = ifelse(multiHypothesesEnabled, "assumedStDevs", "assumedStDev"), + paramCaption1 = "assumed effect", + paramCaption2 = "assumed standard deviation", + shortcut1 = "thetaH1", + shortcut2 = "sd", + digits1 = digitsGeneral, + digits2 = digitsGeneral + ) + } else if (stageResults$isDatasetRates()) { + header <- .getSummaryHeaderEntryAnalysisResults(header, analysisResults, + paramName1 = ifelse(enrichmentEnabled, "piTreatments", ifelse(multiArmEnabled, "piTreatments", "pi1")), + paramName2 = ifelse(enrichmentEnabled, "piControls", ifelse(multiArmEnabled, "piControl", "pi2")), + paramCaption1 = "assumed treatment rate", + paramCaption2 = "assumed control rate", + shortcut1 = "pi", + shortcut2 = "pi" + ) + } else if (stageResults$isDatasetSurvival()) { + header <- .getSummaryHeaderEntryAnalysisResults(header, analysisResults, + paramName1 = "thetaH1", + paramCaption1 = "assumed effect", + shortcut1 = "thetaH1", + digits1 = digitsGeneral + ) + } + + header <- paste0(header, ".") + return(header) +} + +.getSummaryHeaderEntryValueAnalysisResults <- function(shortcut, value, analysisResults) { + if (is.matrix(value)) { + stage <- analysisResults$.stageResults$stage + if (stage <= ncol(value)) { + value <- value[, stage] + } + } + + value[!is.na(value)] <- round(value[!is.na(value)], 2) + + if ((is.matrix(value) && nrow(value) > 1) || length(value) > 1) { + treatmentNames <- 1:length(value) + if (.isEnrichmentAnalysisResults(analysisResults)) { + populations <- paste0("S", treatmentNames) + gMax <- analysisResults$.stageResults$getGMax() + populations[treatmentNames == gMax] <- "F" + treatmentNames <- populations + } + value <- paste0(paste(paste0(shortcut, "(", treatmentNames, ") = ", value)), collapse = ", ") + } + return(value) +} + +.getSummaryHeaderEntryAnalysisResults <- function(header, analysisResults, ..., + paramName1, paramName2 = NA_character_, + paramCaption1, paramCaption2 = NA_character_, + shortcut1, shortcut2 = NA_character_, + digits1 = 2, digits2 = 2) { + if (analysisResults$.design$kMax == 1) { + return(header) + } + + if (length(analysisResults$nPlanned) == 0 || all(is.na(analysisResults$nPlanned))) { + return(header) + } + + paramValue1 <- analysisResults[[paramName1]] + case1 <- analysisResults$.getParameterType(paramName1) != C_PARAM_NOT_APPLICABLE && + !all(is.na(paramValue1)) + if (!is.na(paramCaption1) && analysisResults$.getParameterType(paramName1) == C_PARAM_GENERATED) { + paramCaption1 <- sub("assumed ", "overall ", paramCaption1) + } + + case2 <- FALSE + if (!is.na(paramName2)) { + paramValue2 <- analysisResults[[paramName2]] + case2 <- analysisResults$.getParameterType(paramName2) != C_PARAM_NOT_APPLICABLE && + !all(is.na(paramValue2)) + if (!is.na(paramCaption2) && analysisResults$.getParameterType(paramName2) == C_PARAM_GENERATED) { + paramCaption2 <- sub("assumed ", "overall ", paramCaption2) + } + } + + if (!case1 && !case2) { + return(header) + } + + if (.isTrialDesignFisher(analysisResults$.design) && + length(analysisResults$nPlanned[!is.na(analysisResults$nPlanned)]) > 1) { + header <- .concatenateSummaryText(header, paste0( + "The conditional power simulation with planned sample size and ", + analysisResults$iterations, " iterations is based on" + ), sep = ". ") + } else { + header <- .concatenateSummaryText(header, + "The conditional power calculation with planned sample size is based on", + sep = ". " + ) + } + + header <- .addAllocationRatioToHeader(analysisResults, header, sep = " ") + + sepPrefix <- ifelse(length(analysisResults$allocationRatioPlanned) == 0 || + identical(unique(analysisResults$allocationRatioPlanned), 1), "", ",") + + if (case1) { + if (!any(is.na(paramValue1)) && length(unique(paramValue1)) == 1) { + paramValue1 <- paramValue1[1] + } + if (length(paramValue1) == 1) { + header <- .concatenateSummaryText(header, + paste0(paramCaption1, " = ", ifelse(is.na(paramValue1), paramValue1, round(paramValue1, digits1))), + sep = paste0(sepPrefix, " ") + ) + } else { + header <- .concatenateSummaryText(header, + paste0(paramCaption1, ": ", .getSummaryHeaderEntryValueAnalysisResults( + shortcut1, paramValue1, analysisResults + )), + sep = paste0(sepPrefix, " ") + ) + } + } + + if (case2) { + if (length(paramValue2) == 1) { + header <- .concatenateSummaryText(header, + paste0(paramCaption2, " = ", ifelse(is.na(paramValue2), paramValue2, round(paramValue2, digits2))), + sep = ifelse(case1, paste0(sepPrefix, " and "), " ") + ) + } else { + header <- .concatenateSummaryText(header, + paste0(paramCaption2, ": ", .getSummaryHeaderEntryValueAnalysisResults( + shortcut2, paramValue2, analysisResults + )), + sep = ifelse(case1, paste0(sepPrefix, " and "), " ") + ) + } + } + return(header) +} + +.addEnrichmentEffectListToHeader <- function(header, designPlan) { + if (!grepl("SimulationResultsEnrichment", .getClassName(designPlan)) || + is.null(designPlan[["effectList"]])) { + return(header) + } + + + subGroups <- designPlan$effectList$subGroups + header <- .concatenateSummaryText(header, paste0( + "subgroup", + ifelse(length(subGroups) != 1, "s", ""), + " = ", + .arrayToString(subGroups, vectorLookAndFeelEnabled = TRUE) + )) + + prevalences <- designPlan$effectList$prevalences + header <- .concatenateSummaryText(header, paste0( + "prevalence", + ifelse(length(prevalences) != 1, "s", ""), + " = ", + .arrayToString(round(prevalences, 3), vectorLookAndFeelEnabled = TRUE) + )) + + if (!is.null(designPlan$effectList[["piControls"]])) { + piControls <- designPlan$effectList$piControls + if (length(piControls) > 0) { + if (length(unique(piControls)) == 1) { + piControls <- piControls[1] + } + controlRateText <- paste0( + "control rate", ifelse(length(piControls) == 1, "", "s"), " pi(control) = ", + .arrayToString(round(piControls, 3), vectorLookAndFeelEnabled = (length(unique(piControls)) > 1)) + ) + header <- .concatenateSummaryText(header, controlRateText) + } + } + + return(header) +} + +.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" + } else { + designType <- C_TYPE_OF_DESIGN_LIST[[design$typeOfDesign]] + } + header <- .firstCharacterToUpperCase(designType) + header <- paste0(header, " design") + if (design$.isDelayedResponseDesign()) { + header <- paste0(header, " with delayed response") + } + if (design$kMax > 1 && .isTrialDesignInverseNormalOrGroupSequential(design)) { + if (design$typeOfDesign == C_TYPE_OF_DESIGN_WT) { + header <- .concatenateSummaryText(header, + paste0("(deltaWT = ", round(design$deltaWT, 3), ")"), + sep = " " + ) + } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_WT_OPTIMUM) { + header <- .concatenateSummaryText(header, + paste0("(", design$optimizationCriterion, ", deltaWT = ", round(design$deltaWT, 3), ")"), + sep = " " + ) + } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_PT) { + header <- .concatenateSummaryText(header, + paste0("(deltaPT1 = ", round(design$deltaPT1, 3), ""), + sep = " " + ) + header <- .concatenateSummaryText(header, + paste0("deltaPT0 = ", round(design$deltaPT0, 3), ")"), + sep = ", " + ) + } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_HP) { + header <- .concatenateSummaryText(header, + paste0("(constant bounds = ", round(design$constantBoundsHP, 3), ")"), + sep = " " + ) + } else if (design$typeOfDesign %in% c(C_TYPE_OF_DESIGN_AS_KD, C_TYPE_OF_DESIGN_AS_HSD)) { + header <- .concatenateSummaryText(header, + paste0("(gammaA = ", round(design$gammaA, 3), ")"), + sep = " " + ) + } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_AS_USER) { + header <- .concatenateSummaryText(header, + paste0("(", .arrayToString(round(design$userAlphaSpending, 3)), ")"), + sep = " " + ) + } + + if (grepl("^as", design$typeOfDesign) && design$typeBetaSpending != C_TYPE_OF_DESIGN_BS_NONE) { + typeBetaSpending <- C_TYPE_OF_DESIGN_BS_LIST[[design$typeBetaSpending]] + header <- .concatenateSummaryText(header, typeBetaSpending, sep = " and ") + if (design$typeBetaSpending %in% c(C_TYPE_OF_DESIGN_BS_KD, C_TYPE_OF_DESIGN_BS_HSD)) { + header <- .concatenateSummaryText(header, + paste0("(gammaB = ", round(design$gammaB, 3), ")"), + sep = " " + ) + } else if (design$typeBetaSpending == C_TYPE_OF_DESIGN_BS_USER) { + header <- .concatenateSummaryText(header, + paste0("(", .arrayToString(round(design$userBetaSpending, 3)), ")"), + sep = " " + ) + } + } + } + if (!.isDelayedInformationEnabled(design = design) && + ((.isTrialDesignInverseNormalOrGroupSequential(design) && any(design$futilityBounds > -6, na.rm = TRUE)) || + (.isTrialDesignFisher(design) && any(design$alpha0Vec < 1)))) { + header <- .concatenateSummaryText( + header, + 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 <- .concatenateSummaryText(header, "undefined endpoint") + + if (design$kMax > 1 && .isTrialDesignInverseNormalOrGroupSequential(design)) { + outputSize <- getOption("rpact.summary.output.size", C_SUMMARY_OUTPUT_SIZE_DEFAULT) + designCharacteristics <- NULL + tryCatch( + { + designCharacteristics <- getDesignCharacteristics(design) + }, + error = function(e) { + .logError("Cannot add design characteristics to summary: ", e$message) + } + ) + if (!is.null(designCharacteristics)) { + header <- .concatenateSummaryText( + header, + paste0("inflation factor ", round(designCharacteristics$inflationFactor, 4)) + ) + if (outputSize == "large") { + header <- .concatenateSummaryText( + header, + paste0("ASN H1 ", round(designCharacteristics$averageSampleNumber1, 4)) + ) + header <- .concatenateSummaryText( + header, + paste0("ASN H01 ", round(designCharacteristics$averageSampleNumber01, 4)) + ) + header <- .concatenateSummaryText( + header, + paste0("ASN H0 ", round(designCharacteristics$averageSampleNumber0, 4)) + ) + } + } + } + + header <- paste0(header, ".") + return(header) + } + + header <- "" + if (design$kMax == 1) { + 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 ", "") + header <- .concatenateSummaryText(header, + paste0("(", prefix, design$.toString(startWithUpperCase = FALSE), ")"), + 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 <- paste0(header, "\n") + + header <- paste0(header, "The ", ifelse((inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")) || + designPlan$.isPowerObject(), "results were ", "sample size was ")) + header <- paste0(header, ifelse(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6"), "simulated", "calculated")) + header <- paste0(header, " for a ") + settings <- .getSummaryObjectSettings(designPlan) + if (settings$meansEnabled) { + if (settings$multiArmEnabled && settings$groups > 1) { + header <- .concatenateSummaryText(header, "multi-arm comparisons for means", sep = "") + } else if (settings$enrichmentEnabled && settings$populations > 1) { + header <- .concatenateSummaryText(header, "population enrichment comparisons for means", sep = "") + } else if (settings$groups == 1 && !settings$multiArmEnabled) { + header <- .concatenateSummaryText(header, "one-sample t-test", sep = "") + } else if (settings$groups == 2 || settings$multiArmEnabled) { + header <- .concatenateSummaryText(header, "two-sample t-test", sep = "") + } + } else if (settings$ratesEnabled) { + if (settings$multiArmEnabled && settings$groups > 1) { + header <- .concatenateSummaryText(header, "multi-arm comparisons for rates", sep = "") + } else if (settings$enrichmentEnabled && settings$populations > 1) { + header <- .concatenateSummaryText(header, "population enrichment comparisons for rates", sep = "") + } else if (settings$groups == 1 && !settings$multiArmEnabled) { + header <- .concatenateSummaryText(header, "one-sample test for rates", sep = "") + } else if (settings$groups == 2 || settings$multiArmEnabled) { + header <- .concatenateSummaryText(header, "two-sample test for rates", sep = "") + } + } else if (settings$survivalEnabled) { + if (settings$multiArmEnabled && settings$groups > 1) { + header <- .concatenateSummaryText(header, "multi-arm logrank test", sep = "") + } else if (settings$enrichmentEnabled && settings$populations > 1) { + header <- .concatenateSummaryText(header, "population enrichment logrank test", sep = "") + } else if (settings$groups == 2 || settings$multiArmEnabled) { + header <- .concatenateSummaryText(header, "two-sample logrank test", sep = "") + } + } + + part <- "" + if (settings$multiArmEnabled && settings$groups > 1) { + part <- .concatenateSummaryText(part, paste0(settings$groups, " treatments vs. control")) + } else if (settings$enrichmentEnabled) { + if (settings$groups == 2) { + part <- .concatenateSummaryText(part, "treatment vs. control") + } else if (settings$groups > 2) { + part <- .concatenateSummaryText(part, paste0(settings$groups, " treatments vs. control")) + } + part <- .concatenateSummaryText(part, paste0( + settings$populations, " population", + ifelse(settings$populations == 1, "", "s") + )) + } + if (!is.null(designPlan) && (.isTrialDesignPlan(designPlan) || (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6"))) && + !settings$multiArmEnabled && !settings$enrichmentEnabled && !settings$survivalEnabled) { + if (settings$ratesEnabled) { + if (settings$groups == 1) { + part <- .concatenateSummaryText(part, ifelse(designPlan$normalApproximation, + "normal approximation", "exact test" + )) + } else { + part <- .concatenateSummaryText(part, ifelse(designPlan$normalApproximation, + "normal approximation", "exact test of Fisher" + )) + } + } else if (designPlan$normalApproximation) { + part <- .concatenateSummaryText(part, "normal approximation") + } + } + if (part != "") { + header <- .concatenateSummaryText(header, paste0("(", part, ")"), sep = " ") + } + if (settings$meansEnabled && (.isTrialDesignInverseNormalOrGroupSequential(design) || + (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")))) { + header <- .concatenateSummaryText(header, .createSummaryHypothesisText(designPlan, summaryFactory)) + if (!is.null(designPlan[["alternative"]]) && length(designPlan$alternative) == 1) { + alternativeText <- paste0("H1: effect = ", round(designPlan$alternative, 3)) + } else if (!is.null(designPlan[["muMaxVector"]]) && length(designPlan$muMaxVector) == 1) { + alternativeText <- paste0("H1: mu_max = ", round(designPlan$muMaxVector, 3)) + } else if (!is.null(designPlan[["effectList"]]) && !is.null(designPlan$effectList[["effects"]]) && + isTRUE(nrow(designPlan$effectList$effects) == 1)) { + alternativeText <- paste0( + "H1: effects = ", + .arrayToString(designPlan$effectList$effects, mode = "vector") + ) + } else { + alternativeText <- "H1: effect as specified" + } + header <- .concatenateSummaryText(header, alternativeText) + + header <- .addEnrichmentEffectListToHeader(header, designPlan) + + if (grepl("SimulationResultsEnrichment", .getClassName(designPlan))) { + stDevs <- designPlan$effectList$stDevs + if (length(unique(stDevs)) == 1) { + stDevs <- unique(stDevs) + } + s <- ifelse(length(stDevs) != 1, "s", "") + stDevCaption <- ifelse(.isRatioComparisonEnabled(designPlan), + paste0("coefficient", s, " of variation"), + paste0("standard deviation", s) + ) + header <- .concatenateSummaryText(header, paste0( + stDevCaption, " = ", + .arrayToString(round(stDevs, 3), vectorLookAndFeelEnabled = TRUE) + )) + } else { + stDevCaption <- ifelse(.isRatioComparisonEnabled(designPlan), "coefficient of variation", "standard deviation") + header <- .concatenateSummaryText(header, paste0(stDevCaption, " = ", round(designPlan$stDev, 3))) + } + header <- .addAdditionalArgumentsToHeader(header, designPlan, settings) + } else if (settings$ratesEnabled && (.isTrialDesignInverseNormalOrGroupSequential(design) || + (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")))) { + if (settings$groups == 1) { + if (!is.null(designPlan[["pi1"]]) && length(designPlan$pi1) == 1) { + treatmentRateText <- paste0("H1: treatment rate pi = ", round(designPlan$pi1, 3)) + } else { + treatmentRateText <- "H1: treatment rate pi as specified" + } + + header <- paste0(header, ",\n", .createSummaryHypothesisText(designPlan, summaryFactory)) + header <- .concatenateSummaryText(header, treatmentRateText) + header <- .addAdditionalArgumentsToHeader(header, designPlan, settings) + } else { + if (!is.null(designPlan[["pi1"]]) && length(designPlan$pi1) == 1) { + treatmentRateText <- paste0("H1: treatment rate pi(1) = ", round(designPlan$pi1, 3)) + } else if (!is.null(designPlan[["piMaxVector"]]) && length(designPlan$piMaxVector) == 1) { + treatmentRateText <- paste0( + "H1: treatment rate pi_max = ", + .arrayToString(round(designPlan$piMaxVector, 3), vectorLookAndFeelEnabled = TRUE) + ) + } else if (settings$enrichmentEnabled && !is.null(designPlan[["effectList"]]) && + !is.null(designPlan$effectList[["piTreatments"]])) { + piTreatments <- designPlan$effectList[["piTreatments"]] + if (is.matrix(piTreatments) && nrow(piTreatments) == 1) { + treatmentRateText <- paste0( + "H1: assumed treatment rate pi(treatment) = ", + .arrayToString(round(designPlan$effectList$piTreatments, 3), vectorLookAndFeelEnabled = TRUE) + ) + } else { + treatmentRateText <- paste0("H1: assumed treatment rate pi(treatment) as specified") + } + } else { + treatmentRateText <- paste0( + "H1: treatment rate pi", + ifelse(settings$multiArmEnabled, "_max", "(1)"), " as specified" + ) + } + + controlRateText <- NA_character_ + if (settings$multiArmEnabled && !is.null(designPlan[["piControl"]])) { + controlRateText <- paste0("control rate pi(control) = ", round(designPlan$piControl, 3)) + } else if (settings$enrichmentEnabled && !is.null(designPlan[["piControls"]])) { + controlRateText <- paste0( + "control rates pi(control) = ", + .arrayToString(round(designPlan$piControls, 3), vectorLookAndFeelEnabled = TRUE) + ) + } else if (settings$enrichmentEnabled && !is.null(designPlan[["effectList"]]) && + !is.null(designPlan$effectList[["piControls"]])) { + # controlRateText will be created in .addEnrichmentEffectListToHeader() + } else if (!is.null(designPlan[["pi2"]])) { + controlRateText <- paste0("control rate pi(2) = ", round(designPlan$pi2, 3)) + } else { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to identify case to build ", sQuote("controlRateText")) + } + header <- paste0(header, ",\n", .createSummaryHypothesisText(designPlan, summaryFactory)) + header <- .concatenateSummaryText(header, treatmentRateText) + if (!is.na(controlRateText)) { + header <- .concatenateSummaryText(header, controlRateText) + } + header <- .addEnrichmentEffectListToHeader(header, designPlan) + header <- .addAdditionalArgumentsToHeader(header, designPlan, settings) + } + } else if (settings$survivalEnabled && (.isTrialDesignInverseNormalOrGroupSequential(design) || + (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")))) { + parameterNames <- designPlan$.getVisibleFieldNamesOrdered() + numberOfVariants <- .getMultidimensionalNumberOfVariants(designPlan, parameterNames) + + if (grepl("SimulationResultsEnrichment", .getClassName(designPlan))) { + userDefinedParam <- "hazardRatios" + paramName <- "hazard ratios" + paramValue <- designPlan$effectList$hazardRatios + } else { + userDefinedParam <- "pi1" + for (param in c("pi1", "lambda1", "median1", "hazardRatio")) { + if (designPlan$.getParameterType(param) == C_PARAM_USER_DEFINED && + length(designPlan[[param]]) == numberOfVariants) { + userDefinedParam <- param + } + } + paramValue <- designPlan[[userDefinedParam]] + + if (is.null(paramValue) || length(paramValue) == 0 || all(is.na(paramValue))) { + userDefinedParam <- "hazardRatio" + } + paramName <- "treatment pi(1)" + if (userDefinedParam == "lambda1") { + paramName <- "treatment lambda(1)" + } else if (userDefinedParam == "median1") { + paramName <- "treatment median(1)" + } else if (userDefinedParam == "hazardRatio") { + paramName <- ifelse(grepl("SimulationResultsMultiArm", .getClassName(designPlan)), "omega_max", "hazard ratio") + } + } + + if (length(designPlan[[userDefinedParam]]) == 1) { + treatmentRateText <- paste0("H1: ", paramName, " = ", round(designPlan[[userDefinedParam]], 3)) + } else if (!is.null(designPlan[["omegaMaxVector"]]) && length(designPlan$omegaMaxVector) == 1) { + treatmentRateText <- paste0("H1: omega_max = ", round(designPlan$omegaMaxVector, 3)) + } else if (!is.null(designPlan[["hazardRatio"]]) && (length(designPlan$hazardRatio) == 1) || + ((inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")) && !is.null(designPlan[[".piecewiseSurvivalTime"]]) && + designPlan$.piecewiseSurvivalTime$piecewiseSurvivalEnabled)) { + treatmentRateText <- paste0( + "H1: hazard ratio = ", + .arrayToString(round(designPlan$hazardRatio, 3), vectorLookAndFeelEnabled = TRUE) + ) + } else if (settings$enrichmentEnabled && !is.null(designPlan[["effectList"]]) && + !is.null(designPlan$effectList[["hazardRatios"]]) && + is.matrix(designPlan$effectList$hazardRatios) && + nrow(designPlan$effectList$hazardRatios) == 1) { + treatmentRateText <- paste0( + "H1: hazard ratios = ", + .arrayToString(round(designPlan$effectList$hazardRatios, 3), vectorLookAndFeelEnabled = TRUE) + ) + } else { + treatmentRateText <- paste0("H1: ", paramName, " as specified") + } + if (userDefinedParam %in% c("hazardRatio", "pi1") && + (designPlan$.getParameterType("pi2") == C_PARAM_USER_DEFINED || + designPlan$.getParameterType("pi2") == C_PARAM_DEFAULT_VALUE) && + length(designPlan$pi2) == 1) { + treatmentRateText <- paste0(treatmentRateText, ", control pi(2) = ", round(designPlan$pi2, 3)) + } else if (userDefinedParam %in% c("hazardRatio", "lambda1") && + (designPlan$.getParameterType("lambda2") == C_PARAM_USER_DEFINED || + designPlan$.getParameterType("lambda2") == C_PARAM_DEFAULT_VALUE) && + length(designPlan$lambda2) == 1) { + treatmentRateText <- paste0(treatmentRateText, ", control lambda(2) = ", round(designPlan$lambda2, 3)) + } else if (userDefinedParam %in% c("hazardRatio", "median1") && + (designPlan$.getParameterType("median2") == C_PARAM_USER_DEFINED || + designPlan$.getParameterType("median2") == C_PARAM_GENERATED) && + length(designPlan$median2) == 1) { + treatmentRateText <- paste0(treatmentRateText, ", control median(2) = ", round(designPlan$median2, 3)) + } else if (!is.null(designPlan[[".piecewiseSurvivalTime"]]) && + designPlan$.piecewiseSurvivalTime$piecewiseSurvivalEnabled) { + treatmentRateText <- paste0(treatmentRateText, ", piecewise survival distribution") + treatmentRateText <- paste0( + treatmentRateText, ", \n", + "piecewise survival time = ", .arrayToString(round(designPlan$piecewiseSurvivalTime, 4), vectorLookAndFeelEnabled = TRUE), ", \n", + "control lambda(2) = ", .arrayToString(round(designPlan$lambda2, 4), vectorLookAndFeelEnabled = TRUE) + ) + } + header <- paste0(header, ", \n", .createSummaryHypothesisText(designPlan, summaryFactory)) + header <- .concatenateSummaryText(header, treatmentRateText) + header <- .addEnrichmentEffectListToHeader(header, designPlan) + header <- .addAdditionalArgumentsToHeader(header, designPlan, settings) + } + if (!(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")) && designPlan$.isSampleSizeObject()) { + header <- .concatenateSummaryText(header, paste0("power ", round(100 * (1 - design$beta), 1), "%")) + } + + + if (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")) { + header <- .concatenateSummaryText(header, paste0("simulation runs = ", designPlan$maxNumberOfIterations)) + header <- .concatenateSummaryText(header, paste0("seed = ", designPlan$seed)) + } + header <- paste0(header, ".") + return(header) +} + +.addAdditionalArgumentsToHeader <- function(header, designPlan, settings) { + if (designPlan$.design$kMax > 1) { + if (settings$survivalEnabled) { + if (!is.null(designPlan[["plannedEvents"]])) { + header <- .concatenateSummaryText(header, paste0( + "planned cumulative events = ", + .arrayToString(designPlan$plannedEvents, + vectorLookAndFeelEnabled = (length(designPlan$plannedEvents) > 1) + ) + )) + } + } else { + if (!is.null(designPlan[["plannedSubjects"]])) { + header <- .concatenateSummaryText(header, paste0( + "planned cumulative sample size = ", + .arrayToString(designPlan$plannedSubjects, + vectorLookAndFeelEnabled = (length(designPlan$plannedSubjects) > 1) + ) + )) + } + } + + if (!is.null(designPlan[["maxNumberOfSubjects"]]) && + designPlan$.getParameterType("maxNumberOfSubjects") == C_PARAM_USER_DEFINED) { + header <- .concatenateSummaryText(header, paste0( + "maximum number of subjects = ", + ceiling(designPlan$maxNumberOfSubjects[1]) + )) + } + + if (settings$survivalEnabled) { + if (!is.null(designPlan[["maxNumberOfEvents"]]) && + designPlan$.getParameterType("maxNumberOfEvents") == C_PARAM_USER_DEFINED) { + header <- .concatenateSummaryText(header, paste0( + "maximum number of events = ", + ceiling(designPlan$maxNumberOfEvents[1]) + )) + } + } + } else { + if (settings$survivalEnabled) { + if (!is.null(designPlan[["plannedEvents"]])) { + header <- .concatenateSummaryText(header, paste0( + "planned events = ", + .arrayToString(designPlan$plannedEvents, + vectorLookAndFeelEnabled = (length(designPlan$plannedEvents) > 1) + ) + )) + } + } else { + if (!is.null(designPlan[["plannedSubjects"]])) { + header <- .concatenateSummaryText(header, paste0( + "planned sample size = ", + .arrayToString(designPlan$plannedSubjects, + vectorLookAndFeelEnabled = (length(designPlan$plannedSubjects) > 1) + ) + )) + } + } + + if (!is.null(designPlan[["maxNumberOfSubjects"]]) && + designPlan$.getParameterType("maxNumberOfSubjects") == C_PARAM_USER_DEFINED) { + header <- .concatenateSummaryText(header, paste0( + "number of subjects = ", + ceiling(designPlan$maxNumberOfSubjects[1]) + )) + } + + if (settings$survivalEnabled) { + if (!is.null(designPlan[["maxNumberOfEvents"]]) && + designPlan$.getParameterType("maxNumberOfEvents") == C_PARAM_USER_DEFINED) { + header <- .concatenateSummaryText(header, paste0( + "number of events = ", + designPlan$maxNumberOfEvents[1] + )) + } + } + } + + header <- .addAllocationRatioToHeader(designPlan, header) + + if (settings$survivalEnabled) { + if (!is.null(designPlan[["eventTime"]]) && !is.na(designPlan[["eventTime"]])) { + header <- .concatenateSummaryText(header, paste0( + "event time = ", + .arrayToString(designPlan$eventTime, + vectorLookAndFeelEnabled = (length(designPlan$eventTime) > 1) + ) + )) + } + if (!is.null(designPlan[["accrualTime"]])) { + header <- .concatenateSummaryText(header, paste0( + "accrual time = ", + .arrayToString(designPlan$accrualTime, + vectorLookAndFeelEnabled = (length(designPlan$accrualTime) > 1) + ) + )) + } + if (!is.null(designPlan[["accrualTime"]]) && + length(designPlan$accrualIntensity) == length(designPlan$accrualTime)) { + header <- .concatenateSummaryText(header, paste0( + "accrual intensity = ", + .arrayToString(designPlan$accrualIntensity, + digits = 1, + vectorLookAndFeelEnabled = (length(designPlan$accrualIntensity) > 1) + ) + )) + } + if (!is.null(designPlan[["dropoutTime"]])) { + if (designPlan$dropoutRate1 > 0 || designPlan$dropoutRate2 > 0) { + header <- .concatenateSummaryText(header, paste0( + "dropout rate(1) = ", + .arrayToString(designPlan$dropoutRate1, + vectorLookAndFeelEnabled = (length(designPlan$dropoutRate1) > 1) + ) + )) + header <- .concatenateSummaryText(header, paste0( + "dropout rate(2) = ", + .arrayToString(designPlan$dropoutRate2, + vectorLookAndFeelEnabled = (length(designPlan$dropoutRate2) > 1) + ) + )) + header <- .concatenateSummaryText(header, paste0( + "dropout time = ", + .arrayToString(designPlan$dropoutTime, + vectorLookAndFeelEnabled = (length(designPlan$dropoutTime) > 1) + ) + )) + } + } + } + + if (settings$multiArmEnabled && designPlan$activeArms > 1) { + header <- .addShapeToHeader(header, designPlan) + header <- .addSelectionToHeader(header, designPlan) + } + + if (settings$enrichmentEnabled && settings$populations > 1) { + header <- .addSelectionToHeader(header, designPlan) + } + + functionName <- ifelse(settings$survivalEnabled, "calcEventsFunction", "calcSubjectsFunction") + userDefinedFunction <- !is.null(designPlan[[functionName]]) && + designPlan$.getParameterType(functionName) == C_PARAM_USER_DEFINED + + if (userDefinedFunction || (!is.null(designPlan[["conditionalPower"]]) && !is.na(designPlan$conditionalPower))) { + if (userDefinedFunction) { + header <- .concatenateSummaryText( + header, + paste0("sample size reassessment: user defined '", functionName, "'") + ) + if ((!is.null(designPlan[["conditionalPower"]]) && !is.na(designPlan$conditionalPower))) { + header <- .concatenateSummaryText( + header, + paste0("conditional power = ", designPlan$conditionalPower) + ) + } + } else { + if ((!is.null(designPlan[["conditionalPower"]]) && !is.na(designPlan$conditionalPower))) { + header <- .concatenateSummaryText( + header, + paste0("sample size reassessment: conditional power = ", designPlan$conditionalPower) + ) + } + } + + paramName1 <- ifelse(settings$survivalEnabled, "minNumberOfEventsPerStage", "minNumberOfSubjectsPerStage") + paramName2 <- ifelse(settings$survivalEnabled, "maxNumberOfEventsPerStage", "maxNumberOfSubjectsPerStage") + paramCaption <- ifelse(settings$survivalEnabled, "events", "subjects") + if (!is.null(designPlan[[paramName1]])) { + header <- .concatenateSummaryText(header, paste0( + "minimum ", paramCaption, " per stage = ", + .arrayToString(designPlan[[paramName1]], + vectorLookAndFeelEnabled = (length(designPlan[[paramName1]]) > 1) + ) + )) + } + if (!is.null(designPlan[[paramName2]])) { + header <- .concatenateSummaryText(header, paste0( + "maximum ", paramCaption, " per stage = ", + .arrayToString(designPlan[[paramName2]], + vectorLookAndFeelEnabled = (length(designPlan[[paramName2]]) > 1) + ) + )) + } + + if (settings$meansEnabled) { + if (!is.na(designPlan$thetaH1)) { + header <- .concatenateSummaryText( + header, + paste0("theta H1 = ", round(designPlan$thetaH1, 3)) + ) + } + if (!is.na(designPlan$stDevH1)) { + header <- .concatenateSummaryText( + header, + paste0("standard deviation H1 = ", round(designPlan$stDevH1, 3)) + ) + } + } else if (settings$ratesEnabled) { + if (settings$multiArmEnabled || settings$enrichmentEnabled) { + if (settings$multiArmEnabled && !is.na(designPlan$piTreatmentsH1)) { + header <- .concatenateSummaryText( + header, + paste0("pi(treatment)H1 = ", round(designPlan$piTreatmentsH1, 3)) + ) + } else if (settings$enrichmentEnabled) { + piTreatmentH1 <- designPlan[["piTreatmentH1"]] + if (is.null(piTreatmentH1)) { + piTreatmentH1 <- designPlan[["piTreatmentsH1"]] + } + if (!is.null(piTreatmentH1) && !is.na(piTreatmentH1)) { + header <- .concatenateSummaryText( + header, + paste0("pi(treatment)H1 = ", round(piTreatmentH1, 3)) + ) + } + } + if (!is.na(designPlan$piControlH1)) { + header <- .concatenateSummaryText( + header, + paste0("pi(control)H1 = ", round(designPlan$piControlH1, 3)) + ) + } + } else { + if (!is.na(designPlan$pi1H1)) { + header <- .concatenateSummaryText( + header, + paste0("pi(treatment)H1 = ", round(designPlan$pi1H1, 3)) + ) + } + if (!is.na(designPlan$pi2H1)) { + header <- .concatenateSummaryText( + header, + paste0("pi(control)H1 = ", round(designPlan$pi2H1, 3)) + ) + } + } + } + + if (settings$survivalEnabled && !is.null(designPlan[["thetaH1"]]) && !is.na(designPlan$thetaH1)) { + header <- .concatenateSummaryText(header, paste0("thetaH1 = ", round(designPlan$thetaH1, 3))) + } + } + + return(header) +} + +.addShapeToHeader <- function(header, designPlan) { + header <- .concatenateSummaryText(header, paste0("effect shape = ", .formatCamelCase(designPlan$typeOfShape))) + if (designPlan$typeOfShape == "sigmoidEmax") { + header <- .concatenateSummaryText(header, paste0("slope = ", designPlan$slope)) + header <- .concatenateSummaryText(header, paste0("ED50 = ", designPlan$gED50)) + } + + return(header) +} + +.addSelectionToHeader <- function(header, designPlan) { + header <- .concatenateSummaryText(header, paste0("intersection test = ", designPlan$intersectionTest)) + + if (designPlan$.design$kMax > 1) { + typeOfSelectionText <- paste0("selection = ", .formatCamelCase(designPlan$typeOfSelection)) + if (designPlan$typeOfSelection == "rBest") { + typeOfSelectionText <- paste0(typeOfSelectionText, ", r = ", designPlan$rValue) + } else if (designPlan$typeOfSelection == "epsilon") { + typeOfSelectionText <- paste0(typeOfSelectionText, " rule, eps = ", designPlan$epsilonValue) + } + if (!is.null(designPlan$threshold) && length(designPlan$threshold) == 1 && designPlan$threshold > -Inf) { + typeOfSelectionText <- paste0(typeOfSelectionText, ", threshold = ", designPlan$threshold) + } + header <- .concatenateSummaryText(header, typeOfSelectionText) + + header <- .concatenateSummaryText( + header, + paste0("effect measure based on ", .formatCamelCase(designPlan$effectMeasure)) + ) + } + + header <- .concatenateSummaryText( + header, + paste0("success criterion: ", .formatCamelCase(designPlan$successCriterion)) + ) + + return(header) +} + +.createSummary <- function(object, digits = NA_integer_, output = c("all", "title", "overview", "body")) { + output <- match.arg(output) + if (inherits(object, "TrialDesignCharacteristics") || inherits(object, "TrialDesignCharacteristicsR6")) { + return(.createSummaryDesignPlan(object, digits = digits, output = output, showStageLevels = TRUE)) + } + + if (.isTrialDesign(object) || .isTrialDesignPlan(object) || inherits(object, "SimulationResults") || inherits(object, "SimulationResultsR6")) { + return(.createSummaryDesignPlan(object, digits = digits, output = output, showStageLevels = !.isTrialDesignPlan(object))) + } + + if (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) { + return(.createSummaryAnalysisResults(object, digits = digits, output = output)) + } + + if (inherits(object, "PerformanceScore") || inherits(object, "PerformanceScoreR6")) { + return(.createSummaryPerformanceScore(object, digits = digits, output = output)) + } + + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "function 'summary' not implemented yet for class ", .getClassName(object)) +} + +.createSummaryPerformanceScore <- function(object, digits = NA_integer_, output = c("all", "title", "overview", "body")) { + .createSummaryDesignPlan(object$.simulationResults, + digits = digits, output = output, + showStageLevels = TRUE, performanceScore = object + ) +} + +.getSummaryParameterCaptionCriticalValues <- function(design) { + parameterCaption <- ifelse(.isTrialDesignFisher(design), + "Efficacy boundary (p product scale)", "Efficacy boundary (z-value scale)" + ) + parameterCaption <- ifelse(.isDelayedInformationEnabled(design = design), + "Upper bounds of continuation", parameterCaption + ) + return(parameterCaption) +} + +.getSummaryParameterCaptionFutilityBounds <- function(design) { + bindingInfo <- ifelse(design$bindingFutility, "binding", "non-binding") + parameterCaption <- ifelse(.isDelayedInformationEnabled(design = design), + paste0("Lower bounds of continuation (", bindingInfo, ")"), + paste0("Futility boundary (z-value scale)") + ) + return(parameterCaption) +} + +#' +#' Main function for creating a summary of an analysis result +#' +#' @noRd +#' +.createSummaryAnalysisResults <- function(object, digits = NA_integer_, output = c("all", "title", "overview", "body")) { + output <- match.arg(output) + if (!(inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6"))) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'object' must be a valid analysis result object (is class ", .getClassName(object), ")" + ) + } + + digitSettings <- .getSummaryDigits(digits) + digits <- digitSettings$digits + digitsSampleSize <- digitSettings$digitsSampleSize + digitsGeneral <- digitSettings$digitsGeneral + digitsProbabilities <- digitSettings$digitsProbabilities + + outputSize <- getOption("rpact.summary.output.size", C_SUMMARY_OUTPUT_SIZE_DEFAULT) + + intervalFormat <- getOption("rpact.summary.intervalFormat", "[%s; %s]") + .assertIsValidSummaryIntervalFormat(intervalFormat) + + multiArmEnabled <- .isMultiArmAnalysisResults(object) + enrichmentEnabled <- .isEnrichmentAnalysisResults(object) + multiHypothesesEnabled <- .isMultiHypothesesAnalysisResults(object) + + analysisResults <- object + design <- analysisResults$.design + stageResults <- analysisResults$.stageResults + dataInput <- analysisResults$.dataInput + closedTestResults <- NULL + conditionalPowerResults <- NULL + if (multiHypothesesEnabled) { + closedTestResults <- analysisResults$.closedTestResults + if (length(analysisResults$nPlanned) > 0 && !all(is.na(analysisResults$nPlanned))) { + conditionalPowerResults <- analysisResults$.conditionalPowerResults + } + } + + summaryFactory <- NULL + if(is.R6(object)) { + summaryFactory <- SummaryFactoryR6$new(object = object, intervalFormat = intervalFormat, output = output) + } else { + summaryFactory <- SummaryFactory(object = object, intervalFormat = intervalFormat, output = output) + } + + .addDesignInformationToSummary(design, object, summaryFactory, output = output) + + if (!.isTrialDesignConditionalDunnett(design)) { + summaryFactory$addParameter(design, + parameterName = "criticalValues", + parameterCaption = .getSummaryParameterCaptionCriticalValues(design), + roundDigits = digitsProbabilities - ifelse(.isTrialDesignFisher(design) || digitsProbabilities <= 1, 0, 1), + smoothedZeroFormat = !.isTrialDesignFisher(design) + ) + } + + if (.isTrialDesignFisher(design)) { + if (any(design$alpha0Vec < 1)) { + summaryFactory$addParameter(design, + parameterName = "alpha0Vec", + parameterCaption = "Futility boundary (separate p-value scale)", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + } else if (!.isTrialDesignConditionalDunnett(design)) { + if (any(design$futilityBounds > -6)) { + summaryFactory$addParameter(design, + parameterName = "futilityBounds", + parameterCaption = .getSummaryParameterCaptionFutilityBounds(design), + roundDigits = ifelse(digitsProbabilities > 1, digitsProbabilities - 1, digitsProbabilities), + smoothedZeroFormat = TRUE + ) + } + } + + if (design$kMax > 1 && !.isTrialDesignConditionalDunnett(design)) { + summaryFactory$addParameter(design, + parameterName = "alphaSpent", + parameterCaption = "Cumulative alpha spent", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + + if (!.isTrialDesignConditionalDunnett(design)) { + summaryFactory$addParameter(design, + parameterName = "stageLevels", + parameterCaption = "Stage level", roundDigits = digitsProbabilities, + smoothedZeroFormat = TRUE + ) + } + + summaryFactory$addParameter(stageResults, + parameterName = "effectSizes", + parameterCaption = ifelse(stageResults$isDatasetRates() && dataInput$getNumberOfGroups() == 1, + "Cumulative treatment rate", "Cumulative effect size" + ), roundDigits = digitsGeneral + ) + + if (stageResults$isDatasetMeans()) { + parameterCaption <- ifelse(stageResults$isOneSampleDataset(), + "Cumulative standard deviation", "Cumulative (pooled) standard deviation" + ) + parameterName <- ifelse((inherits(stageResults, "StageResultsMultiArmMeans") || inherits(stageResults, "StageResultsMultiArmMeansR6")) && + !(inherits(stageResults, "StageResultsEnrichmentMeans") || inherits(stageResults, "StageResultsEnrichmentMeansR6")), + "overallPooledStDevs", "overallStDevs" + ) + summaryFactory$addParameter(stageResults, + parameterName = parameterName, + parameterCaption = parameterCaption, roundDigits = digitsGeneral, + enforceFirstCase = (parameterName == "overallPooledStDevs") + ) + } else if (stageResults$isDatasetRates()) { + if (outputSize != "small" && dataInput$getNumberOfGroups() > 1) { + treatmentRateParamName <- "overallPi1" + controlRateParamName <- "overallPi2" + if (.isEnrichmentStageResults(stageResults)) { + treatmentRateParamName <- "overallPisTreatment" + controlRateParamName <- "overallPisControl" + } else if (.isMultiArmStageResults(stageResults)) { + treatmentRateParamName <- "overallPiTreatments" + controlRateParamName <- "overallPiControl" + } + summaryFactory$addParameter(stageResults, + parameterName = treatmentRateParamName, + parameterCaption = "Cumulative treatment rate", roundDigits = digitsGeneral + ) + summaryFactory$addParameter(stageResults, + parameterName = controlRateParamName, + parameterCaption = "Cumulative control rate", roundDigits = digitsGeneral, enforceFirstCase = TRUE + ) + } + } + + if (.isTrialDesignGroupSequential(design)) { + summaryFactory$addParameter(stageResults, + parameterName = "overallTestStatistics", + parameterCaption = "Overall test statistic", + roundDigits = ifelse(digitsProbabilities > 1, digitsProbabilities - 1, digitsProbabilities), + smoothedZeroFormat = TRUE + ) + summaryFactory$addParameter(stageResults, + parameterName = ifelse(multiHypothesesEnabled, "separatePValues", "overallPValues"), + parameterCaption = "Overall p-value", roundDigits = digitsProbabilities + ) + } else { + summaryFactory$addParameter(stageResults, + parameterName = "testStatistics", + parameterCaption = "Stage-wise test statistic", + roundDigits = ifelse(digitsProbabilities > 1, digitsProbabilities - 1, digitsProbabilities), + smoothedZeroFormat = TRUE + ) + summaryFactory$addParameter(stageResults, + parameterName = ifelse(multiHypothesesEnabled, "separatePValues", "pValues"), + parameterCaption = "Stage-wise p-value", roundDigits = digitsProbabilities + ) + } + + if (!is.null(closedTestResults)) { + if (outputSize == "large") { + if (.isTrialDesignConditionalDunnett(design)) { + summaryFactory$addParameter(closedTestResults, + parameterName = "conditionalErrorRate", + parameterCaption = "Conditional error rate", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + summaryFactory$addParameter(closedTestResults, + parameterName = "secondStagePValues", + parameterCaption = "Second stage p-value", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } else { + summaryFactory$addParameter(closedTestResults, + parameterName = "adjustedStageWisePValues", + parameterCaption = "Adjusted stage-wise p-value", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + summaryFactory$addParameter(closedTestResults, + parameterName = "overallAdjustedTestStatistics", + parameterCaption = "Overall adjusted test statistic", + roundDigits = digitsProbabilities - ifelse(.isTrialDesignFisher(design) || digitsProbabilities <= 1, 0, 1), + smoothedZeroFormat = !.isTrialDesignFisher(design) + ) + } + } else if (outputSize == "medium") { + legendEntry <- list("(i, j, ...)" = "comparison of treatment arms 'i, j, ...' vs. control arm") + gMax <- stageResults$getGMax() + if (.isTrialDesignConditionalDunnett(design)) { + summaryFactory$addParameter(closedTestResults, + parameterName = "adjustedStageWisePValues", + values = closedTestResults$conditionalErrorRate[1, ], + parameterCaption = paste0( + "Conditional error rate (", + paste0(1:gMax, collapse = ", "), ")" + ), roundDigits = digitsProbabilities, + smoothedZeroFormat = TRUE, + legendEntry = legendEntry + ) + summaryFactory$addParameter(closedTestResults, + parameterName = "overallAdjustedTestStatistics", + values = closedTestResults$secondStagePValues[1, ], + parameterCaption = paste0( + "Second stage p-value (", + paste0(1:gMax, collapse = ", "), ")" + ), + roundDigits = digitsProbabilities + ifelse(.isTrialDesignFisher(design), 1, 0), + smoothedZeroFormat = !.isTrialDesignFisher(design), + legendEntry = legendEntry + ) + } else { + summaryFactory$addParameter(closedTestResults, + parameterName = "adjustedStageWisePValues", + values = closedTestResults$adjustedStageWisePValues[1, ], + parameterCaption = paste0( + "Adjusted stage-wise p-value (", + paste0(1:gMax, collapse = ", "), ")" + ), roundDigits = digitsProbabilities, + smoothedZeroFormat = TRUE, legendEntry = legendEntry + ) + summaryFactory$addParameter(closedTestResults, + parameterName = "overallAdjustedTestStatistics", + values = closedTestResults$overallAdjustedTestStatistics[1, ], + parameterCaption = paste0( + "Overall adjusted test statistic (", + paste0(1:gMax, collapse = ", "), ")" + ), + roundDigits = digitsProbabilities - ifelse(.isTrialDesignFisher(design) || digitsProbabilities <= 1, 0, 1), + smoothedZeroFormat = !.isTrialDesignFisher(design), + legendEntry = legendEntry + ) + } + } + } + + if (multiHypothesesEnabled) { + summaryFactory$addParameter(closedTestResults, + parameterName = "rejected", + parameterCaption = "Test action: reject", roundDigits = digitsGeneral + ) + } else { + if (.isTrialDesignFisher(design)) { + summaryFactory$addParameter(stageResults, + parameterName = "combFisher", + parameterCaption = "Fisher combination", roundDigits = 0 + ) + } else if (.isTrialDesignInverseNormal(design)) { + summaryFactory$addParameter(stageResults, + parameterName = "combInverseNormal", + parameterCaption = "Inverse normal combination", + roundDigits = ifelse(digitsProbabilities > 1, digitsProbabilities - 1, digitsProbabilities), + smoothedZeroFormat = TRUE + ) + } + summaryFactory$addParameter(analysisResults, + parameterName = "testActions", + parameterCaption = "Test action", roundDigits = digitsGeneral + ) + } + + if (design$kMax > 1 && !.isTrialDesignConditionalDunnett(design)) { + summaryFactory$addParameter(analysisResults, + parameterName = "conditionalRejectionProbabilities", + parameterCaption = "Conditional rejection probability", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + + if (design$kMax > 1) { + if (!is.null(conditionalPowerResults)) { + summaryFactory$addParameter(conditionalPowerResults, + parameterName = "nPlanned", + parameterCaption = "Planned sample size", roundDigits = -1 + ) + } else if (analysisResults$.getParameterType("nPlanned") != C_PARAM_NOT_APPLICABLE) { + summaryFactory$addParameter(analysisResults, + parameterName = "nPlanned", + parameterCaption = "Planned sample size", roundDigits = -1 + ) + } + } + + if (design$kMax > 1) { + if (!is.null(conditionalPowerResults)) { + summaryFactory$addParameter(conditionalPowerResults, + parameterName = "conditionalPower", + parameterCaption = "Conditional power", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } else if (!multiHypothesesEnabled && analysisResults$.getParameterType("nPlanned") != C_PARAM_NOT_APPLICABLE) { + parameterName <- "conditionalPower" + if (!is.null(analysisResults[["conditionalPowerSimulated"]]) && + length(analysisResults[["conditionalPowerSimulated"]]) > 0) { + parameterName <- "conditionalPowerSimulated" + } + summaryFactory$addParameter(analysisResults, + parameterName = parameterName, + parameterCaption = "Conditional power", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + } + + ciLevel <- round((1 - design$alpha * (3 - design$sided)) * 100, 2) + if (.isTrialDesignConditionalDunnett(design)) { + parameterCaptionRepeatedPValues <- "Overall p-value" + parameterCaptionRepeatedCI <- paste0(ciLevel, "% overall confidence interval") + } else { + parameterCaptionRepeatedPValues <- ifelse(design$kMax == 1, + ifelse(design$sided == 1, "One-sided p-value", "Two-sided p-value"), + "Repeated p-value" + ) + parameterCaptionRepeatedCI <- paste0( + ciLevel, "% ", + ifelse(design$kMax == 1, "confidence interval", "repeated confidence interval") + ) + } + + summaryFactory$addParameter(analysisResults, + parameterName = c("repeatedConfidenceIntervalLowerBounds", "repeatedConfidenceIntervalUpperBounds"), + parameterCaption = parameterCaptionRepeatedCI, + roundDigits = digitsGeneral + ) + + summaryFactory$addParameter(analysisResults, + parameterName = "repeatedPValues", + parameterCaption = parameterCaptionRepeatedPValues, + roundDigits = digitsProbabilities, formatRepeatedPValues = TRUE + ) + + if (!multiHypothesesEnabled && !is.null(analysisResults[["finalStage"]]) && !all(is.na(analysisResults$finalStage))) { + summaryFactory$addParameter(analysisResults, + parameterName = "finalPValues", + parameterCaption = "Final p-value", roundDigits = digitsProbabilities + ) + summaryFactory$addParameter(analysisResults, + parameterName = c("finalConfidenceIntervalLowerBounds", "finalConfidenceIntervalUpperBounds"), + parameterCaption = "Final confidence interval", roundDigits = digitsGeneral + ) + summaryFactory$addParameter(analysisResults, + parameterName = "medianUnbiasedEstimates", + parameterCaption = "Median unbiased estimate", roundDigits = digitsGeneral + ) + } + + return(summaryFactory) +} + +.getSummaryDigits <- function(digits = NA_integer_) { + if (is.na(digits)) { + digits <- as.integer(getOption("rpact.summary.digits", 3)) + } + .assertIsSingleInteger(digits, "digits", validateType = FALSE, naAllowed = TRUE) + .assertIsInClosedInterval(digits, "digits", lower = -1, upper = 12, naAllowed = TRUE) + + digitsSampleSize <- 1 + if (digits > 0) { + digitsGeneral <- digits + digitsProbabilities <- NA_integer_ + tryCatch( + { + digitsProbabilities <- as.integer(getOption("rpact.summary.digits.probs", digits + 1)) + }, + warning = function(e) { + } + ) + if (is.na(digitsProbabilities)) { + digitsProbabilities <- digits + 1 + } + .assertIsSingleInteger(digitsProbabilities, "digitsProbabilities", validateType = FALSE, naAllowed = FALSE) + .assertIsInClosedInterval(digitsProbabilities, "digitsProbabilities", lower = -1, upper = 12, naAllowed = FALSE) + } else { + digitsSampleSize <- digits + digitsGeneral <- digits + digitsProbabilities <- digits + } + return(list( + digits = digits, + digitsSampleSize = digitsSampleSize, + digitsGeneral = digitsGeneral, + digitsProbabilities = digitsProbabilities + )) +} + +.getSummaryValuesInPercent <- function(values, percentFormatEnabled = TRUE, digits = 1) { + if (!percentFormatEnabled) { + return(as.character(round(values, digits + 2))) + } + return(paste0(round(100 * values, digits), "%")) +} + +.addDesignInformationToSummary <- function(design, designPlan, summaryFactory, + output = c("all", "title", "overview", "body")) { + if (!(output %in% c("all", "overview"))) { + return(invisible(summaryFactory)) + } + + if (design$kMax == 1) { + summaryFactory$addItem("Stage", "Fixed") + return(invisible(summaryFactory)) + } + + summaryFactory$addItem("Stage", c(1:design$kMax)) + + if (.isTrialDesignConditionalDunnett(design)) { + summaryFactory$addItem( + "Fixed information at interim", + .getSummaryValuesInPercent(design$informationAtInterim, FALSE) + ) + return(invisible(summaryFactory)) + } + + informationRatesCaption <- ifelse(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6") || + (inherits(designPlan, "AnalysisResults") || inherits(designPlan, "AnalysisResultsR6")), "Fixed weight", "Information") + + if (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6") || (inherits(designPlan, "AnalysisResults") || inherits(designPlan, "AnalysisResultsR6"))) { + if (.isTrialDesignFisher(design)) { + weights <- .getWeightsFisher(design) + } else if (.isTrialDesignInverseNormal(design)) { + weights <- .getWeightsInverseNormal(design) + } else { + weights <- design$informationRates + } + summaryFactory$addItem(informationRatesCaption, .getSummaryValuesInPercent(weights, FALSE)) + } else { + summaryFactory$addItem( + paste0( + informationRatesCaption, + ifelse(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6"), "", " rate") + ), + .getSummaryValuesInPercent(design$informationRates) + ) + } + if (design$.isDelayedResponseDesign()) { + summaryFactory$addItem("Delayed information", .getSummaryValuesInPercent(design$delayedInformation, TRUE)) + } + + return(invisible(summaryFactory)) +} + +.addDesignParameterToSummary <- function(design, designPlan, + designCharacteristics, summaryFactory, digitsGeneral, digitsProbabilities) { + if (design$kMax > 1 && !(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")) && + !.isTrialDesignConditionalDunnett(design)) { + summaryFactory$addParameter(design, + parameterName = "alphaSpent", + parameterCaption = "Cumulative alpha spent", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + if (design$.getParameterType("betaSpent") == C_PARAM_GENERATED) { + summaryFactory$addParameter(design, + parameterName = "betaSpent", + parameterCaption = "Cumulative beta spent", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + } + + if (!is.null(designPlan)) { + if (!grepl("SimulationResults(MultiArm|Enrichment)", .getClassName(designPlan))) { + outputSize <- getOption("rpact.summary.output.size", C_SUMMARY_OUTPUT_SIZE_DEFAULT) + if (outputSize == "large" && (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6"))) { + summaryFactory$addParameter(designPlan, + parameterName = "conditionalPowerAchieved", + parameterCaption = "Conditional power (achieved)", + roundDigits = digitsProbabilities + ) + } + } + } else { + powerObject <- NULL + if (!is.null(designCharacteristics)) { + powerObject <- designCharacteristics + } else if (design$.getParameterType("power") == C_PARAM_GENERATED) { + powerObject <- design + } + if (!is.null(powerObject)) { + summaryFactory$addParameter(powerObject, + parameterName = "power", + parameterCaption = ifelse(design$kMax == 1, "Power", "Overall power"), + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + if (design$kMax > 1 && .isTrialDesignInverseNormalOrGroupSequential(design)) { + tryCatch( + { + designCharacteristics <- getDesignCharacteristics(design) + }, + error = function(e) { + designCharacteristics <- NULL + } + ) + if (!is.null(designCharacteristics) && + !any(is.na(designCharacteristics$futilityProbabilities)) && + any(designCharacteristics$futilityProbabilities > 0)) { + summaryFactory$addParameter(designCharacteristics, + parameterName = "futilityProbabilities", + parameterCaption = "Futility probabilities under H1", + roundDigits = digitsGeneral, smoothedZeroFormat = TRUE + ) + } + } + } + + if (design$.isDelayedResponseDesign()) { + summaryFactory$addParameter(design, + parameterName = "decisionCriticalValues", + parameterCaption = "Decision critical values", + roundDigits = digitsGeneral, + smoothedZeroFormat = TRUE + ) + + outputSize <- getOption("rpact.summary.output.size", C_SUMMARY_OUTPUT_SIZE_DEFAULT) + if (outputSize == "large") { + summaryFactory$addParameter(design, + parameterName = "reversalProbabilities", + parameterCaption = "Reversal probabilities", + roundDigits = digitsProbabilities, + smoothedZeroFormat = TRUE + ) + } + } + + if (.isTrialDesignConditionalDunnett(design)) { + summaryFactory$addParameter(design, + parameterName = "alpha", + parameterCaption = "Significance level", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } else if (!is.null(designPlan) && !(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6"))) { + summaryFactory$addParameter(design, + parameterName = "stageLevels", + twoSided = design$sided == 2, + parameterCaption = paste0(ifelse(design$sided == 2, "Two", "One"), "-sided local significance level"), + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + return(summaryFactory) +} + +#' +#' Main function for creating a summary of a design or design plan +#' +#' @noRd +#' +.createSummaryDesignPlan <- function(object, digits = NA_integer_, + output = c("all", "title", "overview", "body"), showStageLevels = FALSE, + performanceScore = NULL) { + output <- match.arg(output) + designPlan <- NULL + if (.isTrialDesignPlan(object) || (inherits(object, "SimulationResults") || inherits(object, "SimulationResultsR6"))) { + design <- object$.design + designPlan <- object + } else if (inherits(object, "TrialDesignCharacteristics") || inherits(object, "TrialDesignCharacteristicsR6")) { + design <- object$.design + # designPlan <- object + } else if (.isTrialDesign(object)) { + design <- object + } else { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'object' must be a valid design, design plan, ", + "or simulation result object (is class ", .getClassName(object), ")" + ) + } + + digitSettings <- .getSummaryDigits(digits) + digits <- digitSettings$digits + digitsSampleSize <- digitSettings$digitsSampleSize + digitsGeneral <- digitSettings$digitsGeneral + digitsProbabilities <- digitSettings$digitsProbabilities + + outputSize <- getOption("rpact.summary.output.size", C_SUMMARY_OUTPUT_SIZE_DEFAULT) + + intervalFormat <- getOption("rpact.summary.intervalFormat", "[%s; %s]") + .assertIsValidSummaryIntervalFormat(intervalFormat) + + summaryFactory <- NULL + if(is.R6(object)) { + summaryFactory <- SummaryFactoryR6$new(object = object, intervalFormat = intervalFormat, output = output) + } else { + summaryFactory <- SummaryFactory(object = object, intervalFormat = intervalFormat, output = output) + } + + + if (output %in% c("all", "title", "overview")) { + .addDesignInformationToSummary(design, designPlan, summaryFactory, output = output) + } + + if (!(output %in% c("all", "body"))) { + return(summaryFactory) + } + + if (!.isTrialDesignConditionalDunnett(design)) { + summaryFactory$addParameter(design, + parameterName = "criticalValues", + parameterCaption = .getSummaryParameterCaptionCriticalValues(design), + roundDigits = digitsGeneral + ) + + if (showStageLevels) { + summaryFactory$addParameter(design, + parameterName = "stageLevels", + parameterCaption = "Stage levels (one-sided)", + roundDigits = digitsProbabilities, + smoothedZeroFormat = TRUE + ) + } + } + + if (.isTrialDesignFisher(design)) { + if (any(design$alpha0Vec < 1)) { + summaryFactory$addParameter(design, + parameterName = "alpha0Vec", + parameterCaption = "Futility boundary (separate p-value scale)", + roundDigits = digitsGeneral + ) + } + } else if (!.isTrialDesignConditionalDunnett(design)) { + if (any(design$futilityBounds > C_FUTILITY_BOUNDS_DEFAULT, na.rm = TRUE)) { + summaryFactory$addParameter(design, + parameterName = "futilityBounds", + parameterCaption = .getSummaryParameterCaptionFutilityBounds(design), + roundDigits = digitsGeneral + ) + } + } + + designCharacteristics <- NULL + if (design$kMax > 1 && .isTrialDesignInverseNormalOrGroupSequential(design)) { + tryCatch( + { + designCharacteristics <- getDesignCharacteristics(design) + }, + error = function(e) { + designCharacteristics <- NULL + } + ) + } + + if (is.null(designPlan)) { + return(.addDesignParameterToSummary( + design, + designPlan, + designCharacteristics, + summaryFactory, + digitsGeneral, + digitsProbabilities + )) + } + + simulationEnabled <- grepl("SimulationResults", .getClassName(designPlan)) + multiArmEnabled <- grepl("MultiArm", .getClassName(designPlan)) + enrichmentEnabled <- grepl("Enrichment", .getClassName(designPlan)) + baseEnabled <- grepl("(TrialDesignPlan|SimulationResults)(Means|Rates|Survival)", .getClassName(designPlan)) + planningEnabled <- .isTrialDesignPlan(designPlan) + simulationEnabled <- .isSimulationResults(designPlan) + survivalEnabled <- grepl("Survival", .getClassName(designPlan)) + + probsH0 <- NULL + probsH1 <- NULL + if (design$kMax > 1) { + if (!is.null(designCharacteristics) && + .isTrialDesignInverseNormalOrGroupSequential(design) && + length(designCharacteristics$shift) == 1 && + !is.na(designCharacteristics$shift) && + designCharacteristics$shift >= 1) { + probsH0 <- getPowerAndAverageSampleNumber(design, theta = 0, nMax = designCharacteristics$shift) + probsH1 <- getPowerAndAverageSampleNumber(design, theta = 1, nMax = designCharacteristics$shift) + } + if (!is.null(designPlan[["rejectPerStage"]])) { + probsH1 <- list( + earlyStop = designPlan$rejectPerStage[1:(design$kMax - 1), ] + as.vector(designPlan$futilityPerStage), + rejectPerStage = designPlan$rejectPerStage, + futilityPerStage = designPlan$futilityPerStage + ) + numberOfVariants <- 1 + if ((inherits(designPlan, "ParameterSet") || inherits(designPlan, "ParameterSetR6"))) { + parameterNames <- designPlan$.getVisibleFieldNamesOrdered() + numberOfVariants <- .getMultidimensionalNumberOfVariants(designPlan, parameterNames) + } + if (numberOfVariants > 1 && is.matrix(probsH1$earlyStop) && ncol(probsH1$earlyStop) == 1) { + probsH1$earlyStop <- matrix(rep(probsH1$earlyStop, numberOfVariants), ncol = numberOfVariants) + probsH1$rejectPerStage <- matrix(rep(probsH1$rejectPerStage, numberOfVariants), ncol = numberOfVariants) + probsH1$futilityPerStage <- matrix(rep(probsH1$futilityPerStage, numberOfVariants), ncol = numberOfVariants) + } + } + } + + if (simulationEnabled && (multiArmEnabled || enrichmentEnabled)) { + # simulation multi-arm #1:rejectAtLeastOne per mu_max + summaryFactory$addParameter(designPlan, + parameterName = "rejectAtLeastOne", + parameterCaption = "Reject at least one", roundDigits = digitsProbabilities, + smoothedZeroFormat = TRUE, transpose = TRUE, + legendEntry = { + if (multiArmEnabled) list("(i)" = "treatment arm i") else list() + } + ) + + # simulation multi-arm #2: rejectedArmsPerStage + if (outputSize == "large" && multiArmEnabled) { + .addSimulationMultiArmArrayParameter(designPlan, + parameterName = "rejectedArmsPerStage", + parameterCaption = ifelse(design$kMax == 1, "Rejected arms", "Rejected arms per stage"), + summaryFactory, roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + # simulation enrichment #2: rejectedPopulationsPerStage + if (outputSize == "large" && enrichmentEnabled) { + .addSimulationArrayToSummary(designPlan, + parameterName = "rejectedPopulationsPerStage", + parameterCaption = ifelse(design$kMax == 1, "Rejected populations", "Rejected populations per stage"), + summaryFactory, digitsSampleSize = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + + # simulation multi-arm #3: successPerStage + summaryFactory$addParameter(designPlan, + parameterName = "successPerStage", + parameterCaption = "Success per stage", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE, transpose = TRUE + ) + + # simulation multi-arm #4: futilityPerStage + if (!planningEnabled && !baseEnabled && any(designPlan$futilityPerStage != 0)) { + summaryFactory$addParameter(designPlan, + parameterName = "futilityPerStage", + parameterCaption = "Exit probability for futility", # (under H1) + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE, transpose = TRUE + ) + } + + if (survivalEnabled) { + summaryFactory$addParameter(designPlan, + parameterName = "expectedNumberOfEvents", + parameterCaption = "Expected number of events", + roundDigits = digitsSampleSize, transpose = TRUE + ) + } else { + summaryFactory$addParameter(designPlan, + parameterName = "expectedNumberOfSubjects", + parameterCaption = "Expected number of subjects", + roundDigits = digitsSampleSize, transpose = TRUE + ) + } + + # simulation multi-arm #5: earlyStop per mu_max + if (outputSize %in% c("medium", "large")) { + summaryFactory$addParameter(designPlan, + parameterName = "earlyStop", + parameterCaption = "Overall exit probability", # (under H1) + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE, transpose = TRUE + ) + } + + # simulation multi-arm / enrichment #6: sampleSizes + if (outputSize %in% c("medium", "large")) { + if (survivalEnabled) { + if (enrichmentEnabled) { + parameterName <- "singleNumberOfEventsPerStage" + parameterCaption <- "Single number of events" + } else { + parameterName <- "eventsPerStage" + parameterCaption <- "Cumulative number of events" + } + } else { + parameterName <- "sampleSizes" + parameterCaption <- "Stagewise number of subjects" + } + .addSimulationArrayToSummary( + designPlan, + parameterName, + parameterCaption, + summaryFactory, + digitsSampleSize, + smoothedZeroFormat = TRUE + ) + } + + # simulation multi-arm #7: selectedArms + if (multiArmEnabled && outputSize %in% c("medium", "large")) { + .addSimulationMultiArmArrayParameter( + designPlan = designPlan, + parameterName = "selectedArms", + parameterCaption = "Selected arms", + summaryFactory = summaryFactory, + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + + # simulation enrichment #7: selectedPopulations + if (enrichmentEnabled && outputSize %in% c("medium", "large")) { + .addSimulationArrayToSummary( + designPlan = designPlan, + parameterName = "selectedPopulations", + parameterCaption = "Selected populations", + summaryFactory = summaryFactory, + digitsSampleSize = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + + # simulation multi-arm #8: numberOfActiveArms + if (multiArmEnabled && outputSize %in% c("medium", "large")) { + summaryFactory$addParameter(designPlan, + parameterName = "numberOfActiveArms", + parameterCaption = "Number of active arms", + roundDigits = digitsGeneral, transpose = TRUE + ) + } + + # simulation enrichment #8: numberOfPopulations + if (enrichmentEnabled && outputSize %in% c("medium", "large")) { + summaryFactory$addParameter(designPlan, + parameterName = "numberOfPopulations", + parameterCaption = "Number of populations", + roundDigits = digitsGeneral, transpose = TRUE + ) + } + + if (outputSize == "large") { + summaryFactory$addParameter(designPlan, + parameterName = "conditionalPowerAchieved", + parameterCaption = "Conditional power (achieved)", + roundDigits = digitsProbabilities, transpose = TRUE + ) + } + } + + if (baseEnabled) { + parameterName <- "rejectPerStage" + if (design$kMax == 1) { + parameterName <- "overallReject" + } + if (any(!is.na(designPlan[[parameterName]]))) { + summaryFactory$addParameter(designPlan, + parameterName = parameterName, + parameterCaption = ifelse(design$kMax == 1, "Power", "Overall power"), + roundDigits = digitsProbabilities, cumsumEnabled = TRUE, smoothedZeroFormat = TRUE + ) + } + + if (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")) { + parameterName1 <- ifelse(survivalEnabled, "numberOfSubjects", "sampleSizes") + parameterName2 <- "eventsPerStage" + } else { + if (design$kMax == 1 && (designPlan$.isSampleSizeObject() || + .isTrialDesignPlanMeans(designPlan) || .isTrialDesignPlanRates(designPlan))) { + parameterName1 <- "nFixed" + parameterName2 <- "eventsFixed" + } else if (design$kMax == 1 && designPlan$.isPowerObject()) { + parameterName1 <- "expectedNumberOfSubjects" + parameterName2 <- "expectedNumberOfEvents" + } else { + parameterName1 <- "numberOfSubjects" + parameterName2 <- "eventsPerStage" + } + } + + if (design$kMax > 1) { + summaryFactory$addParameter(designPlan, + parameterName = ifelse((inherits(designPlan, "TrialDesignPlan") || inherits(designPlan, "TrialDesignPlanR6")) && designPlan$.isSampleSizeObject(), + "expectedNumberOfSubjectsH1", "expectedNumberOfSubjects" + ), + parameterCaption = "Expected number of subjects", + roundDigits = digitsSampleSize, transpose = TRUE + ) + } + + if (outputSize %in% c("medium", "large")) { + subjectsCaption <- ifelse(design$kMax > 1 && (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")) && + !survivalEnabled, "Stagewise number of subjects", "Number of subjects") + summaryFactory$addParameter(designPlan, + parameterName = parameterName1, + parameterCaption = subjectsCaption, roundDigits = digitsSampleSize + ) + } + + if (survivalEnabled) { + if (design$kMax > 1 && !((inherits(designPlan, "TrialDesignPlanSurvival") || inherits(designPlan, "TrialDesignPlanSurvivalR6")) && 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 = parameterName2, + parameterCaption = ifelse(design$kMax == 1, + "Number of events", "Cumulative number of events" + ), + roundDigits = digitsSampleSize, cumsumEnabled = FALSE + ) + } + + if (outputSize == "large") { + summaryFactory$addParameter(designPlan, + parameterName = "analysisTime", + parameterCaption = "Analysis time", roundDigits = digitsSampleSize + ) + } + + summaryFactory$addParameter(designPlan, + parameterName = "studyDuration", + parameterCaption = "Expected study duration", + roundDigits = digitsSampleSize, smoothedZeroFormat = TRUE, transpose = TRUE + ) + } + } + + if (!is.null(designPlan[["allocationRatioPlanned"]]) && + length(unique(designPlan$allocationRatioPlanned)) > 1) { + summaryFactory$addParameter(designPlan, + parameterName = "allocationRatioPlanned", + parameterCaption = "Optimum allocation ratio", roundDigits = digitsGeneral + ) + } + + .addDesignParameterToSummary( + design, designPlan, designCharacteristics, + summaryFactory, digitsGeneral, digitsProbabilities + ) + + if (baseEnabled && !planningEnabled && !is.null(designPlan[["futilityPerStage"]]) && + !any(is.na(designPlan[["futilityPerStage"]])) && + any(designPlan$futilityPerStage != 0) && any(designPlan$futilityPerStage > 1e-08)) { + summaryFactory$addParameter(designPlan, + parameterName = "futilityPerStage", + parameterCaption = "Exit probability for futility", # (under H1) + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + + if (baseEnabled && simulationEnabled && design$kMax > 1) { + values <- NULL + if (!is.null(probsH1)) { + values <- probsH1$rejectPerStage + } + summaryFactory$addParameter(designPlan, + parameterName = "rejectPerStage", + values = values, + parameterCaption = "Exit probability for efficacy", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + + # sample size and power only + if (planningEnabled) { + legendEntry <- list("(t)" = "treatment effect scale") + + if (!is.null(designPlan$criticalValuesEffectScale) && ncol(designPlan$criticalValuesEffectScale) > 0) { + summaryFactory$addParameter(designPlan, + parameterName = "criticalValuesEffectScale", + parameterCaption = ifelse(.isDelayedInformationEnabled(design = design), + "Upper bounds of continuation (t)", "Efficacy boundary (t)" + ), + roundDigits = digitsGeneral, legendEntry = legendEntry + ) + } else if (!is.null(designPlan$criticalValuesEffectScaleUpper) && ncol(designPlan$criticalValuesEffectScaleUpper) > 0) { + summaryFactory$addParameter(designPlan, + parameterName = "criticalValuesEffectScaleLower", + parameterCaption = "Lower efficacy boundary (t)", + roundDigits = digitsGeneral, legendEntry = legendEntry + ) + summaryFactory$addParameter(designPlan, + parameterName = "criticalValuesEffectScaleUpper", + parameterCaption = "Upper efficacy boundary (t)", + roundDigits = digitsGeneral, legendEntry = legendEntry + ) + } + + if (!is.null(designPlan$futilityBoundsEffectScale) && ncol(designPlan$futilityBoundsEffectScale) > 0 && + !all(is.na(designPlan$futilityBoundsEffectScale))) { + summaryFactory$addParameter(designPlan, + parameterName = "futilityBoundsEffectScale", + parameterCaption = ifelse(.isDelayedInformationEnabled(design = design), + "Lower bounds of continuation (t)", "Futility boundary (t)" + ), + roundDigits = digitsGeneral, legendEntry = legendEntry + ) + } else if (ncol(designPlan$futilityBoundsEffectScaleUpper) > 0 && + (any(!is.na(designPlan$futilityBoundsEffectScaleLower)) || + any(!is.na(designPlan$futilityBoundsEffectScaleUpper)))) { + summaryFactory$addParameter(designPlan, + parameterName = "futilityBoundsEffectScaleLower", + parameterCaption = "Lower futility boundary (t)", + roundDigits = digitsGeneral, legendEntry = legendEntry + ) + summaryFactory$addParameter(designPlan, + parameterName = "futilityBoundsEffectScaleUpper", + parameterCaption = "Upper futility boundary (t)", + roundDigits = digitsGeneral, legendEntry = legendEntry + ) + } + + if (!is.null(probsH1) && !is.null(probsH0) && design$kMax > 1) { + probsH0$earlyStop <- matrix(probsH0$earlyStop[1:(design$kMax - 1), 1], ncol = 1) + probsH0$rejectPerStage <- matrix(probsH0$rejectPerStage[1:(design$kMax - 1), 1], ncol = 1) + + if (is.matrix(probsH1$rejectPerStage)) { + if (design$kMax > 1 && designPlan$.isSampleSizeObject()) { + probsH1$rejectPerStage <- probsH1$rejectPerStage[1:(design$kMax - 1), 1] + } else { + probsH1$rejectPerStage <- matrix(probsH1$rejectPerStage[1:(design$kMax - 1), ], + ncol = ncol(probsH1$rejectPerStage) + ) + } + } else { + probsH1$rejectPerStage <- probsH1$rejectPerStage[1:(design$kMax - 1)] + } + + if (any(design$futilityBounds > -6)) { + if (is.matrix(probsH1$earlyStop)) { + probsH1$earlyStop <- matrix(probsH1$earlyStop[1:(design$kMax - 1), ], + ncol = ncol(probsH1$earlyStop) + ) + } else { + probsH1$earlyStop <- probsH1$earlyStop[1:(design$kMax - 1)] + } + summaryFactory$addParameter(probsH0, + parameterName = "earlyStop", + parameterCaption = "Overall exit probability (under H0)", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + x <- designPlan + if (is.null(x)) { + x <- design + } + summaryFactory$addParameter(x, + parameterName = "earlyStop", + values = probsH1$earlyStop, + parameterCaption = "Overall exit probability (under H1)", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + summaryFactory$addParameter(probsH0, + parameterName = "rejectPerStage", + parameterCaption = "Exit probability for efficacy (under H0)", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + if (designPlan$.isPowerObject()) { + summaryFactory$addParameter(designPlan, + parameterName = "rejectPerStage", + values = probsH1$rejectPerStage, + parameterCaption = "Exit probability for efficacy (under H1)", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } else { + summaryFactory$addParameter(probsH1, + parameterName = "rejectPerStage", + parameterCaption = "Exit probability for efficacy (under H1)", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + + if (any(design$futilityBounds > -6)) { + summaryFactory$addParameter(probsH0, + parameterName = "futilityPerStage", + parameterCaption = "Exit probability for futility (under H0)", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + x <- designPlan + if (is.null(x)) { + x <- design + } + futilityPerStage <- probsH1$futilityPerStage + if (.isTrialDesignPlan(x) && x$.isSampleSizeObject() && ncol(futilityPerStage) > 1) { + futilityPerStage <- futilityPerStage[, 1] + } + summaryFactory$addParameter(x, + parameterName = "futilityPerStage", + values = futilityPerStage, + parameterCaption = "Exit probability for futility (under H1)", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + } + } + + if (!is.null(performanceScore)) { + summaryFactory$addParameter(performanceScore, + parameterName = "performanceScore", + parameterCaption = "Performance score", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + ) + } + + return(summaryFactory) +} + +.getSummaryVariedParameterNameEnrichment <- function(designPlan) { + if (grepl("Rates", .getClassName(designPlan))) { + return("piTreatments") + } + if (grepl("Survival", .getClassName(designPlan))) { + return("hazardRatios") + } + return("effects") +} + +.getSummaryGroup <- function(parameterCaption, + numberOfVariedParams, + variedParamNumber, + designPlan) { + if (numberOfVariedParams <= 1) { + return(list( + groupCaption = parameterCaption, + legendEntry = list() + )) + } + + enrichmentEnabled <- grepl("SimulationResultsEnrichment", .getClassName(designPlan)) + if (enrichmentEnabled) { + variedParameterName <- .getSummaryVariedParameterNameEnrichment(designPlan) + variedParameterValues <- designPlan$effectList[[variedParameterName]] + if (variedParameterName == "piTreatments") { + variedParameterCaption <- "pi(treatment)" + } else { + variedParameterCaption <- C_PARAMETER_NAMES[[variedParameterName]] + } + if (is.matrix(variedParameterValues) && ncol(variedParameterValues) == 1) { + variedParameterCaption <- sub("s$", "", variedParameterCaption) + } + } else { + variedParameterName <- .getVariedParameterSimulationMultiArm(designPlan) + variedParameterValues <- designPlan[[variedParameterName]] + variedParameterCaption <- C_PARAMETER_NAMES[[variedParameterName]] + } + + userDefinedEffectMatrix <- !enrichmentEnabled && + designPlan$.getParameterType("effectMatrix") == C_PARAM_USER_DEFINED + + if (userDefinedEffectMatrix) { + return(list( + groupCaption = paste0(parameterCaption, " [", variedParamNumber, "]"), + legendEntry = list("[j]" = "effect matrix row j (situation to consider)") + )) + } + if (is.matrix(variedParameterValues)) { + values <- variedParameterValues[variedParamNumber, ] + if (length(values) > 1) { + values <- .arrayToString(values, vectorLookAndFeelEnabled = TRUE) + } + } else { + values <- variedParameterValues[variedParamNumber] + } + if (is.numeric(values)) { + values <- round(values, 2) + } + return(list( + groupCaption = paste0( + parameterCaption, ", ", + tolower(variedParameterCaption), " = ", values + ), + legendEntry = list() + )) +} + +.getSummaryGroupCaption <- function(designPlan, parameterName, numberOfGroups, groupNumber) { + listItemPrefix <- getOption("rpact.summary.list.item.prefix", C_SUMMARY_LIST_ITEM_PREFIX_DEFAULT) + + if (grepl("Enrichment", .getClassName(designPlan))) { + categoryCaption <- .getCategoryCaptionEnrichment(designPlan, parameterName, groupNumber) + categoryCaption <- sub("^F$", "Full population F", categoryCaption) + categoryCaption <- sub("^R$", "Remaining population R", categoryCaption) + categoryCaption <- sub("^S", "Subset S", categoryCaption) + + return(paste0(listItemPrefix, categoryCaption)) + } + + treatmentCaption <- ifelse(numberOfGroups > 2, paste0("Treatment arm ", groupNumber), "Treatment arm") + + if (!grepl("Survival", .getClassName(designPlan)) || + ((inherits(designPlan, "SimulationResultsMultiArmSurvival") || inherits(designPlan, "SimulationResultsMultiArmSurvivalR6")) && + parameterName == "singleNumberOfEventsPerStage")) { + return(ifelse(groupNumber == numberOfGroups, + paste0(listItemPrefix, "Control arm"), + paste0(listItemPrefix, treatmentCaption) + )) + } + + return(paste0(listItemPrefix, treatmentCaption, " vs. control")) +} + +.addSimulationArrayToSummary <- function(designPlan, + parameterName, parameterCaption, summaryFactory, + digitsSampleSize, smoothedZeroFormat = FALSE) { + arrayData <- designPlan[[parameterName]] + if (is.null(arrayData)) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, class(designPlan)[1], " does not contain the field ", sQuote(parameterName)) + } + + numberOfVariedParams <- dim(arrayData)[2] + numberOfGroups <- dim(arrayData)[3] + for (variedParamNumber in 1:numberOfVariedParams) { + summaryGroup <- .getSummaryGroup( + parameterCaption, + numberOfVariedParams, + variedParamNumber, + designPlan + ) + groupCaption <- summaryGroup$groupCaption + legendEntry <- summaryGroup$legendEntry + if (numberOfGroups > 1) { + summaryFactory$addItem(groupCaption, "", legendEntry = legendEntry) + } + + for (groupNumber in 1:numberOfGroups) { + dataPerGroupAndStage <- arrayData[, variedParamNumber, groupNumber] + if (numberOfGroups > 1) { + groupCaption <- .getSummaryGroupCaption( + designPlan, + parameterName, numberOfGroups, groupNumber + ) + } + summaryFactory$addParameter(designPlan, + parameterName = parameterName, + values = dataPerGroupAndStage, parameterCaption = groupCaption, + roundDigits = digitsSampleSize, + smoothedZeroFormat = smoothedZeroFormat, + enforceFirstCase = TRUE + ) + } + } +} + +.addSimulationMultiArmArrayParameter <- function(designPlan, parameterName, parameterCaption, + summaryFactory, roundDigits, smoothedZeroFormat = FALSE) { + arrayData <- designPlan[[parameterName]] + if (is.array(arrayData) && length(dim(arrayData)) == 3) { + totalNumberOfGroups <- dim(designPlan[[ifelse(grepl("Survival", .getClassName(designPlan)), + "eventsPerStage", "sampleSizes" + )]])[3] + + numberOfGroups <- dim(arrayData)[3] + if (parameterName == "selectedArms" && !grepl("Survival", .getClassName(designPlan))) { # remove control group + numberOfGroups <- numberOfGroups - 1 + } + numberOfVariedParams <- dim(arrayData)[2] + + for (variedParamNumber in 1:numberOfVariedParams) { + summaryGroup <- .getSummaryGroup( + parameterCaption, + numberOfVariedParams, + variedParamNumber, + designPlan + ) + groupCaption <- summaryGroup$groupCaption + legendEntry <- summaryGroup$legendEntry + if (numberOfGroups > 1) { + summaryFactory$addItem(groupCaption, "", legendEntry = legendEntry) + } + + for (groupNumber in 1:numberOfGroups) { + dataPerGroupAndStage <- arrayData[, variedParamNumber, groupNumber] + if (numberOfGroups > 1) { + groupCaption <- .getSummaryGroupCaption( + designPlan, + parameterName, totalNumberOfGroups, groupNumber + ) + } + summaryFactory$addParameter(designPlan, + parameterName = parameterName, + values = dataPerGroupAndStage, parameterCaption = groupCaption, + roundDigits = roundDigits, smoothedZeroFormat = smoothedZeroFormat, + enforceFirstCase = TRUE + ) + } + } + } else { + data <- designPlan[[parameterName]] + numberOfGroups <- ncol(data) + for (groupNumber in 1:numberOfGroups) { + dataPerGroupAndStage <- data[, groupNumber] + summaryFactory$addParameter(designPlan, + parameterName = parameterName, + values = dataPerGroupAndStage, + parameterCaption = ifelse(groupNumber == numberOfGroups, + paste0(parameterCaption, ", control"), + paste0(parameterCaption, ", treatment ", groupNumber) + ), + roundDigits = roundDigits, smoothedZeroFormat = smoothedZeroFormat + ) + } + } +} diff --git a/R/class_summary_r6.R b/R/class_summary_r6.R deleted file mode 100644 index 87899823..00000000 --- a/R/class_summary_r6.R +++ /dev/null @@ -1,3620 +0,0 @@ -## | -## | *Summary classes and functions* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | rpact package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File version: $Revision: 7408 $ -## | Last changed: $Date: 2023-11-09 10:36:19 +0100 (Do, 09 Nov 2023) $ -## | Last changed by: $Author: pahlke $ -## | - -#' @include f_core_utilities.R -#' @include f_core_assertions.R -NULL - - -SummaryItemR6 <- R6Class("SummaryItemR6", - public = list( - title = NULL, - values = NULL, - legendEntry = NULL, - initialize = function(title = NA_character_, values = NA_character_, ...) { - self$title <- title - self$values <- values - #callSuper(...) TODO LEGENDENTRyy - if (!is.null(legendEntry) && length(legendEntry) > 0) { - if (is.null(names(legendEntry))) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("legendEntry"), " must be a named list") - } - for (l in legendEntry) { - if (length(l) == 0) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("legendEntry"), " must be not empty") - } - } - } - }, - show = function() { - cat(self$title, "=", self$values, "\n") - }, - toList = function() { - result <- list() - result[[self$title]] <- self$values - } - ) -) - -#' -#' @title -#' Summary Factory Plotting -#' -#' @param x The summary factory object. -#' @param y Not available for this kind of plot (is only defined to be compatible to the generic plot function). -#' @param showSummary Show the summary before creating the plot output, default is \code{FALSE}. -#' @inheritParams param_three_dots_plot -#' -#' @description -#' Plots a summary factory. -#' -#' @details -#' Generic function to plot all kinds of summary factories. -#' -#' @template return_object_ggplot -#' -#' @export -#' -plot.SummaryFactoryR6 <- function(x, y, ..., showSummary = FALSE) { - fCall <- match.call(expand.dots = FALSE) - if (isTRUE(showSummary) || .isSummaryPipe(fCall)) { - markdown <- .getOptionalArgument("markdown", ..., optionalArgumentDefaultValue = NA) - if (is.na(markdown)) { - markdown <- .isMarkdownEnabled() - } - if (markdown) { - if (.isQuartoEnabled()) { - #cat("#| results: 'asis'\n\n") - } - - x$.catMarkdownText() - } else { - x$show() - } - } - plot(x = x$object, y = y, ...) -} - -#' -#' @title -#' Print Summary Factory in Markdown Code Chunks -#' -#' @description -#' The function `knit_print.SummaryFactory` is the default printing function for rpact summary objects in knitr. -#' The chunk option `render` uses this function by default. -#' To fall back to the normal printing behavior set the chunk option `render = normal_print`. -#' For more information see \code{\link[knitr]{knit_print}}. -#' -#' @param x A \code{SummaryFactory}. -#' @param ... Other arguments (see \code{\link[knitr]{knit_print}}). -#' -#' @details -#' Generic function to print a summary object 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. -#' -#' @export -#' -knit_print.SummaryFactoryR6 <- function(x, ...) { - result <- paste0(utils::capture.output(x$.catMarkdownText()), collapse = "\n") - - if (isTRUE(base::attr(x$object, "printObject"))) { - sep <- base::attr(x$object, "printObjectSeparator") - if (is.null(sep) || !is.character(sep)) { - sep <- "\n-----\n\n" - } - result <- paste0(result, sep, - paste0(utils::capture.output(x$object$.catMarkdownText()), collapse = "\n")) - } - - return(knitr::asis_output(result)) -} - -#' -#' @title -#' Summary Factory Printing -#' -#' @param x The summary factory object. -#' @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}) -#' @param sep The separator line between the summary and the print output. -#' @inheritParams param_three_dots_plot -#' -#' @description -#' Prints the result object stored inside a summary factory. -#' -#' @details -#' Generic function to print all kinds of summary factories. -#' -#' @export -#' -print.SummaryFactoryR6 <- function(x, ..., - markdown = NA, - sep = "\n-----\n\n") { - - if (is.na(markdown)) { - markdown <- .isMarkdownEnabled() - } - - if (markdown) { - result <- paste0(utils::capture.output(x$.catMarkdownText()), collapse = "\n") - cat(result, "\n") - return(invisible()) - } - - x$show() -} - -#' @name SummaryFactory -#' -#' @title -#' Summary Factory -#' -#' @description -#' Basic class for summaries -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -SummaryFactoryR6 <- R6Class("SummaryFactoryR6", - inherit = ParameterSetR6, - public = list( - object = NULL, - title = NULL, - header = NULL, - summaryItems = NULL, - intervalFormat = NULL, - justify = NULL, - output = NULL, - initialize = function(..., intervalFormat = "[%s; %s]", output = "all") { - #callSuper(...) TODO - self$intervalFormat <- intervalFormat - self$output <- output - self$summaryItems <- list() - self$justify <- getOption("rpact.summary.justify", "right") - }, - show = function(showType = 1, digits = NA_integer_) { - self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) - }, - .show = function(showType = 1, digits = NA_integer_, ..., consoleOutputEnabled = TRUE) { - if (self$output %in% c("all", "title")) { - if (is.null(self$title) || length(self$title) == 0) { - self$title <- .createSummaryTitleObject(self$object) - } - if (!is.null(self$title) && length(self$title) == 1 && trimws(self$title) != "") { - self$self$.cat(self$title, "\n\n", - heading = 1, - consoleOutputEnabled = consoleOutputEnabled - ) - } - } - - if (self$output %in% c("all", "overview")) { - if (is.null(self$header) || length(self$header) == 0) { - self$header <- .createSummaryHeaderObject(self$object, self, digits) - } - if (!is.null(self$header) && length(self$header) == 1 && trimws(self$header) != "") { - self$.cat(self$header, "\n\n", - consoleOutputEnabled = consoleOutputEnabled - ) - } - } - - if (!(self$output %in% c("all", "body"))) { - return(invisible()) - } - - legendEntries <- c() - legendEntriesUnique <- c() - summaryItemNames <- c() - for (summaryItem in self$summaryItems) { - if (!is.null(summaryItem$title) && length(summaryItem$title) == 1 && !is.na(summaryItem$title)) { - summaryItemNames <- c(summaryItemNames, summaryItem$title) - } - if (length(summaryItem$legendEntry) > 0) { - a <- sort(names(summaryItem$legendEntry)) - for (aa in a) { - if (!(aa %in% legendEntriesUnique)) { - legendEntriesUnique <- c(legendEntriesUnique, aa) - b <- summaryItem$legendEntry[[aa]] - legendEntries <- c(legendEntries, paste0(" ", aa, ": ", b)) - } - } - } - } - summaryItemNames <- paste0(format(summaryItemNames), " ") - - na <- ifelse(.isDataset(self$object), "NA", NA_character_) - tableColumns <- 0 - maxValueWidth <- 1 - if (length(self$summaryItems) > 0) { - for (i in 1:length(self$summaryItems)) { - validValues <- na.omit(self$summaryItems[[i]]$values) - if (length(validValues) > 0) { - w <- max(nchar(validValues)) - maxValueWidth <- max(maxValueWidth, w) - tableColumns <- max(tableColumns, 1 + length(validValues)) - } - } - spaceString <- paste0(rep(" ", maxValueWidth + 1), collapse = "") - for (i in 1:length(self$summaryItems)) { - itemTitle <- self$summaryItems[[i]]$title - if (!is.null(itemTitle) && length(itemTitle) == 1 && !is.na(itemTitle)) { - summaryItemName <- summaryItemNames[i] - values <- self$summaryItems[[i]]$values - values <- trimws(values) - indices <- !grepl("(\\])$", values) - values[indices] <- paste0(values[indices], " ") - values <- format(c(spaceString, values), justify = self$justify)[2:(length(values) + 1)] - self$.cat(summaryItemName, values, "\n", - tableColumns = tableColumns, - consoleOutputEnabled = consoleOutputEnabled, na = na - ) - if (!consoleOutputEnabled && trimws(summaryItemName) == "Stage") { - self$.cat(rep("----- ", tableColumns), "\n", - tableColumns = tableColumns, - consoleOutputEnabled = consoleOutputEnabled, na = na - ) - } - } - } - } - - if (length(legendEntries) > 0) { - self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) - self$.cat("Legend:\n", consoleOutputEnabled = consoleOutputEnabled) - if (!consoleOutputEnabled) { - self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) - } - for (legendEntry in legendEntries) { - self$.cat(legendEntry, "\n", consoleOutputEnabled = consoleOutputEnabled) - } - self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) - } - }, - addItem = function(title, values, legendEntry = list()) { - if (!is.character(values)) { - values <- as.character(values) - } - tryCatch( - { - self$addSummaryItem(SummaryItem(title = title, values = values, legendEntry = legendEntry)) - }, - error = function(e) { - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to add summary item '", title, - "' = ", .arrayToString(values), " (class: ", .getClassName(values), "): ", e$message - ) - } - ) - }, - addSummaryItem = function(summaryItem) { - if (!(inherits(summaryItem, "SummaryItem") || inherits(summaryItem, "SummaryItemR6"))) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'summaryItem' must be an instance of class 'SummaryItem' (was '", .getClassName(summaryItem), "')" - ) - } - self$summaryItems <- c(self$summaryItems, summaryItem) - }, - .getFormattedParameterValue = function(valuesToShow, valuesToShow2) { - naText <- getOption("rpact.summary.na", "") - if (length(valuesToShow) == length(valuesToShow2) && !all(is.na(valuesToShow2))) { - for (variantIndex in 1:length(valuesToShow)) { - value1 <- as.character(valuesToShow[variantIndex]) - value2 <- as.character(valuesToShow2[variantIndex]) - if (grepl("^ *NA *$", value1)) { - value1 <- naText - } - if (grepl("^ *NA *$", value2)) { - value2 <- naText - } - if (trimws(value1) == "" && trimws(value2) == "") { - valuesToShow[variantIndex] <- naText - } else { - valuesToShow[variantIndex] <- sprintf(self$intervalFormat, value1, value2) - } - } - } else { - valuesToShow[is.na(valuesToShow) | trimws(valuesToShow) == "NA"] <- naText - } - - return(valuesToShow) - }, - addParameter = function(parameterSet, ..., - parameterName = NULL, values = NULL, parameterCaption, - roundDigits = NA_integer_, ceilingEnabled = FALSE, cumsumEnabled = FALSE, - twoSided = FALSE, transpose = FALSE, smoothedZeroFormat = FALSE, - parameterCaptionSingle = parameterCaption, legendEntry = list(), - enforceFirstCase = FALSE, formatRepeatedPValues = FALSE) { - if (!is.null(parameterName) && length(parameterName) == 1 && - (inherits(parameterSet, "ParameterSet") || inherits(parameterSet, "ParameterSetR6")) && - parameterSet$.getParameterType(parameterName) == C_PARAM_NOT_APPLICABLE) { - if (.getLogicalEnvironmentVariable("RPACT_DEVELOPMENT_MODE")) { - warning( - "Failed to add parameter ", .arrayToString(parameterName), " (", - .arrayToString(values), ") stored in ", - .getClassName(parameterSet), " because the parameter has type C_PARAM_NOT_APPLICABLE" - ) - } - - return(invisible()) - } - - parameterName1 <- parameterName[1] - if (!is.null(parameterName1) && is.character(parameterName1) && is.null(values)) { - values <- parameterSet[[parameterName1]] - if (is.null(values)) { - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, .getClassName(parameterSet), - " does not contain a field '", parameterName1, "'" - ) - } - } - - parameterName2 <- NA_character_ - values2 <- NA_real_ - if (!is.null(parameterName) && length(parameterName) > 1) { - parameterName2 <- parameterName[2] - values2 <- parameterSet[[parameterName2]] - parameterName <- parameterName[1] - if (is.null(values2)) { - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, .getClassName(parameterSet), - " does not contain a field '", parameterName2, "'" - ) - } - } - - if (is.null(values) && is.null(parameterName1)) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'parameterName' or 'values' must be defined") - } - - if (transpose) { - if (!is.matrix(values)) { - values <- as.matrix(values) - } else { - values <- t(values) - } - } - - if (is.list(parameterSet) && is.matrix(values)) { - parameterSet <- parameterSet[["parameterSet"]] - if (is.null(parameterSet)) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'parameterSet' must be added to list") - } - } - - parameterNames <- "" - numberOfVariants <- 1 - numberOfStages <- ifelse(is.matrix(values), ncol(values), length(values)) - if (inherits(parameterSet, "ParameterSet") || inherits(parameterSet, "ParameterSetR6")) { - parameterNames <- parameterSet$.getVisibleFieldNamesOrdered() - numberOfVariants <- .getMultidimensionalNumberOfVariants(parameterSet, parameterNames) - numberOfStages <- parameterSet$.getMultidimensionalNumberOfStages(parameterNames) - } - - stages <- parameterSet[["stages"]] - if (is.null(stages) && !is.null(parameterSet[[".stageResults"]])) { - stages <- parameterSet[[".stageResults"]][["stages"]] - } - if (is.null(stages) && (inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResultsR6"))) { - stages <- parameterSet[[".design"]][["stages"]] - } - if (!is.null(stages) && length(stages) > 0) { - numberOfStages <- max(na.omit(stages)) - if (is.matrix(values) && nrow(values) > 0) { - numberOfVariants <- nrow(values) - } - if (is.matrix(values) && ncol(values) > 0) { - numberOfStages <- ncol(values) - } - } - - if (!is.null(parameterSet[[".piecewiseSurvivalTime"]]) && - isTRUE(parameterSet[[".piecewiseSurvivalTime"]]$delayedResponseEnabled)) { - numberOfVariants <- 1 - } - - if (twoSided) { - values <- 2 * values - } - - caseCondition <- list( - and1 = enforceFirstCase, - and2 = inherits(parameterSet, "Dataset"), - and3 = list( - or1 = list( - and1 = !transpose, - and2 = numberOfVariants == 1 - ), - or2 = list( - and1 = !is.matrix(values), - and2 = (!transpose && ncol(values) == 1), - and3 = (transpose && nrow(values) == 1) - ), - or3 = list( - and1 = .isTrialDesign(parameterSet), - and2 = (numberOfStages > 1 && numberOfStages == length(values)), - and3 = length(values) != numberOfVariants, - and4 = length(values) == 1, - and5 = parameterName %in% c( - "futilityBoundsEffectScale", - "futilityBoundsEffectScaleLower", - "futilityBoundsEffectScaleUpper", - "futilityPerStage" - ) - ) - ) - ) - - if (.isConditionTrue(caseCondition, "or", showDebugMessages = FALSE)) { - valuesToShow <- .getSummaryValuesFormatted( - parameterSet, parameterName1, values, - roundDigits = roundDigits, - ceilingEnabled = ceilingEnabled, cumsumEnabled = cumsumEnabled, - smoothedZeroFormat = smoothedZeroFormat, - formatRepeatedPValues = formatRepeatedPValues - ) - - if (parameterName1 %in% c("piControl", "overallPiControl", "overallPooledStDevs")) { - valuesToShow <- self$.getInnerValues(valuesToShow, transpose = TRUE) - } else { - valuesToShow <- self$.getInnerValues(valuesToShow, transpose = transpose) - } - - valuesToShow2 <- NA_real_ - if (!all(is.na(values2))) { - valuesToShow2 <- .getSummaryValuesFormatted(parameterSet, - parameterName1, values2, - roundDigits = roundDigits, - ceilingEnabled = ceilingEnabled, cumsumEnabled = cumsumEnabled, - smoothedZeroFormat = smoothedZeroFormat, - formatRepeatedPValues = formatRepeatedPValues - ) - valuesToShow2 <- self$.getInnerValues(valuesToShow2, transpose = transpose) - } - - valuesToShow <- self$.getFormattedParameterValue(valuesToShow, valuesToShow2) - self$addItem(parameterCaptionSingle, valuesToShow, legendEntry) - } else { - if (!(inherits(parameterSet, "ParameterSet") || inherits(parameterSet, "ParameterSetR6"))) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "for varied values 'parameterSet' must be an instance of ", - "class 'ParameterSet' (was '", .getClassName(parameterSet), "')" - ) - } - - transposed <- !transpose && grepl("MultiArm|Enrichment", .getClassName(parameterSet)) && - (!is.matrix(values) || ncol(values) > 1) - - userDefinedEffectMatrix <- FALSE - if (grepl("MultiArm|Enrichment", .getClassName(parameterSet)) || - (inherits(parameterSet, "AnalysisResultsConditionalDunnett") || inherits(parameterSet, "AnalysisResultsConditionalDunnettR6")) || - (inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResultsR6")) || - (inherits(parameterSet, "ConditionalPowerResults") || inherits(parameterSet, "ConditionalPowerResultsR6"))) { - if (grepl("SimulationResults(MultiArm|Enrichment)", .getClassName(parameterSet)) && - parameterName %in% c( - "rejectAtLeastOne", - "earlyStop", - "futilityPerStage", - "successPerStage", - "expectedNumberOfSubjects", - "expectedNumberOfEvents", - "singleNumberOfEventsPerStage", - "numberOfActiveArms", - "numberOfPopulations", - "conditionalPowerAchieved" - )) { - transposed <- TRUE - userDefinedEffectMatrix <- - parameterSet$.getParameterType("effectMatrix") == C_PARAM_USER_DEFINED - if (userDefinedEffectMatrix) { - legendEntry[["[j]"]] <- "effect matrix row j (situation to consider)" - } - if (grepl("Survival", .getClassName(parameterSet)) && !grepl("Enrichment", .getClassName(parameterSet))) { - legendEntry[["(i)"]] <- "results of treatment arm i vs. control arm" - } - - if (grepl("SimulationResultsEnrichment", .getClassName(parameterSet))) { - variedParameterName <- .getSummaryVariedParameterNameEnrichment(parameterSet) - variedParameterValues <- parameterSet$effectList[[variedParameterName]] - if (variedParameterName == "piTreatments") { - variedParameterCaption <- "pi(treatment)" - } else { - variedParameterCaption <- C_PARAMETER_NAMES[[variedParameterName]] - if (is.matrix(variedParameterValues) && ncol(variedParameterValues) == 1) { - variedParameterCaption <- sub("s$", "", variedParameterCaption) - } - } - if (is.matrix(variedParameterValues)) { - numberOfVariants <- nrow(variedParameterValues) - } else { - numberOfVariants <- length(variedParameterValues) - } - } else { - variedParameterName <- .getVariedParameterSimulationMultiArm(parameterSet) - variedParameterValues <- parameterSet[[variedParameterName]] - variedParameterCaption <- C_PARAMETER_NAMES[[variedParameterName]] - numberOfVariants <- length(variedParameterValues) - } - variedParameterCaption <- tolower(variedParameterCaption) - } else if (self$.isEnrichmentObject(parameterSet)) { - transposed <- TRUE - variedParameterCaption <- "populations" - if (parameterName1 %in% c( - "indices", "conditionalErrorRate", "secondStagePValues", - "adjustedStageWisePValues", "overallAdjustedTestStatistics", "rejectedIntersections" - )) { - if (.isEnrichmentAnalysisResults(parameterSet)) { - variedParameterValues <- parameterSet$.closedTestResults$.getHypothesisPopulationVariants() - } else { - variedParameterValues <- parameterSet$.getHypothesisPopulationVariants() - } - } else { - variedParameterValues <- c(paste0("S", 1:(numberOfVariants - 1)), "F") - } - numberOfVariants <- length(variedParameterValues) - legendEntry[["S[i]"]] <- "population i" - legendEntry[["F"]] <- "full population" - } else if (!(inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResultsR6")) || - parameterName %in% c("rejected", "separatePValues")) { - if ((inherits(parameterSet, "AnalysisResultsConditionalDunnett") || inherits(parameterSet, "AnalysisResultsConditionalDunnettR6")) && - (!is.matrix(values) || ncol(values) > 1)) { - transposed <- TRUE - } - - if ((inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResultsR6")) && - parameterSet$.getParameterType("adjustedStageWisePValues") != "g" && - parameterName == "separatePValues") { - transposed <- TRUE - } - - if ((inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResultsR6")) && - parameterName %in% c("rejected")) { - transposed <- TRUE - } - - if ((inherits(parameterSet, "ConditionalPowerResults") || inherits(parameterSet, "ConditionalPowerResultsR6")) && - parameterName %in% c("conditionalPower", "values")) { - transposed <- TRUE - } - - variedParameterCaption <- "arm" - variedParameterValues <- 1:numberOfVariants - legendEntry[["(i)"]] <- "results of treatment arm i vs. control arm" - } else { - transposed <- TRUE - variedParameterCaption <- "arms" - variedParameterValues <- parameterSet$.getHypothesisTreatmentArmVariants() - numberOfVariants <- length(variedParameterValues) - legendEntry[["(i, j, ...)"]] <- "comparison of treatment arms 'i, j, ...' vs. control arm" - } - } else { - if (inherits(parameterSet, "Dataset")) { - variedParameter <- "groups" - } else if (inherits(parameterSet, "PerformanceScore") || inherits(parameterSet, "PerformanceScoreR6")) { - variedParameter <- ".alternative" - } else { - variedParameter <- parameterSet$.getVariedParameter(parameterNames, numberOfVariants) - } - if (length(variedParameter) == 0 || variedParameter == "") { - warning( - "Failed to get varied parameter from ", .getClassName(parameterSet), - " (", length(parameterNames), " parameter names; numberOfVariants: ", numberOfVariants, ")" - ) - return(invisible()) - } - - variedParameterCaption <- parameterSet$.getDataFrameColumnCaption(variedParameter, - tableColumnNames = C_TABLE_COLUMN_NAMES, niceColumnNamesEnabled = TRUE - ) - variedParameterCaption <- tolower(variedParameterCaption) - - if (variedParameterCaption == "alternative" || variedParameterCaption == ".alternative") { - legendEntry[["alt."]] <- "alternative" - variedParameterCaption <- "alt." - } else if (variedParameterCaption == "hazard ratio") { - legendEntry[["HR"]] <- "hazard ratio" - variedParameterCaption <- "HR" - } else if (grepl("\\(1\\)$", variedParameterCaption)) { - groups <- parameterSet[["groups"]] - if (!is.null(groups) && length(groups) == 1 && groups == 1) { - variedParameterCaption <- sub(" \\(1\\)$", "", variedParameterCaption) - } - } - - variedParameterValues <- round(parameterSet[[variedParameter]], 3) - } - - for (variantIndex in 1:numberOfVariants) { - colValues <- self$.getColumnValues(parameterName, values, variantIndex, transposed) - colValues <- .getSummaryValuesFormatted(parameterSet, parameterName1, - colValues, - roundDigits = roundDigits, - ceilingEnabled = ceilingEnabled, cumsumEnabled = cumsumEnabled, - smoothedZeroFormat = smoothedZeroFormat, - formatRepeatedPValues = formatRepeatedPValues - ) - colValues2 <- NA_real_ - if (!all(is.na(values2))) { - colValues2 <- self$.getColumnValues(parameterName, values2, variantIndex, transposed) - colValues2 <- .getSummaryValuesFormatted(parameterSet, parameterName2, colValues2, - roundDigits = roundDigits, ceilingEnabled = ceilingEnabled, - cumsumEnabled = cumsumEnabled, - smoothedZeroFormat = smoothedZeroFormat, - formatRepeatedPValues = formatRepeatedPValues - ) - } - colValues <- self$.getFormattedParameterValue(valuesToShow = colValues, valuesToShow2 = colValues2) - - if (numberOfVariants == 1) { - self$addItem(parameterCaption, colValues, legendEntry) - } else if (self$.isEnrichmentObject(parameterSet)) { - self$addItem(paste0( - parameterCaption, " ", - variedParameterValues[variantIndex] - ), colValues, legendEntry) - } else if ( - (grepl("MultiArm|Enrichment", .getClassName(parameterSet)) && - !grepl("Simulation", .getClassName(parameterSet))) || - (inherits(parameterSet, "AnalysisResultsConditionalDunnett") || inherits(parameterSet, "AnalysisResultsConditionalDunnettR6")) || - (inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResultsR6")) || - (inherits(parameterSet, "ConditionalPowerResults") || inherits(parameterSet, "ConditionalPowerResultsR6"))) { - spacePrefix <- ifelse(parameterCaption %in% c("pi", "lambda", "median"), "", " ") - self$addItem(paste0( - parameterCaption, spacePrefix, - "(", variedParameterValues[variantIndex], ")" - ), colValues, legendEntry) - } else if (userDefinedEffectMatrix) { - self$addItem(paste0(parameterCaption, " [", variantIndex, "]"), colValues, legendEntry) - } else { - if (is.matrix(variedParameterValues) && ncol(variedParameterValues) > 1) { - variedParameterValuesFormatted <- - .arrayToString(variedParameterValues[variantIndex, ], vectorLookAndFeelEnabled = TRUE) - } else { - variedParameterValuesFormatted <- variedParameterValues[variantIndex] - } - self$addItem( - paste0( - parameterCaption, ", ", - variedParameterCaption, " = ", variedParameterValuesFormatted - ), - colValues, legendEntry - ) - } - } - } - }, - .isEnrichmentObject = function(parameterSet) { - return( - .isEnrichmentAnalysisResults(parameterSet) || - .isEnrichmentStageResults(parameterSet) || - .isEnrichmentConditionalPowerResults(parameterSet) || - ((inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResultsR6")) && - isTRUE(parameterSet$.enrichment)) - ) - }, - .getInnerValues = function(values, transpose = FALSE) { - if (!is.matrix(values)) { - return(values) - } - - if (nrow(values) == 1 && ncol(values) == 1) { - return(values[1, 1]) - } - - if (transpose) { - return(values[1, ]) - } - - return(values[, 1]) - }, - .getColumnValues = function(parameterName, values, variantIndex, transposed = FALSE) { - tryCatch( - { - if (transposed) { - if (!is.matrix(values)) { - return(values) - } - - if (nrow(values) == 0) { - return("") - } - - if (nrow(values) == 1 && ncol(values) == 1) { - colValues <- values[1, 1] - } else if (nrow(values) == 1) { - colValues <- values[1, variantIndex] - } else if (ncol(values) == 1) { - colValues <- values[variantIndex, 1] - } else { - colValues <- values[variantIndex, ] - } - return(colValues) - } - - if (length(values) <= 1 && !is.matrix(values)) { - colValues <- values - } else if (is.matrix(values)) { - if (nrow(values) == 1 && ncol(values) == 1) { - colValues <- values[1, 1] - } else if (ncol(values) == 1) { - colValues <- values[variantIndex, 1] - } else if (nrow(values) == 1) { - colValues <- values[1, variantIndex] - } else { - if (ncol(values) == 0) { - return("") - } - - colValues <- values[, variantIndex] - } - } else { - colValues <- values[variantIndex] - } - return(colValues) - }, - error = function(e) { - stop( - ".getColumnValues(", dQuote(parameterName), "): ", e$message, - "; .getClassName(values) = ", .getClassName(values), - "; dim(values) = ", .arrayToString(dim(values), vectorLookAndFeelEnabled = TRUE), - "; variantIndex = ", variantIndex, - "; transposed = ", transposed - ) - } - ) - } - ) -) - -.formatSummaryValues <- function(values, digits, smoothedZeroFormat = FALSE, formatRepeatedPValues = FALSE) { - if (is.na(digits)) { - digits <- 3 - } - - if (digits < 1) { - formattedValue <- as.character(values) - formattedValue[is.na(formattedValue) | trimws(formattedValue) == "NA"] <- getOption("rpact.summary.na", "") - return(formattedValue) - } - - if (sum(is.na(values)) == length(values)) { - formattedValue <- rep(getOption("rpact.summary.na", ""), length(values)) - return(formattedValue) - } - - threshold <- 10^-digits - text <- "<0." - if (digits > 1) { - for (i in 1:(digits - 1)) { - text <- paste0(text, "0") - } - } - text <- paste0(text, "1") - - if (smoothedZeroFormat) { - values[abs(values) < 1e-15] <- 0 - } - indices <- (!is.na(values) & values > 1e-10 & abs(values) < threshold) - values[!is.na(values) & !indices] <- round(values[!is.na(values) & !indices], digits) - if (sum(indices) > 0) { - values[indices] <- threshold - formattedValue <- .getFormattedValue(values, digits = digits, nsmall = digits, scientific = FALSE) - formattedValue[indices] <- text - } else { - formattedValue <- .getFormattedValue(values, digits = digits, nsmall = digits, scientific = FALSE) - formattedValue <- format(formattedValue, scientific = FALSE) - } - - if (formatRepeatedPValues) { - formattedValue[!is.na(formattedValue) & - nchar(gsub("\\D", "", (formattedValue))) > 0 & formattedValue > 0.4999] <- ">0.5" - } - - if (as.logical(getOption("rpact.summary.trim.zeroes", TRUE))) { - zeroes <- grepl("^0\\.0*$", formattedValue) - if (sum(zeroes) > 0) { - formattedValue[zeroes] <- "0" - } - } - - formattedValue[is.na(formattedValue) | trimws(formattedValue) == "NA"] <- getOption("rpact.summary.na", "") - - return(formattedValue) -} - -.getSummaryValuesFormatted <- function(fieldSet, parameterName, values, - roundDigits = NA_integer_, ceilingEnabled = FALSE, cumsumEnabled = FALSE, - smoothedZeroFormat = FALSE, formatRepeatedPValues = FALSE) { - if (!is.numeric(values)) { - return(values) - } - - if (cumsumEnabled) { - values <- cumsum(values) - } - - if (ceilingEnabled) { - values <- ceiling(values) - } else { - tryCatch( - { - formatFunctionName <- NULL - - if (!is.null(parameterName) && length(parameterName) == 1 && !is.na(parameterName)) { - if (parameterName == "futilityBounds") { - values[!is.na(values) & values <= -6] <- -Inf - } else if (parameterName %in% c("criticalValues", "decisionCriticalValue", "overallAdjustedTestStatistics")) { - design <- fieldSet - if (!.isTrialDesign(design)) { - design <- fieldSet[[".design"]] - } - if (!is.null(design) && .isTrialDesignFisher(design)) { - roundDigits <- 0 - } - } - if (!is.na(roundDigits) && roundDigits == 0) { - if (inherits(fieldSet, "Dataset") && - grepl("samplesize|event", tolower(parameterName))) { - } else { - if (inherits(fieldSet, "FieldSet") || inherits(fieldSet, "FieldSetR6")) { - formatFunctionName <- fieldSet$.parameterFormatFunctions[[parameterName]] - } - if (is.null(formatFunctionName)) { - formatFunctionName <- C_PARAMETER_FORMAT_FUNCTIONS[[parameterName]] - } - } - } - } - - if (!is.null(formatFunctionName)) { - values <- eval(call(formatFunctionName, values)) - } else { - values <- .formatSummaryValues(values, - digits = roundDigits, - smoothedZeroFormat = smoothedZeroFormat, - formatRepeatedPValues = formatRepeatedPValues - ) - } - }, - error = function(e) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to show parameter '", parameterName, "': ", e$message) - } - ) - } - - return(format(values)) -} - -.createSummaryTitleObject <- function(object) { - design <- NULL - designPlan <- NULL - if (inherits(object, "TrialDesignCharacteristics")) { - design <- object$.design - } else if (.isTrialDesignPlan(object) || inherits(object, "SimulationResults") || inherits(object, "SimulationResultsR6")) { - design <- object$.design - designPlan <- object - } else if (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) { - return(.createSummaryTitleAnalysisResults(object$.design, object)) - } else if (.isTrialDesign(object)) { - design <- object - } - if (!is.null(design)) { - return(.createSummaryTitleDesign(design, designPlan)) - } - return("") -} - -.createSummaryTitleAnalysisResults <- function(design, analysisResults) { - kMax <- design$kMax - - title <- "" - if (kMax == 1) { - title <- paste0(title, "Fixed sample analysis results") - } else { - title <- paste0(title, "Sequential analysis results with a maximum of ", kMax, " looks") - } - - if (!is.null(analysisResults)) { - if (.isMultiArmAnalysisResults(analysisResults)) { - title <- "Multi-arm analysis results for a " - } else if (.isEnrichmentAnalysisResults(analysisResults)) { - title <- "Enrichment analysis results for a " - } else { - title <- "Analysis results for a " - } - - if (grepl("Means", .getClassName(analysisResults$.dataInput))) { - title <- paste0(title, "continuous endpoint") - } else if (grepl("Rates", .getClassName(analysisResults$.dataInput))) { - title <- paste0(title, "binary endpoint") - } else if (grepl("Survival", .getClassName(analysisResults$.dataInput))) { - title <- paste0(title, "survival endpoint") - } - - if (.isMultiHypothesesAnalysisResults(analysisResults)) { - gMax <- analysisResults$.stageResults$getGMax() - if (.isMultiArmAnalysisResults(analysisResults)) { - title <- paste0(title, " (", gMax, " active arms vs. control)") - } else if (.isEnrichmentAnalysisResults(analysisResults)) { - title <- paste0(title, " (", gMax, " populations)") - } - } - } else if (kMax > 1) { - prefix <- ifelse(design$.isDelayedResponseDesign(), "delayed response ", "") - title <- .concatenateSummaryText(title, - paste0("(", prefix, design$.toString(startWithUpperCase = FALSE), ")"), - sep = " " - ) - } - - return(title) -} - -.createSummaryTitleDesign <- function(design, designPlan) { - kMax <- design$kMax - - title <- "" - if (kMax == 1) { - title <- paste0(title, "Fixed sample analysis") - } else { - title <- paste0(title, "Sequential analysis with a maximum of ", kMax, " looks") - } - if (!is.null(designPlan)) { - if (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")) { - title <- "Simulation of a " - } else if (designPlan$.isSampleSizeObject()) { - title <- "Sample size calculation for a " - } else if (designPlan$.isPowerObject()) { - title <- "Power calculation for a " - } - - if (grepl("Means", .getClassName(designPlan))) { - title <- paste0(title, "continuous endpoint") - } else if (grepl("Rates", .getClassName(designPlan))) { - title <- paste0(title, "binary endpoint") - } else if (grepl("Survival", .getClassName(designPlan))) { - title <- paste0(title, "survival endpoint") - } - - if (grepl("MultiArm", .getClassName(designPlan)) && - !is.null(designPlan[["activeArms"]]) && designPlan$activeArms > 1) { - title <- .concatenateSummaryText(title, "(multi-arm design)", sep = " ") - } else if (grepl("Enrichment", .getClassName(designPlan))) { - title <- .concatenateSummaryText(title, "(enrichment design)", sep = " ") - } - } else if (kMax > 1) { - prefix <- ifelse(design$.isDelayedResponseDesign(), "delayed response ", "") - title <- .concatenateSummaryText(title, - paste0("(", prefix, design$.toString(startWithUpperCase = FALSE), ")"), - sep = " " - ) - } - - return(title) -} - -.isRatioComparisonEnabled <- function(object) { - if (!is.null(object[["meanRatio"]]) && isTRUE(object[["meanRatio"]])) { - return(TRUE) - } - - if (!is.null(object[["riskRatio"]]) && isTRUE(object[["riskRatio"]])) { - return(TRUE) - } - - return(FALSE) -} - -.getSummaryObjectSettings <- function(object) { - multiArmEnabled <- grepl("MultiArm", .getClassName(object)) - enrichmentEnabled <- grepl("Enrichment", .getClassName(object)) - simulationEnabled <- grepl("Simulation", .getClassName(object)) - ratioEnabled <- FALSE - populations <- NA_integer_ - if ((inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) || (inherits(object, "StageResults") || inherits(object, "StageResultsR6"))) { - groups <- object$.dataInput$getNumberOfGroups() - meansEnabled <- grepl("Means", .getClassName(object$.dataInput)) - ratesEnabled <- grepl("Rates", .getClassName(object$.dataInput)) - survivalEnabled <- grepl("Survival", .getClassName(object$.dataInput)) - } else { - meansEnabled <- grepl("Means", .getClassName(object)) - ratesEnabled <- grepl("Rates", .getClassName(object)) - survivalEnabled <- grepl("Survival", .getClassName(object)) - if (simulationEnabled && multiArmEnabled) { - groups <- object$activeArms - } else if (simulationEnabled && enrichmentEnabled) { - groups <- 2 - populations <- object$populations - } else { - # for analysis multi-arm / enrichment always 2 groups are applicable - groups <- ifelse(multiArmEnabled || enrichmentEnabled || survivalEnabled, 2, object[["groups"]]) - } - ratioEnabled <- .isRatioComparisonEnabled(object) - } - - return(list( - meansEnabled = meansEnabled, - ratesEnabled = ratesEnabled, - survivalEnabled = survivalEnabled, - groups = groups, - populations = populations, - multiArmEnabled = multiArmEnabled, - enrichmentEnabled = enrichmentEnabled, - simulationEnabled = simulationEnabled, - ratioEnabled = ratioEnabled - )) -} - -.createSummaryHypothesisText <- function(object, summaryFactory) { - if (!(inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) && !(inherits(object, "TrialDesignPlan") || inherits(object, "TrialDesignPlanR6")) && - !(inherits(object, "SimulationResults") || inherits(object, "SimulationResultsR6"))) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'object' must be an instance of class 'AnalysisResults', 'TrialDesignPlan' ", - "or 'SimulationResults' (is '", .getClassName(object), "')" - ) - } - - design <- object[[".design"]] - if (is.null(design)) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'.design' must be defined in specified ", .getClassName(object)) - } - - settings <- .getSummaryObjectSettings(object) - sided <- ifelse(settings$multiArmEnabled || settings$enrichmentEnabled, 1, design$sided) - directionUpper <- object[["directionUpper"]] - if (is.null(directionUpper) || length(directionUpper) != 1 || is.na(directionUpper)) { - directionUpper <- TRUE - } - - comparisonH0 <- " = " - comparisonH1 <- NA_character_ - if ((inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) && !is.null(directionUpper)) { - comparisonH1 <- ifelse(sided == 2, " != ", ifelse(directionUpper, " > ", " < ")) - } - - if (!is.null(object[["thetaH0"]])) { - thetaH0 <- round(object$thetaH0, 3) - } else { - thetaH0 <- ifelse(settings$survivalEnabled, 1, 0) - } - - treatmentArmIndex <- ifelse(settings$groups > 1, "(i)", "(treatment)") - controlArmIndex <- ifelse(settings$groups > 1, "(i)", "(control)") - - if (settings$multiArmEnabled || settings$enrichmentEnabled) { - if ((settings$survivalEnabled) && (settings$multiArmEnabled)) { - treatmentArmIndex <- "(i)" - controlArmIndex <- "" - } else if ((settings$survivalEnabled) && (settings$enrichmentEnabled)) { - treatmentArmIndex <- "" - controlArmIndex <- "" - } else if (settings$groups == 1) { - treatmentArmIndex <- "(treatment)" - controlArmIndex <- "(control)" - } else { - if (settings$enrichmentEnabled) { - treatmentArmIndex <- "(treatment)" - } else { - treatmentArmIndex <- "(i)" - } - controlArmIndex <- "(control)" - } - } else { - if (settings$groups == 1 || settings$survivalEnabled) { - treatmentArmIndex <- "" - controlArmIndex <- "" - } else { - treatmentArmIndex <- "(1)" - controlArmIndex <- "(2)" - } - } - - value <- "?" - if (settings$meansEnabled) { - value <- "mu" - } else if (settings$ratesEnabled) { - value <- "pi" - } else if (settings$survivalEnabled) { - value <- "hazard ratio" - } - - calcSep <- ifelse(settings$ratioEnabled, " / ", " - ") - hypothesis <- "" - if (!settings$survivalEnabled && (settings$multiArmEnabled || settings$enrichmentEnabled || settings$groups == 2)) { - hypothesis <- paste0( - hypothesis, "H0: ", value, treatmentArmIndex, - calcSep, value, controlArmIndex, comparisonH0, thetaH0 - ) - if (!is.na(comparisonH1)) { - hypothesis <- paste0(hypothesis, " against ") - hypothesis <- paste0( - hypothesis, "H1: ", value, treatmentArmIndex, - calcSep, value, controlArmIndex, comparisonH1, thetaH0 - ) - } - } else { - hypothesis <- paste0(hypothesis, "H0: ", value, treatmentArmIndex, comparisonH0, thetaH0) - if (!is.na(comparisonH1)) { - hypothesis <- paste0(hypothesis, " against ") - hypothesis <- paste0(hypothesis, "H1: ", value, treatmentArmIndex, comparisonH1, thetaH0) - } - } - hypothesis <- .concatenateSummaryText( - hypothesis, - .createSummaryHypothesisPowerDirectionText(object, sided, directionUpper) - ) - return(hypothesis) -} - -.createSummaryHypothesisPowerDirectionText <- function(object, sided, directionUpper) { - if (sided == 2 || is.null(directionUpper)) { - return("") - } - - directionUpper <- unique(directionUpper) - if (length(directionUpper) != 1) { - return("") - } - - if (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) { - return("") - } - - if (.isTrialDesignPlan(object) && object$.objectType != "power") { - return("") - } - - if (directionUpper) { - return("power directed towards larger values") - } else { - return("power directed towards smaller values") - } -} - -.addSummaryLineBreak <- function(text, newLineLength) { - maxLineLength <- as.integer(getOption("rpact.summary.width", 83)) - lines <- strsplit(text, "\n", fixed = TRUE)[[1]] - lastLine <- lines[length(lines)] - if (nchar(lastLine) + newLineLength > maxLineLength) { - text <- paste0(text, "\n") - } - return(text) -} - -.concatenateSummaryText <- function(a, b, sep = ", ") { - .assertIsSingleCharacter(a, "a") - .assertIsSingleCharacter(b, "b") - if (is.na(b) || nchar(trimws(b)) == 0) { - return(a) - } - - if (a == "") { - return(b) - } - - a <- paste0(a, sep) - a <- .addSummaryLineBreak(a, nchar(b)) - return(paste0(a, b)) -} - -.createSummaryHeaderObject <- function(object, summaryFactory, digits = NA_integer_) { - if (inherits(object, "TrialDesignCharacteristics")) { - return(.createSummaryHeaderDesign(object$.design, NULL, summaryFactory)) - } - - if (.isTrialDesignPlan(object) || (inherits(object, "SimulationResults") || inherits(object, "SimulationResultsR6"))) { - return(.createSummaryHeaderDesign(object$.design, object, summaryFactory)) - } - - if (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) { - return(.createSummaryHeaderAnalysisResults(object$.design, object, summaryFactory, digits)) - } - - if (.isTrialDesign(object)) { - return(.createSummaryHeaderDesign(object, NULL, summaryFactory)) - } - - return("") -} - -.addAllocationRatioToHeader <- function(parameterSet, header, sep = ", ") { - if (!.isTrialDesignPlanSurvival(parameterSet) && !grepl("Simulation", .getClassName(parameterSet))) { - numberOfGroups <- 1 - if (inherits(parameterSet, "TrialDesignPlan") || inherits(parameterSet, "TrialDesignPlanR6")) { - numberOfGroups <- parameterSet$groups - } else if (inherits(parameterSet, "AnalysisResults") || inherits(parameterSet, "AnalysisResultsR6")) { - numberOfGroups <- parameterSet$.dataInput$getNumberOfGroups() - } - if (numberOfGroups == 1) { - return(header) - } - } - - prefix <- "" - if (!is.null(parameterSet[["optimumAllocationRatio"]]) && - length(parameterSet$optimumAllocationRatio) == 1 && - parameterSet$optimumAllocationRatio) { - if (length(unique(parameterSet$allocationRatioPlanned)) > 1) { - return(.concatenateSummaryText(header, "optimum planned allocation ratio", sep = sep)) - } - prefix <- "optimum " - } - - allocationRatioPlanned <- round(unique(parameterSet$allocationRatioPlanned), 3) - if (identical(allocationRatioPlanned, 1) && prefix == "") { - return(header) - } - - if (!all(is.na(allocationRatioPlanned))) { - return(.concatenateSummaryText(header, - paste0( - prefix, "planned allocation ratio = ", - .arrayToString(allocationRatioPlanned, vectorLookAndFeelEnabled = length(allocationRatioPlanned) > 1) - ), - sep = sep - )) - } else { - return(header) - } -} - -.createSummaryHeaderAnalysisResults <- function(design, analysisResults, summaryFactory, digits) { - digitSettings <- .getSummaryDigits(digits) - digitsGeneral <- digitSettings$digitsGeneral - - stageResults <- analysisResults$.stageResults - dataInput <- analysisResults$.dataInput - - multiArmEnabled <- .isMultiArmAnalysisResults(analysisResults) - enrichmentEnabled <- .isEnrichmentAnalysisResults(analysisResults) - multiHypothesesEnabled <- .isMultiHypothesesAnalysisResults(analysisResults) - - header <- "" - if (design$kMax == 1) { - header <- paste0(header, "Fixed sample analysis.") - } else { - header <- paste0(header, "Sequential analysis with ", design$kMax, " looks") - header <- .concatenateSummaryText(header, - paste0("(", design$.toString(startWithUpperCase = FALSE), ")."), - sep = " " - ) - } - header <- paste0(header, "\n") - - header <- paste0(header, "The results were calculated using a ") - if (stageResults$isDatasetMeans()) { - if (dataInput$getNumberOfGroups() == 1) { - header <- paste0(header, "one-sample t-test") - } else if (dataInput$getNumberOfGroups() == 2) { - header <- paste0(header, "two-sample t-test") - } else { - header <- paste0(header, "multi-arm t-test") - } - } else if (stageResults$isDatasetRates()) { - if (dataInput$getNumberOfGroups() == 1) { - header <- paste0(header, "one-sample test for rates") - } else if (dataInput$getNumberOfGroups() == 2) { - header <- paste0(header, "two-sample test for rates") - } else { - header <- paste0(header, "multi-arm test for rates") - } - } else if (stageResults$isDatasetSurvival()) { - if (dataInput$getNumberOfGroups() == 2) { - header <- paste0(header, "two-sample logrank test") - } else { - header <- paste0(header, "multi-arm logrank test") - } - } - - 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") - } else if (stageResults$intersectionTest == "Bonferroni") { - header <- .concatenateSummaryText(header, "Bonferroni intersection test") - } else if (stageResults$intersectionTest == "Simes") { - header <- .concatenateSummaryText(header, "Simes intersection test") - } else if (stageResults$intersectionTest == "Sidak") { - header <- .concatenateSummaryText(header, "Sidak intersection test") - } else if (stageResults$intersectionTest == "Hierarchical") { - header <- .concatenateSummaryText(header, "Hierarchical intersection test") - } else if (stageResults$intersectionTest == "SpiessensDebois") { - header <- .concatenateSummaryText(header, "Spiessens and Debois intersection test") - } - } - - if (!is.null(stageResults[["normalApproximation"]]) && stageResults$normalApproximation) { - header <- .concatenateSummaryText(header, "normal approximation test") - } else if (stageResults$isDatasetRates()) { - if (dataInput$getNumberOfGroups() == 1) { - header <- .concatenateSummaryText(header, "exact test") - } else { - header <- .concatenateSummaryText(header, "exact test of Fisher") - } - } else { - # header <- .concatenateSummaryText(header, "exact t test") - } - - if (stageResults$isDatasetMeans() && multiHypothesesEnabled) { - if (stageResults$varianceOption == "overallPooled") { - header <- .concatenateSummaryText(header, "overall pooled variances option") - } else if (stageResults$varianceOption == "pairwisePooled") { - header <- .concatenateSummaryText(header, "pairwise pooled variances option") - } else if (stageResults$varianceOption == "pooledFromFull") { - header <- .concatenateSummaryText(header, "pooled from full population variances option") - } else if (stageResults$varianceOption == "pooled") { - header <- .concatenateSummaryText(header, "pooled variances option") - } else if (stageResults$varianceOption == "notPooled") { - header <- .concatenateSummaryText(header, "not pooled variances option") - } - } - - if ((inherits(stageResults, "StageResultsMeans") || inherits(stageResults, "StageResultsMeansR6")) && (dataInput$getNumberOfGroups() == 2)) { - if (stageResults$equalVariances) { - header <- .concatenateSummaryText(header, "equal variances option") - } else { - header <- .concatenateSummaryText(header, "unequal variances option") - } - } - - if (.isTrialDesignConditionalDunnett(design)) { - if (design$secondStageConditioning) { - header <- .concatenateSummaryText(header, "conditional second stage p-values") - } else { - header <- .concatenateSummaryText(header, "unconditional second stage p-values") - } - } - - if (enrichmentEnabled) { - header <- .concatenateSummaryText(header, paste0( - ifelse(analysisResults$stratifiedAnalysis, "", "non-"), "stratified analysis" - )) - } - - header <- paste0(header, ".\n", .createSummaryHypothesisText(analysisResults, summaryFactory)) - - if (stageResults$isDatasetMeans()) { - header <- .getSummaryHeaderEntryAnalysisResults(header, analysisResults, - paramName1 = "thetaH1", - paramName2 = ifelse(multiHypothesesEnabled, "assumedStDevs", "assumedStDev"), - paramCaption1 = "assumed effect", - paramCaption2 = "assumed standard deviation", - shortcut1 = "thetaH1", - shortcut2 = "sd", - digits1 = digitsGeneral, - digits2 = digitsGeneral - ) - } else if (stageResults$isDatasetRates()) { - header <- .getSummaryHeaderEntryAnalysisResults(header, analysisResults, - paramName1 = ifelse(enrichmentEnabled, "piTreatments", ifelse(multiArmEnabled, "piTreatments", "pi1")), - paramName2 = ifelse(enrichmentEnabled, "piControls", ifelse(multiArmEnabled, "piControl", "pi2")), - paramCaption1 = "assumed treatment rate", - paramCaption2 = "assumed control rate", - shortcut1 = "pi", - shortcut2 = "pi" - ) - } else if (stageResults$isDatasetSurvival()) { - header <- .getSummaryHeaderEntryAnalysisResults(header, analysisResults, - paramName1 = "thetaH1", - paramCaption1 = "assumed effect", - shortcut1 = "thetaH1", - digits1 = digitsGeneral - ) - } - - header <- paste0(header, ".") - return(header) -} - -.getSummaryHeaderEntryValueAnalysisResults <- function(shortcut, value, analysisResults) { - if (is.matrix(value)) { - stage <- analysisResults$.stageResults$stage - if (stage <= ncol(value)) { - value <- value[, stage] - } - } - - value[!is.na(value)] <- round(value[!is.na(value)], 2) - - if ((is.matrix(value) && nrow(value) > 1) || length(value) > 1) { - treatmentNames <- 1:length(value) - if (.isEnrichmentAnalysisResults(analysisResults)) { - populations <- paste0("S", treatmentNames) - gMax <- analysisResults$.stageResults$getGMax() - populations[treatmentNames == gMax] <- "F" - treatmentNames <- populations - } - value <- paste0(paste(paste0(shortcut, "(", treatmentNames, ") = ", value)), collapse = ", ") - } - return(value) -} - -.getSummaryHeaderEntryAnalysisResults <- function(header, analysisResults, ..., - paramName1, paramName2 = NA_character_, - paramCaption1, paramCaption2 = NA_character_, - shortcut1, shortcut2 = NA_character_, - digits1 = 2, digits2 = 2) { - if (analysisResults$.design$kMax == 1) { - return(header) - } - - if (length(analysisResults$nPlanned) == 0 || all(is.na(analysisResults$nPlanned))) { - return(header) - } - - paramValue1 <- analysisResults[[paramName1]] - case1 <- analysisResults$.getParameterType(paramName1) != C_PARAM_NOT_APPLICABLE && - !all(is.na(paramValue1)) - if (!is.na(paramCaption1) && analysisResults$.getParameterType(paramName1) == C_PARAM_GENERATED) { - paramCaption1 <- sub("assumed ", "overall ", paramCaption1) - } - - case2 <- FALSE - if (!is.na(paramName2)) { - paramValue2 <- analysisResults[[paramName2]] - case2 <- analysisResults$.getParameterType(paramName2) != C_PARAM_NOT_APPLICABLE && - !all(is.na(paramValue2)) - if (!is.na(paramCaption2) && analysisResults$.getParameterType(paramName2) == C_PARAM_GENERATED) { - paramCaption2 <- sub("assumed ", "overall ", paramCaption2) - } - } - - if (!case1 && !case2) { - return(header) - } - - if (.isTrialDesignFisher(analysisResults$.design) && - length(analysisResults$nPlanned[!is.na(analysisResults$nPlanned)]) > 1) { - header <- .concatenateSummaryText(header, paste0( - "The conditional power simulation with planned sample size and ", - analysisResults$iterations, " iterations is based on" - ), sep = ". ") - } else { - header <- .concatenateSummaryText(header, - "The conditional power calculation with planned sample size is based on", - sep = ". " - ) - } - - header <- .addAllocationRatioToHeader(analysisResults, header, sep = " ") - - sepPrefix <- ifelse(length(analysisResults$allocationRatioPlanned) == 0 || - identical(unique(analysisResults$allocationRatioPlanned), 1), "", ",") - - if (case1) { - if (!any(is.na(paramValue1)) && length(unique(paramValue1)) == 1) { - paramValue1 <- paramValue1[1] - } - if (length(paramValue1) == 1) { - header <- .concatenateSummaryText(header, - paste0(paramCaption1, " = ", ifelse(is.na(paramValue1), paramValue1, round(paramValue1, digits1))), - sep = paste0(sepPrefix, " ") - ) - } else { - header <- .concatenateSummaryText(header, - paste0(paramCaption1, ": ", .getSummaryHeaderEntryValueAnalysisResults( - shortcut1, paramValue1, analysisResults - )), - sep = paste0(sepPrefix, " ") - ) - } - } - - if (case2) { - if (length(paramValue2) == 1) { - header <- .concatenateSummaryText(header, - paste0(paramCaption2, " = ", ifelse(is.na(paramValue2), paramValue2, round(paramValue2, digits2))), - sep = ifelse(case1, paste0(sepPrefix, " and "), " ") - ) - } else { - header <- .concatenateSummaryText(header, - paste0(paramCaption2, ": ", .getSummaryHeaderEntryValueAnalysisResults( - shortcut2, paramValue2, analysisResults - )), - sep = ifelse(case1, paste0(sepPrefix, " and "), " ") - ) - } - } - return(header) -} - -.addEnrichmentEffectListToHeader <- function(header, designPlan) { - if (!grepl("SimulationResultsEnrichment", .getClassName(designPlan)) || - is.null(designPlan[["effectList"]])) { - return(header) - } - - - subGroups <- designPlan$effectList$subGroups - header <- .concatenateSummaryText(header, paste0( - "subgroup", - ifelse(length(subGroups) != 1, "s", ""), - " = ", - .arrayToString(subGroups, vectorLookAndFeelEnabled = TRUE) - )) - - prevalences <- designPlan$effectList$prevalences - header <- .concatenateSummaryText(header, paste0( - "prevalence", - ifelse(length(prevalences) != 1, "s", ""), - " = ", - .arrayToString(round(prevalences, 3), vectorLookAndFeelEnabled = TRUE) - )) - - if (!is.null(designPlan$effectList[["piControls"]])) { - piControls <- designPlan$effectList$piControls - if (length(piControls) > 0) { - if (length(unique(piControls)) == 1) { - piControls <- piControls[1] - } - controlRateText <- paste0( - "control rate", ifelse(length(piControls) == 1, "", "s"), " pi(control) = ", - .arrayToString(round(piControls, 3), vectorLookAndFeelEnabled = (length(unique(piControls)) > 1)) - ) - header <- .concatenateSummaryText(header, controlRateText) - } - } - - return(header) -} - -.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" - } else { - designType <- C_TYPE_OF_DESIGN_LIST[[design$typeOfDesign]] - } - header <- .firstCharacterToUpperCase(designType) - header <- paste0(header, " design") - if (design$.isDelayedResponseDesign()) { - header <- paste0(header, " with delayed response") - } - if (design$kMax > 1 && .isTrialDesignInverseNormalOrGroupSequential(design)) { - if (design$typeOfDesign == C_TYPE_OF_DESIGN_WT) { - header <- .concatenateSummaryText(header, - paste0("(deltaWT = ", round(design$deltaWT, 3), ")"), - sep = " " - ) - } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_WT_OPTIMUM) { - header <- .concatenateSummaryText(header, - paste0("(", design$optimizationCriterion, ", deltaWT = ", round(design$deltaWT, 3), ")"), - sep = " " - ) - } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_PT) { - header <- .concatenateSummaryText(header, - paste0("(deltaPT1 = ", round(design$deltaPT1, 3), ""), - sep = " " - ) - header <- .concatenateSummaryText(header, - paste0("deltaPT0 = ", round(design$deltaPT0, 3), ")"), - sep = ", " - ) - } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_HP) { - header <- .concatenateSummaryText(header, - paste0("(constant bounds = ", round(design$constantBoundsHP, 3), ")"), - sep = " " - ) - } else if (design$typeOfDesign %in% c(C_TYPE_OF_DESIGN_AS_KD, C_TYPE_OF_DESIGN_AS_HSD)) { - header <- .concatenateSummaryText(header, - paste0("(gammaA = ", round(design$gammaA, 3), ")"), - sep = " " - ) - } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_AS_USER) { - header <- .concatenateSummaryText(header, - paste0("(", .arrayToString(round(design$userAlphaSpending, 3)), ")"), - sep = " " - ) - } - - if (grepl("^as", design$typeOfDesign) && design$typeBetaSpending != C_TYPE_OF_DESIGN_BS_NONE) { - typeBetaSpending <- C_TYPE_OF_DESIGN_BS_LIST[[design$typeBetaSpending]] - header <- .concatenateSummaryText(header, typeBetaSpending, sep = " and ") - if (design$typeBetaSpending %in% c(C_TYPE_OF_DESIGN_BS_KD, C_TYPE_OF_DESIGN_BS_HSD)) { - header <- .concatenateSummaryText(header, - paste0("(gammaB = ", round(design$gammaB, 3), ")"), - sep = " " - ) - } else if (design$typeBetaSpending == C_TYPE_OF_DESIGN_BS_USER) { - header <- .concatenateSummaryText(header, - paste0("(", .arrayToString(round(design$userBetaSpending, 3)), ")"), - sep = " " - ) - } - } - } - if (!.isDelayedInformationEnabled(design = design) && - ((.isTrialDesignInverseNormalOrGroupSequential(design) && any(design$futilityBounds > -6, na.rm = TRUE)) || - (.isTrialDesignFisher(design) && any(design$alpha0Vec < 1)))) { - header <- .concatenateSummaryText( - header, - 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 <- .concatenateSummaryText(header, "undefined endpoint") - - if (design$kMax > 1 && .isTrialDesignInverseNormalOrGroupSequential(design)) { - outputSize <- getOption("rpact.summary.output.size", C_SUMMARY_OUTPUT_SIZE_DEFAULT) - designCharacteristics <- NULL - tryCatch( - { - designCharacteristics <- getDesignCharacteristics(design) - }, - error = function(e) { - .logError("Cannot add design characteristics to summary: ", e$message) - } - ) - if (!is.null(designCharacteristics)) { - header <- .concatenateSummaryText( - header, - paste0("inflation factor ", round(designCharacteristics$inflationFactor, 4)) - ) - if (outputSize == "large") { - header <- .concatenateSummaryText( - header, - paste0("ASN H1 ", round(designCharacteristics$averageSampleNumber1, 4)) - ) - header <- .concatenateSummaryText( - header, - paste0("ASN H01 ", round(designCharacteristics$averageSampleNumber01, 4)) - ) - header <- .concatenateSummaryText( - header, - paste0("ASN H0 ", round(designCharacteristics$averageSampleNumber0, 4)) - ) - } - } - } - - header <- paste0(header, ".") - return(header) - } - - header <- "" - if (design$kMax == 1) { - 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 ", "") - header <- .concatenateSummaryText(header, - paste0("(", prefix, design$.toString(startWithUpperCase = FALSE), ")"), - 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 <- paste0(header, "\n") - - header <- paste0(header, "The ", ifelse((inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")) || - designPlan$.isPowerObject(), "results were ", "sample size was ")) - header <- paste0(header, ifelse(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6"), "simulated", "calculated")) - header <- paste0(header, " for a ") - settings <- .getSummaryObjectSettings(designPlan) - if (settings$meansEnabled) { - if (settings$multiArmEnabled && settings$groups > 1) { - header <- .concatenateSummaryText(header, "multi-arm comparisons for means", sep = "") - } else if (settings$enrichmentEnabled && settings$populations > 1) { - header <- .concatenateSummaryText(header, "population enrichment comparisons for means", sep = "") - } else if (settings$groups == 1 && !settings$multiArmEnabled) { - header <- .concatenateSummaryText(header, "one-sample t-test", sep = "") - } else if (settings$groups == 2 || settings$multiArmEnabled) { - header <- .concatenateSummaryText(header, "two-sample t-test", sep = "") - } - } else if (settings$ratesEnabled) { - if (settings$multiArmEnabled && settings$groups > 1) { - header <- .concatenateSummaryText(header, "multi-arm comparisons for rates", sep = "") - } else if (settings$enrichmentEnabled && settings$populations > 1) { - header <- .concatenateSummaryText(header, "population enrichment comparisons for rates", sep = "") - } else if (settings$groups == 1 && !settings$multiArmEnabled) { - header <- .concatenateSummaryText(header, "one-sample test for rates", sep = "") - } else if (settings$groups == 2 || settings$multiArmEnabled) { - header <- .concatenateSummaryText(header, "two-sample test for rates", sep = "") - } - } else if (settings$survivalEnabled) { - if (settings$multiArmEnabled && settings$groups > 1) { - header <- .concatenateSummaryText(header, "multi-arm logrank test", sep = "") - } else if (settings$enrichmentEnabled && settings$populations > 1) { - header <- .concatenateSummaryText(header, "population enrichment logrank test", sep = "") - } else if (settings$groups == 2 || settings$multiArmEnabled) { - header <- .concatenateSummaryText(header, "two-sample logrank test", sep = "") - } - } - - part <- "" - if (settings$multiArmEnabled && settings$groups > 1) { - part <- .concatenateSummaryText(part, paste0(settings$groups, " treatments vs. control")) - } else if (settings$enrichmentEnabled) { - if (settings$groups == 2) { - part <- .concatenateSummaryText(part, "treatment vs. control") - } else if (settings$groups > 2) { - part <- .concatenateSummaryText(part, paste0(settings$groups, " treatments vs. control")) - } - part <- .concatenateSummaryText(part, paste0( - settings$populations, " population", - ifelse(settings$populations == 1, "", "s") - )) - } - if (!is.null(designPlan) && (.isTrialDesignPlan(designPlan) || (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6"))) && - !settings$multiArmEnabled && !settings$enrichmentEnabled && !settings$survivalEnabled) { - if (settings$ratesEnabled) { - if (settings$groups == 1) { - part <- .concatenateSummaryText(part, ifelse(designPlan$normalApproximation, - "normal approximation", "exact test" - )) - } else { - part <- .concatenateSummaryText(part, ifelse(designPlan$normalApproximation, - "normal approximation", "exact test of Fisher" - )) - } - } else if (designPlan$normalApproximation) { - part <- .concatenateSummaryText(part, "normal approximation") - } - } - if (part != "") { - header <- .concatenateSummaryText(header, paste0("(", part, ")"), sep = " ") - } - if (settings$meansEnabled && (.isTrialDesignInverseNormalOrGroupSequential(design) || - (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")))) { - header <- .concatenateSummaryText(header, .createSummaryHypothesisText(designPlan, summaryFactory)) - if (!is.null(designPlan[["alternative"]]) && length(designPlan$alternative) == 1) { - alternativeText <- paste0("H1: effect = ", round(designPlan$alternative, 3)) - } else if (!is.null(designPlan[["muMaxVector"]]) && length(designPlan$muMaxVector) == 1) { - alternativeText <- paste0("H1: mu_max = ", round(designPlan$muMaxVector, 3)) - } else if (!is.null(designPlan[["effectList"]]) && !is.null(designPlan$effectList[["effects"]]) && - isTRUE(nrow(designPlan$effectList$effects) == 1)) { - alternativeText <- paste0( - "H1: effects = ", - .arrayToString(designPlan$effectList$effects, mode = "vector") - ) - } else { - alternativeText <- "H1: effect as specified" - } - header <- .concatenateSummaryText(header, alternativeText) - - header <- .addEnrichmentEffectListToHeader(header, designPlan) - - if (grepl("SimulationResultsEnrichment", .getClassName(designPlan))) { - stDevs <- designPlan$effectList$stDevs - if (length(unique(stDevs)) == 1) { - stDevs <- unique(stDevs) - } - s <- ifelse(length(stDevs) != 1, "s", "") - stDevCaption <- ifelse(.isRatioComparisonEnabled(designPlan), - paste0("coefficient", s, " of variation"), - paste0("standard deviation", s) - ) - header <- .concatenateSummaryText(header, paste0( - stDevCaption, " = ", - .arrayToString(round(stDevs, 3), vectorLookAndFeelEnabled = TRUE) - )) - } else { - stDevCaption <- ifelse(.isRatioComparisonEnabled(designPlan), "coefficient of variation", "standard deviation") - header <- .concatenateSummaryText(header, paste0(stDevCaption, " = ", round(designPlan$stDev, 3))) - } - header <- .addAdditionalArgumentsToHeader(header, designPlan, settings) - } else if (settings$ratesEnabled && (.isTrialDesignInverseNormalOrGroupSequential(design) || - (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")))) { - if (settings$groups == 1) { - if (!is.null(designPlan[["pi1"]]) && length(designPlan$pi1) == 1) { - treatmentRateText <- paste0("H1: treatment rate pi = ", round(designPlan$pi1, 3)) - } else { - treatmentRateText <- "H1: treatment rate pi as specified" - } - - header <- paste0(header, ",\n", .createSummaryHypothesisText(designPlan, summaryFactory)) - header <- .concatenateSummaryText(header, treatmentRateText) - header <- .addAdditionalArgumentsToHeader(header, designPlan, settings) - } else { - if (!is.null(designPlan[["pi1"]]) && length(designPlan$pi1) == 1) { - treatmentRateText <- paste0("H1: treatment rate pi(1) = ", round(designPlan$pi1, 3)) - } else if (!is.null(designPlan[["piMaxVector"]]) && length(designPlan$piMaxVector) == 1) { - treatmentRateText <- paste0( - "H1: treatment rate pi_max = ", - .arrayToString(round(designPlan$piMaxVector, 3), vectorLookAndFeelEnabled = TRUE) - ) - } else if (settings$enrichmentEnabled && !is.null(designPlan[["effectList"]]) && - !is.null(designPlan$effectList[["piTreatments"]])) { - piTreatments <- designPlan$effectList[["piTreatments"]] - if (is.matrix(piTreatments) && nrow(piTreatments) == 1) { - treatmentRateText <- paste0( - "H1: assumed treatment rate pi(treatment) = ", - .arrayToString(round(designPlan$effectList$piTreatments, 3), vectorLookAndFeelEnabled = TRUE) - ) - } else { - treatmentRateText <- paste0("H1: assumed treatment rate pi(treatment) as specified") - } - } else { - treatmentRateText <- paste0( - "H1: treatment rate pi", - ifelse(settings$multiArmEnabled, "_max", "(1)"), " as specified" - ) - } - - controlRateText <- NA_character_ - if (settings$multiArmEnabled && !is.null(designPlan[["piControl"]])) { - controlRateText <- paste0("control rate pi(control) = ", round(designPlan$piControl, 3)) - } else if (settings$enrichmentEnabled && !is.null(designPlan[["piControls"]])) { - controlRateText <- paste0( - "control rates pi(control) = ", - .arrayToString(round(designPlan$piControls, 3), vectorLookAndFeelEnabled = TRUE) - ) - } else if (settings$enrichmentEnabled && !is.null(designPlan[["effectList"]]) && - !is.null(designPlan$effectList[["piControls"]])) { - # controlRateText will be created in .addEnrichmentEffectListToHeader() - } else if (!is.null(designPlan[["pi2"]])) { - controlRateText <- paste0("control rate pi(2) = ", round(designPlan$pi2, 3)) - } else { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to identify case to build ", sQuote("controlRateText")) - } - header <- paste0(header, ",\n", .createSummaryHypothesisText(designPlan, summaryFactory)) - header <- .concatenateSummaryText(header, treatmentRateText) - if (!is.na(controlRateText)) { - header <- .concatenateSummaryText(header, controlRateText) - } - header <- .addEnrichmentEffectListToHeader(header, designPlan) - header <- .addAdditionalArgumentsToHeader(header, designPlan, settings) - } - } else if (settings$survivalEnabled && (.isTrialDesignInverseNormalOrGroupSequential(design) || - (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")))) { - parameterNames <- designPlan$.getVisibleFieldNamesOrdered() - numberOfVariants <- .getMultidimensionalNumberOfVariants(designPlan, parameterNames) - - if (grepl("SimulationResultsEnrichment", .getClassName(designPlan))) { - userDefinedParam <- "hazardRatios" - paramName <- "hazard ratios" - paramValue <- designPlan$effectList$hazardRatios - } else { - userDefinedParam <- "pi1" - for (param in c("pi1", "lambda1", "median1", "hazardRatio")) { - if (designPlan$.getParameterType(param) == C_PARAM_USER_DEFINED && - length(designPlan[[param]]) == numberOfVariants) { - userDefinedParam <- param - } - } - paramValue <- designPlan[[userDefinedParam]] - - if (is.null(paramValue) || length(paramValue) == 0 || all(is.na(paramValue))) { - userDefinedParam <- "hazardRatio" - } - paramName <- "treatment pi(1)" - if (userDefinedParam == "lambda1") { - paramName <- "treatment lambda(1)" - } else if (userDefinedParam == "median1") { - paramName <- "treatment median(1)" - } else if (userDefinedParam == "hazardRatio") { - paramName <- ifelse(grepl("SimulationResultsMultiArm", .getClassName(designPlan)), "omega_max", "hazard ratio") - } - } - - if (length(designPlan[[userDefinedParam]]) == 1) { - treatmentRateText <- paste0("H1: ", paramName, " = ", round(designPlan[[userDefinedParam]], 3)) - } else if (!is.null(designPlan[["omegaMaxVector"]]) && length(designPlan$omegaMaxVector) == 1) { - treatmentRateText <- paste0("H1: omega_max = ", round(designPlan$omegaMaxVector, 3)) - } else if (!is.null(designPlan[["hazardRatio"]]) && (length(designPlan$hazardRatio) == 1) || - ((inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")) && !is.null(designPlan[[".piecewiseSurvivalTime"]]) && - designPlan$.piecewiseSurvivalTime$piecewiseSurvivalEnabled)) { - treatmentRateText <- paste0( - "H1: hazard ratio = ", - .arrayToString(round(designPlan$hazardRatio, 3), vectorLookAndFeelEnabled = TRUE) - ) - } else if (settings$enrichmentEnabled && !is.null(designPlan[["effectList"]]) && - !is.null(designPlan$effectList[["hazardRatios"]]) && - is.matrix(designPlan$effectList$hazardRatios) && - nrow(designPlan$effectList$hazardRatios) == 1) { - treatmentRateText <- paste0( - "H1: hazard ratios = ", - .arrayToString(round(designPlan$effectList$hazardRatios, 3), vectorLookAndFeelEnabled = TRUE) - ) - } else { - treatmentRateText <- paste0("H1: ", paramName, " as specified") - } - if (userDefinedParam %in% c("hazardRatio", "pi1") && - (designPlan$.getParameterType("pi2") == C_PARAM_USER_DEFINED || - designPlan$.getParameterType("pi2") == C_PARAM_DEFAULT_VALUE) && - length(designPlan$pi2) == 1) { - treatmentRateText <- paste0(treatmentRateText, ", control pi(2) = ", round(designPlan$pi2, 3)) - } else if (userDefinedParam %in% c("hazardRatio", "lambda1") && - (designPlan$.getParameterType("lambda2") == C_PARAM_USER_DEFINED || - designPlan$.getParameterType("lambda2") == C_PARAM_DEFAULT_VALUE) && - length(designPlan$lambda2) == 1) { - treatmentRateText <- paste0(treatmentRateText, ", control lambda(2) = ", round(designPlan$lambda2, 3)) - } else if (userDefinedParam %in% c("hazardRatio", "median1") && - (designPlan$.getParameterType("median2") == C_PARAM_USER_DEFINED || - designPlan$.getParameterType("median2") == C_PARAM_GENERATED) && - length(designPlan$median2) == 1) { - treatmentRateText <- paste0(treatmentRateText, ", control median(2) = ", round(designPlan$median2, 3)) - } else if (!is.null(designPlan[[".piecewiseSurvivalTime"]]) && - designPlan$.piecewiseSurvivalTime$piecewiseSurvivalEnabled) { - treatmentRateText <- paste0(treatmentRateText, ", piecewise survival distribution") - treatmentRateText <- paste0( - treatmentRateText, ", \n", - "piecewise survival time = ", .arrayToString(round(designPlan$piecewiseSurvivalTime, 4), vectorLookAndFeelEnabled = TRUE), ", \n", - "control lambda(2) = ", .arrayToString(round(designPlan$lambda2, 4), vectorLookAndFeelEnabled = TRUE) - ) - } - header <- paste0(header, ", \n", .createSummaryHypothesisText(designPlan, summaryFactory)) - header <- .concatenateSummaryText(header, treatmentRateText) - header <- .addEnrichmentEffectListToHeader(header, designPlan) - header <- .addAdditionalArgumentsToHeader(header, designPlan, settings) - } - if (!(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")) && designPlan$.isSampleSizeObject()) { - header <- .concatenateSummaryText(header, paste0("power ", round(100 * (1 - design$beta), 1), "%")) - } - - - if (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")) { - header <- .concatenateSummaryText(header, paste0("simulation runs = ", designPlan$maxNumberOfIterations)) - header <- .concatenateSummaryText(header, paste0("seed = ", designPlan$seed)) - } - header <- paste0(header, ".") - return(header) -} - -.addAdditionalArgumentsToHeader <- function(header, designPlan, settings) { - if (designPlan$.design$kMax > 1) { - if (settings$survivalEnabled) { - if (!is.null(designPlan[["plannedEvents"]])) { - header <- .concatenateSummaryText(header, paste0( - "planned cumulative events = ", - .arrayToString(designPlan$plannedEvents, - vectorLookAndFeelEnabled = (length(designPlan$plannedEvents) > 1) - ) - )) - } - } else { - if (!is.null(designPlan[["plannedSubjects"]])) { - header <- .concatenateSummaryText(header, paste0( - "planned cumulative sample size = ", - .arrayToString(designPlan$plannedSubjects, - vectorLookAndFeelEnabled = (length(designPlan$plannedSubjects) > 1) - ) - )) - } - } - - if (!is.null(designPlan[["maxNumberOfSubjects"]]) && - designPlan$.getParameterType("maxNumberOfSubjects") == C_PARAM_USER_DEFINED) { - header <- .concatenateSummaryText(header, paste0( - "maximum number of subjects = ", - ceiling(designPlan$maxNumberOfSubjects[1]) - )) - } - - if (settings$survivalEnabled) { - if (!is.null(designPlan[["maxNumberOfEvents"]]) && - designPlan$.getParameterType("maxNumberOfEvents") == C_PARAM_USER_DEFINED) { - header <- .concatenateSummaryText(header, paste0( - "maximum number of events = ", - ceiling(designPlan$maxNumberOfEvents[1]) - )) - } - } - } else { - if (settings$survivalEnabled) { - if (!is.null(designPlan[["plannedEvents"]])) { - header <- .concatenateSummaryText(header, paste0( - "planned events = ", - .arrayToString(designPlan$plannedEvents, - vectorLookAndFeelEnabled = (length(designPlan$plannedEvents) > 1) - ) - )) - } - } else { - if (!is.null(designPlan[["plannedSubjects"]])) { - header <- .concatenateSummaryText(header, paste0( - "planned sample size = ", - .arrayToString(designPlan$plannedSubjects, - vectorLookAndFeelEnabled = (length(designPlan$plannedSubjects) > 1) - ) - )) - } - } - - if (!is.null(designPlan[["maxNumberOfSubjects"]]) && - designPlan$.getParameterType("maxNumberOfSubjects") == C_PARAM_USER_DEFINED) { - header <- .concatenateSummaryText(header, paste0( - "number of subjects = ", - ceiling(designPlan$maxNumberOfSubjects[1]) - )) - } - - if (settings$survivalEnabled) { - if (!is.null(designPlan[["maxNumberOfEvents"]]) && - designPlan$.getParameterType("maxNumberOfEvents") == C_PARAM_USER_DEFINED) { - header <- .concatenateSummaryText(header, paste0( - "number of events = ", - designPlan$maxNumberOfEvents[1] - )) - } - } - } - - header <- .addAllocationRatioToHeader(designPlan, header) - - if (settings$survivalEnabled) { - if (!is.null(designPlan[["eventTime"]]) && !is.na(designPlan[["eventTime"]])) { - header <- .concatenateSummaryText(header, paste0( - "event time = ", - .arrayToString(designPlan$eventTime, - vectorLookAndFeelEnabled = (length(designPlan$eventTime) > 1) - ) - )) - } - if (!is.null(designPlan[["accrualTime"]])) { - header <- .concatenateSummaryText(header, paste0( - "accrual time = ", - .arrayToString(designPlan$accrualTime, - vectorLookAndFeelEnabled = (length(designPlan$accrualTime) > 1) - ) - )) - } - if (!is.null(designPlan[["accrualTime"]]) && - length(designPlan$accrualIntensity) == length(designPlan$accrualTime)) { - header <- .concatenateSummaryText(header, paste0( - "accrual intensity = ", - .arrayToString(designPlan$accrualIntensity, - digits = 1, - vectorLookAndFeelEnabled = (length(designPlan$accrualIntensity) > 1) - ) - )) - } - if (!is.null(designPlan[["dropoutTime"]])) { - if (designPlan$dropoutRate1 > 0 || designPlan$dropoutRate2 > 0) { - header <- .concatenateSummaryText(header, paste0( - "dropout rate(1) = ", - .arrayToString(designPlan$dropoutRate1, - vectorLookAndFeelEnabled = (length(designPlan$dropoutRate1) > 1) - ) - )) - header <- .concatenateSummaryText(header, paste0( - "dropout rate(2) = ", - .arrayToString(designPlan$dropoutRate2, - vectorLookAndFeelEnabled = (length(designPlan$dropoutRate2) > 1) - ) - )) - header <- .concatenateSummaryText(header, paste0( - "dropout time = ", - .arrayToString(designPlan$dropoutTime, - vectorLookAndFeelEnabled = (length(designPlan$dropoutTime) > 1) - ) - )) - } - } - } - - if (settings$multiArmEnabled && designPlan$activeArms > 1) { - header <- .addShapeToHeader(header, designPlan) - header <- .addSelectionToHeader(header, designPlan) - } - - if (settings$enrichmentEnabled && settings$populations > 1) { - header <- .addSelectionToHeader(header, designPlan) - } - - functionName <- ifelse(settings$survivalEnabled, "calcEventsFunction", "calcSubjectsFunction") - userDefinedFunction <- !is.null(designPlan[[functionName]]) && - designPlan$.getParameterType(functionName) == C_PARAM_USER_DEFINED - - if (userDefinedFunction || (!is.null(designPlan[["conditionalPower"]]) && !is.na(designPlan$conditionalPower))) { - if (userDefinedFunction) { - header <- .concatenateSummaryText( - header, - paste0("sample size reassessment: user defined '", functionName, "'") - ) - if ((!is.null(designPlan[["conditionalPower"]]) && !is.na(designPlan$conditionalPower))) { - header <- .concatenateSummaryText( - header, - paste0("conditional power = ", designPlan$conditionalPower) - ) - } - } else { - if ((!is.null(designPlan[["conditionalPower"]]) && !is.na(designPlan$conditionalPower))) { - header <- .concatenateSummaryText( - header, - paste0("sample size reassessment: conditional power = ", designPlan$conditionalPower) - ) - } - } - - paramName1 <- ifelse(settings$survivalEnabled, "minNumberOfEventsPerStage", "minNumberOfSubjectsPerStage") - paramName2 <- ifelse(settings$survivalEnabled, "maxNumberOfEventsPerStage", "maxNumberOfSubjectsPerStage") - paramCaption <- ifelse(settings$survivalEnabled, "events", "subjects") - if (!is.null(designPlan[[paramName1]])) { - header <- .concatenateSummaryText(header, paste0( - "minimum ", paramCaption, " per stage = ", - .arrayToString(designPlan[[paramName1]], - vectorLookAndFeelEnabled = (length(designPlan[[paramName1]]) > 1) - ) - )) - } - if (!is.null(designPlan[[paramName2]])) { - header <- .concatenateSummaryText(header, paste0( - "maximum ", paramCaption, " per stage = ", - .arrayToString(designPlan[[paramName2]], - vectorLookAndFeelEnabled = (length(designPlan[[paramName2]]) > 1) - ) - )) - } - - if (settings$meansEnabled) { - if (!is.na(designPlan$thetaH1)) { - header <- .concatenateSummaryText( - header, - paste0("theta H1 = ", round(designPlan$thetaH1, 3)) - ) - } - if (!is.na(designPlan$stDevH1)) { - header <- .concatenateSummaryText( - header, - paste0("standard deviation H1 = ", round(designPlan$stDevH1, 3)) - ) - } - } else if (settings$ratesEnabled) { - if (settings$multiArmEnabled || settings$enrichmentEnabled) { - if (settings$multiArmEnabled && !is.na(designPlan$piTreatmentsH1)) { - header <- .concatenateSummaryText( - header, - paste0("pi(treatment)H1 = ", round(designPlan$piTreatmentsH1, 3)) - ) - } else if (settings$enrichmentEnabled) { - piTreatmentH1 <- designPlan[["piTreatmentH1"]] - if (is.null(piTreatmentH1)) { - piTreatmentH1 <- designPlan[["piTreatmentsH1"]] - } - if (!is.null(piTreatmentH1) && !is.na(piTreatmentH1)) { - header <- .concatenateSummaryText( - header, - paste0("pi(treatment)H1 = ", round(piTreatmentH1, 3)) - ) - } - } - if (!is.na(designPlan$piControlH1)) { - header <- .concatenateSummaryText( - header, - paste0("pi(control)H1 = ", round(designPlan$piControlH1, 3)) - ) - } - } else { - if (!is.na(designPlan$pi1H1)) { - header <- .concatenateSummaryText( - header, - paste0("pi(treatment)H1 = ", round(designPlan$pi1H1, 3)) - ) - } - if (!is.na(designPlan$pi2H1)) { - header <- .concatenateSummaryText( - header, - paste0("pi(control)H1 = ", round(designPlan$pi2H1, 3)) - ) - } - } - } - - if (settings$survivalEnabled && !is.null(designPlan[["thetaH1"]]) && !is.na(designPlan$thetaH1)) { - header <- .concatenateSummaryText(header, paste0("thetaH1 = ", round(designPlan$thetaH1, 3))) - } - } - - return(header) -} - -.addShapeToHeader <- function(header, designPlan) { - header <- .concatenateSummaryText(header, paste0("effect shape = ", .formatCamelCase(designPlan$typeOfShape))) - if (designPlan$typeOfShape == "sigmoidEmax") { - header <- .concatenateSummaryText(header, paste0("slope = ", designPlan$slope)) - header <- .concatenateSummaryText(header, paste0("ED50 = ", designPlan$gED50)) - } - - return(header) -} - -.addSelectionToHeader <- function(header, designPlan) { - header <- .concatenateSummaryText(header, paste0("intersection test = ", designPlan$intersectionTest)) - - if (designPlan$.design$kMax > 1) { - typeOfSelectionText <- paste0("selection = ", .formatCamelCase(designPlan$typeOfSelection)) - if (designPlan$typeOfSelection == "rBest") { - typeOfSelectionText <- paste0(typeOfSelectionText, ", r = ", designPlan$rValue) - } else if (designPlan$typeOfSelection == "epsilon") { - typeOfSelectionText <- paste0(typeOfSelectionText, " rule, eps = ", designPlan$epsilonValue) - } - if (!is.null(designPlan$threshold) && length(designPlan$threshold) == 1 && designPlan$threshold > -Inf) { - typeOfSelectionText <- paste0(typeOfSelectionText, ", threshold = ", designPlan$threshold) - } - header <- .concatenateSummaryText(header, typeOfSelectionText) - - header <- .concatenateSummaryText( - header, - paste0("effect measure based on ", .formatCamelCase(designPlan$effectMeasure)) - ) - } - - header <- .concatenateSummaryText( - header, - paste0("success criterion: ", .formatCamelCase(designPlan$successCriterion)) - ) - - return(header) -} - -.createSummary <- function(object, digits = NA_integer_, output = c("all", "title", "overview", "body")) { - output <- match.arg(output) - if (inherits(object, "TrialDesignCharacteristics") || inherits(object, "TrialDesignCharacteristicsR6")) { - return(.createSummaryDesignPlan(object, digits = digits, output = output, showStageLevels = TRUE)) - } - - if (.isTrialDesign(object) || .isTrialDesignPlan(object) || inherits(object, "SimulationResults") || inherits(object, "SimulationResultsR6")) { - return(.createSummaryDesignPlan(object, digits = digits, output = output, showStageLevels = !.isTrialDesignPlan(object))) - } - - if (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) { - return(.createSummaryAnalysisResults(object, digits = digits, output = output)) - } - - if (inherits(object, "PerformanceScore") || inherits(object, "PerformanceScoreR6")) { - return(.createSummaryPerformanceScore(object, digits = digits, output = output)) - } - - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "function 'summary' not implemented yet for class ", .getClassName(object)) -} - -.createSummaryPerformanceScore <- function(object, digits = NA_integer_, output = c("all", "title", "overview", "body")) { - .createSummaryDesignPlan(object$.simulationResults, - digits = digits, output = output, - showStageLevels = TRUE, performanceScore = object - ) -} - -.getSummaryParameterCaptionCriticalValues <- function(design) { - parameterCaption <- ifelse(.isTrialDesignFisher(design), - "Efficacy boundary (p product scale)", "Efficacy boundary (z-value scale)" - ) - parameterCaption <- ifelse(.isDelayedInformationEnabled(design = design), - "Upper bounds of continuation", parameterCaption - ) - return(parameterCaption) -} - -.getSummaryParameterCaptionFutilityBounds <- function(design) { - bindingInfo <- ifelse(design$bindingFutility, "binding", "non-binding") - parameterCaption <- ifelse(.isDelayedInformationEnabled(design = design), - paste0("Lower bounds of continuation (", bindingInfo, ")"), - paste0("Futility boundary (z-value scale)") - ) - return(parameterCaption) -} - -#' -#' Main function for creating a summary of an analysis result -#' -#' @noRd -#' -.createSummaryAnalysisResults <- function(object, digits = NA_integer_, output = c("all", "title", "overview", "body")) { - output <- match.arg(output) - if (!(inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6"))) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'object' must be a valid analysis result object (is class ", .getClassName(object), ")" - ) - } - - digitSettings <- .getSummaryDigits(digits) - digits <- digitSettings$digits - digitsSampleSize <- digitSettings$digitsSampleSize - digitsGeneral <- digitSettings$digitsGeneral - digitsProbabilities <- digitSettings$digitsProbabilities - - outputSize <- getOption("rpact.summary.output.size", C_SUMMARY_OUTPUT_SIZE_DEFAULT) - - intervalFormat <- getOption("rpact.summary.intervalFormat", "[%s; %s]") - .assertIsValidSummaryIntervalFormat(intervalFormat) - - multiArmEnabled <- .isMultiArmAnalysisResults(object) - enrichmentEnabled <- .isEnrichmentAnalysisResults(object) - multiHypothesesEnabled <- .isMultiHypothesesAnalysisResults(object) - - analysisResults <- object - design <- analysisResults$.design - stageResults <- analysisResults$.stageResults - dataInput <- analysisResults$.dataInput - closedTestResults <- NULL - conditionalPowerResults <- NULL - if (multiHypothesesEnabled) { - closedTestResults <- analysisResults$.closedTestResults - if (length(analysisResults$nPlanned) > 0 && !all(is.na(analysisResults$nPlanned))) { - conditionalPowerResults <- analysisResults$.conditionalPowerResults - } - } - - summaryFactory <- NULL - if(is.R6(object)) { - summaryFactory <- SummaryFactoryR6$new(object = object, intervalFormat = intervalFormat, output = output) - } else { - summaryFactory <- SummaryFactory(object = object, intervalFormat = intervalFormat, output = output) - } - - .addDesignInformationToSummary(design, object, summaryFactory, output = output) - - if (!.isTrialDesignConditionalDunnett(design)) { - summaryFactory$addParameter(design, - parameterName = "criticalValues", - parameterCaption = .getSummaryParameterCaptionCriticalValues(design), - roundDigits = digitsProbabilities - ifelse(.isTrialDesignFisher(design) || digitsProbabilities <= 1, 0, 1), - smoothedZeroFormat = !.isTrialDesignFisher(design) - ) - } - - if (.isTrialDesignFisher(design)) { - if (any(design$alpha0Vec < 1)) { - summaryFactory$addParameter(design, - parameterName = "alpha0Vec", - parameterCaption = "Futility boundary (separate p-value scale)", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - } else if (!.isTrialDesignConditionalDunnett(design)) { - if (any(design$futilityBounds > -6)) { - summaryFactory$addParameter(design, - parameterName = "futilityBounds", - parameterCaption = .getSummaryParameterCaptionFutilityBounds(design), - roundDigits = ifelse(digitsProbabilities > 1, digitsProbabilities - 1, digitsProbabilities), - smoothedZeroFormat = TRUE - ) - } - } - - if (design$kMax > 1 && !.isTrialDesignConditionalDunnett(design)) { - summaryFactory$addParameter(design, - parameterName = "alphaSpent", - parameterCaption = "Cumulative alpha spent", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - - if (!.isTrialDesignConditionalDunnett(design)) { - summaryFactory$addParameter(design, - parameterName = "stageLevels", - parameterCaption = "Stage level", roundDigits = digitsProbabilities, - smoothedZeroFormat = TRUE - ) - } - - summaryFactory$addParameter(stageResults, - parameterName = "effectSizes", - parameterCaption = ifelse(stageResults$isDatasetRates() && dataInput$getNumberOfGroups() == 1, - "Cumulative treatment rate", "Cumulative effect size" - ), roundDigits = digitsGeneral - ) - - if (stageResults$isDatasetMeans()) { - parameterCaption <- ifelse(stageResults$isOneSampleDataset(), - "Cumulative standard deviation", "Cumulative (pooled) standard deviation" - ) - parameterName <- ifelse((inherits(stageResults, "StageResultsMultiArmMeans") || inherits(stageResults, "StageResultsMultiArmMeansR6")) && - !(inherits(stageResults, "StageResultsEnrichmentMeans") || inherits(stageResults, "StageResultsEnrichmentMeansR6")), - "overallPooledStDevs", "overallStDevs" - ) - summaryFactory$addParameter(stageResults, - parameterName = parameterName, - parameterCaption = parameterCaption, roundDigits = digitsGeneral, - enforceFirstCase = (parameterName == "overallPooledStDevs") - ) - } else if (stageResults$isDatasetRates()) { - if (outputSize != "small" && dataInput$getNumberOfGroups() > 1) { - treatmentRateParamName <- "overallPi1" - controlRateParamName <- "overallPi2" - if (.isEnrichmentStageResults(stageResults)) { - treatmentRateParamName <- "overallPisTreatment" - controlRateParamName <- "overallPisControl" - } else if (.isMultiArmStageResults(stageResults)) { - treatmentRateParamName <- "overallPiTreatments" - controlRateParamName <- "overallPiControl" - } - summaryFactory$addParameter(stageResults, - parameterName = treatmentRateParamName, - parameterCaption = "Cumulative treatment rate", roundDigits = digitsGeneral - ) - summaryFactory$addParameter(stageResults, - parameterName = controlRateParamName, - parameterCaption = "Cumulative control rate", roundDigits = digitsGeneral, enforceFirstCase = TRUE - ) - } - } - - if (.isTrialDesignGroupSequential(design)) { - summaryFactory$addParameter(stageResults, - parameterName = "overallTestStatistics", - parameterCaption = "Overall test statistic", - roundDigits = ifelse(digitsProbabilities > 1, digitsProbabilities - 1, digitsProbabilities), - smoothedZeroFormat = TRUE - ) - summaryFactory$addParameter(stageResults, - parameterName = ifelse(multiHypothesesEnabled, "separatePValues", "overallPValues"), - parameterCaption = "Overall p-value", roundDigits = digitsProbabilities - ) - } else { - summaryFactory$addParameter(stageResults, - parameterName = "testStatistics", - parameterCaption = "Stage-wise test statistic", - roundDigits = ifelse(digitsProbabilities > 1, digitsProbabilities - 1, digitsProbabilities), - smoothedZeroFormat = TRUE - ) - summaryFactory$addParameter(stageResults, - parameterName = ifelse(multiHypothesesEnabled, "separatePValues", "pValues"), - parameterCaption = "Stage-wise p-value", roundDigits = digitsProbabilities - ) - } - - if (!is.null(closedTestResults)) { - if (outputSize == "large") { - if (.isTrialDesignConditionalDunnett(design)) { - summaryFactory$addParameter(closedTestResults, - parameterName = "conditionalErrorRate", - parameterCaption = "Conditional error rate", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - summaryFactory$addParameter(closedTestResults, - parameterName = "secondStagePValues", - parameterCaption = "Second stage p-value", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } else { - summaryFactory$addParameter(closedTestResults, - parameterName = "adjustedStageWisePValues", - parameterCaption = "Adjusted stage-wise p-value", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - summaryFactory$addParameter(closedTestResults, - parameterName = "overallAdjustedTestStatistics", - parameterCaption = "Overall adjusted test statistic", - roundDigits = digitsProbabilities - ifelse(.isTrialDesignFisher(design) || digitsProbabilities <= 1, 0, 1), - smoothedZeroFormat = !.isTrialDesignFisher(design) - ) - } - } else if (outputSize == "medium") { - legendEntry <- list("(i, j, ...)" = "comparison of treatment arms 'i, j, ...' vs. control arm") - gMax <- stageResults$getGMax() - if (.isTrialDesignConditionalDunnett(design)) { - summaryFactory$addParameter(closedTestResults, - parameterName = "adjustedStageWisePValues", - values = closedTestResults$conditionalErrorRate[1, ], - parameterCaption = paste0( - "Conditional error rate (", - paste0(1:gMax, collapse = ", "), ")" - ), roundDigits = digitsProbabilities, - smoothedZeroFormat = TRUE, - legendEntry = legendEntry - ) - summaryFactory$addParameter(closedTestResults, - parameterName = "overallAdjustedTestStatistics", - values = closedTestResults$secondStagePValues[1, ], - parameterCaption = paste0( - "Second stage p-value (", - paste0(1:gMax, collapse = ", "), ")" - ), - roundDigits = digitsProbabilities + ifelse(.isTrialDesignFisher(design), 1, 0), - smoothedZeroFormat = !.isTrialDesignFisher(design), - legendEntry = legendEntry - ) - } else { - summaryFactory$addParameter(closedTestResults, - parameterName = "adjustedStageWisePValues", - values = closedTestResults$adjustedStageWisePValues[1, ], - parameterCaption = paste0( - "Adjusted stage-wise p-value (", - paste0(1:gMax, collapse = ", "), ")" - ), roundDigits = digitsProbabilities, - smoothedZeroFormat = TRUE, legendEntry = legendEntry - ) - summaryFactory$addParameter(closedTestResults, - parameterName = "overallAdjustedTestStatistics", - values = closedTestResults$overallAdjustedTestStatistics[1, ], - parameterCaption = paste0( - "Overall adjusted test statistic (", - paste0(1:gMax, collapse = ", "), ")" - ), - roundDigits = digitsProbabilities - ifelse(.isTrialDesignFisher(design) || digitsProbabilities <= 1, 0, 1), - smoothedZeroFormat = !.isTrialDesignFisher(design), - legendEntry = legendEntry - ) - } - } - } - - if (multiHypothesesEnabled) { - summaryFactory$addParameter(closedTestResults, - parameterName = "rejected", - parameterCaption = "Test action: reject", roundDigits = digitsGeneral - ) - } else { - if (.isTrialDesignFisher(design)) { - summaryFactory$addParameter(stageResults, - parameterName = "combFisher", - parameterCaption = "Fisher combination", roundDigits = 0 - ) - } else if (.isTrialDesignInverseNormal(design)) { - summaryFactory$addParameter(stageResults, - parameterName = "combInverseNormal", - parameterCaption = "Inverse normal combination", - roundDigits = ifelse(digitsProbabilities > 1, digitsProbabilities - 1, digitsProbabilities), - smoothedZeroFormat = TRUE - ) - } - summaryFactory$addParameter(analysisResults, - parameterName = "testActions", - parameterCaption = "Test action", roundDigits = digitsGeneral - ) - } - - if (design$kMax > 1 && !.isTrialDesignConditionalDunnett(design)) { - summaryFactory$addParameter(analysisResults, - parameterName = "conditionalRejectionProbabilities", - parameterCaption = "Conditional rejection probability", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - - if (design$kMax > 1) { - if (!is.null(conditionalPowerResults)) { - summaryFactory$addParameter(conditionalPowerResults, - parameterName = "nPlanned", - parameterCaption = "Planned sample size", roundDigits = -1 - ) - } else if (analysisResults$.getParameterType("nPlanned") != C_PARAM_NOT_APPLICABLE) { - summaryFactory$addParameter(analysisResults, - parameterName = "nPlanned", - parameterCaption = "Planned sample size", roundDigits = -1 - ) - } - } - - if (design$kMax > 1) { - if (!is.null(conditionalPowerResults)) { - summaryFactory$addParameter(conditionalPowerResults, - parameterName = "conditionalPower", - parameterCaption = "Conditional power", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } else if (!multiHypothesesEnabled && analysisResults$.getParameterType("nPlanned") != C_PARAM_NOT_APPLICABLE) { - parameterName <- "conditionalPower" - if (!is.null(analysisResults[["conditionalPowerSimulated"]]) && - length(analysisResults[["conditionalPowerSimulated"]]) > 0) { - parameterName <- "conditionalPowerSimulated" - } - summaryFactory$addParameter(analysisResults, - parameterName = parameterName, - parameterCaption = "Conditional power", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - } - - ciLevel <- round((1 - design$alpha * (3 - design$sided)) * 100, 2) - if (.isTrialDesignConditionalDunnett(design)) { - parameterCaptionRepeatedPValues <- "Overall p-value" - parameterCaptionRepeatedCI <- paste0(ciLevel, "% overall confidence interval") - } else { - parameterCaptionRepeatedPValues <- ifelse(design$kMax == 1, - ifelse(design$sided == 1, "One-sided p-value", "Two-sided p-value"), - "Repeated p-value" - ) - parameterCaptionRepeatedCI <- paste0( - ciLevel, "% ", - ifelse(design$kMax == 1, "confidence interval", "repeated confidence interval") - ) - } - - summaryFactory$addParameter(analysisResults, - parameterName = c("repeatedConfidenceIntervalLowerBounds", "repeatedConfidenceIntervalUpperBounds"), - parameterCaption = parameterCaptionRepeatedCI, - roundDigits = digitsGeneral - ) - - summaryFactory$addParameter(analysisResults, - parameterName = "repeatedPValues", - parameterCaption = parameterCaptionRepeatedPValues, - roundDigits = digitsProbabilities, formatRepeatedPValues = TRUE - ) - - if (!multiHypothesesEnabled && !is.null(analysisResults[["finalStage"]]) && !all(is.na(analysisResults$finalStage))) { - summaryFactory$addParameter(analysisResults, - parameterName = "finalPValues", - parameterCaption = "Final p-value", roundDigits = digitsProbabilities - ) - summaryFactory$addParameter(analysisResults, - parameterName = c("finalConfidenceIntervalLowerBounds", "finalConfidenceIntervalUpperBounds"), - parameterCaption = "Final confidence interval", roundDigits = digitsGeneral - ) - summaryFactory$addParameter(analysisResults, - parameterName = "medianUnbiasedEstimates", - parameterCaption = "Median unbiased estimate", roundDigits = digitsGeneral - ) - } - - return(summaryFactory) -} - -.getSummaryDigits <- function(digits = NA_integer_) { - if (is.na(digits)) { - digits <- as.integer(getOption("rpact.summary.digits", 3)) - } - .assertIsSingleInteger(digits, "digits", validateType = FALSE, naAllowed = TRUE) - .assertIsInClosedInterval(digits, "digits", lower = -1, upper = 12, naAllowed = TRUE) - - digitsSampleSize <- 1 - if (digits > 0) { - digitsGeneral <- digits - digitsProbabilities <- NA_integer_ - tryCatch( - { - digitsProbabilities <- as.integer(getOption("rpact.summary.digits.probs", digits + 1)) - }, - warning = function(e) { - } - ) - if (is.na(digitsProbabilities)) { - digitsProbabilities <- digits + 1 - } - .assertIsSingleInteger(digitsProbabilities, "digitsProbabilities", validateType = FALSE, naAllowed = FALSE) - .assertIsInClosedInterval(digitsProbabilities, "digitsProbabilities", lower = -1, upper = 12, naAllowed = FALSE) - } else { - digitsSampleSize <- digits - digitsGeneral <- digits - digitsProbabilities <- digits - } - return(list( - digits = digits, - digitsSampleSize = digitsSampleSize, - digitsGeneral = digitsGeneral, - digitsProbabilities = digitsProbabilities - )) -} - -.getSummaryValuesInPercent <- function(values, percentFormatEnabled = TRUE, digits = 1) { - if (!percentFormatEnabled) { - return(as.character(round(values, digits + 2))) - } - return(paste0(round(100 * values, digits), "%")) -} - -.addDesignInformationToSummary <- function(design, designPlan, summaryFactory, - output = c("all", "title", "overview", "body")) { - if (!(output %in% c("all", "overview"))) { - return(invisible(summaryFactory)) - } - - if (design$kMax == 1) { - summaryFactory$addItem("Stage", "Fixed") - return(invisible(summaryFactory)) - } - - summaryFactory$addItem("Stage", c(1:design$kMax)) - - if (.isTrialDesignConditionalDunnett(design)) { - summaryFactory$addItem( - "Fixed information at interim", - .getSummaryValuesInPercent(design$informationAtInterim, FALSE) - ) - return(invisible(summaryFactory)) - } - - informationRatesCaption <- ifelse(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6") || - (inherits(designPlan, "AnalysisResults") || inherits(designPlan, "AnalysisResultsR6")), "Fixed weight", "Information") - - if (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6") || (inherits(designPlan, "AnalysisResults") || inherits(designPlan, "AnalysisResultsR6"))) { - if (.isTrialDesignFisher(design)) { - weights <- .getWeightsFisher(design) - } else if (.isTrialDesignInverseNormal(design)) { - weights <- .getWeightsInverseNormal(design) - } else { - weights <- design$informationRates - } - summaryFactory$addItem(informationRatesCaption, .getSummaryValuesInPercent(weights, FALSE)) - } else { - summaryFactory$addItem( - paste0( - informationRatesCaption, - ifelse(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6"), "", " rate") - ), - .getSummaryValuesInPercent(design$informationRates) - ) - } - if (design$.isDelayedResponseDesign()) { - summaryFactory$addItem("Delayed information", .getSummaryValuesInPercent(design$delayedInformation, TRUE)) - } - - return(invisible(summaryFactory)) -} - -.addDesignParameterToSummary <- function(design, designPlan, - designCharacteristics, summaryFactory, digitsGeneral, digitsProbabilities) { - if (design$kMax > 1 && !(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")) && - !.isTrialDesignConditionalDunnett(design)) { - summaryFactory$addParameter(design, - parameterName = "alphaSpent", - parameterCaption = "Cumulative alpha spent", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - if (design$.getParameterType("betaSpent") == C_PARAM_GENERATED) { - summaryFactory$addParameter(design, - parameterName = "betaSpent", - parameterCaption = "Cumulative beta spent", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - } - - if (!is.null(designPlan)) { - if (!grepl("SimulationResults(MultiArm|Enrichment)", .getClassName(designPlan))) { - outputSize <- getOption("rpact.summary.output.size", C_SUMMARY_OUTPUT_SIZE_DEFAULT) - if (outputSize == "large" && (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6"))) { - summaryFactory$addParameter(designPlan, - parameterName = "conditionalPowerAchieved", - parameterCaption = "Conditional power (achieved)", - roundDigits = digitsProbabilities - ) - } - } - } else { - powerObject <- NULL - if (!is.null(designCharacteristics)) { - powerObject <- designCharacteristics - } else if (design$.getParameterType("power") == C_PARAM_GENERATED) { - powerObject <- design - } - if (!is.null(powerObject)) { - summaryFactory$addParameter(powerObject, - parameterName = "power", - parameterCaption = ifelse(design$kMax == 1, "Power", "Overall power"), - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - if (design$kMax > 1 && .isTrialDesignInverseNormalOrGroupSequential(design)) { - tryCatch( - { - designCharacteristics <- getDesignCharacteristics(design) - }, - error = function(e) { - designCharacteristics <- NULL - } - ) - if (!is.null(designCharacteristics) && - !any(is.na(designCharacteristics$futilityProbabilities)) && - any(designCharacteristics$futilityProbabilities > 0)) { - summaryFactory$addParameter(designCharacteristics, - parameterName = "futilityProbabilities", - parameterCaption = "Futility probabilities under H1", - roundDigits = digitsGeneral, smoothedZeroFormat = TRUE - ) - } - } - } - - if (design$.isDelayedResponseDesign()) { - summaryFactory$addParameter(design, - parameterName = "decisionCriticalValues", - parameterCaption = "Decision critical values", - roundDigits = digitsGeneral, - smoothedZeroFormat = TRUE - ) - - outputSize <- getOption("rpact.summary.output.size", C_SUMMARY_OUTPUT_SIZE_DEFAULT) - if (outputSize == "large") { - summaryFactory$addParameter(design, - parameterName = "reversalProbabilities", - parameterCaption = "Reversal probabilities", - roundDigits = digitsProbabilities, - smoothedZeroFormat = TRUE - ) - } - } - - if (.isTrialDesignConditionalDunnett(design)) { - summaryFactory$addParameter(design, - parameterName = "alpha", - parameterCaption = "Significance level", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } else if (!is.null(designPlan) && !(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6"))) { - summaryFactory$addParameter(design, - parameterName = "stageLevels", - twoSided = design$sided == 2, - parameterCaption = paste0(ifelse(design$sided == 2, "Two", "One"), "-sided local significance level"), - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - return(summaryFactory) -} - -#' -#' Main function for creating a summary of a design or design plan -#' -#' @noRd -#' -.createSummaryDesignPlan <- function(object, digits = NA_integer_, - output = c("all", "title", "overview", "body"), showStageLevels = FALSE, - performanceScore = NULL) { - output <- match.arg(output) - designPlan <- NULL - if (.isTrialDesignPlan(object) || (inherits(object, "SimulationResults") || inherits(object, "SimulationResultsR6"))) { - design <- object$.design - designPlan <- object - } else if (inherits(object, "TrialDesignCharacteristics") || inherits(object, "TrialDesignCharacteristicsR6")) { - design <- object$.design - # designPlan <- object - } else if (.isTrialDesign(object)) { - design <- object - } else { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'object' must be a valid design, design plan, ", - "or simulation result object (is class ", .getClassName(object), ")" - ) - } - - digitSettings <- .getSummaryDigits(digits) - digits <- digitSettings$digits - digitsSampleSize <- digitSettings$digitsSampleSize - digitsGeneral <- digitSettings$digitsGeneral - digitsProbabilities <- digitSettings$digitsProbabilities - - outputSize <- getOption("rpact.summary.output.size", C_SUMMARY_OUTPUT_SIZE_DEFAULT) - - intervalFormat <- getOption("rpact.summary.intervalFormat", "[%s; %s]") - .assertIsValidSummaryIntervalFormat(intervalFormat) - - summaryFactory <- NULL - if(is.R6(object)) { - summaryFactory <- SummaryFactoryR6$new(object = object, intervalFormat = intervalFormat, output = output) - } else { - summaryFactory <- SummaryFactory(object = object, intervalFormat = intervalFormat, output = output) - } - - - if (output %in% c("all", "title", "overview")) { - .addDesignInformationToSummary(design, designPlan, summaryFactory, output = output) - } - - if (!(output %in% c("all", "body"))) { - return(summaryFactory) - } - - if (!.isTrialDesignConditionalDunnett(design)) { - summaryFactory$addParameter(design, - parameterName = "criticalValues", - parameterCaption = .getSummaryParameterCaptionCriticalValues(design), - roundDigits = digitsGeneral - ) - - if (showStageLevels) { - summaryFactory$addParameter(design, - parameterName = "stageLevels", - parameterCaption = "Stage levels (one-sided)", - roundDigits = digitsProbabilities, - smoothedZeroFormat = TRUE - ) - } - } - - if (.isTrialDesignFisher(design)) { - if (any(design$alpha0Vec < 1)) { - summaryFactory$addParameter(design, - parameterName = "alpha0Vec", - parameterCaption = "Futility boundary (separate p-value scale)", - roundDigits = digitsGeneral - ) - } - } else if (!.isTrialDesignConditionalDunnett(design)) { - if (any(design$futilityBounds > C_FUTILITY_BOUNDS_DEFAULT, na.rm = TRUE)) { - summaryFactory$addParameter(design, - parameterName = "futilityBounds", - parameterCaption = .getSummaryParameterCaptionFutilityBounds(design), - roundDigits = digitsGeneral - ) - } - } - - designCharacteristics <- NULL - if (design$kMax > 1 && .isTrialDesignInverseNormalOrGroupSequential(design)) { - tryCatch( - { - designCharacteristics <- getDesignCharacteristics(design) - }, - error = function(e) { - designCharacteristics <- NULL - } - ) - } - - if (is.null(designPlan)) { - return(.addDesignParameterToSummary( - design, - designPlan, - designCharacteristics, - summaryFactory, - digitsGeneral, - digitsProbabilities - )) - } - - simulationEnabled <- grepl("SimulationResults", .getClassName(designPlan)) - multiArmEnabled <- grepl("MultiArm", .getClassName(designPlan)) - enrichmentEnabled <- grepl("Enrichment", .getClassName(designPlan)) - baseEnabled <- grepl("(TrialDesignPlan|SimulationResults)(Means|Rates|Survival)", .getClassName(designPlan)) - planningEnabled <- .isTrialDesignPlan(designPlan) - simulationEnabled <- .isSimulationResults(designPlan) - survivalEnabled <- grepl("Survival", .getClassName(designPlan)) - - probsH0 <- NULL - probsH1 <- NULL - if (design$kMax > 1) { - if (!is.null(designCharacteristics) && - .isTrialDesignInverseNormalOrGroupSequential(design) && - length(designCharacteristics$shift) == 1 && - !is.na(designCharacteristics$shift) && - designCharacteristics$shift >= 1) { - probsH0 <- getPowerAndAverageSampleNumber(design, theta = 0, nMax = designCharacteristics$shift) - probsH1 <- getPowerAndAverageSampleNumber(design, theta = 1, nMax = designCharacteristics$shift) - } - if (!is.null(designPlan[["rejectPerStage"]])) { - probsH1 <- list( - earlyStop = designPlan$rejectPerStage[1:(design$kMax - 1), ] + as.vector(designPlan$futilityPerStage), - rejectPerStage = designPlan$rejectPerStage, - futilityPerStage = designPlan$futilityPerStage - ) - numberOfVariants <- 1 - if ((inherits(designPlan, "ParameterSet") || inherits(designPlan, "ParameterSetR6"))) { - parameterNames <- designPlan$.getVisibleFieldNamesOrdered() - numberOfVariants <- .getMultidimensionalNumberOfVariants(designPlan, parameterNames) - } - if (numberOfVariants > 1 && is.matrix(probsH1$earlyStop) && ncol(probsH1$earlyStop) == 1) { - probsH1$earlyStop <- matrix(rep(probsH1$earlyStop, numberOfVariants), ncol = numberOfVariants) - probsH1$rejectPerStage <- matrix(rep(probsH1$rejectPerStage, numberOfVariants), ncol = numberOfVariants) - probsH1$futilityPerStage <- matrix(rep(probsH1$futilityPerStage, numberOfVariants), ncol = numberOfVariants) - } - } - } - - if (simulationEnabled && (multiArmEnabled || enrichmentEnabled)) { - # simulation multi-arm #1:rejectAtLeastOne per mu_max - summaryFactory$addParameter(designPlan, - parameterName = "rejectAtLeastOne", - parameterCaption = "Reject at least one", roundDigits = digitsProbabilities, - smoothedZeroFormat = TRUE, transpose = TRUE, - legendEntry = { - if (multiArmEnabled) list("(i)" = "treatment arm i") else list() - } - ) - - # simulation multi-arm #2: rejectedArmsPerStage - if (outputSize == "large" && multiArmEnabled) { - .addSimulationMultiArmArrayParameter(designPlan, - parameterName = "rejectedArmsPerStage", - parameterCaption = ifelse(design$kMax == 1, "Rejected arms", "Rejected arms per stage"), - summaryFactory, roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - # simulation enrichment #2: rejectedPopulationsPerStage - if (outputSize == "large" && enrichmentEnabled) { - .addSimulationArrayToSummary(designPlan, - parameterName = "rejectedPopulationsPerStage", - parameterCaption = ifelse(design$kMax == 1, "Rejected populations", "Rejected populations per stage"), - summaryFactory, digitsSampleSize = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - - # simulation multi-arm #3: successPerStage - summaryFactory$addParameter(designPlan, - parameterName = "successPerStage", - parameterCaption = "Success per stage", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE, transpose = TRUE - ) - - # simulation multi-arm #4: futilityPerStage - if (!planningEnabled && !baseEnabled && any(designPlan$futilityPerStage != 0)) { - summaryFactory$addParameter(designPlan, - parameterName = "futilityPerStage", - parameterCaption = "Exit probability for futility", # (under H1) - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE, transpose = TRUE - ) - } - - if (survivalEnabled) { - summaryFactory$addParameter(designPlan, - parameterName = "expectedNumberOfEvents", - parameterCaption = "Expected number of events", - roundDigits = digitsSampleSize, transpose = TRUE - ) - } else { - summaryFactory$addParameter(designPlan, - parameterName = "expectedNumberOfSubjects", - parameterCaption = "Expected number of subjects", - roundDigits = digitsSampleSize, transpose = TRUE - ) - } - - # simulation multi-arm #5: earlyStop per mu_max - if (outputSize %in% c("medium", "large")) { - summaryFactory$addParameter(designPlan, - parameterName = "earlyStop", - parameterCaption = "Overall exit probability", # (under H1) - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE, transpose = TRUE - ) - } - - # simulation multi-arm / enrichment #6: sampleSizes - if (outputSize %in% c("medium", "large")) { - if (survivalEnabled) { - if (enrichmentEnabled) { - parameterName <- "singleNumberOfEventsPerStage" - parameterCaption <- "Single number of events" - } else { - parameterName <- "eventsPerStage" - parameterCaption <- "Cumulative number of events" - } - } else { - parameterName <- "sampleSizes" - parameterCaption <- "Stagewise number of subjects" - } - .addSimulationArrayToSummary( - designPlan, - parameterName, - parameterCaption, - summaryFactory, - digitsSampleSize, - smoothedZeroFormat = TRUE - ) - } - - # simulation multi-arm #7: selectedArms - if (multiArmEnabled && outputSize %in% c("medium", "large")) { - .addSimulationMultiArmArrayParameter( - designPlan = designPlan, - parameterName = "selectedArms", - parameterCaption = "Selected arms", - summaryFactory = summaryFactory, - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - - # simulation enrichment #7: selectedPopulations - if (enrichmentEnabled && outputSize %in% c("medium", "large")) { - .addSimulationArrayToSummary( - designPlan = designPlan, - parameterName = "selectedPopulations", - parameterCaption = "Selected populations", - summaryFactory = summaryFactory, - digitsSampleSize = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - - # simulation multi-arm #8: numberOfActiveArms - if (multiArmEnabled && outputSize %in% c("medium", "large")) { - summaryFactory$addParameter(designPlan, - parameterName = "numberOfActiveArms", - parameterCaption = "Number of active arms", - roundDigits = digitsGeneral, transpose = TRUE - ) - } - - # simulation enrichment #8: numberOfPopulations - if (enrichmentEnabled && outputSize %in% c("medium", "large")) { - summaryFactory$addParameter(designPlan, - parameterName = "numberOfPopulations", - parameterCaption = "Number of populations", - roundDigits = digitsGeneral, transpose = TRUE - ) - } - - if (outputSize == "large") { - summaryFactory$addParameter(designPlan, - parameterName = "conditionalPowerAchieved", - parameterCaption = "Conditional power (achieved)", - roundDigits = digitsProbabilities, transpose = TRUE - ) - } - } - - if (baseEnabled) { - parameterName <- "rejectPerStage" - if (design$kMax == 1) { - parameterName <- "overallReject" - } - if (any(!is.na(designPlan[[parameterName]]))) { - summaryFactory$addParameter(designPlan, - parameterName = parameterName, - parameterCaption = ifelse(design$kMax == 1, "Power", "Overall power"), - roundDigits = digitsProbabilities, cumsumEnabled = TRUE, smoothedZeroFormat = TRUE - ) - } - - if (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")) { - parameterName1 <- ifelse(survivalEnabled, "numberOfSubjects", "sampleSizes") - parameterName2 <- "eventsPerStage" - } else { - if (design$kMax == 1 && (designPlan$.isSampleSizeObject() || - .isTrialDesignPlanMeans(designPlan) || .isTrialDesignPlanRates(designPlan))) { - parameterName1 <- "nFixed" - parameterName2 <- "eventsFixed" - } else if (design$kMax == 1 && designPlan$.isPowerObject()) { - parameterName1 <- "expectedNumberOfSubjects" - parameterName2 <- "expectedNumberOfEvents" - } else { - parameterName1 <- "numberOfSubjects" - parameterName2 <- "eventsPerStage" - } - } - - if (design$kMax > 1) { - summaryFactory$addParameter(designPlan, - parameterName = ifelse((inherits(designPlan, "TrialDesignPlan") || inherits(designPlan, "TrialDesignPlanR6")) && designPlan$.isSampleSizeObject(), - "expectedNumberOfSubjectsH1", "expectedNumberOfSubjects" - ), - parameterCaption = "Expected number of subjects", - roundDigits = digitsSampleSize, transpose = TRUE - ) - } - - if (outputSize %in% c("medium", "large")) { - subjectsCaption <- ifelse(design$kMax > 1 && (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")) && - !survivalEnabled, "Stagewise number of subjects", "Number of subjects") - summaryFactory$addParameter(designPlan, - parameterName = parameterName1, - parameterCaption = subjectsCaption, roundDigits = digitsSampleSize - ) - } - - if (survivalEnabled) { - if (design$kMax > 1 && !((inherits(designPlan, "TrialDesignPlanSurvival") || inherits(designPlan, "TrialDesignPlanSurvivalR6")) && 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 = parameterName2, - parameterCaption = ifelse(design$kMax == 1, - "Number of events", "Cumulative number of events" - ), - roundDigits = digitsSampleSize, cumsumEnabled = FALSE - ) - } - - if (outputSize == "large") { - summaryFactory$addParameter(designPlan, - parameterName = "analysisTime", - parameterCaption = "Analysis time", roundDigits = digitsSampleSize - ) - } - - summaryFactory$addParameter(designPlan, - parameterName = "studyDuration", - parameterCaption = "Expected study duration", - roundDigits = digitsSampleSize, smoothedZeroFormat = TRUE, transpose = TRUE - ) - } - } - - if (!is.null(designPlan[["allocationRatioPlanned"]]) && - length(unique(designPlan$allocationRatioPlanned)) > 1) { - summaryFactory$addParameter(designPlan, - parameterName = "allocationRatioPlanned", - parameterCaption = "Optimum allocation ratio", roundDigits = digitsGeneral - ) - } - - .addDesignParameterToSummary( - design, designPlan, designCharacteristics, - summaryFactory, digitsGeneral, digitsProbabilities - ) - - if (baseEnabled && !planningEnabled && !is.null(designPlan[["futilityPerStage"]]) && - !any(is.na(designPlan[["futilityPerStage"]])) && - any(designPlan$futilityPerStage != 0) && any(designPlan$futilityPerStage > 1e-08)) { - summaryFactory$addParameter(designPlan, - parameterName = "futilityPerStage", - parameterCaption = "Exit probability for futility", # (under H1) - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - - if (baseEnabled && simulationEnabled && design$kMax > 1) { - values <- NULL - if (!is.null(probsH1)) { - values <- probsH1$rejectPerStage - } - summaryFactory$addParameter(designPlan, - parameterName = "rejectPerStage", - values = values, - parameterCaption = "Exit probability for efficacy", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - - # sample size and power only - if (planningEnabled) { - legendEntry <- list("(t)" = "treatment effect scale") - - if (!is.null(designPlan$criticalValuesEffectScale) && ncol(designPlan$criticalValuesEffectScale) > 0) { - summaryFactory$addParameter(designPlan, - parameterName = "criticalValuesEffectScale", - parameterCaption = ifelse(.isDelayedInformationEnabled(design = design), - "Upper bounds of continuation (t)", "Efficacy boundary (t)" - ), - roundDigits = digitsGeneral, legendEntry = legendEntry - ) - } else if (!is.null(designPlan$criticalValuesEffectScaleUpper) && ncol(designPlan$criticalValuesEffectScaleUpper) > 0) { - summaryFactory$addParameter(designPlan, - parameterName = "criticalValuesEffectScaleLower", - parameterCaption = "Lower efficacy boundary (t)", - roundDigits = digitsGeneral, legendEntry = legendEntry - ) - summaryFactory$addParameter(designPlan, - parameterName = "criticalValuesEffectScaleUpper", - parameterCaption = "Upper efficacy boundary (t)", - roundDigits = digitsGeneral, legendEntry = legendEntry - ) - } - - if (!is.null(designPlan$futilityBoundsEffectScale) && ncol(designPlan$futilityBoundsEffectScale) > 0 && - !all(is.na(designPlan$futilityBoundsEffectScale))) { - summaryFactory$addParameter(designPlan, - parameterName = "futilityBoundsEffectScale", - parameterCaption = ifelse(.isDelayedInformationEnabled(design = design), - "Lower bounds of continuation (t)", "Futility boundary (t)" - ), - roundDigits = digitsGeneral, legendEntry = legendEntry - ) - } else if (ncol(designPlan$futilityBoundsEffectScaleUpper) > 0 && - (any(!is.na(designPlan$futilityBoundsEffectScaleLower)) || - any(!is.na(designPlan$futilityBoundsEffectScaleUpper)))) { - summaryFactory$addParameter(designPlan, - parameterName = "futilityBoundsEffectScaleLower", - parameterCaption = "Lower futility boundary (t)", - roundDigits = digitsGeneral, legendEntry = legendEntry - ) - summaryFactory$addParameter(designPlan, - parameterName = "futilityBoundsEffectScaleUpper", - parameterCaption = "Upper futility boundary (t)", - roundDigits = digitsGeneral, legendEntry = legendEntry - ) - } - - if (!is.null(probsH1) && !is.null(probsH0) && design$kMax > 1) { - probsH0$earlyStop <- matrix(probsH0$earlyStop[1:(design$kMax - 1), 1], ncol = 1) - probsH0$rejectPerStage <- matrix(probsH0$rejectPerStage[1:(design$kMax - 1), 1], ncol = 1) - - if (is.matrix(probsH1$rejectPerStage)) { - if (design$kMax > 1 && designPlan$.isSampleSizeObject()) { - probsH1$rejectPerStage <- probsH1$rejectPerStage[1:(design$kMax - 1), 1] - } else { - probsH1$rejectPerStage <- matrix(probsH1$rejectPerStage[1:(design$kMax - 1), ], - ncol = ncol(probsH1$rejectPerStage) - ) - } - } else { - probsH1$rejectPerStage <- probsH1$rejectPerStage[1:(design$kMax - 1)] - } - - if (any(design$futilityBounds > -6)) { - if (is.matrix(probsH1$earlyStop)) { - probsH1$earlyStop <- matrix(probsH1$earlyStop[1:(design$kMax - 1), ], - ncol = ncol(probsH1$earlyStop) - ) - } else { - probsH1$earlyStop <- probsH1$earlyStop[1:(design$kMax - 1)] - } - summaryFactory$addParameter(probsH0, - parameterName = "earlyStop", - parameterCaption = "Overall exit probability (under H0)", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - x <- designPlan - if (is.null(x)) { - x <- design - } - summaryFactory$addParameter(x, - parameterName = "earlyStop", - values = probsH1$earlyStop, - parameterCaption = "Overall exit probability (under H1)", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - summaryFactory$addParameter(probsH0, - parameterName = "rejectPerStage", - parameterCaption = "Exit probability for efficacy (under H0)", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - if (designPlan$.isPowerObject()) { - summaryFactory$addParameter(designPlan, - parameterName = "rejectPerStage", - values = probsH1$rejectPerStage, - parameterCaption = "Exit probability for efficacy (under H1)", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } else { - summaryFactory$addParameter(probsH1, - parameterName = "rejectPerStage", - parameterCaption = "Exit probability for efficacy (under H1)", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - - if (any(design$futilityBounds > -6)) { - summaryFactory$addParameter(probsH0, - parameterName = "futilityPerStage", - parameterCaption = "Exit probability for futility (under H0)", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - x <- designPlan - if (is.null(x)) { - x <- design - } - futilityPerStage <- probsH1$futilityPerStage - if (.isTrialDesignPlan(x) && x$.isSampleSizeObject() && ncol(futilityPerStage) > 1) { - futilityPerStage <- futilityPerStage[, 1] - } - summaryFactory$addParameter(x, - parameterName = "futilityPerStage", - values = futilityPerStage, - parameterCaption = "Exit probability for futility (under H1)", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - } - } - - if (!is.null(performanceScore)) { - summaryFactory$addParameter(performanceScore, - parameterName = "performanceScore", - parameterCaption = "Performance score", - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE - ) - } - - return(summaryFactory) -} - -.getSummaryVariedParameterNameEnrichment <- function(designPlan) { - if (grepl("Rates", .getClassName(designPlan))) { - return("piTreatments") - } - if (grepl("Survival", .getClassName(designPlan))) { - return("hazardRatios") - } - return("effects") -} - -.getSummaryGroup <- function(parameterCaption, - numberOfVariedParams, - variedParamNumber, - designPlan) { - if (numberOfVariedParams <= 1) { - return(list( - groupCaption = parameterCaption, - legendEntry = list() - )) - } - - enrichmentEnabled <- grepl("SimulationResultsEnrichment", .getClassName(designPlan)) - if (enrichmentEnabled) { - variedParameterName <- .getSummaryVariedParameterNameEnrichment(designPlan) - variedParameterValues <- designPlan$effectList[[variedParameterName]] - if (variedParameterName == "piTreatments") { - variedParameterCaption <- "pi(treatment)" - } else { - variedParameterCaption <- C_PARAMETER_NAMES[[variedParameterName]] - } - if (is.matrix(variedParameterValues) && ncol(variedParameterValues) == 1) { - variedParameterCaption <- sub("s$", "", variedParameterCaption) - } - } else { - variedParameterName <- .getVariedParameterSimulationMultiArm(designPlan) - variedParameterValues <- designPlan[[variedParameterName]] - variedParameterCaption <- C_PARAMETER_NAMES[[variedParameterName]] - } - - userDefinedEffectMatrix <- !enrichmentEnabled && - designPlan$.getParameterType("effectMatrix") == C_PARAM_USER_DEFINED - - if (userDefinedEffectMatrix) { - return(list( - groupCaption = paste0(parameterCaption, " [", variedParamNumber, "]"), - legendEntry = list("[j]" = "effect matrix row j (situation to consider)") - )) - } - if (is.matrix(variedParameterValues)) { - values <- variedParameterValues[variedParamNumber, ] - if (length(values) > 1) { - values <- .arrayToString(values, vectorLookAndFeelEnabled = TRUE) - } - } else { - values <- variedParameterValues[variedParamNumber] - } - if (is.numeric(values)) { - values <- round(values, 2) - } - return(list( - groupCaption = paste0( - parameterCaption, ", ", - tolower(variedParameterCaption), " = ", values - ), - legendEntry = list() - )) -} - -.getSummaryGroupCaption <- function(designPlan, parameterName, numberOfGroups, groupNumber) { - listItemPrefix <- getOption("rpact.summary.list.item.prefix", C_SUMMARY_LIST_ITEM_PREFIX_DEFAULT) - - if (grepl("Enrichment", .getClassName(designPlan))) { - categoryCaption <- .getCategoryCaptionEnrichment(designPlan, parameterName, groupNumber) - categoryCaption <- sub("^F$", "Full population F", categoryCaption) - categoryCaption <- sub("^R$", "Remaining population R", categoryCaption) - categoryCaption <- sub("^S", "Subset S", categoryCaption) - - return(paste0(listItemPrefix, categoryCaption)) - } - - treatmentCaption <- ifelse(numberOfGroups > 2, paste0("Treatment arm ", groupNumber), "Treatment arm") - - if (!grepl("Survival", .getClassName(designPlan)) || - ((inherits(designPlan, "SimulationResultsMultiArmSurvival") || inherits(designPlan, "SimulationResultsMultiArmSurvivalR6")) && - parameterName == "singleNumberOfEventsPerStage")) { - return(ifelse(groupNumber == numberOfGroups, - paste0(listItemPrefix, "Control arm"), - paste0(listItemPrefix, treatmentCaption) - )) - } - - return(paste0(listItemPrefix, treatmentCaption, " vs. control")) -} - -.addSimulationArrayToSummary <- function(designPlan, - parameterName, parameterCaption, summaryFactory, - digitsSampleSize, smoothedZeroFormat = FALSE) { - arrayData <- designPlan[[parameterName]] - if (is.null(arrayData)) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, class(designPlan)[1], " does not contain the field ", sQuote(parameterName)) - } - - numberOfVariedParams <- dim(arrayData)[2] - numberOfGroups <- dim(arrayData)[3] - for (variedParamNumber in 1:numberOfVariedParams) { - summaryGroup <- .getSummaryGroup( - parameterCaption, - numberOfVariedParams, - variedParamNumber, - designPlan - ) - groupCaption <- summaryGroup$groupCaption - legendEntry <- summaryGroup$legendEntry - if (numberOfGroups > 1) { - summaryFactory$addItem(groupCaption, "", legendEntry = legendEntry) - } - - for (groupNumber in 1:numberOfGroups) { - dataPerGroupAndStage <- arrayData[, variedParamNumber, groupNumber] - if (numberOfGroups > 1) { - groupCaption <- .getSummaryGroupCaption( - designPlan, - parameterName, numberOfGroups, groupNumber - ) - } - summaryFactory$addParameter(designPlan, - parameterName = parameterName, - values = dataPerGroupAndStage, parameterCaption = groupCaption, - roundDigits = digitsSampleSize, - smoothedZeroFormat = smoothedZeroFormat, - enforceFirstCase = TRUE - ) - } - } -} - -.addSimulationMultiArmArrayParameter <- function(designPlan, parameterName, parameterCaption, - summaryFactory, roundDigits, smoothedZeroFormat = FALSE) { - arrayData <- designPlan[[parameterName]] - if (is.array(arrayData) && length(dim(arrayData)) == 3) { - totalNumberOfGroups <- dim(designPlan[[ifelse(grepl("Survival", .getClassName(designPlan)), - "eventsPerStage", "sampleSizes" - )]])[3] - - numberOfGroups <- dim(arrayData)[3] - if (parameterName == "selectedArms" && !grepl("Survival", .getClassName(designPlan))) { # remove control group - numberOfGroups <- numberOfGroups - 1 - } - numberOfVariedParams <- dim(arrayData)[2] - - for (variedParamNumber in 1:numberOfVariedParams) { - summaryGroup <- .getSummaryGroup( - parameterCaption, - numberOfVariedParams, - variedParamNumber, - designPlan - ) - groupCaption <- summaryGroup$groupCaption - legendEntry <- summaryGroup$legendEntry - if (numberOfGroups > 1) { - summaryFactory$addItem(groupCaption, "", legendEntry = legendEntry) - } - - for (groupNumber in 1:numberOfGroups) { - dataPerGroupAndStage <- arrayData[, variedParamNumber, groupNumber] - if (numberOfGroups > 1) { - groupCaption <- .getSummaryGroupCaption( - designPlan, - parameterName, totalNumberOfGroups, groupNumber - ) - } - summaryFactory$addParameter(designPlan, - parameterName = parameterName, - values = dataPerGroupAndStage, parameterCaption = groupCaption, - roundDigits = roundDigits, smoothedZeroFormat = smoothedZeroFormat, - enforceFirstCase = TRUE - ) - } - } - } else { - data <- designPlan[[parameterName]] - numberOfGroups <- ncol(data) - for (groupNumber in 1:numberOfGroups) { - dataPerGroupAndStage <- data[, groupNumber] - summaryFactory$addParameter(designPlan, - parameterName = parameterName, - values = dataPerGroupAndStage, - parameterCaption = ifelse(groupNumber == numberOfGroups, - paste0(parameterCaption, ", control"), - paste0(parameterCaption, ", treatment ", groupNumber) - ), - roundDigits = roundDigits, smoothedZeroFormat = smoothedZeroFormat - ) - } - } -} diff --git a/R/class_time.R b/R/class_time.R index 3078663a..5efb3c07 100644 --- a/R/class_time.R +++ b/R/class_time.R @@ -23,13 +23,14 @@ C_REGEXP_SMALLER <- "< ?" C_REGEXP_SMALLER_OR_EQUAL <- "<= ?" C_REGEXP_DECIMAL_NUMBER <- "\\d*(\\.{1}\\d*)?" -TimeDefinition <- setRefClass("TimeDefinition", - contains = "ParameterSet", - methods = list( +TimeDefinitionR6 <- R6Class("TimeDefinitionR6", + inherit = ParameterSetR6, + public = list( initialize = function(...) { - callSuper(...) - .parameterNames <<- C_PARAMETER_NAMES - .parameterFormatFunctions <<- C_PARAMETER_FORMAT_FUNCTIONS + super$initialize() + + self$.parameterNames <- C_PARAMETER_NAMES + self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS }, .getRegexpFromTo = function(..., from, to, fromPrefix = "", toPrefix = "") { return(paste0("(^ *", fromPrefix, from, " *- *", toPrefix, to, " *$)")) @@ -44,22 +45,22 @@ TimeDefinition <- setRefClass("TimeDefinition", return(paste0("(^ *", C_REGEXP_GREATER_OR_EQUAL, C_REGEXP_DECIMAL_NUMBER, " *$)")) }, .getRegexpDecimalRangeStart = function() { - return(.getRegexpFromTo(from = "0", to = C_REGEXP_DECIMAL_NUMBER, toPrefix = C_REGEXP_SMALLER)) + return(self$.getRegexpFromTo(from = "0", to = C_REGEXP_DECIMAL_NUMBER, toPrefix = C_REGEXP_SMALLER)) }, .getRegexpDecimalRange = function() { - return(.getRegexpFromTo( + return(self$.getRegexpFromTo( from = C_REGEXP_DECIMAL_NUMBER, to = C_REGEXP_DECIMAL_NUMBER, toPrefix = C_REGEXP_SMALLER )) }, .getRegexpDecimalRangeEnd = function() { - return(.getRegexpFromTo( + return(self$.getRegexpFromTo( from = C_REGEXP_DECIMAL_NUMBER, to = "(Inf|x|\\?)", toPrefix = paste0("(", C_REGEXP_SMALLER, " *)?") )) }, .getRegexpDecimalRangeFiniteEnd = function() { - return(.getRegexpFromTo( + return(self$.getRegexpFromTo( from = C_REGEXP_DECIMAL_NUMBER, to = C_REGEXP_DECIMAL_NUMBER, toPrefix = "<=? ?" )) @@ -79,7 +80,7 @@ TimeDefinition <- setRefClass("TimeDefinition", .validateTimePeriod = function(timePeriod, i, n, accrualTimeMode = FALSE) { endOfAccrualIsUndefined <- FALSE if (i == 1 && (n > 1 || !accrualTimeMode)) { - if (!grepl(.getRegexpOr(.getRegexpSmallerThan(), .getRegexpDecimalRangeStart()), + if (!grepl(self$.getRegexpOr(self$.getRegexpSmallerThan(), self$.getRegexpDecimalRangeStart()), timePeriod, perl = TRUE )) { @@ -91,7 +92,7 @@ TimeDefinition <- setRefClass("TimeDefinition", ) } } - if (grepl(.getRegexpSmallerThan(), timePeriod, perl = TRUE)) { + if (grepl(self$.getRegexpSmallerThan(), timePeriod, perl = TRUE)) { timePeriod <- sub("^ *< *", "0 - <", timePeriod) } if (!accrualTimeMode && n == 1 && !grepl("(0 *- ?)?=20\" or \"20 - Inf\" or \"20 - <=30\"" ) } - if (grepl(.getRegexpOr(.getRegexpGreaterOrEqualThan(), .getRegexpDecimalRangeEnd()), + if (grepl(self$.getRegexpOr(self$.getRegexpGreaterOrEqualThan(), self$.getRegexpDecimalRangeEnd()), timePeriod, perl = TRUE )) { @@ -126,7 +127,7 @@ TimeDefinition <- setRefClass("TimeDefinition", } timePeriod <- gsub("([Inf >=\\?x]*)|-", "", timePeriod) } else { - if (!grepl(.getRegexpOr(.getRegexpGreaterOrEqualThan(), .getRegexpDecimalRangeEnd()), + if (!grepl(self$.getRegexpOr(self$.getRegexpGreaterOrEqualThan(), self$.getRegexpDecimalRangeEnd()), timePeriod, perl = TRUE )) { @@ -138,7 +139,7 @@ TimeDefinition <- setRefClass("TimeDefinition", } } } else { - if (!grepl(.getRegexpDecimalRange(), timePeriod, perl = TRUE)) { + if (!grepl(self$.getRegexpDecimalRange(), timePeriod, perl = TRUE)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the name of the inner regions must have the format \"time_1 - = 1" + ) + } + } else if (accrualIntensityType == "relative") { + absoluteAccrualIntensityEnabled <- FALSE + } + + args <- list(...) + showWarnings <- args[["showWarnings"]] + if (is.null(showWarnings) || !is.logical(showWarnings)) { + showWarnings <- TRUE + } + + return(AccrualTimeR6$new( + accrualTime = accrualTime, + accrualIntensity = accrualIntensity, + maxNumberOfSubjects = maxNumberOfSubjects, + showWarnings = showWarnings, + absoluteAccrualIntensityEnabled = absoluteAccrualIntensityEnabled + )) +} #' #' @name PiecewiseSurvivalTime @@ -191,27 +392,25 @@ TimeDefinition <- setRefClass("TimeDefinition", #' #' @importFrom methods new #' -PiecewiseSurvivalTime <- setRefClass("PiecewiseSurvivalTime", - contains = "TimeDefinition", - fields = list( - .pi1Default = "numeric", - .lambdaBased = "logical", - .silent = "logical", - piecewiseSurvivalTime = "numeric", - lambda1 = "numeric", - lambda2 = "numeric", - hazardRatio = "numeric", - pi1 = "numeric", - pi2 = "numeric", - median1 = "numeric", - median2 = "numeric", - eventTime = "numeric", - kappa = "numeric", - piecewiseSurvivalEnabled = "logical", - delayedResponseAllowed = "logical", - delayedResponseEnabled = "logical" - ), - methods = list( +PiecewiseSurvivalTimeR6 <- R6Class("PiecewiseSurvivalTimeR6", + inherit = TimeDefinitionR6, + public = list( + .pi1Default = NULL, + .lambdaBased = NULL, + .silent = NULL, + piecewiseSurvivalTime = NULL, + lambda1 = NULL, + lambda2 = NULL, + hazardRatio = NULL, + pi1 = NULL, + pi2 = NULL, + median1 = NULL, + median2 = NULL, + eventTime = NULL, + kappa = NULL, + piecewiseSurvivalEnabled = NULL, + delayedResponseAllowed = NULL, + delayedResponseEnabled = NULL, initialize = function(piecewiseSurvivalTime = NA_real_, ..., lambda1 = NA_real_, @@ -224,194 +423,193 @@ PiecewiseSurvivalTime <- setRefClass("PiecewiseSurvivalTime", eventTime = C_EVENT_TIME_DEFAULT, kappa = 1, delayedResponseAllowed = FALSE) { - callSuper( - piecewiseSurvivalTime = NA_real_, - lambda1 = lambda1, - lambda2 = lambda2, - hazardRatio = hazardRatio, - pi1 = pi1, - pi2 = pi2, - median1 = median1, - median2 = median2, - eventTime = eventTime, - kappa = kappa, - delayedResponseAllowed = delayedResponseAllowed, ... - ) - - if (length(piecewiseSurvivalTime) == 0) { + super$initialize() + self$piecewiseSurvivalTime <- piecewiseSurvivalTime + self$lambda1 <- lambda1 + self$lambda2 <- lambda2 + self$hazardRatio <- hazardRatio + self$pi1 <- pi1 + self$pi2 <- pi2 + self$median1 <- median1 + self$median2 <- median2 + self$eventTime <- eventTime + self$kappa <- kappa + self$delayedResponseAllowed <- delayedResponseAllowed + + if (length(self$piecewiseSurvivalTime) == 0) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'piecewiseSurvivalTime' must be defined (set to NA_real_ if not applicable)" ) } - .stopInCaseOfConflictingArguments(lambda1, "lambda1", median1, "median1") - .stopInCaseOfConflictingArguments(lambda2, "lambda2", median2, "median2") + self$.stopInCaseOfConflictingArguments(self$lambda1, "lambda1", self$median1, "median1") + self$.stopInCaseOfConflictingArguments(self$lambda2, "lambda2", self$median2, "median2") - .stopInCaseOfConflictingArguments(pi1, "pi1", median1, "median1") - .stopInCaseOfConflictingArguments(pi1, "pi1", median2, "median2") - .stopInCaseOfConflictingArguments(pi1, "pi1", lambda1, "lambda1") - .stopInCaseOfConflictingArguments(pi1, "pi1", lambda2, "lambda2") - .stopInCaseOfConflictingArguments(pi2, "pi2", median1, "median1") - .stopInCaseOfConflictingArguments(pi2, "pi2", median2, "median2") - .stopInCaseOfConflictingArguments(pi2, "pi2", lambda1, "lambda1") - .stopInCaseOfConflictingArguments(pi2, "pi2", lambda2, "lambda2") + self$.stopInCaseOfConflictingArguments(self$pi1, "pi1", self$median1, "median1") + self$.stopInCaseOfConflictingArguments(self$pi1, "pi1", self$median2, "median2") + self$.stopInCaseOfConflictingArguments(self$pi1, "pi1", self$lambda1, "lambda1") + self$.stopInCaseOfConflictingArguments(self$pi1, "pi1", self$lambda2, "lambda2") + self$.stopInCaseOfConflictingArguments(self$pi2, "pi2", self$median1, "median1") + self$.stopInCaseOfConflictingArguments(self$pi2, "pi2", self$median2, "median2") + self$.stopInCaseOfConflictingArguments(self$pi2, "pi2", self$lambda1, "lambda1") + self$.stopInCaseOfConflictingArguments(self$pi2, "pi2", self$lambda2, "lambda2") - if (length(median1) > 0 && !all(is.na(median1))) { - .self$lambda1 <<- getLambdaByMedian(median1, kappa = kappa) - .setParameterType("median1", C_PARAM_USER_DEFINED) - .setParameterType("lambda1", C_PARAM_GENERATED) + if (length(self$median1) > 0 && !all(is.na(self$median1))) { + self$lambda1 <- getLambdaByMedian(self$median1, kappa = self$kappa) + self$.setParameterType("median1", C_PARAM_USER_DEFINED) + self$.setParameterType("lambda1", C_PARAM_GENERATED) } else { - .setParameterType("median1", C_PARAM_NOT_APPLICABLE) - .setParameterType("lambda1", ifelse(length(lambda1) == 1 && is.na(lambda1), + self$.setParameterType("median1", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("lambda1", ifelse(length(self$lambda1) == 1 && is.na(self$lambda1), C_PARAM_NOT_APPLICABLE, C_PARAM_USER_DEFINED )) } - if (length(median2) > 0 && !all(is.na(median2))) { - .self$lambda2 <<- getLambdaByMedian(median2, kappa = kappa) - .setParameterType("median2", C_PARAM_USER_DEFINED) - .setParameterType("lambda2", C_PARAM_GENERATED) + if (length(self$median2) > 0 && !all(is.na(self$median2))) { + self$lambda2 <- getLambdaByMedian(self$median2, kappa = self$kappa) + self$.setParameterType("median2", C_PARAM_USER_DEFINED) + self$.setParameterType("lambda2", C_PARAM_GENERATED) } else { - .setParameterType("median2", C_PARAM_NOT_APPLICABLE) - .setParameterType("lambda2", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("median2", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("lambda2", C_PARAM_NOT_APPLICABLE) } args <- list(...) if (!is.null(args[[".pi1Default"]])) { - .pi1Default <<- args[[".pi1Default"]] + self$.pi1Default <- args[[".pi1Default"]] } if (!is.null(args[[".lambdaBased"]])) { - .lambdaBased <<- args[[".lambdaBased"]] + self$.lambdaBased <- args[[".lambdaBased"]] } if (!is.null(args[[".silent"]])) { - .silent <<- args[[".silent"]] + self$.silent <- args[[".silent"]] } else { - .silent <<- FALSE + self$.silent <- FALSE } - piecewiseSurvivalEnabled <<- FALSE - delayedResponseEnabled <<- FALSE + self$piecewiseSurvivalEnabled <- FALSE + self$delayedResponseEnabled <- FALSE - .setParameterType("piecewiseSurvivalTime", C_PARAM_NOT_APPLICABLE) - .setParameterType("piecewiseSurvivalEnabled", C_PARAM_GENERATED) - .setParameterType("delayedResponseEnabled", ifelse(isTRUE(delayedResponseAllowed), + self$.setParameterType("piecewiseSurvivalTime", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("piecewiseSurvivalEnabled", C_PARAM_GENERATED) + self$.setParameterType("delayedResponseEnabled", ifelse(isTRUE(self$delayedResponseAllowed), C_PARAM_GENERATED, C_PARAM_NOT_APPLICABLE )) - .setParameterType("delayedResponseAllowed", ifelse(isTRUE(delayedResponseAllowed), + self$.setParameterType("delayedResponseAllowed", ifelse(isTRUE(self$delayedResponseAllowed), C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE )) - .setParameterType("pi1", C_PARAM_NOT_APPLICABLE) - .setParameterType("pi2", C_PARAM_NOT_APPLICABLE) - .setParameterType("eventTime", ifelse(length(eventTime) == 1 && is.na(eventTime), + self$.setParameterType("pi1", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("pi2", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("eventTime", ifelse(length(self$eventTime) == 1 && is.na(self$eventTime), C_PARAM_NOT_APPLICABLE, - ifelse(eventTime == C_EVENT_TIME_DEFAULT, C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED) + ifelse(self$eventTime == C_EVENT_TIME_DEFAULT, C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED) )) - .setParameterType("kappa", ifelse(length(kappa) == 1 && !is.na(kappa) && kappa == 1, + self$.setParameterType("kappa", ifelse(length(self$kappa) == 1 && !is.na(self$kappa) && self$kappa == 1, C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED )) - .init(piecewiseSurvivalTime) + self$.init(self$piecewiseSurvivalTime) - if (.getParameterType("median1") == C_PARAM_USER_DEFINED && - .getParameterType("lambda1") == C_PARAM_USER_DEFINED) { - .setParameterType("lambda1", C_PARAM_GENERATED) + if (self$.getParameterType("median1") == C_PARAM_USER_DEFINED && + self$.getParameterType("lambda1") == C_PARAM_USER_DEFINED) { + self$.setParameterType("lambda1", C_PARAM_GENERATED) } - if (.getParameterType("median2") == C_PARAM_USER_DEFINED && - .getParameterType("lambda2") == C_PARAM_USER_DEFINED) { - .setParameterType("lambda2", C_PARAM_GENERATED) + if (self$.getParameterType("median2") == C_PARAM_USER_DEFINED && + self$.getParameterType("lambda2") == C_PARAM_USER_DEFINED) { + self$.setParameterType("lambda2", C_PARAM_GENERATED) } - if (!is.na(eventTime) && - .getParameterType("pi1") != C_PARAM_USER_DEFINED && - .getParameterType("pi1") != C_PARAM_DEFAULT_VALUE && - .getParameterType("pi2") != C_PARAM_USER_DEFINED && - .getParameterType("pi2") != C_PARAM_DEFAULT_VALUE) { - if (.getParameterType("eventTime") == C_PARAM_USER_DEFINED) { - warning("'eventTime' (", round(eventTime, 3), ") will be ignored", call. = FALSE) + if (!is.na(self$eventTime) && + self$.getParameterType("pi1") != C_PARAM_USER_DEFINED && + self$.getParameterType("pi1") != C_PARAM_DEFAULT_VALUE && + self$.getParameterType("pi2") != C_PARAM_USER_DEFINED && + self$.getParameterType("pi2") != C_PARAM_DEFAULT_VALUE) { + if (self$.getParameterType("eventTime") == C_PARAM_USER_DEFINED) { + warning("'eventTime' (", round(self$eventTime, 3), ") will be ignored", call. = FALSE) } - .setParameterType("eventTime", C_PARAM_NOT_APPLICABLE) - eventTime <<- NA_real_ + self$.setParameterType("eventTime", C_PARAM_NOT_APPLICABLE) + self$eventTime <- NA_real_ } - .validateCalculatedArguments() + self$.validateCalculatedArguments() }, .validateCalculatedArguments = function() { - if (.getParameterType("median1") == C_PARAM_USER_DEFINED) { - if (!isTRUE(all.equal(getLambdaByMedian(median1, kappa = kappa), lambda1, tolerance = 1e-05))) { + if (self$.getParameterType("median1") == C_PARAM_USER_DEFINED) { + if (!isTRUE(all.equal(getLambdaByMedian(self$median1, kappa = self$kappa), self$lambda1, tolerance = 1e-05))) { stop( C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'lambda1' must be ", - round(getLambdaByMedian(median1, kappa = kappa), 5), ", but is ", round(lambda1, 5) + round(getLambdaByMedian(self$median1, kappa = self$kappa), 5), ", but is ", round(self$lambda1, 5) ) } - if (!any(is.na(pi1)) && - !isTRUE(all.equal(getPiByMedian(median1, eventTime = eventTime, kappa = kappa), - pi1, + if (!any(is.na(self$pi1)) && + !isTRUE(all.equal(getPiByMedian(self$median1, eventTime = self$eventTime, kappa = self$kappa), + self$pi1, tolerance = 1e-05 ))) { stop( C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'pi1' must be ", - round(getPiByMedian(median1, eventTime = eventTime, kappa = kappa), 5), ", but is ", round(pi1, 5) + round(getPiByMedian(self$median1, eventTime = self$eventTime, kappa = self$kappa), 5), ", but is ", round(self$pi1, 5) ) } } - if (.getParameterType("median2") == C_PARAM_USER_DEFINED) { - if (!isTRUE(all.equal(getLambdaByMedian(median2, kappa = kappa), lambda2, tolerance = 1e-05))) { + if (self$.getParameterType("median2") == C_PARAM_USER_DEFINED) { + if (!isTRUE(all.equal(getLambdaByMedian(self$median2, kappa = self$kappa), self$lambda2, tolerance = 1e-05))) { stop( C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'lambda2' must be ", - round(getLambdaByMedian(median2, kappa = kappa), 5), ", but is ", round(lambda2, 5) + round(getLambdaByMedian(self$median2, kappa = self$kappa), 5), ", but is ", round(self$lambda2, 5) ) } - if (!is.na(pi2) && - !isTRUE(all.equal(getPiByMedian(median2, eventTime = eventTime, kappa = kappa), - pi2, + if (!is.na(self$pi2) && + !isTRUE(all.equal(getPiByMedian(self$median2, eventTime = self$eventTime, kappa = self$kappa), + self$pi2, tolerance = 1e-05 ))) { stop( C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'pi2' must be ", - round(getPiByMedian(median2, eventTime = eventTime, kappa = kappa), 5), ", but is ", round(pi2, 5) + round(getPiByMedian(self$median2, eventTime = self$eventTime, kappa = self$kappa), 5), ", but is ", round(self$pi2, 5) ) } } - if (.getParameterType("lambda1") == C_PARAM_USER_DEFINED || - .getParameterType("median1") == C_PARAM_USER_DEFINED || - .getParameterType("lambda2") == C_PARAM_USER_DEFINED || - .getParameterType("median2") == C_PARAM_USER_DEFINED) { - if (!any(is.na(pi1))) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'pi1' (", pi1, ") must be NA_real_") + if (self$.getParameterType("lambda1") == C_PARAM_USER_DEFINED || + self$.getParameterType("median1") == C_PARAM_USER_DEFINED || + self$.getParameterType("lambda2") == C_PARAM_USER_DEFINED || + self$.getParameterType("median2") == C_PARAM_USER_DEFINED) { + if (!any(is.na(self$pi1))) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'pi1' (", self$pi1, ") must be NA_real_") } - if (.getParameterType("pi1") != C_PARAM_NOT_APPLICABLE) { + if (self$.getParameterType("pi1") != C_PARAM_NOT_APPLICABLE) { stop( C_EXCEPTION_TYPE_RUNTIME_ISSUE, "parameter type of 'pi1' (", - .getParameterType("pi1"), ") must be C_PARAM_NOT_APPLICABLE" + self$.getParameterType("pi1"), ") must be C_PARAM_NOT_APPLICABLE" ) } - if (!any(is.na(pi1))) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'pi2' (", pi2, ") must be NA_real_") + if (!any(is.na(self$pi1))) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'pi2' (", self$pi2, ") must be NA_real_") } - if (.getParameterType("pi2") != C_PARAM_NOT_APPLICABLE) { + if (self$.getParameterType("pi2") != C_PARAM_NOT_APPLICABLE) { stop( C_EXCEPTION_TYPE_RUNTIME_ISSUE, "parameter type of 'pi2' (", - .getParameterType("pi2"), ") must be C_PARAM_NOT_APPLICABLE" + self$.getParameterType("pi2"), ") must be C_PARAM_NOT_APPLICABLE" ) } - if (!any(is.na(eventTime))) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'eventTime' (", eventTime, ") must be NA_real_") + if (!any(is.na(self$eventTime))) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'eventTime' (", self$eventTime, ") must be NA_real_") } - if (.getParameterType("eventTime") != C_PARAM_NOT_APPLICABLE) { + if (self$.getParameterType("eventTime") != C_PARAM_NOT_APPLICABLE) { stop( C_EXCEPTION_TYPE_RUNTIME_ISSUE, "parameter type of 'eventTime' (", - .getParameterType("eventTime"), ") must be C_PARAM_NOT_APPLICABLE" + self$.getParameterType("eventTime"), ") must be C_PARAM_NOT_APPLICABLE" ) } } - if (.getParameterType("hazardRatio") == C_PARAM_TYPE_UNKNOWN) { + if (self$.getParameterType("hazardRatio") == C_PARAM_TYPE_UNKNOWN) { stop( C_EXCEPTION_TYPE_RUNTIME_ISSUE, "parameter type of 'hazardRatio' (", - hazardRatio, ") must be != C_PARAM_TYPE_UNKNOWN" + self$hazardRatio, ") must be != C_PARAM_TYPE_UNKNOWN" ) } }, @@ -426,9 +624,9 @@ PiecewiseSurvivalTime <- setRefClass("PiecewiseSurvivalTime", }, .asDataFrame = function() { data <- data.frame( - piecewiseSurvivalTime = piecewiseSurvivalTime, - lambda1 = lambda1, - lambda2 = lambda2 + piecewiseSurvivalTime = self$piecewiseSurvivalTime, + lambda1 = self$lambda1, + lambda2 = self$lambda2 ) rownames(data) <- as.character(1:nrow(data)) colnames(data) <- c( @@ -439,48 +637,48 @@ PiecewiseSurvivalTime <- setRefClass("PiecewiseSurvivalTime", return(data) }, .isPiBased = function() { - return(!.isLambdaBased()) + return(!self$.isLambdaBased()) }, .isLambdaBased = function(minNumberOfLambdas = 2) { - if (.getParameterType("lambda2") == C_PARAM_USER_DEFINED || - .getParameterType("median2") == C_PARAM_USER_DEFINED) { - if (length(lambda2) >= minNumberOfLambdas && !any(is.na(lambda2))) { + if (self$.getParameterType("lambda2") == C_PARAM_USER_DEFINED || + self$.getParameterType("median2") == C_PARAM_USER_DEFINED) { + if (length(self$lambda2) >= minNumberOfLambdas && !any(is.na(self$lambda2))) { return(TRUE) } } - return((length(pi1) == 0 || any(is.na(pi1))) && (length(pi2) == 0 || any(is.na(pi2)))) + return((length(self$pi1) == 0 || any(is.na(self$pi1))) && (length(self$pi2) == 0 || any(is.na(self$pi2)))) }, show = function(showType = 1, digits = NA_integer_) { - .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) }, .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { "Method for automatically printing piecewise survival time objects" - .resetCat() + self$.resetCat() if (showType == 2) { - callSuper(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) } else { - .cat("Piecewise exponential survival times:\n", + self$.cat("Piecewise exponential survival times:\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled ) - if (!piecewiseSurvivalEnabled) { - .cat(" Piecewise exponential survival is disabled.\n\n", consoleOutputEnabled = consoleOutputEnabled) - } else if (length(piecewiseSurvivalTime) == 1) { - .cat(" At all times:", lambda2[1], "\n\n", consoleOutputEnabled = consoleOutputEnabled) + if (!self$piecewiseSurvivalEnabled) { + self$.cat(" Piecewise exponential survival is disabled.\n\n", consoleOutputEnabled = consoleOutputEnabled) + } else if (length(self$piecewiseSurvivalTime) == 1) { + self$.cat(" At all times:", self$lambda2[1], "\n\n", consoleOutputEnabled = consoleOutputEnabled) } else { - piecewiseSurvivalTimeStr <- format(piecewiseSurvivalTime) - lambda2Str <- format(lambda2) - for (i in 1:length(piecewiseSurvivalTime)) { - if (i < length(piecewiseSurvivalTime)) { - .cat(" ", piecewiseSurvivalTimeStr[i], " - <", + piecewiseSurvivalTimeStr <- format(self$piecewiseSurvivalTime) + lambda2Str <- format(self$lambda2) + for (i in 1:length(self$piecewiseSurvivalTime)) { + if (i < length(self$piecewiseSurvivalTime)) { + self$.cat(" ", piecewiseSurvivalTimeStr[i], " - <", piecewiseSurvivalTimeStr[i + 1], ": ", lambda2Str[i], "\n", sep = "", consoleOutputEnabled = consoleOutputEnabled ) } else { - .cat(" ", rep(" ", 2 + max(nchar(piecewiseSurvivalTimeStr))), + self$.cat(" ", rep(" ", 2 + max(nchar(piecewiseSurvivalTimeStr))), ">=", piecewiseSurvivalTimeStr[i], ": ", lambda2Str[i], "\n", sep = "", @@ -488,23 +686,23 @@ PiecewiseSurvivalTime <- setRefClass("PiecewiseSurvivalTime", ) } } - if (delayedResponseEnabled) { - .cat("Delayed response is enabled.\n", consoleOutputEnabled = consoleOutputEnabled) + if (self$delayedResponseEnabled) { + self$.cat("Delayed response is enabled.\n", consoleOutputEnabled = consoleOutputEnabled) } - .cat("\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) } - .cat("Details:\n\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) - .showParametersOfOneGroup(.getUserDefinedParameters(), "User defined parameters", + self$.cat("Details:\n\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) + self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled ) - .showParametersOfOneGroup(.getDefaultParameters(), "Default parameters", + self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled ) - .showParametersOfOneGroup(.getGeneratedParameters(), "Generated parameters", + self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Generated parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled ) - .showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) } }, .toString = function(startWithUpperCase = FALSE) { @@ -512,14 +710,14 @@ PiecewiseSurvivalTime <- setRefClass("PiecewiseSurvivalTime", return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) }, isDelayedResponseEnabled = function() { - return(delayedResponseEnabled) + return(self$delayedResponseEnabled) }, isPiecewiseSurvivalEnabled = function() { - if (length(piecewiseSurvivalTime) == 0) { + if (length(self$piecewiseSurvivalTime) == 0) { return(FALSE) } - if (length(piecewiseSurvivalTime) == 1 && is.na(piecewiseSurvivalTime)) { + if (length(self$piecewiseSurvivalTime) == 1 && is.na(self$piecewiseSurvivalTime)) { return(FALSE) } @@ -541,8 +739,8 @@ PiecewiseSurvivalTime <- setRefClass("PiecewiseSurvivalTime", stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'piecewiseSurvivalTime' must be a named list") } - if (!all(is.na(lambda2))) { - warning("'lambda2' (", .arrayToString(lambda2), + if (!all(is.na(self$lambda2))) { + warning("'lambda2' (", .arrayToString(self$lambda2), ") will be ignored because 'piecewiseSurvivalTime' is a list", call. = FALSE ) @@ -556,7 +754,7 @@ PiecewiseSurvivalTime <- setRefClass("PiecewiseSurvivalTime", lambdaValue <- pwSurvTimeList[[timePeriod]] .assertIsSingleNumber(lambdaValue, paste0("pwSurvLambda[", i, "]")) - timePeriod <- .validateTimePeriod(timePeriod, i = i, n = length(pwSurvTimeNames)) + timePeriod <- self$.validateTimePeriod(timePeriod, i = i, n = length(pwSurvTimeNames)) if (i < length(pwSurvTimeNames)) { parts <- strsplit(timePeriod, "- *(< *)?", perl = TRUE)[[1]] @@ -573,215 +771,215 @@ PiecewiseSurvivalTime <- setRefClass("PiecewiseSurvivalTime", pwSurvLambda2 <- c(pwSurvLambda2, lambdaValue) } - piecewiseSurvivalTime <<- pwSurvStartTimes - .setParameterType("piecewiseSurvivalTime", C_PARAM_USER_DEFINED) - if (length(hazardRatio) == 1 && !is.na(hazardRatio)) { - lambda1 <<- pwSurvLambda2 * hazardRatio^(1 / kappa) - .setParameterType("lambda1", C_PARAM_GENERATED) - } else if (length(hazardRatio) > 1 && delayedResponseAllowed) { - if (length(hazardRatio) != length(pwSurvLambda2)) { - warning("Only the first 'hazardRatio' (", round(hazardRatio[1], 4), + self$piecewiseSurvivalTime <- pwSurvStartTimes + self$.setParameterType("piecewiseSurvivalTime", C_PARAM_USER_DEFINED) + if (length(self$hazardRatio) == 1 && !is.na(self$hazardRatio)) { + self$lambda1 <- pwSurvLambda2 * self$hazardRatio^(1 / self$kappa) + self$.setParameterType("lambda1", C_PARAM_GENERATED) + } else if (length(self$hazardRatio) > 1 && self$delayedResponseAllowed) { + if (length(self$hazardRatio) != length(pwSurvLambda2)) { + warning("Only the first 'hazardRatio' (", round(self$hazardRatio[1], 4), ") was used for piecewise survival time definition ", "(use a loop over the function to simulate different hazard ratios)", call. = FALSE ) - hazardRatio <<- hazardRatio[1] + self$hazardRatio <- self$hazardRatio[1] } else { - delayedResponseEnabled <<- TRUE + self$delayedResponseEnabled <- TRUE } - lambda1 <<- pwSurvLambda2 * hazardRatio^(1 / kappa) - .setParameterType("lambda1", C_PARAM_GENERATED) + self$lambda1 <- pwSurvLambda2 * self$hazardRatio^(1 / self$kappa) + self$.setParameterType("lambda1", C_PARAM_GENERATED) } else { - lambda1 <<- NA_real_ - .setParameterType("lambda1", C_PARAM_NOT_APPLICABLE) + self$lambda1 <- NA_real_ + self$.setParameterType("lambda1", C_PARAM_NOT_APPLICABLE) } - lambda2 <<- pwSurvLambda2 - .setParameterType("lambda2", C_PARAM_USER_DEFINED) + self$lambda2 <- pwSurvLambda2 + self$.setParameterType("lambda2", C_PARAM_USER_DEFINED) - piecewiseSurvivalEnabled <<- !identical(piecewiseSurvivalTime, 0) + self$piecewiseSurvivalEnabled <- !identical(self$piecewiseSurvivalTime, 0) }, .init = function(pwSurvTime) { .logDebug("pwSurvTime %s, %s", ifelse(is.numeric(pwSurvTime), .arrayToString(pwSurvTime), pwSurvTime ), .getClassName(pwSurvTime[1])) - .logDebug("lambda1 %s, %s", lambda1, .getParameterType("lambda1")) - .logDebug("lambda2 %s, %s", lambda2, .getParameterType("lambda2")) + .logDebug("lambda1 %s, %s", self$lambda1, self$.getParameterType("lambda1")) + .logDebug("lambda2 %s, %s", self$lambda2, self$.getParameterType("lambda2")) # case 1: lambda1 and lambda2 = NA or generated if (length(pwSurvTime) == 1 && (is.na(pwSurvTime) || is.numeric(pwSurvTime)) && - (all(is.na(lambda1)) || .getParameterType("lambda1") == C_PARAM_GENERATED) && - length(lambda2) == 1 && (is.na(lambda2) || .getParameterType("lambda2") == C_PARAM_GENERATED) + (all(is.na(self$lambda1)) || self$.getParameterType("lambda1") == C_PARAM_GENERATED) && + length(self$lambda2) == 1 && (is.na(self$lambda2) || self$.getParameterType("lambda2") == C_PARAM_GENERATED) ) { .logDebug(".init, case 1: lambda1 and lambda2 = NA") - if (!is.null(.lambdaBased) && isTRUE(.lambdaBased)) { + if (!is.null(self$.lambdaBased) && isTRUE(self$.lambdaBased)) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'lambda1' and 'lambda2' must be specified") } - if (!any(is.na(hazardRatio))) { - .setParameterType("hazardRatio", C_PARAM_USER_DEFINED) + if (!any(is.na(self$hazardRatio))) { + self$.setParameterType("hazardRatio", C_PARAM_USER_DEFINED) } if (!is.na(pwSurvTime)) { warning("'piecewiseSurvivalTime' (", pwSurvTime, ") will be ignored") } - if (is.na(pi2)) { - if (!is.na(median2) || !any(is.na(median1))) { + if (is.na(self$pi2)) { + if (!is.na(self$median2) || !any(is.na(self$median1))) { .logDebug(".init: set pi2 to 'not applicable'") - .setParameterType("pi2", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("pi2", C_PARAM_NOT_APPLICABLE) } else { .logDebug(".init: set pi2 to default") - pi2 <<- C_PI_2_DEFAULT - .setParameterType("pi2", C_PARAM_DEFAULT_VALUE) + self$pi2 <- C_PI_2_DEFAULT + self$.setParameterType("pi2", C_PARAM_DEFAULT_VALUE) } } else { - .assertIsSingleNumber(pi2, "pi2") - .setParameterType("pi2", ifelse(pi2 == C_PI_2_DEFAULT, + .assertIsSingleNumber(self$pi2, "pi2") + self$.setParameterType("pi2", ifelse(self$pi2 == C_PI_2_DEFAULT, C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED )) - if (!any(is.na(median2))) { - warning("'median2' (", .arrayToString(median2), ") will be ignored") - median2 <<- NA_real_ + if (!any(is.na(self$median2))) { + warning("'median2' (", .arrayToString(self$median2), ") will be ignored") + self$median2 <- NA_real_ } } hazardRatioCalculationEnabled <- TRUE - if (all(is.na(pi1))) { - if (length(hazardRatio) > 0 && !all(is.na(hazardRatio))) { - .setParameterType("hazardRatio", C_PARAM_USER_DEFINED) + if (all(is.na(self$pi1))) { + if (length(self$hazardRatio) > 0 && !all(is.na(self$hazardRatio))) { + self$.setParameterType("hazardRatio", C_PARAM_USER_DEFINED) hazardRatioCalculationEnabled <- FALSE } - if (!any(is.na(median1))) { + if (!any(is.na(self$median1))) { .logDebug(".init: set pi1 to 'not applicable'") - .setParameterType("pi1", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("pi1", C_PARAM_NOT_APPLICABLE) - if (is.na(median2)) { - if (any(is.na(hazardRatio))) { + if (is.na(self$median2)) { + if (any(is.na(self$hazardRatio))) { stop( C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'hazardRatio', 'lambda2', or 'median2' must be specified" ) } - if (length(hazardRatio) != length(median1)) { + if (length(self$hazardRatio) != length(self$median1)) { stop( C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, - "length of 'hazardRatio' (", .arrayToString(hazardRatio), ") must be ", - "equal to length of 'median1' (", .arrayToString(median1), ")" + "length of 'hazardRatio' (", .arrayToString(self$hazardRatio), ") must be ", + "equal to length of 'median1' (", .arrayToString(self$median1), ")" ) } .logDebug(".init: calculate lambda2 and median2 by median1") - lambda2 <<- getLambdaByMedian(median1, kappa) / hazardRatio^(1 / kappa) + self$lambda2 <- getLambdaByMedian(self$median1, self$kappa) / self$hazardRatio^(1 / self$kappa) - if (!delayedResponseAllowed && length(unique(round(lambda2, 8))) > 1) { + if (!self$delayedResponseAllowed && length(unique(round(self$lambda2, 8))) > 1) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'lambda2' can only be calculated if 'unique(lambda1 / hazardRatio^(1 / kappa))' ", "result in a single value; current result = ", - .arrayToString(round(lambda2, 4), vectorLookAndFeelEnabled = TRUE), + .arrayToString(round(self$lambda2, 4), vectorLookAndFeelEnabled = TRUE), " (e.g., delayed response is not allowed)" ) } - median2 <<- getMedianByLambda(lambda2, kappa) - .setParameterType("lambda2", C_PARAM_GENERATED) - .setParameterType("median2", C_PARAM_GENERATED) + self$median2 <- getMedianByLambda(self$lambda2, self$kappa) + self$.setParameterType("lambda2", C_PARAM_GENERATED) + self$.setParameterType("median2", C_PARAM_GENERATED) } - } else if (length(hazardRatio) > 0 && !all(is.na(hazardRatio))) { - .setParameterType("pi1", C_PARAM_NOT_APPLICABLE) + } else if (length(self$hazardRatio) > 0 && !all(is.na(self$hazardRatio))) { + self$.setParameterType("pi1", C_PARAM_NOT_APPLICABLE) - if (!any(is.na(lambda1))) { + if (!any(is.na(self$lambda1))) { .logDebug(".init: calculate median1 by lambda1") - median1 <<- getMedianByLambda(lambda1, kappa) - .setParameterType("median1", C_PARAM_GENERATED) - } else if (!is.na(median2)) { + self$median1 <- getMedianByLambda(self$lambda1, self$kappa) + self$.setParameterType("median1", C_PARAM_GENERATED) + } else if (!is.na(self$median2)) { .logDebug(".init: calculate lambda1 and median1 by median2") - lambda1 <<- getLambdaByMedian(median2, kappa) * hazardRatio^(1 / kappa) - median1 <<- getMedianByLambda(lambda1, kappa) - .setParameterType("lambda1", C_PARAM_GENERATED) - .setParameterType("median1", C_PARAM_GENERATED) + self$lambda1 <- getLambdaByMedian(self$median2, self$kappa) * self$hazardRatio^(1 / self$kappa) + self$median1 <- getMedianByLambda(self$lambda1, self$kappa) + self$.setParameterType("lambda1", C_PARAM_GENERATED) + self$.setParameterType("median1", C_PARAM_GENERATED) } } else { .logDebug(".init: set pi1 to default") - if (!is.null(.pi1Default) && is.numeric(.pi1Default) && - length(.pi1Default) > 0) { - pi1 <<- .pi1Default + if (!is.null(self$.pi1Default) && is.numeric(self$.pi1Default) && + length(self$.pi1Default) > 0) { + self$pi1 <- self$.pi1Default } else { - pi1 <<- C_PI_1_SAMPLE_SIZE_DEFAULT + self$pi1 <- C_PI_1_SAMPLE_SIZE_DEFAULT } - .setParameterType("pi1", C_PARAM_DEFAULT_VALUE) + self$.setParameterType("pi1", C_PARAM_DEFAULT_VALUE) } } else { - .assertIsNumericVector(pi1, "pi1") - if (!any(is.na(median1))) { + .assertIsNumericVector(self$pi1, "pi1") + if (!any(is.na(self$median1))) { .logDebug(".init: set median1 to NA") - warning("'median1' (", .arrayToString(median1), ") will be ignored") - median1 <<- NA_real_ + warning("'median1' (", .arrayToString(self$median1), ") will be ignored") + self$median1 <- NA_real_ } } if (hazardRatioCalculationEnabled) { - if (length(hazardRatio) > 0 && !all(is.na(hazardRatio))) { - warning("'hazardRatio' (", .arrayToString(hazardRatio), + if (length(self$hazardRatio) > 0 && !all(is.na(self$hazardRatio))) { + warning("'hazardRatio' (", .arrayToString(self$hazardRatio), ") will be ignored because it will be calculated", call. = FALSE ) } - if (!any(is.na(lambda1)) && !is.na(lambda2)) { + if (!any(is.na(self$lambda1)) && !is.na(self$lambda2)) { .logDebug(".init: calculate hazardRatio by lambda1 and lambda2") - hazardRatio <<- (lambda1 / lambda2)^kappa - .setParameterType("hazardRatio", C_PARAM_GENERATED) - } else if (!any(is.na(pi1)) && !is.na(pi2)) { + self$hazardRatio <- (self$lambda1 / self$lambda2)^self$kappa + self$.setParameterType("hazardRatio", C_PARAM_GENERATED) + } else if (!any(is.na(self$pi1)) && !is.na(self$pi2)) { .logDebug(".init: calculate hazardRatio by pi1 and pi2") - hazardRatio <<- getHazardRatioByPi(pi1, pi2, eventTime, kappa = kappa) - .setParameterType("hazardRatio", C_PARAM_GENERATED) + self$hazardRatio <- getHazardRatioByPi(self$pi1, self$pi2, self$eventTime, kappa = self$kappa) + self$.setParameterType("hazardRatio", C_PARAM_GENERATED) } } - if (length(pi1) > 0 && !any(is.na(pi1))) { + if (length(self$pi1) > 0 && !any(is.na(self$pi1))) { pi1Default <- C_PI_1_SAMPLE_SIZE_DEFAULT - if (!is.null(.pi1Default) && is.numeric(.pi1Default) && - length(.pi1Default) > 0) { - pi1Default <- .pi1Default + if (!is.null(self$.pi1Default) && is.numeric(self$.pi1Default) && + length(self$.pi1Default) > 0) { + pi1Default <- self$.pi1Default } - if (identical(pi1, pi1Default)) { - .setParameterType("pi1", C_PARAM_DEFAULT_VALUE) - } else if (hazardRatioCalculationEnabled && .getParameterType("pi1") != C_PARAM_GENERATED) { - .setParameterType("pi1", C_PARAM_USER_DEFINED) + if (identical(self$pi1, pi1Default)) { + self$.setParameterType("pi1", C_PARAM_DEFAULT_VALUE) + } else if (hazardRatioCalculationEnabled && self$.getParameterType("pi1") != C_PARAM_GENERATED) { + self$.setParameterType("pi1", C_PARAM_USER_DEFINED) } } - if (length(pi2) == 1 && !is.na(pi2)) { - if (length(eventTime) == 1 && !is.na(eventTime)) { - lambda2 <<- getLambdaByPi(pi2, eventTime, kappa = kappa) - .setParameterType("lambda2", C_PARAM_GENERATED) + if (length(self$pi2) == 1 && !is.na(self$pi2)) { + if (length(self$eventTime) == 1 && !is.na(self$eventTime)) { + self$lambda2 <- getLambdaByPi(self$pi2, self$eventTime, kappa = self$kappa) + self$.setParameterType("lambda2", C_PARAM_GENERATED) } - if (length(pi1) == 1 && is.na(pi1) && !any(is.na(hazardRatio))) { - pi1 <<- getPiByLambda( + if (length(self$pi1) == 1 && is.na(self$pi1) && !any(is.na(self$hazardRatio))) { + self$pi1 <- getPiByLambda( getLambdaByPi( - pi2, eventTime, - kappa = kappa - ) * hazardRatio^(1 / kappa), - eventTime, - kappa = kappa + self$pi2, self$eventTime, + kappa = self$kappa + ) * self$hazardRatio^(1 / self$kappa), + self$eventTime, + kappa = self$kappa ) - .setParameterType("pi1", C_PARAM_GENERATED) + self$.setParameterType("pi1", C_PARAM_GENERATED) } - if (length(pi1) > 0 && !any(is.na(pi1)) && - length(eventTime) == 1 && !is.na(eventTime)) { - lambda1 <<- getLambdaByPi(pi1, eventTime, kappa = kappa) - .setParameterType("lambda1", C_PARAM_GENERATED) + if (length(self$pi1) > 0 && !any(is.na(self$pi1)) && + length(self$eventTime) == 1 && !is.na(self$eventTime)) { + self$lambda1 <- getLambdaByPi(self$pi1, self$eventTime, kappa = self$kappa) + self$.setParameterType("lambda1", C_PARAM_GENERATED) } } - .initMedian() + self$.initMedian() return(invisible()) } @@ -790,64 +988,64 @@ PiecewiseSurvivalTime <- setRefClass("PiecewiseSurvivalTime", } if (is.list(pwSurvTime)) { - .assertIsValidHazardRatioVector(hazardRatio) - .initFromList(pwSurvTime) - .initHazardRatio() - if (!piecewiseSurvivalEnabled) { - .initPi() - .initMedian() - } - } else if (delayedResponseAllowed && length(lambda2) == 1 && - !is.na(lambda2) && length(hazardRatio) > 0 && + .assertIsValidHazardRatioVector(self$hazardRatio) + self$.initFromList(pwSurvTime) + self$.initHazardRatio() + if (!self$piecewiseSurvivalEnabled) { + self$.initPi() + self$.initMedian() + } + } else if (self$delayedResponseAllowed && length(self$lambda2) == 1 && + !is.na(self$lambda2) && length(self$hazardRatio) > 0 && (all(is.na(pwSurvTime)) || identical(pwSurvTime, 0))) { .logDebug(".init, case 2: delayedResponseAllowed") - piecewiseSurvivalEnabled <<- FALSE + self$piecewiseSurvivalEnabled <- FALSE if (!all(is.na(pwSurvTime)) && !identical(pwSurvTime, 0)) { warning("'piecewiseSurvivalTime' (", .arrayToString(pwSurvTime), ") will be ignored") } - piecewiseSurvivalTime <<- 0 + self$piecewiseSurvivalTime <- 0 - .initPi() - .initHazardRatio() - .initMedian() + self$.initPi() + self$.initHazardRatio() + self$.initMedian() } else if (!is.numeric(pwSurvTime)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'piecewiseSurvivalTime' must be a list, a numeric value, or vector" ) } else { - piecewiseSurvivalTime <<- pwSurvTime - if ((all(is.na(piecewiseSurvivalTime)) || identical(piecewiseSurvivalTime, 0)) && - length(lambda2) == 1 && !is.na(lambda2)) { + self$piecewiseSurvivalTime <- pwSurvTime + if ((all(is.na(self$piecewiseSurvivalTime)) || identical(self$piecewiseSurvivalTime, 0)) && + length(self$lambda2) == 1 && !is.na(self$lambda2)) { .logDebug(".init, case 3: piecewise survival is disabled") - if (!all(is.na(piecewiseSurvivalTime)) && !identical(piecewiseSurvivalTime, 0)) { - warning("'piecewiseSurvivalTime' (", .arrayToString(piecewiseSurvivalTime), ") will be ignored") + if (!all(is.na(self$piecewiseSurvivalTime)) && !identical(self$piecewiseSurvivalTime, 0)) { + warning("'piecewiseSurvivalTime' (", .arrayToString(self$piecewiseSurvivalTime), ") will be ignored") } - piecewiseSurvivalTime <<- 0 - .setParameterType("piecewiseSurvivalTime", C_PARAM_DEFAULT_VALUE) - piecewiseSurvivalEnabled <<- FALSE - .initHazardRatio() - .initPi() - .initMedian() + self$piecewiseSurvivalTime <- 0 + self$.setParameterType("piecewiseSurvivalTime", C_PARAM_DEFAULT_VALUE) + self$piecewiseSurvivalEnabled <- FALSE + self$.initHazardRatio() + self$.initPi() + self$.initMedian() } else { .logDebug(".init, case 3: piecewise survival is enabled") - if (all(is.na(piecewiseSurvivalTime))) { - if (.getParameterType("median1") == C_PARAM_USER_DEFINED) { + if (all(is.na(self$piecewiseSurvivalTime))) { + if (self$.getParameterType("median1") == C_PARAM_USER_DEFINED) { stop( C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, - "'median1' (", .arrayToString(median1), ") with length > 1 can only ", + "'median1' (", .arrayToString(self$median1), ") with length > 1 can only ", "defined together with a single 'median2', 'lambda2' or 'pi2'" ) } - if (delayedResponseAllowed && length(lambda1 > 0) && !all(is.na(lambda1)) && - length(lambda1) != length(lambda2) && delayedResponseAllowed) { + if (self$delayedResponseAllowed && length(self$lambda1 > 0) && !all(is.na(self$lambda1)) && + length(self$lambda1) != length(self$lambda2) && self$delayedResponseAllowed) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "length of 'lambda1' (", length(lambda1), "), 'lambda2' (", length(lambda2), "), and ", - "'piecewiseSurvivalTime' (", length(piecewiseSurvivalTime), ") must be equal" + "length of 'lambda1' (", length(self$lambda1), "), 'lambda2' (", length(self$lambda2), "), and ", + "'piecewiseSurvivalTime' (", length(self$piecewiseSurvivalTime), ") must be equal" ) } @@ -856,20 +1054,20 @@ PiecewiseSurvivalTime <- setRefClass("PiecewiseSurvivalTime", "'piecewiseSurvivalTime' must be specified" ) } - .setParameterType("piecewiseSurvivalTime", C_PARAM_USER_DEFINED) - piecewiseSurvivalEnabled <<- TRUE - .initHazardRatio() - .initPi() + self$.setParameterType("piecewiseSurvivalTime", C_PARAM_USER_DEFINED) + self$piecewiseSurvivalEnabled <- TRUE + self$.initHazardRatio() + self$.initPi() } } - if (piecewiseSurvivalEnabled) { + if (self$piecewiseSurvivalEnabled) { for (param in c("pi", "median")) { for (group in 1:2) { paramName <- paste0(param, group) - if (.getParameterType(paramName) == C_PARAM_USER_DEFINED) { + if (self$.getParameterType(paramName) == C_PARAM_USER_DEFINED) { warning( - "'", paramName, "' (", .arrayToString(.self[[paramName]]), ") ", + "'", paramName, "' (", .arrayToString(self[[paramName]]), ") ", "was converted to 'lambda", group, "' ", "and is not available in output because piecewise ", "exponential survival time is enabled" @@ -877,120 +1075,120 @@ PiecewiseSurvivalTime <- setRefClass("PiecewiseSurvivalTime", } } } - pi1 <<- NA_real_ - pi2 <<- NA_real_ - median1 <<- NA_real_ - median2 <<- NA_real_ - .setParameterType("pi1", C_PARAM_NOT_APPLICABLE) - .setParameterType("pi2", C_PARAM_NOT_APPLICABLE) - .setParameterType("median1", C_PARAM_NOT_APPLICABLE) - .setParameterType("median2", C_PARAM_NOT_APPLICABLE) - .setParameterType("eventTime", C_PARAM_NOT_APPLICABLE) - if (!is.na(eventTime) && eventTime != C_EVENT_TIME_DEFAULT) { - warning("Event time (", eventTime, ") will be ignored because it is not ", + self$pi1 <- NA_real_ + self$pi2 <- NA_real_ + self$median1 <- NA_real_ + self$median2 <- NA_real_ + self$.setParameterType("pi1", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("pi2", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("median1", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("median2", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("eventTime", C_PARAM_NOT_APPLICABLE) + if (!is.na(self$eventTime) && self$eventTime != C_EVENT_TIME_DEFAULT) { + warning("Event time (", self$eventTime, ") will be ignored because it is not ", "applicable for piecewise exponential survival time", call. = FALSE ) - eventTime <<- C_EVENT_TIME_DEFAULT + self$eventTime <- C_EVENT_TIME_DEFAULT } } - .validateInitialization() + self$.validateInitialization() }, .initMedian = function() { - if (length(eventTime) == 1 && !is.na(eventTime)) { - if (length(pi1) > 0 && !all(is.na(pi1)) && .getParameterType("median1") != C_PARAM_USER_DEFINED) { - median1 <<- getMedianByPi(pi1, eventTime, kappa = kappa) - .setParameterType("median1", C_PARAM_GENERATED) + if (length(self$eventTime) == 1 && !is.na(self$eventTime)) { + if (length(self$pi1) > 0 && !all(is.na(self$pi1)) && self$.getParameterType("median1") != C_PARAM_USER_DEFINED) { + self$median1 <- getMedianByPi(self$pi1, self$eventTime, kappa = self$kappa) + self$.setParameterType("median1", C_PARAM_GENERATED) } - if (length(pi2) == 1 && !is.na(pi2) && .getParameterType("median2") != C_PARAM_USER_DEFINED) { - median2 <<- getMedianByPi(pi2, eventTime, kappa = kappa) - .setParameterType("median2", C_PARAM_GENERATED) + if (length(self$pi2) == 1 && !is.na(self$pi2) && self$.getParameterType("median2") != C_PARAM_USER_DEFINED) { + self$median2 <- getMedianByPi(self$pi2, self$eventTime, kappa = self$kappa) + self$.setParameterType("median2", C_PARAM_GENERATED) } } else { - if (length(lambda1) > 0 && !all(is.na(lambda1)) && .getParameterType("median1") != C_PARAM_USER_DEFINED) { - median1 <<- getMedianByLambda(lambda1, kappa = kappa) - .setParameterType("median1", C_PARAM_GENERATED) + if (length(self$lambda1) > 0 && !all(is.na(self$lambda1)) && self$.getParameterType("median1") != C_PARAM_USER_DEFINED) { + self$median1 <- getMedianByLambda(self$lambda1, kappa =self$kappa) + self$.setParameterType("median1", C_PARAM_GENERATED) } - if (length(lambda2) == 1 && !is.na(lambda2) && .getParameterType("median2") != C_PARAM_USER_DEFINED) { - median2 <<- getMedianByLambda(lambda2, kappa = kappa) - .setParameterType("median2", C_PARAM_GENERATED) + if (length(self$lambda2) == 1 && !is.na(self$lambda2) && self$.getParameterType("median2") != C_PARAM_USER_DEFINED) { + self$median2 <- getMedianByLambda(self$lambda2, kappa = self$kappa) + self$.setParameterType("median2", C_PARAM_GENERATED) } } }, .initPi = function() { .logDebug(".initPi: set pi1, pi2, and eventTime to NA") - if (!is.na(eventTime) && .getParameterType("eventTime") == C_PARAM_USER_DEFINED) { - warning("'eventTime' (", round(eventTime, 3), ") will be ignored", call. = FALSE) + if (!is.na(self$eventTime) && self$.getParameterType("eventTime") == C_PARAM_USER_DEFINED) { + warning("'eventTime' (", round(self$eventTime, 3), ") will be ignored", call. = FALSE) } - if (!is.na(pi1) && !identical(pi2, C_PI_1_DEFAULT) && !identical(pi2, C_PI_1_SAMPLE_SIZE_DEFAULT)) { - warning("'pi1' (", .arrayToString(pi1), ") will be ignored", call. = FALSE) + if (!is.na(self$pi1) && !identical(self$pi2, C_PI_1_DEFAULT) && !identical(self$pi2, C_PI_1_SAMPLE_SIZE_DEFAULT)) { + warning("'pi1' (", .arrayToString(self$pi1), ") will be ignored", call. = FALSE) } - if (!is.na(pi2) && pi2 != C_PI_2_DEFAULT) { - warning("'pi2' (", pi2, ") will be ignored", call. = FALSE) + if (!is.na(self$pi2) && self$pi2 != C_PI_2_DEFAULT) { + warning("'pi2' (", self$pi2, ") will be ignored", call. = FALSE) } - .setParameterType("eventTime", C_PARAM_NOT_APPLICABLE) - .setParameterType("pi1", C_PARAM_NOT_APPLICABLE) - .setParameterType("pi2", C_PARAM_NOT_APPLICABLE) - eventTime <<- NA_real_ - pi1 <<- NA_real_ - pi2 <<- NA_real_ + self$.setParameterType("eventTime", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("pi1", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("pi2", C_PARAM_NOT_APPLICABLE) + self$eventTime <- NA_real_ + self$pi1 <- NA_real_ + self$pi2 <- NA_real_ - if (length(lambda2) == 0 || any(is.na(lambda2))) { + if (length(self$lambda2) == 0 || any(is.na(self$lambda2))) { stop( C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'lambda2' must be defined before .initPi() can be called" ) } - .setParameterType("lambda2", C_PARAM_USER_DEFINED) + self$.setParameterType("lambda2", C_PARAM_USER_DEFINED) - if (piecewiseSurvivalEnabled && length(hazardRatio) > 1) { + if (self$piecewiseSurvivalEnabled && length(self$hazardRatio) > 1) { return(invisible()) } - if (length(lambda1) == 0 || any(is.na(lambda1))) { - if (length(hazardRatio) > 0 && !any(is.na(hazardRatio))) { + if (length(self$lambda1) == 0 || any(is.na(self$lambda1))) { + if (length(self$hazardRatio) > 0 && !any(is.na(self$hazardRatio))) { .logDebug(".initPi: calculate lambda1 by hazardRatio") - lambda1 <<- lambda2 * hazardRatio^(1 / kappa) - .setParameterType("lambda1", C_PARAM_GENERATED) - } else if (length(lambda1) == 0) { - lambda1 <<- NA_real_ - } else if (delayedResponseAllowed) { - .setParameterType("lambda1", C_PARAM_USER_DEFINED) + self$lambda1 <- self$lambda2 * self$hazardRatio^(1 / self$kappa) + self$.setParameterType("lambda1", C_PARAM_GENERATED) + } else if (length(self$lambda1) == 0) { + self$lambda1 <- NA_real_ + } else if (self$delayedResponseAllowed) { + self$.setParameterType("lambda1", C_PARAM_USER_DEFINED) } } }, .initHazardRatio = function() { .logDebug(".initHazardRatio") - if (!is.null(hazardRatio) && length(hazardRatio) > 0 && !all(is.na(hazardRatio))) { - if ((length(lambda1) == 1 && is.na(lambda1)) || - .getParameterType("lambda1") == C_PARAM_GENERATED) { - .setParameterType("hazardRatio", C_PARAM_USER_DEFINED) + if (!is.null(self$hazardRatio) && length(self$hazardRatio) > 0 && !all(is.na(self$hazardRatio))) { + if ((length(self$lambda1) == 1 && is.na(self$lambda1)) || + self$.getParameterType("lambda1") == C_PARAM_GENERATED) { + self$.setParameterType("hazardRatio", C_PARAM_USER_DEFINED) return(invisible()) } - if (!.silent) { - warning("'hazardRatio' (", .arrayToString(hazardRatio), + if (!self$.silent) { + warning("'hazardRatio' (", .arrayToString(self$hazardRatio), ") will be ignored because it will be calculated", call. = FALSE ) } } - if (any(is.na(lambda2))) { + if (any(is.na(self$lambda2))) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'lambda2' must be specified") } - if (any(is.na(lambda1))) { - if (delayedResponseAllowed && any(is.na(hazardRatio) && - !any(is.na(piecewiseSurvivalTime)) && length(lambda2) == length(piecewiseSurvivalTime))) { + if (any(is.na(self$lambda1))) { + if (self$delayedResponseAllowed && any(is.na(self$hazardRatio) && + !any(is.na(self$piecewiseSurvivalTime)) && length(self$lambda2) == length(self$piecewiseSurvivalTime))) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'hazardRatio' must be specified") } - if (any(is.na(hazardRatio))) { + if (any(is.na(self$hazardRatio))) { stop( C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'hazardRatio', 'lambda1' or 'median1' must be specified" @@ -999,18 +1197,18 @@ PiecewiseSurvivalTime <- setRefClass("PiecewiseSurvivalTime", stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'lambda1' must be specified") } - .setParameterType("lambda1", C_PARAM_USER_DEFINED) + self$.setParameterType("lambda1", C_PARAM_USER_DEFINED) - hr <- unique(round(lambda1 / lambda2, 8)^kappa) + hr <- unique(round(self$lambda1 / self$lambda2, 8)^self$kappa) if (length(hr) != 1) { - if (length(lambda2) == 1 && length(lambda1) > 1) { - hazardRatio <<- (lambda1 / lambda2)^kappa - .setParameterType("hazardRatio", C_PARAM_GENERATED) + if (length(self$lambda2) == 1 && length(self$lambda1) > 1) { + self$hazardRatio <- (self$lambda1 / self$lambda2)^self$kappa + self$.setParameterType("hazardRatio", C_PARAM_GENERATED) return(invisible()) - } else if (delayedResponseAllowed) { - hazardRatio <<- (lambda1 / lambda2)^kappa - .setParameterType("hazardRatio", C_PARAM_GENERATED) - delayedResponseEnabled <<- TRUE + } else if (self$delayedResponseAllowed) { + self$hazardRatio <- (self$lambda1 / self$lambda2)^self$kappa + self$.setParameterType("hazardRatio", C_PARAM_GENERATED) + self$delayedResponseEnabled <- TRUE return(invisible()) } else { stop( @@ -1023,98 +1221,98 @@ PiecewiseSurvivalTime <- setRefClass("PiecewiseSurvivalTime", } } - hazardRatio <<- ((lambda1 / lambda2)^kappa)[1] - .setParameterType("hazardRatio", C_PARAM_GENERATED) + self$hazardRatio <- ((self$lambda1 / self$lambda2)^self$kappa)[1] + self$.setParameterType("hazardRatio", C_PARAM_GENERATED) }, .validateInitialization = function() { - if (length(piecewiseSurvivalTime) == 0) { + if (length(self$piecewiseSurvivalTime) == 0) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'piecewiseSurvivalTime' must contain at least one survival start time" ) } - if (any(is.na(piecewiseSurvivalTime))) { + if (any(is.na(self$piecewiseSurvivalTime))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'piecewiseSurvivalTime' must contain valid survival start times" ) } - if (piecewiseSurvivalTime[1] != 0) { + if (self$piecewiseSurvivalTime[1] != 0) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the first value of 'piecewiseSurvivalTime' must be 0" ) } - if (length(piecewiseSurvivalTime) != length(lambda2)) { + if (length(self$piecewiseSurvivalTime) != length(self$lambda2)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "length of 'piecewiseSurvivalTime' (", length(piecewiseSurvivalTime), - ") and length of 'lambda2' (", length(lambda2), ") must be equal" + "length of 'piecewiseSurvivalTime' (", length(self$piecewiseSurvivalTime), + ") and length of 'lambda2' (", length(self$lambda2), ") must be equal" ) } - .assertValuesAreStrictlyIncreasing(piecewiseSurvivalTime, "piecewiseSurvivalTime") + .assertValuesAreStrictlyIncreasing(self$piecewiseSurvivalTime, "piecewiseSurvivalTime") - if ((length(lambda1) != 1 || is.na(lambda1)) && - !(.getParameterType("lambda1") %in% c(C_PARAM_GENERATED, C_PARAM_USER_DEFINED))) { - if (length(hazardRatio) == 1 && !is.na(hazardRatio)) { - lambda1 <<- lambda2 * hazardRatio^(1 / kappa) - .setParameterType("lambda1", C_PARAM_GENERATED) - } else if (length(hazardRatio) > 1 && delayedResponseAllowed && - !is.na(hazardRatio[1])) { - if (!delayedResponseEnabled && .isLambdaBased()) { - if (delayedResponseAllowed) { - if (length(hazardRatio) != length(lambda2)) { + if ((length(self$lambda1) != 1 || is.na(self$lambda1)) && + !(self$.getParameterType("lambda1") %in% c(C_PARAM_GENERATED, C_PARAM_USER_DEFINED))) { + if (length(self$hazardRatio) == 1 && !is.na(self$hazardRatio)) { + self$lambda1 <- self$lambda2 * self$hazardRatio^(1 / self$kappa) + self$.setParameterType("lambda1", C_PARAM_GENERATED) + } else if (length(self$hazardRatio) > 1 && self$delayedResponseAllowed && + !is.na(self$hazardRatio[1])) { + if (!self$delayedResponseEnabled && self$.isLambdaBased()) { + if (self$delayedResponseAllowed) { + if (length(self$hazardRatio) != length(self$lambda2)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "length of 'hazardRatio' (", length(hazardRatio), - ") and length of 'lambda2' (", length(lambda2), ") must be equal" + "length of 'hazardRatio' (", length(self$hazardRatio), + ") and length of 'lambda2' (", length(self$lambda2), ") must be equal" ) } - delayedResponseEnabled <<- TRUE + self$delayedResponseEnabled <- TRUE } else { - warning("Only the first 'hazardRatio' (", round(hazardRatio[1], 4), + warning("Only the first 'hazardRatio' (", round(self$hazardRatio[1], 4), ") was used for piecewise survival time definition", call. = FALSE ) - hazardRatio <<- hazardRatio[1] + self$hazardRatio <- self$hazardRatio[1] } - lambda1 <<- lambda2 * hazardRatio^(1 / kappa) - .setParameterType("lambda1", C_PARAM_GENERATED) + self$lambda1 <- self$lambda2 * self$hazardRatio^(1 / self$kappa) + self$.setParameterType("lambda1", C_PARAM_GENERATED) } - } else if (!delayedResponseEnabled && !(length(lambda2) == 1 && length(lambda1) > 1)) { - if (length(lambda1) > 1) { - warning("'lambda1' (", .arrayToString(lambda1), + } else if (!self$delayedResponseEnabled && !(length(self$lambda2) == 1 && length(self$lambda1) > 1)) { + if (length(self$lambda1) > 1) { + warning("'lambda1' (", .arrayToString(self$lambda1), ") will be ignored", call. = FALSE ) } - lambda1 <<- NA_real_ - .setParameterType("lambda1", C_PARAM_NOT_APPLICABLE) - } - } else if (length(hazardRatio) == 1 && !is.na(hazardRatio) && - length(lambda1) > 0 && !any(is.na(lambda1)) && - length(lambda2) > 0 && !any(is.na(lambda2))) { - target <- lambda2 * hazardRatio^(1 / kappa) - if (length(lambda1) > 0 && !all(is.na(lambda1)) && - !isTRUE(all.equal(target, lambda1))) { + self$lambda1 <- NA_real_ + self$.setParameterType("lambda1", C_PARAM_NOT_APPLICABLE) + } + } else if (length(self$hazardRatio) == 1 && !is.na(self$hazardRatio) && + length(self$lambda1) > 0 && !any(is.na(self$lambda1)) && + length(self$lambda2) > 0 && !any(is.na(self$lambda2))) { + target <- self$lambda2 * self$hazardRatio^(1 / self$kappa) + if (length(self$lambda1) > 0 && !all(is.na(self$lambda1)) && + !isTRUE(all.equal(target, self$lambda1))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'lambda1' (", .arrayToString(lambda1), ") ", - "is not as expected (", .arrayToString(target), ") for given hazard ratio ", hazardRatio + "'lambda1' (", .arrayToString(self$lambda1), ") ", + "is not as expected (", .arrayToString(target), ") for given hazard ratio ", self$hazardRatio ) } } - if (piecewiseSurvivalEnabled && !(length(lambda1) == 1 && is.na(lambda1)) && - length(piecewiseSurvivalTime) != length(lambda1)) { + if (self$piecewiseSurvivalEnabled && !(length(self$lambda1) == 1 && is.na(self$lambda1)) && + length(self$piecewiseSurvivalTime) != length(self$lambda1)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "length of 'piecewiseSurvivalTime' (", length(piecewiseSurvivalTime), - ") and length of 'lambda1' (", length(lambda1), ") must be equal" + "length of 'piecewiseSurvivalTime' (", length(self$piecewiseSurvivalTime), + ") and length of 'lambda1' (", length(self$lambda1), ") must be equal" ) } } @@ -1153,79 +1351,76 @@ PiecewiseSurvivalTime <- setRefClass("PiecewiseSurvivalTime", #' #' @importFrom methods new #' -AccrualTime <- setRefClass("AccrualTime", - contains = "TimeDefinition", - fields = list( - .showWarnings = "logical", - endOfAccrualIsUserDefined = "logical", - followUpTimeMustBeUserDefined = "logical", - maxNumberOfSubjectsIsUserDefined = "logical", - maxNumberOfSubjectsCanBeCalculatedDirectly = "logical", - absoluteAccrualIntensityEnabled = "logical", - accrualTime = "numeric", - accrualIntensity = "numeric", - accrualIntensityRelative = "numeric", - maxNumberOfSubjects = "numeric", - remainingTime = "numeric", - piecewiseAccrualEnabled = "logical" - ), - methods = list( +AccrualTimeR6 <- R6Class("AccrualTimeR6", + inherit = TimeDefinitionR6, + public = list( + .showWarnings = NULL, + endOfAccrualIsUserDefined = NULL, + followUpTimeMustBeUserDefined = NULL, + maxNumberOfSubjectsIsUserDefined = NULL, + maxNumberOfSubjectsCanBeCalculatedDirectly = NULL, + absoluteAccrualIntensityEnabled = NULL, + accrualTime = NULL, + accrualIntensity = NULL, + accrualIntensityRelative = NULL, + maxNumberOfSubjects = NULL, + remainingTime = NULL, + piecewiseAccrualEnabled = NULL, initialize = function(accrualTime = NA_real_, ..., accrualIntensity = NA_real_, maxNumberOfSubjects = NA_real_, showWarnings = TRUE, absoluteAccrualIntensityEnabled = NA) { - callSuper( - accrualTime = NA_real_, - accrualIntensity = accrualIntensity, - maxNumberOfSubjects = maxNumberOfSubjects, - .showWarnings = showWarnings, - absoluteAccrualIntensityEnabled = absoluteAccrualIntensityEnabled, ... - ) - - endOfAccrualIsUserDefined <<- NA - followUpTimeMustBeUserDefined <<- NA - maxNumberOfSubjectsIsUserDefined <<- NA - maxNumberOfSubjectsCanBeCalculatedDirectly <<- TRUE + super$initialize() + self$accrualTime <- accrualTime + self$accrualIntensity <- accrualIntensity + self$maxNumberOfSubjects <- maxNumberOfSubjects + self$.showWarnings <- showWarnings + self$absoluteAccrualIntensityEnabled <- absoluteAccrualIntensityEnabled + + self$endOfAccrualIsUserDefined <- NA + self$followUpTimeMustBeUserDefined <- NA + self$maxNumberOfSubjectsIsUserDefined <- NA + self$maxNumberOfSubjectsCanBeCalculatedDirectly <- TRUE # absoluteAccrualIntensityEnabled <<- NA - .setParameterType("endOfAccrualIsUserDefined", C_PARAM_GENERATED) - .setParameterType("followUpTimeMustBeUserDefined", C_PARAM_GENERATED) - .setParameterType("maxNumberOfSubjectsIsUserDefined", C_PARAM_GENERATED) - .setParameterType("maxNumberOfSubjectsCanBeCalculatedDirectly", C_PARAM_GENERATED) - .setParameterType( + self$.setParameterType("endOfAccrualIsUserDefined", C_PARAM_GENERATED) + self$.setParameterType("followUpTimeMustBeUserDefined", C_PARAM_GENERATED) + self$.setParameterType("maxNumberOfSubjectsIsUserDefined", C_PARAM_GENERATED) + self$.setParameterType("maxNumberOfSubjectsCanBeCalculatedDirectly", C_PARAM_GENERATED) + self$.setParameterType( "absoluteAccrualIntensityEnabled", - ifelse(is.na(absoluteAccrualIntensityEnabled), C_PARAM_GENERATED, C_PARAM_USER_DEFINED) + ifelse(is.na(self$absoluteAccrualIntensityEnabled), C_PARAM_GENERATED, C_PARAM_USER_DEFINED) ) - accrualIntensityRelative <<- NA_real_ - .setParameterType("accrualIntensityRelative", C_PARAM_NOT_APPLICABLE) - remainingTime <<- NA_real_ + self$accrualIntensityRelative <- NA_real_ + self$.setParameterType("accrualIntensityRelative", C_PARAM_NOT_APPLICABLE) + self$remainingTime <- NA_real_ - .init(accrualTime) + self$.init(self$accrualTime) # case 6 correction - if (!endOfAccrualIsUserDefined && maxNumberOfSubjectsIsUserDefined && - !.self$absoluteAccrualIntensityEnabled) { - remainingTime <<- NA_real_ - .setParameterType("remainingTime", C_PARAM_NOT_APPLICABLE) - .self$accrualTime <<- .self$accrualTime[1:length(.self$accrualIntensity)] + if (!self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && + !self$absoluteAccrualIntensityEnabled) { + self$remainingTime <- NA_real_ + self$.setParameterType("remainingTime", C_PARAM_NOT_APPLICABLE) + self$accrualTime <- self$accrualTime[1:length(self$accrualIntensity)] } - .initAccrualIntensityAbsolute() - .validateFormula() - .showWarningIfCaseIsNotAllowd() + self$.initAccrualIntensityAbsolute() + self$.validateFormula() + self$.showWarningIfCaseIsNotAllowed() }, .asDataFrame = function() { - accrualIntensityTemp <- accrualIntensity - if (!all(is.na(accrualIntensityRelative))) { - accrualIntensityTemp <- accrualIntensityRelative + accrualIntensityTemp <- self$accrualIntensity + if (!all(is.na(self$accrualIntensityRelative))) { + accrualIntensityTemp <- self$accrualIntensityRelative } - if (length(accrualIntensityTemp) + 1 == length(accrualTime)) { + if (length(accrualIntensityTemp) + 1 == length(self$accrualTime)) { accrualIntensityTemp <- c(accrualIntensityTemp, NA_real_) } data <- data.frame( - accrualTime = accrualTime, + accrualTime = self$accrualTime, accrualIntensity = accrualIntensityTemp ) rownames(data) <- as.character(1:nrow(data)) @@ -1236,88 +1431,88 @@ AccrualTime <- setRefClass("AccrualTime", return(data) }, show = function(showType = 1, digits = NA_integer_) { - .show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) }, .isAbsoluteAccrualIntensity = function(x) { - return(!.isRelativeAccrualIntensity(x)) + return(!self$.isRelativeAccrualIntensity(x)) }, .isRelativeAccrualIntensity = function(x) { return(all(x < 1)) }, .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { "Method for automatically printing accrual time objects" - .resetCat() + self$.resetCat() if (showType == 2) { - callSuper(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) } else { - .cat("Accrual time and intensity:\n", + self$.cat("Accrual time and intensity:\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled ) - if (!isAccrualTimeEnabled()) { - .cat(" Accrual time is disabled.\n", consoleOutputEnabled = consoleOutputEnabled) - } else if (length(accrualTime) == 1) { - .cat(" At all times:", accrualIntensity[1], "\n", consoleOutputEnabled = consoleOutputEnabled) + if (!self$isAccrualTimeEnabled()) { + self$.cat(" Accrual time is disabled.\n", consoleOutputEnabled = consoleOutputEnabled) + } else if (length(self$accrualTime) == 1) { + self$.cat(" At all times:", self$accrualIntensity[1], "\n", consoleOutputEnabled = consoleOutputEnabled) } else { - accrualTimeStr <- format(accrualTime) - accrualIntensityStr <- format(accrualIntensity) - for (i in 1:length(accrualTime)) { - prefix <- ifelse(i == length(accrualTime) - 1, "<=", " <") + accrualTimeStr <- format(self$accrualTime) + accrualIntensityStr <- format(self$accrualIntensity) + for (i in 1:length(self$accrualTime)) { + prefix <- ifelse(i == length(self$accrualTime) - 1, "<=", " <") suffix <- "" - if (!maxNumberOfSubjectsIsUserDefined) { + if (!self$maxNumberOfSubjectsIsUserDefined) { suffix <- " " } - if (i < length(accrualTime)) { - .cat(" ", accrualTimeStr[i], " - ", prefix, accrualTimeStr[i + 1], suffix, ": ", + if (i < length(self$accrualTime)) { + self$.cat(" ", accrualTimeStr[i], " - ", prefix, accrualTimeStr[i + 1], suffix, ": ", accrualIntensityStr[i], "\n", consoleOutputEnabled = consoleOutputEnabled ) - } else if (!maxNumberOfSubjectsIsUserDefined && !is.na(accrualIntensityStr[i]) && + } else if (!self$maxNumberOfSubjectsIsUserDefined && !is.na(accrualIntensityStr[i]) && accrualIntensityStr[i] != "NA") { - .cat(" ", accrualTimeStr[i], " - <=[?]: ", + self$.cat(" ", accrualTimeStr[i], " - <=[?]: ", accrualIntensityStr[i], "\n", consoleOutputEnabled = consoleOutputEnabled ) } } - .cat("", consoleOutputEnabled = consoleOutputEnabled) + self$.cat("", consoleOutputEnabled = consoleOutputEnabled) } - .cat("\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) - if (isAccrualTimeEnabled()) { - .showFormula(consoleOutputEnabled = consoleOutputEnabled) - .cat("\n", consoleOutputEnabled = consoleOutputEnabled) + if (self$isAccrualTimeEnabled()) { + self$.showFormula(consoleOutputEnabled = consoleOutputEnabled) + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) - .showCase(consoleOutputEnabled = consoleOutputEnabled) - .cat("\n", consoleOutputEnabled = consoleOutputEnabled) + self$.showCase(consoleOutputEnabled = consoleOutputEnabled) + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) } - .cat("Details:\n\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) - .showParametersOfOneGroup(.getUserDefinedParameters(), "User defined parameters", + self$.cat("Details:\n\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) + self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled ) - .showParametersOfOneGroup(.getDefaultParameters(), "Default parameters", + self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled ) - .showParametersOfOneGroup(.getGeneratedParameters(), "Generated parameters", + self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Generated parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled ) - .showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) } }, .getFormula = function() { s <- "" - for (i in 1:length(accrualTime)) { - if (i < length(accrualTime)) { + for (i in 1:length(self$accrualTime)) { + if (i < length(self$accrualTime)) { s <- paste0( - s, (round(accrualTime[i + 1], 4) - round(accrualTime[i], 4)), - " * ", round(accrualIntensity[i], 4) + s, (round(self$accrualTime[i + 1], 4) - round(self$accrualTime[i], 4)), + " * ", round(self$accrualIntensity[i], 4) ) - if (!absoluteAccrualIntensityEnabled && - (!maxNumberOfSubjectsIsUserDefined || !endOfAccrualIsUserDefined)) { + if (!self$absoluteAccrualIntensityEnabled && + (!self$maxNumberOfSubjectsIsUserDefined || !self$endOfAccrualIsUserDefined)) { s <- paste0(s, " * c ") } - if (i < length(accrualIntensity)) { + if (i < length(self$accrualIntensity)) { s <- paste0(s, " + ") } } @@ -1325,34 +1520,34 @@ AccrualTime <- setRefClass("AccrualTime", return(s) }, .validateFormula = function() { - if (is.na(maxNumberOfSubjects) || length(accrualTime) != length(accrualIntensity) + 1) { + if (is.na(self$maxNumberOfSubjects) || length(self$accrualTime) != length(self$accrualIntensity) + 1) { return(invisible()) } numberOfSubjects <- 0 - for (i in 1:length(accrualTime)) { - if (i < length(accrualTime)) { + for (i in 1:length(self$accrualTime)) { + if (i < length(self$accrualTime)) { numberOfSubjects <- numberOfSubjects + - (accrualTime[i + 1] - accrualTime[i]) * accrualIntensity[i] + (self$accrualTime[i + 1] - self$accrualTime[i]) * self$accrualIntensity[i] } } - if (!isTRUE(all.equal(numberOfSubjects, maxNumberOfSubjects, tolerance = 1e-03)) && - absoluteAccrualIntensityEnabled) { + if (!isTRUE(all.equal(numberOfSubjects, self$maxNumberOfSubjects, tolerance = 1e-03)) && + self$absoluteAccrualIntensityEnabled) { stop( C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, - "'maxNumberOfSubjects' (", maxNumberOfSubjects, ") disagrees with ", + "'maxNumberOfSubjects' (", self$maxNumberOfSubjects, ") disagrees with ", "the defined accrual time and intensity: ", - .getFormula(), " = ", numberOfSubjects + self$.getFormula(), " = ", numberOfSubjects ) } }, - .showWarningIfCaseIsNotAllowd = function() { + .showWarningIfCaseIsNotAllowed = function() { caseIsAllowed <- TRUE - if (!endOfAccrualIsUserDefined && maxNumberOfSubjectsIsUserDefined && - !absoluteAccrualIntensityEnabled) { + if (!self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && + !self$absoluteAccrualIntensityEnabled) { caseIsAllowed <- FALSE - } else if (!endOfAccrualIsUserDefined && !maxNumberOfSubjectsIsUserDefined && - followUpTimeMustBeUserDefined && !absoluteAccrualIntensityEnabled) { + } else if (!self$endOfAccrualIsUserDefined && !self$maxNumberOfSubjectsIsUserDefined && + self$followUpTimeMustBeUserDefined && !self$absoluteAccrualIntensityEnabled) { caseIsAllowed <- FALSE } if (!caseIsAllowed) { @@ -1364,34 +1559,34 @@ AccrualTime <- setRefClass("AccrualTime", } }, .showFormula = function(consoleOutputEnabled) { - .cat("Formula:\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) - .cat(" ", consoleOutputEnabled = consoleOutputEnabled) - .cat("maxNumberOfSubjects = ", consoleOutputEnabled = consoleOutputEnabled) - if (!is.na(maxNumberOfSubjects)) { - .cat(maxNumberOfSubjects, " = ", consoleOutputEnabled = consoleOutputEnabled) - } - .cat(.getFormula(), consoleOutputEnabled = consoleOutputEnabled) - if (length(accrualTime) == length(accrualIntensity)) { - .cat("(x - ", accrualTime[length(accrualTime)], ") * ", - accrualIntensity[length(accrualIntensity)], + self$.cat("Formula:\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" ", consoleOutputEnabled = consoleOutputEnabled) + self$.cat("maxNumberOfSubjects = ", consoleOutputEnabled = consoleOutputEnabled) + if (!is.na(self$maxNumberOfSubjects)) { + self$.cat(self$maxNumberOfSubjects, " = ", consoleOutputEnabled = consoleOutputEnabled) + } + self$.cat(self$.getFormula(), consoleOutputEnabled = consoleOutputEnabled) + if (length(self$accrualTime) == length(self$accrualIntensity)) { + self$.cat("(x - ", self$accrualTime[length(self$accrualTime)], ") * ", + self$accrualIntensity[length(self$accrualIntensity)], consoleOutputEnabled = consoleOutputEnabled ) - if (!absoluteAccrualIntensityEnabled && - (!maxNumberOfSubjectsIsUserDefined || !endOfAccrualIsUserDefined)) { - .cat(" * c ", consoleOutputEnabled = consoleOutputEnabled) + if (!self$absoluteAccrualIntensityEnabled && + (!self$maxNumberOfSubjectsIsUserDefined || !self$endOfAccrualIsUserDefined)) { + self$.cat(" * c ", consoleOutputEnabled = consoleOutputEnabled) } - .cat(", where 'x' is the unknown last accrual time", + self$.cat(", where 'x' is the unknown last accrual time", consoleOutputEnabled = consoleOutputEnabled ) - if (!absoluteAccrualIntensityEnabled && - (!maxNumberOfSubjectsIsUserDefined || !endOfAccrualIsUserDefined)) { - .cat(" and 'c' a constant factor", consoleOutputEnabled = consoleOutputEnabled) + if (!self$absoluteAccrualIntensityEnabled && + (!self$maxNumberOfSubjectsIsUserDefined || !self$endOfAccrualIsUserDefined)) { + self$.cat(" and 'c' a constant factor", consoleOutputEnabled = consoleOutputEnabled) } - } else if (!absoluteAccrualIntensityEnabled && - (!maxNumberOfSubjectsIsUserDefined || !endOfAccrualIsUserDefined)) { - .cat(", where 'c' is a constant factor", consoleOutputEnabled = consoleOutputEnabled) + } else if (!self$absoluteAccrualIntensityEnabled && + (!self$maxNumberOfSubjectsIsUserDefined || !self$endOfAccrualIsUserDefined)) { + self$.cat(", where 'c' is a constant factor", consoleOutputEnabled = consoleOutputEnabled) } - .cat("\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) }, .showCase = function(consoleOutputEnabled = TRUE) { caseIsAllowed <- TRUE @@ -1401,14 +1596,14 @@ AccrualTime <- setRefClass("AccrualTime", # Case 1 # example: getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(22, 33), # maxNumberOfSubjects = 1000) - if (endOfAccrualIsUserDefined && maxNumberOfSubjectsIsUserDefined && - absoluteAccrualIntensityEnabled) { - .cat("Case (#1):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) - .cat(prefix, "End of accrual, absolute accrual intensity and 'maxNumberOfSubjects' are given, ", + if (self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && + self$absoluteAccrualIntensityEnabled) { + self$.cat("Case (#1):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(prefix, "End of accrual, absolute accrual intensity and 'maxNumberOfSubjects' are given, ", " 'followUpTime'** shall be calculated.\n", consoleOutputEnabled = consoleOutputEnabled ) - .cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6, 30), ", + self$.cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6, 30), ", "accrualIntensity = c(22, 33), maxNumberOfSubjects = 924)\n", consoleOutputEnabled = consoleOutputEnabled ) @@ -1417,14 +1612,14 @@ AccrualTime <- setRefClass("AccrualTime", # Case 2 # example: getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(0.22, 0.33), # maxNumberOfSubjects = 1000) - else if (endOfAccrualIsUserDefined && maxNumberOfSubjectsIsUserDefined && - !absoluteAccrualIntensityEnabled) { - .cat("Case (#2):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) - .cat(prefix, "End of accrual, relative accrual intensity and 'maxNumberOfSubjects' are given, ", + else if (self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && + !self$absoluteAccrualIntensityEnabled) { + self$.cat("Case (#2):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(prefix, "End of accrual, relative accrual intensity and 'maxNumberOfSubjects' are given, ", "absolute accrual intensity* and 'followUpTime'** shall be calculated.\n", consoleOutputEnabled = consoleOutputEnabled ) - .cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6, 30), ", + self$.cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6, 30), ", "accrualIntensity = c(0.22, 0.33), maxNumberOfSubjects = 1000)\n", consoleOutputEnabled = consoleOutputEnabled ) @@ -1432,28 +1627,28 @@ AccrualTime <- setRefClass("AccrualTime", # Case 3 # example: getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(22, 33)) - else if (endOfAccrualIsUserDefined && !maxNumberOfSubjectsIsUserDefined && - absoluteAccrualIntensityEnabled) { - .cat("Case (#3):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) - .cat(prefix, "End of accrual and absolute accrual intensity are given, ", + else if (self$endOfAccrualIsUserDefined && !self$maxNumberOfSubjectsIsUserDefined && + self$absoluteAccrualIntensityEnabled) { + self$.cat("Case (#3):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(prefix, "End of accrual and absolute accrual intensity are given, ", "'maxNumberOfSubjects'* and 'followUpTime'** shall be calculated.\n", consoleOutputEnabled = consoleOutputEnabled ) - .cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(22, 33))\n", + self$.cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(22, 33))\n", consoleOutputEnabled = consoleOutputEnabled ) } # Case 4 # example: getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(0.22, 0.33)) - else if (endOfAccrualIsUserDefined && !maxNumberOfSubjectsIsUserDefined && - !absoluteAccrualIntensityEnabled) { - .cat("Case (#4):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) - .cat(prefix, "End of accrual, relative accrual intensity and 'followUpTime' are given, ", + else if (self$endOfAccrualIsUserDefined && !self$maxNumberOfSubjectsIsUserDefined && + !self$absoluteAccrualIntensityEnabled) { + self$.cat("Case (#4):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(prefix, "End of accrual, relative accrual intensity and 'followUpTime' are given, ", "absolute accrual intensity** and 'maxNumberOfSubjects'** shall be calculated.\n", consoleOutputEnabled = consoleOutputEnabled ) - .cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(0.22, 0.33))\n", + self$.cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(0.22, 0.33))\n", consoleOutputEnabled = consoleOutputEnabled ) } @@ -1461,14 +1656,14 @@ AccrualTime <- setRefClass("AccrualTime", # Case 5 # example: getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(22, 33), # maxNumberOfSubjects = 1000) - else if (!endOfAccrualIsUserDefined && maxNumberOfSubjectsIsUserDefined && - absoluteAccrualIntensityEnabled) { - .cat("Case (#5):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) - .cat(prefix, "'maxNumberOfSubjects' and absolute accrual intensity are given, ", + else if (!self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && + self$absoluteAccrualIntensityEnabled) { + self$.cat("Case (#5):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(prefix, "'maxNumberOfSubjects' and absolute accrual intensity are given, ", "end of accrual* and 'followUpTime'** shall be calculated\n", consoleOutputEnabled = consoleOutputEnabled ) - .cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6), ", + self$.cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6), ", "accrualIntensity = c(22, 33), maxNumberOfSubjects = 1000)\n", consoleOutputEnabled = consoleOutputEnabled ) @@ -1477,15 +1672,15 @@ AccrualTime <- setRefClass("AccrualTime", # Case 6 # example: getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(0.22, 0.33), # maxNumberOfSubjects = 1000) - else if (!endOfAccrualIsUserDefined && maxNumberOfSubjectsIsUserDefined && - !absoluteAccrualIntensityEnabled) { + else if (!self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && + !self$absoluteAccrualIntensityEnabled) { caseIsAllowed <- FALSE - .cat("Case (#6):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) - .cat(prefix, "'maxNumberOfSubjects' and relative accrual intensity are given, ", + self$.cat("Case (#6):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(prefix, "'maxNumberOfSubjects' and relative accrual intensity are given, ", "absolute accrual intensity@, end of accrual* and 'followUpTime'** shall be calculated\n", consoleOutputEnabled = consoleOutputEnabled ) - .cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6), ", + self$.cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6), ", "accrualIntensity = c(0.22, 0.33), maxNumberOfSubjects = 1000)\n", consoleOutputEnabled = consoleOutputEnabled ) @@ -1493,76 +1688,76 @@ AccrualTime <- setRefClass("AccrualTime", # Case 7 # example: getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(22, 33)) - else if (!endOfAccrualIsUserDefined && !maxNumberOfSubjectsIsUserDefined && - followUpTimeMustBeUserDefined && absoluteAccrualIntensityEnabled) { - .cat("Case (#7):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) - .cat(prefix, "'followUpTime' and absolute accrual intensity are given, ", + else if (!self$endOfAccrualIsUserDefined && !self$maxNumberOfSubjectsIsUserDefined && + self$followUpTimeMustBeUserDefined && self$absoluteAccrualIntensityEnabled) { + self$.cat("Case (#7):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(prefix, "'followUpTime' and absolute accrual intensity are given, ", "end of accrual** and 'maxNumberOfSubjects'** shall be calculated\n", consoleOutputEnabled = consoleOutputEnabled ) - .cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(22, 33))\n", + self$.cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(22, 33))\n", consoleOutputEnabled = consoleOutputEnabled ) } # Case 8 # example: getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(0.22, 0.33)) - else if (!endOfAccrualIsUserDefined && !maxNumberOfSubjectsIsUserDefined && - followUpTimeMustBeUserDefined && !absoluteAccrualIntensityEnabled) { + else if (!self$endOfAccrualIsUserDefined && !self$maxNumberOfSubjectsIsUserDefined && + self$followUpTimeMustBeUserDefined && !self$absoluteAccrualIntensityEnabled) { caseIsAllowed <- FALSE - .cat("Case (#8):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) - .cat(prefix, "'followUpTime' and relative accrual intensity are given, ", + self$.cat("Case (#8):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(prefix, "'followUpTime' and relative accrual intensity are given, ", "absolute accrual intensity@, end of accrual and 'maxNumberOfSubjects' shall be calculated\n", consoleOutputEnabled = consoleOutputEnabled ) - .cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(0.22, 0.33))\n", + self$.cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(0.22, 0.33))\n", consoleOutputEnabled = consoleOutputEnabled ) } # .cat("\n", consoleOutputEnabled = consoleOutputEnabled) if (!caseIsAllowed) { - .cat(prefix, "(@) Cannot be calculated.\n", + self$.cat(prefix, "(@) Cannot be calculated.\n", consoleOutputEnabled = consoleOutputEnabled ) } - .cat(prefix, "(*) Can be calculated directly.\n", + self$.cat(prefix, "(*) Can be calculated directly.\n", consoleOutputEnabled = consoleOutputEnabled ) - .cat(prefix, "(**) Cannot be calculated directly but with ", + self$.cat(prefix, "(**) Cannot be calculated directly but with ", "'getSampleSizeSurvival()' or 'getPowerSurvival()'.\n", consoleOutputEnabled = consoleOutputEnabled ) }, .followUpTimeShallBeCalculated = function() { # Case 1: 'followUpTime'** shall be calculated - if (endOfAccrualIsUserDefined && maxNumberOfSubjectsIsUserDefined && - absoluteAccrualIntensityEnabled) { + if (self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && + self$absoluteAccrualIntensityEnabled) { return(TRUE) } # Case 2: 'followUpTime'** shall be calculated - else if (endOfAccrualIsUserDefined && maxNumberOfSubjectsIsUserDefined && - !absoluteAccrualIntensityEnabled) { + else if (self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && + !self$absoluteAccrualIntensityEnabled) { return(TRUE) } # Case 3: 'followUpTime'** shall be calculated - else if (endOfAccrualIsUserDefined && !maxNumberOfSubjectsIsUserDefined && - absoluteAccrualIntensityEnabled) { + else if (self$endOfAccrualIsUserDefined && !self$maxNumberOfSubjectsIsUserDefined && + self$absoluteAccrualIntensityEnabled) { return(TRUE) } # Case 5: 'followUpTime'** shall be calculated - else if (!endOfAccrualIsUserDefined && maxNumberOfSubjectsIsUserDefined && - absoluteAccrualIntensityEnabled) { + else if (!self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && + self$absoluteAccrualIntensityEnabled) { return(TRUE) } # Case 6: 'followUpTime'** shall be calculated - else if (!endOfAccrualIsUserDefined && maxNumberOfSubjectsIsUserDefined && - !absoluteAccrualIntensityEnabled) { + else if (!self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && + !self$absoluteAccrualIntensityEnabled) { return(TRUE) } @@ -1572,8 +1767,8 @@ AccrualTime <- setRefClass("AccrualTime", }, .validate = function() { # Case 6 - if (!endOfAccrualIsUserDefined && maxNumberOfSubjectsIsUserDefined && - !absoluteAccrualIntensityEnabled) { + if (!self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && + !self$absoluteAccrualIntensityEnabled) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the calculation of 'followUpTime' for given 'maxNumberOfSubjects' ", @@ -1583,8 +1778,8 @@ AccrualTime <- setRefClass("AccrualTime", } # Case 8 - else if (!endOfAccrualIsUserDefined && !maxNumberOfSubjectsIsUserDefined && - followUpTimeMustBeUserDefined && !absoluteAccrualIntensityEnabled) { + else if (!self$endOfAccrualIsUserDefined && !self$maxNumberOfSubjectsIsUserDefined && + self$followUpTimeMustBeUserDefined && !self$absoluteAccrualIntensityEnabled) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "the calculation of 'maxNumberOfSubjects' for given 'followUpTime' ", @@ -1598,18 +1793,18 @@ AccrualTime <- setRefClass("AccrualTime", return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) }, .getAccrualTimeWithoutLeadingZero = function() { - if (length(accrualTime) <= 1) { + if (length(self$accrualTime) <= 1) { return(NA_real_) } - return(accrualTime[2:length(accrualTime)]) + return(self$accrualTime[2:length(self$accrualTime)]) }, isAccrualTimeEnabled = function() { - if (length(accrualTime) == 0) { + if (length(self$accrualTime) == 0) { return(FALSE) } - if (length(accrualTime) == 1 && is.na(accrualTime)) { + if (length(self$accrualTime) == 1 && is.na(self$accrualTime)) { return(FALSE) } @@ -1632,25 +1827,25 @@ AccrualTime <- setRefClass("AccrualTime", ) } - if (.showWarnings && !all(is.na(accrualIntensity)) && (length(accrualIntensity) != 1 || - accrualIntensity != C_ACCRUAL_INTENSITY_DEFAULT)) { - warning("'accrualIntensity' (", .arrayToString(accrualIntensity), + if (self$.showWarnings && !all(is.na(self$accrualIntensity)) && (length(self$accrualIntensity) != 1 || + self$accrualIntensity != C_ACCRUAL_INTENSITY_DEFAULT)) { + warning("'accrualIntensity' (", .arrayToString(self$accrualIntensity), ") will be ignored because 'accrualTime' is a list", call. = FALSE ) } - accrualTime <<- numeric(0) - accrualIntensity <<- numeric(0) + self$accrualTime <- numeric(0) + self$accrualIntensity <- numeric(0) timeRegions <- names(accrualTimeList) endOfAccrualIsUndefined <- FALSE - accrualTime <<- c(accrualTime, 0) + self$accrualTime <- c(self$accrualTime, 0) for (i in 1:length(timeRegions)) { timePeriod <- timeRegions[i] accrualTimeValue <- accrualTimeList[[timePeriod]] .assertIsSingleNumber(accrualTimeValue, paste0("accrualTime[", i, "]")) - settings <- .validateTimePeriod(timePeriod, i = i, n = length(timeRegions), accrualTimeMode = TRUE) + settings <- self$.validateTimePeriod(timePeriod, i = i, n = length(timeRegions), accrualTimeMode = TRUE) timePeriod <- settings$timePeriod endOfAccrualIsUndefined <- settings$endOfAccrualIsUndefined @@ -1663,73 +1858,73 @@ AccrualTime <- setRefClass("AccrualTime", "\"time_1 - = 2 && length(accrualTime) == length(accrualIntensity) + 1 && - !any(is.na(accrualTime)) && !any(is.na(accrualIntensity))) { - len <- length(accrualIntensity) - accrualIntensityAbsolute <- maxNumberOfSubjects / sum((accrualTime[2:(len + 1)] - - accrualTime[1:len]) * accrualIntensity) * accrualIntensity - if (!isTRUE(all.equal(accrualIntensityAbsolute, accrualIntensity, tolerance = 1e-06)) && + if (length(self$accrualTime) >= 2 && length(self$accrualTime) == length(self$accrualIntensity) + 1 && + !any(is.na(self$accrualTime)) && !any(is.na(self$accrualIntensity))) { + len <- length(self$accrualIntensity) + accrualIntensityAbsolute <- self$maxNumberOfSubjects / sum((self$accrualTime[2:(len + 1)] - + self$accrualTime[1:len]) * self$accrualIntensity) * self$accrualIntensity + if (!isTRUE(all.equal(accrualIntensityAbsolute, self$accrualIntensity, tolerance = 1e-06)) && !isTRUE(all.equal(accrualIntensityAbsolute, 0, tolerance = 1e-06))) { - .validateAccrualTimeAndIntensity() - - if (absoluteAccrualIntensityEnabled && - .getParameterType("maxNumberOfSubjects") == C_PARAM_USER_DEFINED) { - if (.getParameterType("accrualTime") == C_PARAM_DEFAULT_VALUE) { - accrualTime <<- maxNumberOfSubjects / accrualIntensity - .setParameterType("accrualTime", C_PARAM_GENERATED) - remainingTime <<- accrualTime - accrualTime <<- c(0, accrualTime) + self$.validateAccrualTimeAndIntensity() + + if (self$absoluteAccrualIntensityEnabled && + self$.getParameterType("maxNumberOfSubjects") == C_PARAM_USER_DEFINED) { + if (self$.getParameterType("accrualTime") == C_PARAM_DEFAULT_VALUE) { + self$accrualTime <- self$maxNumberOfSubjects / self$accrualIntensity + self$.setParameterType("accrualTime", C_PARAM_GENERATED) + self$remainingTime <- self$accrualTime + self$accrualTime <- c(0, self$accrualTime) } else { stop( C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, - "'maxNumberOfSubjects' (", maxNumberOfSubjects, ") disagrees with ", - "the defined accrual time (", .arrayToString(accrualTime), ") and intensity: ", - .getFormula(), " = ", .getSampleSize() + "'maxNumberOfSubjects' (", self$maxNumberOfSubjects, ") disagrees with ", + "the defined accrual time (", .arrayToString(self$accrualTime), ") and intensity: ", + self$.getFormula(), " = ", self$.getSampleSize() ) } } else { - if (!absoluteAccrualIntensityEnabled && # .isRelativeAccrualIntensity(accrualIntensity) - .getParameterType("accrualIntensity") == C_PARAM_USER_DEFINED && - .getParameterType("accrualTime") == C_PARAM_DEFAULT_VALUE && - .getParameterType("maxNumberOfSubjects") == C_PARAM_USER_DEFINED) { - if (.showWarnings) { - warning("'accrualIntensity' (", accrualIntensity, ") will be ignored", call. = FALSE) + if (!self$absoluteAccrualIntensityEnabled && # .isRelativeAccrualIntensity(accrualIntensity) + self$.getParameterType("accrualIntensity") == C_PARAM_USER_DEFINED && + self$.getParameterType("accrualTime") == C_PARAM_DEFAULT_VALUE && + self$.getParameterType("maxNumberOfSubjects") == C_PARAM_USER_DEFINED) { + if (self$.showWarnings) { + warning("'accrualIntensity' (", self$accrualIntensity, ") will be ignored", call. = FALSE) } - accrualIntensityRelative <<- C_ACCRUAL_INTENSITY_DEFAULT - accrualIntensity <<- accrualIntensityAbsolute - .setParameterType("accrualIntensity", C_PARAM_GENERATED) - .setParameterType("remainingTime", C_PARAM_NOT_APPLICABLE) + self$accrualIntensityRelative <- C_ACCRUAL_INTENSITY_DEFAULT + self$accrualIntensity <- accrualIntensityAbsolute + self$.setParameterType("accrualIntensity", C_PARAM_GENERATED) + self$.setParameterType("remainingTime", C_PARAM_NOT_APPLICABLE) } else { - accrualIntensityRelative <<- accrualIntensity - accrualIntensity <<- accrualIntensityAbsolute - .setParameterType("accrualIntensity", C_PARAM_GENERATED) - .setParameterType("accrualIntensityRelative", C_PARAM_USER_DEFINED) + self$accrualIntensityRelative <- self$accrualIntensity + self$accrualIntensity <- accrualIntensityAbsolute + self$.setParameterType("accrualIntensity", C_PARAM_GENERATED) + self$.setParameterType("accrualIntensityRelative", C_PARAM_USER_DEFINED) } } } @@ -1762,159 +1957,159 @@ AccrualTime <- setRefClass("AccrualTime", calculateLastAccrualTimeEnabled <- FALSE if (is.list(accrualTimeArg)) { - endOfAccrualIsUndefined <- .initFromList(accrualTimeArg) + endOfAccrualIsUndefined <- self$.initFromList(accrualTimeArg) calculateLastAccrualTimeEnabled <- endOfAccrualIsUndefined && - !is.null(maxNumberOfSubjects) && length(maxNumberOfSubjects) == 1 && - !is.na(maxNumberOfSubjects) + !is.null(self$maxNumberOfSubjects) && length(self$maxNumberOfSubjects) == 1 && + !is.na(self$maxNumberOfSubjects) } else if (is.numeric(accrualTimeArg)) { .assertIsNumericVector(accrualTimeArg, "accrualTime") - if (length(accrualIntensity) > 1) { - .assertIsNumericVector(accrualIntensity, "accrualIntensity") + if (length(self$accrualIntensity) > 1) { + .assertIsNumericVector(self$accrualIntensity, "accrualIntensity") } - if (.isNoPiecewiseAccrualTime(accrualTimeArg) && - (length(accrualIntensity) == 0 || is.null(accrualIntensity) || - all(is.na(accrualIntensity)) || - all(accrualIntensity == C_ACCRUAL_INTENSITY_DEFAULT))) { + if (self$.isNoPiecewiseAccrualTime(accrualTimeArg) && + (length(self$accrualIntensity) == 0 || is.null(self$accrualIntensity) || + all(is.na(self$accrualIntensity)) || + all(self$accrualIntensity == C_ACCRUAL_INTENSITY_DEFAULT))) { accrualTimeArg <- accrualTimeArg[length(accrualTimeArg)] - accrualTime <<- c(0L, accrualTimeArg) - .setParameterType("accrualTime", ifelse( - identical(as.integer(accrualTime), C_ACCRUAL_TIME_DEFAULT), + self$accrualTime <- c(0L, accrualTimeArg) + self$.setParameterType("accrualTime", ifelse( + identical(as.integer(self$accrualTime), C_ACCRUAL_TIME_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED )) - accrualIntensity <<- C_ACCRUAL_INTENSITY_DEFAULT - .setParameterType("accrualIntensity", C_PARAM_DEFAULT_VALUE) + self$accrualIntensity <- C_ACCRUAL_INTENSITY_DEFAULT + self$.setParameterType("accrualIntensity", C_PARAM_DEFAULT_VALUE) - .setParameterType( + self$.setParameterType( "maxNumberOfSubjects", - ifelse(length(maxNumberOfSubjects) == 1 && is.na(maxNumberOfSubjects), + ifelse(length(self$maxNumberOfSubjects) == 1 && is.na(self$maxNumberOfSubjects), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED ) ) - endOfAccrualIsUserDefined <<- length(accrualTime) == length(accrualIntensity) + 1 - maxNumberOfSubjectsIsUserDefined <<- - .getParameterType("maxNumberOfSubjects") == C_PARAM_USER_DEFINED - followUpTimeMustBeUserDefined <<- !endOfAccrualIsUserDefined && - !maxNumberOfSubjectsIsUserDefined - absoluteAccrualIntensityEnabled <<- FALSE + self$endOfAccrualIsUserDefined <- length(self$accrualTime) == length(self$accrualIntensity) + 1 + self$maxNumberOfSubjectsIsUserDefined <- + self$.getParameterType("maxNumberOfSubjects") == C_PARAM_USER_DEFINED + self$followUpTimeMustBeUserDefined <- !self$endOfAccrualIsUserDefined && + !self$maxNumberOfSubjectsIsUserDefined + self$absoluteAccrualIntensityEnabled <- FALSE - if (maxNumberOfSubjectsIsUserDefined) { - accrualIntensity <<- maxNumberOfSubjects / accrualTime[length(accrualTime)] - .setParameterType("accrualIntensity", C_PARAM_GENERATED) + if (self$maxNumberOfSubjectsIsUserDefined) { + self$accrualIntensity <- self$maxNumberOfSubjects / self$accrualTime[length(self$accrualTime)] + self$.setParameterType("accrualIntensity", C_PARAM_GENERATED) } return(invisible()) } - accrualTime <<- accrualTimeArg - if (length(accrualTime) == 0) { + self$accrualTime <- accrualTimeArg + if (length(self$accrualTime) == 0) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'accrualTime' must contain at least one time value" ) } - if (accrualTime[1] != 0) { + if (self$accrualTime[1] != 0) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "the first value of 'accrualTime' (", .arrayToString(accrualTime), ") must be 0" + "the first value of 'accrualTime' (", .arrayToString(self$accrualTime), ") must be 0" ) } - .setParameterType("accrualTime", ifelse( - identical(as.integer(accrualTime), C_ACCRUAL_TIME_DEFAULT), + self$.setParameterType("accrualTime", ifelse( + identical(as.integer(self$accrualTime), C_ACCRUAL_TIME_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED )) - .setParameterType("accrualIntensity", C_PARAM_USER_DEFINED) + self$.setParameterType("accrualIntensity", C_PARAM_USER_DEFINED) } else { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'accrualTime' must be a list or a numeric vector") } - if (is.na(absoluteAccrualIntensityEnabled)) { - absoluteAccrualIntensityEnabled <<- .isAbsoluteAccrualIntensity(accrualIntensity) + if (is.na(self$absoluteAccrualIntensityEnabled)) { + self$absoluteAccrualIntensityEnabled <- self$.isAbsoluteAccrualIntensity(self$accrualIntensity) } - if (is.null(maxNumberOfSubjects) || length(maxNumberOfSubjects) == 0 || - any(is.na(maxNumberOfSubjects))) { - if (length(accrualTime) != length(accrualIntensity) + 1 || - !absoluteAccrualIntensityEnabled) { - maxNumberOfSubjectsCanBeCalculatedDirectly <<- FALSE + if (is.null(self$maxNumberOfSubjects) || length(self$maxNumberOfSubjects) == 0 || + any(is.na(self$maxNumberOfSubjects))) { + if (length(self$accrualTime) != length(self$accrualIntensity) + 1 || + !self$absoluteAccrualIntensityEnabled) { + self$maxNumberOfSubjectsCanBeCalculatedDirectly <- FALSE } - .setParameterType("maxNumberOfSubjects", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("maxNumberOfSubjects", C_PARAM_NOT_APPLICABLE) } else { - if (!(length(accrualTime) %in% c( - length(accrualIntensity), - length(accrualIntensity) + 1 + if (!(length(self$accrualTime) %in% c( + length(self$accrualIntensity), + length(self$accrualIntensity) + 1 ))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "length of 'accrualTime' (", length(accrualTime), + "length of 'accrualTime' (", length(self$accrualTime), ") must be equal to length of 'accrualIntensity' if the last 'accrualTime' ", "shall be calculated ", "based on 'maxNumberOfSubjects' or length of 'accrualIntensity' (", - length(accrualIntensity), ") + 1 otherwise" + length(self$accrualIntensity), ") + 1 otherwise" ) } - if (length(accrualTime) == length(accrualIntensity)) { + if (length(self$accrualTime) == length(self$accrualIntensity)) { calculateLastAccrualTimeEnabled <- TRUE } - .setParameterType("maxNumberOfSubjects", C_PARAM_USER_DEFINED) + self$.setParameterType("maxNumberOfSubjects", C_PARAM_USER_DEFINED) } - endOfAccrualIsUserDefined <<- length(accrualTime) == length(accrualIntensity) + 1 + self$endOfAccrualIsUserDefined <- length(self$accrualTime) == length(self$accrualIntensity) + 1 if (calculateLastAccrualTimeEnabled) { - .calculateRemainingTime() - } else if (maxNumberOfSubjectsCanBeCalculatedDirectly) { - if (length(accrualTime) == 1) { - if (length(maxNumberOfSubjects) > 0 && !is.na(maxNumberOfSubjects) && - maxNumberOfSubjects > 0 && maxNumberOfSubjects < accrualIntensity[1]) { + self$.calculateRemainingTime() + } else if (self$maxNumberOfSubjectsCanBeCalculatedDirectly) { + if (length(self$accrualTime) == 1) { + if (length(self$maxNumberOfSubjects) > 0 && !is.na(self$maxNumberOfSubjects) && + self$maxNumberOfSubjects > 0 && self$maxNumberOfSubjects < self$accrualIntensity[1]) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'maxNumberOfSubjects' (", maxNumberOfSubjects, ") ", - "must be >= ", accrualIntensity[1], " ('accrualIntensity')" + "'maxNumberOfSubjects' (", self$maxNumberOfSubjects, ") ", + "must be >= ", self$accrualIntensity[1], " ('accrualIntensity')" ) } - remainingTime <<- accrualTime - .setParameterType("remainingTime", C_PARAM_USER_DEFINED) - } else if (length(accrualTime) > 1) { - sampleSize <- .getSampleSize() - if (!isTRUE(all.equal(sampleSize, maxNumberOfSubjects, tolerance = 1e-04))) { - if (length(maxNumberOfSubjects) == 1 && !is.na(maxNumberOfSubjects) && - maxNumberOfSubjects > 0 && maxNumberOfSubjects < sampleSize) { - if (length(accrualIntensity) == 1 && length(accrualTime) == 1) { - .setParameterType("maxNumberOfSubjects", C_PARAM_USER_DEFINED) - accrualTime <<- 0 - .calculateRemainingTime() + self$remainingTime <- self$accrualTime + self$.setParameterType("remainingTime", C_PARAM_USER_DEFINED) + } else if (length(self$accrualTime) > 1) { + sampleSize <- self$.getSampleSize() + if (!isTRUE(all.equal(sampleSize, self$maxNumberOfSubjects, tolerance = 1e-04))) { + if (length(self$maxNumberOfSubjects) == 1 && !is.na(self$maxNumberOfSubjects) && + self$maxNumberOfSubjects > 0 && self$maxNumberOfSubjects < sampleSize) { + if (length(self$accrualIntensity) == 1 && length(self$accrualTime) == 1) { + self$.setParameterType("maxNumberOfSubjects", C_PARAM_USER_DEFINED) + self$accrualTime <- 0 + self$.calculateRemainingTime() } else { - if (length(accrualTime) == length(accrualIntensity) + 1 && - absoluteAccrualIntensityEnabled) { + if (length(self$accrualTime) == length(self$accrualIntensity) + 1 && + self$absoluteAccrualIntensityEnabled) { stop( C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, - "'maxNumberOfSubjects' (", maxNumberOfSubjects, ") disagrees with ", + "'maxNumberOfSubjects' (", self$maxNumberOfSubjects, ") disagrees with ", "the defined accrual time and intensity: ", - .getFormula(), " = ", sampleSize + self$.getFormula(), " = ", sampleSize ) } else { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'maxNumberOfSubjects' (", - maxNumberOfSubjects, ") ", "must be >= ", sampleSize + self$maxNumberOfSubjects, ") ", "must be >= ", sampleSize ) } } } else { - if ((length(maxNumberOfSubjects) != 1 || is.na(maxNumberOfSubjects)) && - absoluteAccrualIntensityEnabled) { - maxNumberOfSubjects <<- sampleSize - .setParameterType("maxNumberOfSubjects", C_PARAM_GENERATED) + if ((length(self$maxNumberOfSubjects) != 1 || is.na(self$maxNumberOfSubjects)) && + self$absoluteAccrualIntensityEnabled) { + self$maxNumberOfSubjects <- sampleSize + self$.setParameterType("maxNumberOfSubjects", C_PARAM_GENERATED) } - remainingTime <<- accrualTime[length(accrualTime)] - accrualTime[length(accrualTime) - 1] - .setParameterType( + self$remainingTime <- self$accrualTime[length(self$accrualTime)] - self$accrualTime[length(self$accrualTime) - 1] + self$.setParameterType( "remainingTime", - ifelse(!isTRUE(all.equal(0, remainingTime, tolerance = 1e-06)), + ifelse(!isTRUE(all.equal(0, self$remainingTime, tolerance = 1e-06)), C_PARAM_GENERATED, C_PARAM_NOT_APPLICABLE ) ) @@ -1923,20 +2118,20 @@ AccrualTime <- setRefClass("AccrualTime", } } - .validateInitialization() + self$.validateInitialization() - maxNumberOfSubjectsIsUserDefined <<- .getParameterType("maxNumberOfSubjects") == C_PARAM_USER_DEFINED - followUpTimeMustBeUserDefined <<- !endOfAccrualIsUserDefined && !maxNumberOfSubjectsIsUserDefined + self$maxNumberOfSubjectsIsUserDefined <- self$.getParameterType("maxNumberOfSubjects") == C_PARAM_USER_DEFINED + self$followUpTimeMustBeUserDefined <- !self$endOfAccrualIsUserDefined && !self$maxNumberOfSubjectsIsUserDefined }, .getSampleSize = function() { - if (length(accrualTime) < 2) { + if (length(self$accrualTime) < 2) { return(0) } sampleSize <- 0 - for (i in 2:length(accrualTime)) { - time <- accrualTime[i] - accrualTime[i - 1] - sampleSize <- sampleSize + time * accrualIntensity[i - 1] + for (i in 2:length(self$accrualTime)) { + time <- self$accrualTime[i] - self$accrualTime[i - 1] + sampleSize <- sampleSize + time * self$accrualIntensity[i - 1] } return(sampleSize) }, @@ -1952,44 +2147,44 @@ AccrualTime <- setRefClass("AccrualTime", return(values) }, .getBaseLevel = function(x) { - return(min(.getValuesAfterDecimalPoint(x[x > 0]))) + return(min(self$.getValuesAfterDecimalPoint(x[x > 0]))) }, .calcSampleSize = function() { - if (length(accrualTime) <= 1) { + if (length(self$accrualTime) <= 1) { return(0) } - accrualTimeTemp <- accrualTime - accrualIntensityTemp <- accrualIntensity + accrualTimeTemp <- self$accrualTime + accrualIntensityTemp <- self$accrualIntensity sampleSize <- 0 - for (i in 2:length(accrualTime)) { - time <- accrualTime[i] - accrualTime[i - 1] - sampleSize <- sampleSize + time * accrualIntensity[i - 1] - if (sampleSize >= maxNumberOfSubjects && - length(accrualTime) == length(accrualIntensity)) { - if (sampleSize > maxNumberOfSubjects) { - accrualTime <<- accrualTime[1:(i - 1)] + for (i in 2:length(self$accrualTime)) { + time <- self$accrualTime[i] - self$accrualTime[i - 1] + sampleSize <- sampleSize + time * self$accrualIntensity[i - 1] + if (sampleSize >= self$maxNumberOfSubjects && + length(self$accrualTime) == length(self$accrualIntensity)) { + if (sampleSize > self$maxNumberOfSubjects) { + self$accrualTime <- self$accrualTime[1:(i - 1)] } i2 <- i - if (length(accrualTime) == length(accrualIntensity) + 1) { + if (length(self$accrualTime) == length(self$accrualIntensity) + 1) { i2 <- i - 1 } - accrualIntensity <<- accrualIntensity[1:(i2 - 1)] + self$accrualIntensity <- self$accrualIntensity[1:(i2 - 1)] - while (length(accrualTime) > length(accrualIntensity) + 1) { - accrualTime <<- accrualTime[1:(length(accrualTime) - 1)] + while (length(self$accrualTime) > length(self$accrualIntensity) + 1) { + self$accrualTime <- self$accrualTime[1:(length(self$accrualTime) - 1)] } sampleSize <- 0 - if (length(accrualTime) > 1) { - sampleSize <- .getSampleSize() + if (length(self$accrualTime) > 1) { + sampleSize <- self$.getSampleSize() } - if (.showWarnings) { - n1 <- length(accrualTimeTemp) - length(accrualTime) - n2 <- length(accrualIntensityTemp) - length(accrualIntensity) + if (self$.showWarnings) { + n1 <- length(accrualTimeTemp) - length(self$accrualTime) + n2 <- length(accrualIntensityTemp) - length(self$accrualIntensity) if (n1 == 1) { warning("Last accrual time value (", @@ -2024,79 +2219,79 @@ AccrualTime <- setRefClass("AccrualTime", return(sampleSize) }, .calculateRemainingTime = function(stopInCaseOfError = TRUE) { - .assertIsValidMaxNumberOfSubjects(maxNumberOfSubjects) + .assertIsValidMaxNumberOfSubjects(self$maxNumberOfSubjects) - sampleSize <- .calcSampleSize() - remainingSubjects <- maxNumberOfSubjects - sampleSize + sampleSize <- self$.calcSampleSize() + remainingSubjects <- self$maxNumberOfSubjects - sampleSize if (remainingSubjects < 0) { if (!stopInCaseOfError) { return(invisible()) } stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'maxNumberOfSubjects' (", maxNumberOfSubjects, ") ", + "'maxNumberOfSubjects' (", self$maxNumberOfSubjects, ") ", "is too small for the defined accrual time (minimum = ", sampleSize, ")" ) } - lastAccrualIntensity <- accrualIntensity[length(accrualIntensity)] - remainingTime <<- remainingSubjects / lastAccrualIntensity - .setParameterType( + lastAccrualIntensity <- self$accrualIntensity[length(self$accrualIntensity)] + self$remainingTime <- remainingSubjects / lastAccrualIntensity + self$.setParameterType( "remainingTime", - ifelse(!isTRUE(all.equal(0, remainingTime, tolerance = 1e-06)), + ifelse(!isTRUE(all.equal(0, self$remainingTime, tolerance = 1e-06)), C_PARAM_GENERATED, C_PARAM_NOT_APPLICABLE ) ) - if (length(accrualTime) == length(accrualIntensity)) { - accrualTime <<- c(accrualTime, accrualTime[length(accrualTime)] + remainingTime) + if (length(self$accrualTime) == length(self$accrualIntensity)) { + self$accrualTime <- c(self$accrualTime, self$accrualTime[length(self$accrualTime)] + self$remainingTime) } # .setParameterType("accrualTime", C_PARAM_GENERATED) - if (any(accrualTime < 0)) { + if (any(self$accrualTime < 0)) { if (!stopInCaseOfError) { return(invisible()) } stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'maxNumberOfSubjects' (", maxNumberOfSubjects, ") ", + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'maxNumberOfSubjects' (", self$maxNumberOfSubjects, ") ", "is too small for the defined accrual time" ) } }, .validateAccrualTimeAndIntensity = function() { - if ((length(accrualTime) >= 2 && any(accrualTime[2:length(accrualTime)] < 0))) { + if ((length(self$accrualTime) >= 2 && any(self$accrualTime[2:length(self$accrualTime)] < 0))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'accrualTime' (", .arrayToString(accrualTime), ") must be > 0" + "'accrualTime' (", .arrayToString(self$accrualTime), ") must be > 0" ) } - .assertValuesAreStrictlyIncreasing(accrualTime, "accrualTime") + .assertValuesAreStrictlyIncreasing(self$accrualTime, "accrualTime") - if ((length(accrualTime) > 1) && any(accrualIntensity < 0)) { + if ((length(self$accrualTime) > 1) && any(self$accrualIntensity < 0)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'accrualIntensity' (", .arrayToString(accrualIntensity), ") must be >= 0" + "'accrualIntensity' (", .arrayToString(self$accrualIntensity), ") must be >= 0" ) } - if (length(accrualIntensity) == 1 && !is.na(accrualIntensity) && - accrualIntensity == 0) { + if (length(self$accrualIntensity) == 1 && !is.na(self$accrualIntensity) && + self$accrualIntensity == 0) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "at least one 'accrualIntensity' value must be > 0" ) } - if (length(accrualIntensity) > 0 && accrualIntensity[1] == 0) { + if (length(self$accrualIntensity) > 0 && self$accrualIntensity[1] == 0) { warning( "It makes no sense to start 'accrualIntensity' (", - .arrayToString(accrualIntensity), ") with 0" + .arrayToString(self$accrualIntensity), ") with 0" ) } }, .validateInitialization = function() { - .validateAccrualTimeAndIntensity() + self$.validateAccrualTimeAndIntensity() - piecewiseAccrualEnabled <<- !.isNoPiecewiseAccrualTime(accrualTime) + self$piecewiseAccrualEnabled <- !self$.isNoPiecewiseAccrualTime(self$accrualTime) } ) ) diff --git a/R/class_time_r6.R b/R/class_time_r6.R deleted file mode 100644 index 5efb3c07..00000000 --- a/R/class_time_r6.R +++ /dev/null @@ -1,2297 +0,0 @@ -## | -## | *Time classes* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | rpact package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File version: $Revision: 7126 $ -## | Last changed: $Date: 2023-06-23 14:26:39 +0200 (Fr, 23 Jun 2023) $ -## | Last changed by: $Author: pahlke $ -## | - -C_REGEXP_GREATER_OR_EQUAL <- ">= ?" -C_REGEXP_SMALLER <- "< ?" -C_REGEXP_SMALLER_OR_EQUAL <- "<= ?" -C_REGEXP_DECIMAL_NUMBER <- "\\d*(\\.{1}\\d*)?" - -TimeDefinitionR6 <- R6Class("TimeDefinitionR6", - inherit = ParameterSetR6, - public = list( - initialize = function(...) { - super$initialize() - - self$.parameterNames <- C_PARAMETER_NAMES - self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS - }, - .getRegexpFromTo = function(..., from, to, fromPrefix = "", toPrefix = "") { - return(paste0("(^ *", fromPrefix, from, " *- *", toPrefix, to, " *$)")) - }, - .getRegexpSmallerThan = function() { - return(paste0("(^ *", C_REGEXP_SMALLER, C_REGEXP_DECIMAL_NUMBER, " *$)")) - }, - .getRegexpDecimalNumber = function() { - return(paste0("(^ *", C_REGEXP_DECIMAL_NUMBER, " *$)")) - }, - .getRegexpGreaterOrEqualThan = function() { - return(paste0("(^ *", C_REGEXP_GREATER_OR_EQUAL, C_REGEXP_DECIMAL_NUMBER, " *$)")) - }, - .getRegexpDecimalRangeStart = function() { - return(self$.getRegexpFromTo(from = "0", to = C_REGEXP_DECIMAL_NUMBER, toPrefix = C_REGEXP_SMALLER)) - }, - .getRegexpDecimalRange = function() { - return(self$.getRegexpFromTo( - from = C_REGEXP_DECIMAL_NUMBER, to = C_REGEXP_DECIMAL_NUMBER, - toPrefix = C_REGEXP_SMALLER - )) - }, - .getRegexpDecimalRangeEnd = function() { - return(self$.getRegexpFromTo( - from = C_REGEXP_DECIMAL_NUMBER, to = "(Inf|x|\\?)", - toPrefix = paste0("(", C_REGEXP_SMALLER, " *)?") - )) - }, - .getRegexpDecimalRangeFiniteEnd = function() { - return(self$.getRegexpFromTo( - from = C_REGEXP_DECIMAL_NUMBER, to = C_REGEXP_DECIMAL_NUMBER, - toPrefix = "<=? ?" - )) - }, - .getRegexpOr = function(...) { - args <- list(...) - if (length(args) == 0) { - return("") - } - - if (length(args) == 1) { - return(args[[1]]) - } - - return(paste(unlist(args, recursive = FALSE, use.names = FALSE), collapse = "|")) - }, - .validateTimePeriod = function(timePeriod, i, n, accrualTimeMode = FALSE) { - endOfAccrualIsUndefined <- FALSE - if (i == 1 && (n > 1 || !accrualTimeMode)) { - if (!grepl(self$.getRegexpOr(self$.getRegexpSmallerThan(), self$.getRegexpDecimalRangeStart()), - timePeriod, - perl = TRUE - )) { - if (!accrualTimeMode && n == 1 && !grepl("(0 *- ?)?=time\", \"time - Inf\" or \"time1 - <=time2\", ", - "e.g., \"20\", \">=20\" or \"20 - Inf\" or \"20 - <=30\"" - ) - } - if (grepl(self$.getRegexpOr(self$.getRegexpGreaterOrEqualThan(), self$.getRegexpDecimalRangeEnd()), - timePeriod, - perl = TRUE - )) { - endOfAccrualIsUndefined <- TRUE - } - timePeriod <- gsub("([Inf >=\\?x]*)|-", "", timePeriod) - } else { - if (!grepl(self$.getRegexpOr(self$.getRegexpGreaterOrEqualThan(), self$.getRegexpDecimalRangeEnd()), - timePeriod, - perl = TRUE - )) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "the name of the last region must have the format ", - "\">=time\" or \"time - Inf\", e.g., \">=20\" or \"20 - Inf\"" - ) - } - } - } else { - if (!grepl(self$.getRegexpDecimalRange(), timePeriod, perl = TRUE)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "the name of the inner regions must have the format \"time_1 - = 1" - ) - } - } else if (accrualIntensityType == "relative") { - absoluteAccrualIntensityEnabled <- FALSE - } - - args <- list(...) - showWarnings <- args[["showWarnings"]] - if (is.null(showWarnings) || !is.logical(showWarnings)) { - showWarnings <- TRUE - } - - return(AccrualTimeR6$new( - accrualTime = accrualTime, - accrualIntensity = accrualIntensity, - maxNumberOfSubjects = maxNumberOfSubjects, - showWarnings = showWarnings, - absoluteAccrualIntensityEnabled = absoluteAccrualIntensityEnabled - )) -} - -#' -#' @name PiecewiseSurvivalTime -#' -#' @title -#' Piecewise Exponential Survival Time -#' -#' @description -#' Class for the definition of piecewise survival times. -#' -#' @template field_piecewiseSurvivalTime -#' @template field_lambda1 -#' @template field_lambda2 -#' @template field_hazardRatio -#' @template field_pi1_survival -#' @template field_pi2_survival -#' @template field_median1 -#' @template field_median2 -#' @template field_eventTime -#' @template field_kappa -#' @template field_piecewiseSurvivalEnabled -#' @template field_delayedResponseAllowed -#' @template field_delayedResponseEnabled -#' -#' @details -#' \code{PiecewiseSurvivalTime} is a class for the definition of piecewise survival times. -#' -#' @include f_core_constants.R -#' @include class_core_parameter_set.R -#' @include f_core_utilities.R -#' @include f_logger.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -PiecewiseSurvivalTimeR6 <- R6Class("PiecewiseSurvivalTimeR6", - inherit = TimeDefinitionR6, - public = list( - .pi1Default = NULL, - .lambdaBased = NULL, - .silent = NULL, - piecewiseSurvivalTime = NULL, - lambda1 = NULL, - lambda2 = NULL, - hazardRatio = NULL, - pi1 = NULL, - pi2 = NULL, - median1 = NULL, - median2 = NULL, - eventTime = NULL, - kappa = NULL, - piecewiseSurvivalEnabled = NULL, - delayedResponseAllowed = NULL, - delayedResponseEnabled = NULL, - initialize = function(piecewiseSurvivalTime = NA_real_, - ..., - lambda1 = NA_real_, - lambda2 = NA_real_, - hazardRatio = NA_real_, - pi1 = NA_real_, - pi2 = NA_real_, - median1 = NA_real_, - median2 = NA_real_, - eventTime = C_EVENT_TIME_DEFAULT, - kappa = 1, - delayedResponseAllowed = FALSE) { - super$initialize() - self$piecewiseSurvivalTime <- piecewiseSurvivalTime - self$lambda1 <- lambda1 - self$lambda2 <- lambda2 - self$hazardRatio <- hazardRatio - self$pi1 <- pi1 - self$pi2 <- pi2 - self$median1 <- median1 - self$median2 <- median2 - self$eventTime <- eventTime - self$kappa <- kappa - self$delayedResponseAllowed <- delayedResponseAllowed - - if (length(self$piecewiseSurvivalTime) == 0) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'piecewiseSurvivalTime' must be defined (set to NA_real_ if not applicable)" - ) - } - - self$.stopInCaseOfConflictingArguments(self$lambda1, "lambda1", self$median1, "median1") - self$.stopInCaseOfConflictingArguments(self$lambda2, "lambda2", self$median2, "median2") - - self$.stopInCaseOfConflictingArguments(self$pi1, "pi1", self$median1, "median1") - self$.stopInCaseOfConflictingArguments(self$pi1, "pi1", self$median2, "median2") - self$.stopInCaseOfConflictingArguments(self$pi1, "pi1", self$lambda1, "lambda1") - self$.stopInCaseOfConflictingArguments(self$pi1, "pi1", self$lambda2, "lambda2") - self$.stopInCaseOfConflictingArguments(self$pi2, "pi2", self$median1, "median1") - self$.stopInCaseOfConflictingArguments(self$pi2, "pi2", self$median2, "median2") - self$.stopInCaseOfConflictingArguments(self$pi2, "pi2", self$lambda1, "lambda1") - self$.stopInCaseOfConflictingArguments(self$pi2, "pi2", self$lambda2, "lambda2") - - if (length(self$median1) > 0 && !all(is.na(self$median1))) { - self$lambda1 <- getLambdaByMedian(self$median1, kappa = self$kappa) - self$.setParameterType("median1", C_PARAM_USER_DEFINED) - self$.setParameterType("lambda1", C_PARAM_GENERATED) - } else { - self$.setParameterType("median1", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("lambda1", ifelse(length(self$lambda1) == 1 && is.na(self$lambda1), - C_PARAM_NOT_APPLICABLE, C_PARAM_USER_DEFINED - )) - } - if (length(self$median2) > 0 && !all(is.na(self$median2))) { - self$lambda2 <- getLambdaByMedian(self$median2, kappa = self$kappa) - self$.setParameterType("median2", C_PARAM_USER_DEFINED) - self$.setParameterType("lambda2", C_PARAM_GENERATED) - } else { - self$.setParameterType("median2", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("lambda2", C_PARAM_NOT_APPLICABLE) - } - - args <- list(...) - if (!is.null(args[[".pi1Default"]])) { - self$.pi1Default <- args[[".pi1Default"]] - } - if (!is.null(args[[".lambdaBased"]])) { - self$.lambdaBased <- args[[".lambdaBased"]] - } - if (!is.null(args[[".silent"]])) { - self$.silent <- args[[".silent"]] - } else { - self$.silent <- FALSE - } - - self$piecewiseSurvivalEnabled <- FALSE - self$delayedResponseEnabled <- FALSE - - self$.setParameterType("piecewiseSurvivalTime", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("piecewiseSurvivalEnabled", C_PARAM_GENERATED) - self$.setParameterType("delayedResponseEnabled", ifelse(isTRUE(self$delayedResponseAllowed), - C_PARAM_GENERATED, C_PARAM_NOT_APPLICABLE - )) - self$.setParameterType("delayedResponseAllowed", ifelse(isTRUE(self$delayedResponseAllowed), - C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE - )) - self$.setParameterType("pi1", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("pi2", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("eventTime", ifelse(length(self$eventTime) == 1 && is.na(self$eventTime), - C_PARAM_NOT_APPLICABLE, - ifelse(self$eventTime == C_EVENT_TIME_DEFAULT, C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED) - )) - self$.setParameterType("kappa", ifelse(length(self$kappa) == 1 && !is.na(self$kappa) && self$kappa == 1, - C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - - self$.init(self$piecewiseSurvivalTime) - - if (self$.getParameterType("median1") == C_PARAM_USER_DEFINED && - self$.getParameterType("lambda1") == C_PARAM_USER_DEFINED) { - self$.setParameterType("lambda1", C_PARAM_GENERATED) - } - - if (self$.getParameterType("median2") == C_PARAM_USER_DEFINED && - self$.getParameterType("lambda2") == C_PARAM_USER_DEFINED) { - self$.setParameterType("lambda2", C_PARAM_GENERATED) - } - - if (!is.na(self$eventTime) && - self$.getParameterType("pi1") != C_PARAM_USER_DEFINED && - self$.getParameterType("pi1") != C_PARAM_DEFAULT_VALUE && - self$.getParameterType("pi2") != C_PARAM_USER_DEFINED && - self$.getParameterType("pi2") != C_PARAM_DEFAULT_VALUE) { - if (self$.getParameterType("eventTime") == C_PARAM_USER_DEFINED) { - warning("'eventTime' (", round(self$eventTime, 3), ") will be ignored", call. = FALSE) - } - self$.setParameterType("eventTime", C_PARAM_NOT_APPLICABLE) - self$eventTime <- NA_real_ - } - - self$.validateCalculatedArguments() - }, - .validateCalculatedArguments = function() { - if (self$.getParameterType("median1") == C_PARAM_USER_DEFINED) { - if (!isTRUE(all.equal(getLambdaByMedian(self$median1, kappa = self$kappa), self$lambda1, tolerance = 1e-05))) { - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'lambda1' must be ", - round(getLambdaByMedian(self$median1, kappa = self$kappa), 5), ", but is ", round(self$lambda1, 5) - ) - } - if (!any(is.na(self$pi1)) && - !isTRUE(all.equal(getPiByMedian(self$median1, eventTime = self$eventTime, kappa = self$kappa), - self$pi1, - tolerance = 1e-05 - ))) { - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'pi1' must be ", - round(getPiByMedian(self$median1, eventTime = self$eventTime, kappa = self$kappa), 5), ", but is ", round(self$pi1, 5) - ) - } - } - - if (self$.getParameterType("median2") == C_PARAM_USER_DEFINED) { - if (!isTRUE(all.equal(getLambdaByMedian(self$median2, kappa = self$kappa), self$lambda2, tolerance = 1e-05))) { - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'lambda2' must be ", - round(getLambdaByMedian(self$median2, kappa = self$kappa), 5), ", but is ", round(self$lambda2, 5) - ) - } - if (!is.na(self$pi2) && - !isTRUE(all.equal(getPiByMedian(self$median2, eventTime = self$eventTime, kappa = self$kappa), - self$pi2, - tolerance = 1e-05 - ))) { - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'pi2' must be ", - round(getPiByMedian(self$median2, eventTime = self$eventTime, kappa = self$kappa), 5), ", but is ", round(self$pi2, 5) - ) - } - } - - if (self$.getParameterType("lambda1") == C_PARAM_USER_DEFINED || - self$.getParameterType("median1") == C_PARAM_USER_DEFINED || - self$.getParameterType("lambda2") == C_PARAM_USER_DEFINED || - self$.getParameterType("median2") == C_PARAM_USER_DEFINED) { - if (!any(is.na(self$pi1))) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'pi1' (", self$pi1, ") must be NA_real_") - } - if (self$.getParameterType("pi1") != C_PARAM_NOT_APPLICABLE) { - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, "parameter type of 'pi1' (", - self$.getParameterType("pi1"), ") must be C_PARAM_NOT_APPLICABLE" - ) - } - if (!any(is.na(self$pi1))) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'pi2' (", self$pi2, ") must be NA_real_") - } - if (self$.getParameterType("pi2") != C_PARAM_NOT_APPLICABLE) { - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, "parameter type of 'pi2' (", - self$.getParameterType("pi2"), ") must be C_PARAM_NOT_APPLICABLE" - ) - } - if (!any(is.na(self$eventTime))) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'eventTime' (", self$eventTime, ") must be NA_real_") - } - if (self$.getParameterType("eventTime") != C_PARAM_NOT_APPLICABLE) { - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, "parameter type of 'eventTime' (", - self$.getParameterType("eventTime"), ") must be C_PARAM_NOT_APPLICABLE" - ) - } - } - - if (self$.getParameterType("hazardRatio") == C_PARAM_TYPE_UNKNOWN) { - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, "parameter type of 'hazardRatio' (", - self$hazardRatio, ") must be != C_PARAM_TYPE_UNKNOWN" - ) - } - }, - .stopInCaseOfConflictingArguments = function(arg1, argName1, arg2, argName2) { - if (length(arg1) > 0 && !all(is.na(arg1)) && length(arg2) > 0 && !all(is.na(arg2))) { - stop( - C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, - "it is not allowed to specify '", argName1, "' (", .arrayToString(arg1), ")", - " and '", argName2, "' (", .arrayToString(arg2), ") concurrently" - ) - } - }, - .asDataFrame = function() { - data <- data.frame( - piecewiseSurvivalTime = self$piecewiseSurvivalTime, - lambda1 = self$lambda1, - lambda2 = self$lambda2 - ) - rownames(data) <- as.character(1:nrow(data)) - colnames(data) <- c( - "Start time", - C_PARAMETER_NAMES["lambda1"], # Hazard rate (1) - C_PARAMETER_NAMES["lambda2"] - ) # Hazard rate (2) - return(data) - }, - .isPiBased = function() { - return(!self$.isLambdaBased()) - }, - .isLambdaBased = function(minNumberOfLambdas = 2) { - if (self$.getParameterType("lambda2") == C_PARAM_USER_DEFINED || - self$.getParameterType("median2") == C_PARAM_USER_DEFINED) { - if (length(self$lambda2) >= minNumberOfLambdas && !any(is.na(self$lambda2))) { - return(TRUE) - } - } - - return((length(self$pi1) == 0 || any(is.na(self$pi1))) && (length(self$pi2) == 0 || any(is.na(self$pi2)))) - }, - show = function(showType = 1, digits = NA_integer_) { - self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) - }, - .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { - "Method for automatically printing piecewise survival time objects" - self$.resetCat() - if (showType == 2) { - super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) - } else { - self$.cat("Piecewise exponential survival times:\n", - sep = "", heading = 1, - consoleOutputEnabled = consoleOutputEnabled - ) - if (!self$piecewiseSurvivalEnabled) { - self$.cat(" Piecewise exponential survival is disabled.\n\n", consoleOutputEnabled = consoleOutputEnabled) - } else if (length(self$piecewiseSurvivalTime) == 1) { - self$.cat(" At all times:", self$lambda2[1], "\n\n", consoleOutputEnabled = consoleOutputEnabled) - } else { - piecewiseSurvivalTimeStr <- format(self$piecewiseSurvivalTime) - lambda2Str <- format(self$lambda2) - for (i in 1:length(self$piecewiseSurvivalTime)) { - if (i < length(self$piecewiseSurvivalTime)) { - self$.cat(" ", piecewiseSurvivalTimeStr[i], " - <", - piecewiseSurvivalTimeStr[i + 1], ": ", - lambda2Str[i], "\n", - sep = "", - consoleOutputEnabled = consoleOutputEnabled - ) - } else { - self$.cat(" ", rep(" ", 2 + max(nchar(piecewiseSurvivalTimeStr))), - ">=", piecewiseSurvivalTimeStr[i], ": ", - lambda2Str[i], "\n", - sep = "", - consoleOutputEnabled = consoleOutputEnabled - ) - } - } - if (self$delayedResponseEnabled) { - self$.cat("Delayed response is enabled.\n", consoleOutputEnabled = consoleOutputEnabled) - } - self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) - } - - self$.cat("Details:\n\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) - self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Generated parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - } - }, - .toString = function(startWithUpperCase = FALSE) { - s <- "piecewise survival time" - return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) - }, - isDelayedResponseEnabled = function() { - return(self$delayedResponseEnabled) - }, - isPiecewiseSurvivalEnabled = function() { - if (length(self$piecewiseSurvivalTime) == 0) { - return(FALSE) - } - - if (length(self$piecewiseSurvivalTime) == 1 && is.na(self$piecewiseSurvivalTime)) { - return(FALSE) - } - - return(TRUE) - }, - .initFromList = function(pwSurvTimeList) { - if (!is.list(pwSurvTimeList)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'piecewiseSurvivalTime' must be a list") - } - - if (length(pwSurvTimeList) == 0) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'piecewiseSurvivalTime' must contain at least one entry" - ) - } - - if (is.null(names(pwSurvTimeList))) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'piecewiseSurvivalTime' must be a named list") - } - - if (!all(is.na(self$lambda2))) { - warning("'lambda2' (", .arrayToString(self$lambda2), - ") will be ignored because 'piecewiseSurvivalTime' is a list", - call. = FALSE - ) - } - - pwSurvStartTimes <- c(0) - pwSurvLambda2 <- c() - pwSurvTimeNames <- names(pwSurvTimeList) - for (i in 1:length(pwSurvTimeNames)) { - timePeriod <- pwSurvTimeNames[i] - lambdaValue <- pwSurvTimeList[[timePeriod]] - .assertIsSingleNumber(lambdaValue, paste0("pwSurvLambda[", i, "]")) - - timePeriod <- self$.validateTimePeriod(timePeriod, i = i, n = length(pwSurvTimeNames)) - - if (i < length(pwSurvTimeNames)) { - parts <- strsplit(timePeriod, "- *(< *)?", perl = TRUE)[[1]] - if (length(parts) != 2) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "all regions (", timePeriod, ") must have the format ", - "\"time_1 - 1 && self$delayedResponseAllowed) { - if (length(self$hazardRatio) != length(pwSurvLambda2)) { - warning("Only the first 'hazardRatio' (", round(self$hazardRatio[1], 4), - ") was used for piecewise survival time definition ", - "(use a loop over the function to simulate different hazard ratios)", - call. = FALSE - ) - self$hazardRatio <- self$hazardRatio[1] - } else { - self$delayedResponseEnabled <- TRUE - } - self$lambda1 <- pwSurvLambda2 * self$hazardRatio^(1 / self$kappa) - self$.setParameterType("lambda1", C_PARAM_GENERATED) - } else { - self$lambda1 <- NA_real_ - self$.setParameterType("lambda1", C_PARAM_NOT_APPLICABLE) - } - - self$lambda2 <- pwSurvLambda2 - self$.setParameterType("lambda2", C_PARAM_USER_DEFINED) - - self$piecewiseSurvivalEnabled <- !identical(self$piecewiseSurvivalTime, 0) - }, - .init = function(pwSurvTime) { - .logDebug("pwSurvTime %s, %s", ifelse(is.numeric(pwSurvTime), - .arrayToString(pwSurvTime), pwSurvTime - ), .getClassName(pwSurvTime[1])) - .logDebug("lambda1 %s, %s", self$lambda1, self$.getParameterType("lambda1")) - .logDebug("lambda2 %s, %s", self$lambda2, self$.getParameterType("lambda2")) - - # case 1: lambda1 and lambda2 = NA or generated - if (length(pwSurvTime) == 1 && (is.na(pwSurvTime) || is.numeric(pwSurvTime)) && - (all(is.na(self$lambda1)) || self$.getParameterType("lambda1") == C_PARAM_GENERATED) && - length(self$lambda2) == 1 && (is.na(self$lambda2) || self$.getParameterType("lambda2") == C_PARAM_GENERATED) - ) { - .logDebug(".init, case 1: lambda1 and lambda2 = NA") - - if (!is.null(self$.lambdaBased) && isTRUE(self$.lambdaBased)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'lambda1' and 'lambda2' must be specified") - } - - if (!any(is.na(self$hazardRatio))) { - self$.setParameterType("hazardRatio", C_PARAM_USER_DEFINED) - } - - if (!is.na(pwSurvTime)) { - warning("'piecewiseSurvivalTime' (", pwSurvTime, ") will be ignored") - } - - if (is.na(self$pi2)) { - if (!is.na(self$median2) || !any(is.na(self$median1))) { - .logDebug(".init: set pi2 to 'not applicable'") - self$.setParameterType("pi2", C_PARAM_NOT_APPLICABLE) - } else { - .logDebug(".init: set pi2 to default") - self$pi2 <- C_PI_2_DEFAULT - self$.setParameterType("pi2", C_PARAM_DEFAULT_VALUE) - } - } else { - .assertIsSingleNumber(self$pi2, "pi2") - self$.setParameterType("pi2", ifelse(self$pi2 == C_PI_2_DEFAULT, - C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - if (!any(is.na(self$median2))) { - warning("'median2' (", .arrayToString(self$median2), ") will be ignored") - self$median2 <- NA_real_ - } - } - - hazardRatioCalculationEnabled <- TRUE - if (all(is.na(self$pi1))) { - if (length(self$hazardRatio) > 0 && !all(is.na(self$hazardRatio))) { - self$.setParameterType("hazardRatio", C_PARAM_USER_DEFINED) - hazardRatioCalculationEnabled <- FALSE - } - - if (!any(is.na(self$median1))) { - .logDebug(".init: set pi1 to 'not applicable'") - self$.setParameterType("pi1", C_PARAM_NOT_APPLICABLE) - - if (is.na(self$median2)) { - if (any(is.na(self$hazardRatio))) { - stop( - C_EXCEPTION_TYPE_MISSING_ARGUMENT, - "'hazardRatio', 'lambda2', or 'median2' must be specified" - ) - } - - if (length(self$hazardRatio) != length(self$median1)) { - stop( - C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, - "length of 'hazardRatio' (", .arrayToString(self$hazardRatio), ") must be ", - "equal to length of 'median1' (", .arrayToString(self$median1), ")" - ) - } - - .logDebug(".init: calculate lambda2 and median2 by median1") - - self$lambda2 <- getLambdaByMedian(self$median1, self$kappa) / self$hazardRatio^(1 / self$kappa) - - if (!self$delayedResponseAllowed && length(unique(round(self$lambda2, 8))) > 1) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'lambda2' can only be calculated if 'unique(lambda1 / hazardRatio^(1 / kappa))' ", - "result in a single value; current result = ", - .arrayToString(round(self$lambda2, 4), vectorLookAndFeelEnabled = TRUE), - " (e.g., delayed response is not allowed)" - ) - } - - self$median2 <- getMedianByLambda(self$lambda2, self$kappa) - self$.setParameterType("lambda2", C_PARAM_GENERATED) - self$.setParameterType("median2", C_PARAM_GENERATED) - } - } else if (length(self$hazardRatio) > 0 && !all(is.na(self$hazardRatio))) { - self$.setParameterType("pi1", C_PARAM_NOT_APPLICABLE) - - if (!any(is.na(self$lambda1))) { - .logDebug(".init: calculate median1 by lambda1") - self$median1 <- getMedianByLambda(self$lambda1, self$kappa) - self$.setParameterType("median1", C_PARAM_GENERATED) - } else if (!is.na(self$median2)) { - .logDebug(".init: calculate lambda1 and median1 by median2") - self$lambda1 <- getLambdaByMedian(self$median2, self$kappa) * self$hazardRatio^(1 / self$kappa) - self$median1 <- getMedianByLambda(self$lambda1, self$kappa) - self$.setParameterType("lambda1", C_PARAM_GENERATED) - self$.setParameterType("median1", C_PARAM_GENERATED) - } - } else { - .logDebug(".init: set pi1 to default") - if (!is.null(self$.pi1Default) && is.numeric(self$.pi1Default) && - length(self$.pi1Default) > 0) { - self$pi1 <- self$.pi1Default - } else { - self$pi1 <- C_PI_1_SAMPLE_SIZE_DEFAULT - } - self$.setParameterType("pi1", C_PARAM_DEFAULT_VALUE) - } - } else { - .assertIsNumericVector(self$pi1, "pi1") - if (!any(is.na(self$median1))) { - .logDebug(".init: set median1 to NA") - warning("'median1' (", .arrayToString(self$median1), ") will be ignored") - self$median1 <- NA_real_ - } - } - - if (hazardRatioCalculationEnabled) { - if (length(self$hazardRatio) > 0 && !all(is.na(self$hazardRatio))) { - warning("'hazardRatio' (", .arrayToString(self$hazardRatio), - ") will be ignored because it will be calculated", - call. = FALSE - ) - } - - if (!any(is.na(self$lambda1)) && !is.na(self$lambda2)) { - .logDebug(".init: calculate hazardRatio by lambda1 and lambda2") - self$hazardRatio <- (self$lambda1 / self$lambda2)^self$kappa - self$.setParameterType("hazardRatio", C_PARAM_GENERATED) - } else if (!any(is.na(self$pi1)) && !is.na(self$pi2)) { - .logDebug(".init: calculate hazardRatio by pi1 and pi2") - self$hazardRatio <- getHazardRatioByPi(self$pi1, self$pi2, self$eventTime, kappa = self$kappa) - self$.setParameterType("hazardRatio", C_PARAM_GENERATED) - } - } - - if (length(self$pi1) > 0 && !any(is.na(self$pi1))) { - pi1Default <- C_PI_1_SAMPLE_SIZE_DEFAULT - if (!is.null(self$.pi1Default) && is.numeric(self$.pi1Default) && - length(self$.pi1Default) > 0) { - pi1Default <- self$.pi1Default - } - if (identical(self$pi1, pi1Default)) { - self$.setParameterType("pi1", C_PARAM_DEFAULT_VALUE) - } else if (hazardRatioCalculationEnabled && self$.getParameterType("pi1") != C_PARAM_GENERATED) { - self$.setParameterType("pi1", C_PARAM_USER_DEFINED) - } - } - - if (length(self$pi2) == 1 && !is.na(self$pi2)) { - if (length(self$eventTime) == 1 && !is.na(self$eventTime)) { - self$lambda2 <- getLambdaByPi(self$pi2, self$eventTime, kappa = self$kappa) - self$.setParameterType("lambda2", C_PARAM_GENERATED) - } - - if (length(self$pi1) == 1 && is.na(self$pi1) && !any(is.na(self$hazardRatio))) { - self$pi1 <- getPiByLambda( - getLambdaByPi( - self$pi2, self$eventTime, - kappa = self$kappa - ) * self$hazardRatio^(1 / self$kappa), - self$eventTime, - kappa = self$kappa - ) - self$.setParameterType("pi1", C_PARAM_GENERATED) - } - if (length(self$pi1) > 0 && !any(is.na(self$pi1)) && - length(self$eventTime) == 1 && !is.na(self$eventTime)) { - self$lambda1 <- getLambdaByPi(self$pi1, self$eventTime, kappa = self$kappa) - self$.setParameterType("lambda1", C_PARAM_GENERATED) - } - } - - self$.initMedian() - return(invisible()) - } - - if (length(pwSurvTime) == 1 && is.na(pwSurvTime)) { - pwSurvTime <- NA_real_ - } - - if (is.list(pwSurvTime)) { - .assertIsValidHazardRatioVector(self$hazardRatio) - self$.initFromList(pwSurvTime) - self$.initHazardRatio() - if (!self$piecewiseSurvivalEnabled) { - self$.initPi() - self$.initMedian() - } - } else if (self$delayedResponseAllowed && length(self$lambda2) == 1 && - !is.na(self$lambda2) && length(self$hazardRatio) > 0 && - (all(is.na(pwSurvTime)) || identical(pwSurvTime, 0))) { - .logDebug(".init, case 2: delayedResponseAllowed") - - self$piecewiseSurvivalEnabled <- FALSE - - if (!all(is.na(pwSurvTime)) && !identical(pwSurvTime, 0)) { - warning("'piecewiseSurvivalTime' (", .arrayToString(pwSurvTime), ") will be ignored") - } - self$piecewiseSurvivalTime <- 0 - - self$.initPi() - self$.initHazardRatio() - self$.initMedian() - } else if (!is.numeric(pwSurvTime)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'piecewiseSurvivalTime' must be a list, a numeric value, or vector" - ) - } else { - self$piecewiseSurvivalTime <- pwSurvTime - if ((all(is.na(self$piecewiseSurvivalTime)) || identical(self$piecewiseSurvivalTime, 0)) && - length(self$lambda2) == 1 && !is.na(self$lambda2)) { - .logDebug(".init, case 3: piecewise survival is disabled") - if (!all(is.na(self$piecewiseSurvivalTime)) && !identical(self$piecewiseSurvivalTime, 0)) { - warning("'piecewiseSurvivalTime' (", .arrayToString(self$piecewiseSurvivalTime), ") will be ignored") - } - self$piecewiseSurvivalTime <- 0 - self$.setParameterType("piecewiseSurvivalTime", C_PARAM_DEFAULT_VALUE) - self$piecewiseSurvivalEnabled <- FALSE - self$.initHazardRatio() - self$.initPi() - self$.initMedian() - } else { - .logDebug(".init, case 3: piecewise survival is enabled") - if (all(is.na(self$piecewiseSurvivalTime))) { - if (self$.getParameterType("median1") == C_PARAM_USER_DEFINED) { - stop( - C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, - "'median1' (", .arrayToString(self$median1), ") with length > 1 can only ", - "defined together with a single 'median2', 'lambda2' or 'pi2'" - ) - } - - if (self$delayedResponseAllowed && length(self$lambda1 > 0) && !all(is.na(self$lambda1)) && - length(self$lambda1) != length(self$lambda2) && self$delayedResponseAllowed) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "length of 'lambda1' (", length(self$lambda1), "), 'lambda2' (", length(self$lambda2), "), and ", - "'piecewiseSurvivalTime' (", length(self$piecewiseSurvivalTime), ") must be equal" - ) - } - - stop( - C_EXCEPTION_TYPE_MISSING_ARGUMENT, - "'piecewiseSurvivalTime' must be specified" - ) - } - self$.setParameterType("piecewiseSurvivalTime", C_PARAM_USER_DEFINED) - self$piecewiseSurvivalEnabled <- TRUE - self$.initHazardRatio() - self$.initPi() - } - } - - if (self$piecewiseSurvivalEnabled) { - for (param in c("pi", "median")) { - for (group in 1:2) { - paramName <- paste0(param, group) - if (self$.getParameterType(paramName) == C_PARAM_USER_DEFINED) { - warning( - "'", paramName, "' (", .arrayToString(self[[paramName]]), ") ", - "was converted to 'lambda", group, "' ", - "and is not available in output because piecewise ", - "exponential survival time is enabled" - ) - } - } - } - self$pi1 <- NA_real_ - self$pi2 <- NA_real_ - self$median1 <- NA_real_ - self$median2 <- NA_real_ - self$.setParameterType("pi1", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("pi2", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("median1", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("median2", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("eventTime", C_PARAM_NOT_APPLICABLE) - if (!is.na(self$eventTime) && self$eventTime != C_EVENT_TIME_DEFAULT) { - warning("Event time (", self$eventTime, ") will be ignored because it is not ", - "applicable for piecewise exponential survival time", - call. = FALSE - ) - self$eventTime <- C_EVENT_TIME_DEFAULT - } - } - - self$.validateInitialization() - }, - .initMedian = function() { - if (length(self$eventTime) == 1 && !is.na(self$eventTime)) { - if (length(self$pi1) > 0 && !all(is.na(self$pi1)) && self$.getParameterType("median1") != C_PARAM_USER_DEFINED) { - self$median1 <- getMedianByPi(self$pi1, self$eventTime, kappa = self$kappa) - self$.setParameterType("median1", C_PARAM_GENERATED) - } - if (length(self$pi2) == 1 && !is.na(self$pi2) && self$.getParameterType("median2") != C_PARAM_USER_DEFINED) { - self$median2 <- getMedianByPi(self$pi2, self$eventTime, kappa = self$kappa) - self$.setParameterType("median2", C_PARAM_GENERATED) - } - } else { - if (length(self$lambda1) > 0 && !all(is.na(self$lambda1)) && self$.getParameterType("median1") != C_PARAM_USER_DEFINED) { - self$median1 <- getMedianByLambda(self$lambda1, kappa =self$kappa) - self$.setParameterType("median1", C_PARAM_GENERATED) - } - if (length(self$lambda2) == 1 && !is.na(self$lambda2) && self$.getParameterType("median2") != C_PARAM_USER_DEFINED) { - self$median2 <- getMedianByLambda(self$lambda2, kappa = self$kappa) - self$.setParameterType("median2", C_PARAM_GENERATED) - } - } - }, - .initPi = function() { - .logDebug(".initPi: set pi1, pi2, and eventTime to NA") - - if (!is.na(self$eventTime) && self$.getParameterType("eventTime") == C_PARAM_USER_DEFINED) { - warning("'eventTime' (", round(self$eventTime, 3), ") will be ignored", call. = FALSE) - } - if (!is.na(self$pi1) && !identical(self$pi2, C_PI_1_DEFAULT) && !identical(self$pi2, C_PI_1_SAMPLE_SIZE_DEFAULT)) { - warning("'pi1' (", .arrayToString(self$pi1), ") will be ignored", call. = FALSE) - } - if (!is.na(self$pi2) && self$pi2 != C_PI_2_DEFAULT) { - warning("'pi2' (", self$pi2, ") will be ignored", call. = FALSE) - } - - self$.setParameterType("eventTime", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("pi1", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("pi2", C_PARAM_NOT_APPLICABLE) - self$eventTime <- NA_real_ - self$pi1 <- NA_real_ - self$pi2 <- NA_real_ - - if (length(self$lambda2) == 0 || any(is.na(self$lambda2))) { - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, - "'lambda2' must be defined before .initPi() can be called" - ) - } - - self$.setParameterType("lambda2", C_PARAM_USER_DEFINED) - - if (self$piecewiseSurvivalEnabled && length(self$hazardRatio) > 1) { - return(invisible()) - } - - if (length(self$lambda1) == 0 || any(is.na(self$lambda1))) { - if (length(self$hazardRatio) > 0 && !any(is.na(self$hazardRatio))) { - .logDebug(".initPi: calculate lambda1 by hazardRatio") - self$lambda1 <- self$lambda2 * self$hazardRatio^(1 / self$kappa) - self$.setParameterType("lambda1", C_PARAM_GENERATED) - } else if (length(self$lambda1) == 0) { - self$lambda1 <- NA_real_ - } else if (self$delayedResponseAllowed) { - self$.setParameterType("lambda1", C_PARAM_USER_DEFINED) - } - } - }, - .initHazardRatio = function() { - .logDebug(".initHazardRatio") - - if (!is.null(self$hazardRatio) && length(self$hazardRatio) > 0 && !all(is.na(self$hazardRatio))) { - if ((length(self$lambda1) == 1 && is.na(self$lambda1)) || - self$.getParameterType("lambda1") == C_PARAM_GENERATED) { - self$.setParameterType("hazardRatio", C_PARAM_USER_DEFINED) - return(invisible()) - } - - if (!self$.silent) { - warning("'hazardRatio' (", .arrayToString(self$hazardRatio), - ") will be ignored because it will be calculated", - call. = FALSE - ) - } - } - - if (any(is.na(self$lambda2))) { - stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'lambda2' must be specified") - } - - if (any(is.na(self$lambda1))) { - if (self$delayedResponseAllowed && any(is.na(self$hazardRatio) && - !any(is.na(self$piecewiseSurvivalTime)) && length(self$lambda2) == length(self$piecewiseSurvivalTime))) { - stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'hazardRatio' must be specified") - } - if (any(is.na(self$hazardRatio))) { - stop( - C_EXCEPTION_TYPE_MISSING_ARGUMENT, - "'hazardRatio', 'lambda1' or 'median1' must be specified" - ) - } - stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'lambda1' must be specified") - } - - self$.setParameterType("lambda1", C_PARAM_USER_DEFINED) - - hr <- unique(round(self$lambda1 / self$lambda2, 8)^self$kappa) - if (length(hr) != 1) { - if (length(self$lambda2) == 1 && length(self$lambda1) > 1) { - self$hazardRatio <- (self$lambda1 / self$lambda2)^self$kappa - self$.setParameterType("hazardRatio", C_PARAM_GENERATED) - return(invisible()) - } else if (self$delayedResponseAllowed) { - self$hazardRatio <- (self$lambda1 / self$lambda2)^self$kappa - self$.setParameterType("hazardRatio", C_PARAM_GENERATED) - self$delayedResponseEnabled <- TRUE - return(invisible()) - } else { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'hazardRatio' can only be calculated if 'unique(lambda1 / lambda2)' ", - "result in a single value; current result = ", - .arrayToString(round(hr, 4), vectorLookAndFeelEnabled = TRUE), - " (e.g., delayed response is not allowed)" - ) - } - } - - self$hazardRatio <- ((self$lambda1 / self$lambda2)^self$kappa)[1] - self$.setParameterType("hazardRatio", C_PARAM_GENERATED) - }, - .validateInitialization = function() { - if (length(self$piecewiseSurvivalTime) == 0) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'piecewiseSurvivalTime' must contain at least one survival start time" - ) - } - - if (any(is.na(self$piecewiseSurvivalTime))) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'piecewiseSurvivalTime' must contain valid survival start times" - ) - } - - if (self$piecewiseSurvivalTime[1] != 0) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "the first value of 'piecewiseSurvivalTime' must be 0" - ) - } - - if (length(self$piecewiseSurvivalTime) != length(self$lambda2)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "length of 'piecewiseSurvivalTime' (", length(self$piecewiseSurvivalTime), - ") and length of 'lambda2' (", length(self$lambda2), ") must be equal" - ) - } - - .assertValuesAreStrictlyIncreasing(self$piecewiseSurvivalTime, "piecewiseSurvivalTime") - - if ((length(self$lambda1) != 1 || is.na(self$lambda1)) && - !(self$.getParameterType("lambda1") %in% c(C_PARAM_GENERATED, C_PARAM_USER_DEFINED))) { - if (length(self$hazardRatio) == 1 && !is.na(self$hazardRatio)) { - self$lambda1 <- self$lambda2 * self$hazardRatio^(1 / self$kappa) - self$.setParameterType("lambda1", C_PARAM_GENERATED) - } else if (length(self$hazardRatio) > 1 && self$delayedResponseAllowed && - !is.na(self$hazardRatio[1])) { - if (!self$delayedResponseEnabled && self$.isLambdaBased()) { - if (self$delayedResponseAllowed) { - if (length(self$hazardRatio) != length(self$lambda2)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "length of 'hazardRatio' (", length(self$hazardRatio), - ") and length of 'lambda2' (", length(self$lambda2), ") must be equal" - ) - } - self$delayedResponseEnabled <- TRUE - } else { - warning("Only the first 'hazardRatio' (", round(self$hazardRatio[1], 4), - ") was used for piecewise survival time definition", - call. = FALSE - ) - self$hazardRatio <- self$hazardRatio[1] - } - self$lambda1 <- self$lambda2 * self$hazardRatio^(1 / self$kappa) - self$.setParameterType("lambda1", C_PARAM_GENERATED) - } - } else if (!self$delayedResponseEnabled && !(length(self$lambda2) == 1 && length(self$lambda1) > 1)) { - if (length(self$lambda1) > 1) { - warning("'lambda1' (", .arrayToString(self$lambda1), - ") will be ignored", - call. = FALSE - ) - } - self$lambda1 <- NA_real_ - self$.setParameterType("lambda1", C_PARAM_NOT_APPLICABLE) - } - } else if (length(self$hazardRatio) == 1 && !is.na(self$hazardRatio) && - length(self$lambda1) > 0 && !any(is.na(self$lambda1)) && - length(self$lambda2) > 0 && !any(is.na(self$lambda2))) { - target <- self$lambda2 * self$hazardRatio^(1 / self$kappa) - if (length(self$lambda1) > 0 && !all(is.na(self$lambda1)) && - !isTRUE(all.equal(target, self$lambda1))) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'lambda1' (", .arrayToString(self$lambda1), ") ", - "is not as expected (", .arrayToString(target), ") for given hazard ratio ", self$hazardRatio - ) - } - } - - if (self$piecewiseSurvivalEnabled && !(length(self$lambda1) == 1 && is.na(self$lambda1)) && - length(self$piecewiseSurvivalTime) != length(self$lambda1)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "length of 'piecewiseSurvivalTime' (", length(self$piecewiseSurvivalTime), - ") and length of 'lambda1' (", length(self$lambda1), ") must be equal" - ) - } - } - ) -) - -#' -#' @name AccrualTime -#' -#' @title -#' Accrual Time -#' -#' @description -#' Class for the definition of accrual time and accrual intensity. -#' -#' @template field_endOfAccrualIsUserDefined -#' @template field_followUpTimeMustBeUserDefined -#' @template field_maxNumberOfSubjectsIsUserDefined -#' @template field_maxNumberOfSubjectsCanBeCalculatedDirectly -#' @template field_absoluteAccrualIntensityEnabled -#' @template field_accrualTime -#' @template field_accrualIntensity -#' @template field_accrualIntensityRelative -#' @template field_maxNumberOfSubjects -#' @template field_remainingTime -#' @template field_piecewiseAccrualEnabled -#' -#' @details -#' \code{AccrualTime} is a class for the definition of accrual time and accrual intensity. -#' -#' @include f_core_constants.R -#' @include f_core_utilities.R -#' @include class_core_parameter_set.R -#' -#' @keywords internal -#' -#' @importFrom methods new -#' -AccrualTimeR6 <- R6Class("AccrualTimeR6", - inherit = TimeDefinitionR6, - public = list( - .showWarnings = NULL, - endOfAccrualIsUserDefined = NULL, - followUpTimeMustBeUserDefined = NULL, - maxNumberOfSubjectsIsUserDefined = NULL, - maxNumberOfSubjectsCanBeCalculatedDirectly = NULL, - absoluteAccrualIntensityEnabled = NULL, - accrualTime = NULL, - accrualIntensity = NULL, - accrualIntensityRelative = NULL, - maxNumberOfSubjects = NULL, - remainingTime = NULL, - piecewiseAccrualEnabled = NULL, - initialize = function(accrualTime = NA_real_, - ..., - accrualIntensity = NA_real_, - maxNumberOfSubjects = NA_real_, - showWarnings = TRUE, - absoluteAccrualIntensityEnabled = NA) { - super$initialize() - self$accrualTime <- accrualTime - self$accrualIntensity <- accrualIntensity - self$maxNumberOfSubjects <- maxNumberOfSubjects - self$.showWarnings <- showWarnings - self$absoluteAccrualIntensityEnabled <- absoluteAccrualIntensityEnabled - - self$endOfAccrualIsUserDefined <- NA - self$followUpTimeMustBeUserDefined <- NA - self$maxNumberOfSubjectsIsUserDefined <- NA - self$maxNumberOfSubjectsCanBeCalculatedDirectly <- TRUE - # absoluteAccrualIntensityEnabled <<- NA - self$.setParameterType("endOfAccrualIsUserDefined", C_PARAM_GENERATED) - self$.setParameterType("followUpTimeMustBeUserDefined", C_PARAM_GENERATED) - self$.setParameterType("maxNumberOfSubjectsIsUserDefined", C_PARAM_GENERATED) - self$.setParameterType("maxNumberOfSubjectsCanBeCalculatedDirectly", C_PARAM_GENERATED) - self$.setParameterType( - "absoluteAccrualIntensityEnabled", - ifelse(is.na(self$absoluteAccrualIntensityEnabled), C_PARAM_GENERATED, C_PARAM_USER_DEFINED) - ) - - self$accrualIntensityRelative <- NA_real_ - self$.setParameterType("accrualIntensityRelative", C_PARAM_NOT_APPLICABLE) - self$remainingTime <- NA_real_ - - self$.init(self$accrualTime) - - # case 6 correction - if (!self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && - !self$absoluteAccrualIntensityEnabled) { - self$remainingTime <- NA_real_ - self$.setParameterType("remainingTime", C_PARAM_NOT_APPLICABLE) - self$accrualTime <- self$accrualTime[1:length(self$accrualIntensity)] - } - - self$.initAccrualIntensityAbsolute() - self$.validateFormula() - self$.showWarningIfCaseIsNotAllowed() - }, - .asDataFrame = function() { - accrualIntensityTemp <- self$accrualIntensity - if (!all(is.na(self$accrualIntensityRelative))) { - accrualIntensityTemp <- self$accrualIntensityRelative - } - if (length(accrualIntensityTemp) + 1 == length(self$accrualTime)) { - accrualIntensityTemp <- c(accrualIntensityTemp, NA_real_) - } - data <- data.frame( - accrualTime = self$accrualTime, - accrualIntensity = accrualIntensityTemp - ) - rownames(data) <- as.character(1:nrow(data)) - colnames(data) <- c( - "Start time", - C_PARAMETER_NAMES["accrualIntensity"] - ) - return(data) - }, - show = function(showType = 1, digits = NA_integer_) { - self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) - }, - .isAbsoluteAccrualIntensity = function(x) { - return(!self$.isRelativeAccrualIntensity(x)) - }, - .isRelativeAccrualIntensity = function(x) { - return(all(x < 1)) - }, - .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { - "Method for automatically printing accrual time objects" - self$.resetCat() - if (showType == 2) { - super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) - } else { - self$.cat("Accrual time and intensity:\n", - sep = "", heading = 1, - consoleOutputEnabled = consoleOutputEnabled - ) - if (!self$isAccrualTimeEnabled()) { - self$.cat(" Accrual time is disabled.\n", consoleOutputEnabled = consoleOutputEnabled) - } else if (length(self$accrualTime) == 1) { - self$.cat(" At all times:", self$accrualIntensity[1], "\n", consoleOutputEnabled = consoleOutputEnabled) - } else { - accrualTimeStr <- format(self$accrualTime) - accrualIntensityStr <- format(self$accrualIntensity) - for (i in 1:length(self$accrualTime)) { - prefix <- ifelse(i == length(self$accrualTime) - 1, "<=", " <") - suffix <- "" - if (!self$maxNumberOfSubjectsIsUserDefined) { - suffix <- " " - } - if (i < length(self$accrualTime)) { - self$.cat(" ", accrualTimeStr[i], " - ", prefix, accrualTimeStr[i + 1], suffix, ": ", - accrualIntensityStr[i], "\n", - consoleOutputEnabled = consoleOutputEnabled - ) - } else if (!self$maxNumberOfSubjectsIsUserDefined && !is.na(accrualIntensityStr[i]) && - accrualIntensityStr[i] != "NA") { - self$.cat(" ", accrualTimeStr[i], " - <=[?]: ", - accrualIntensityStr[i], "\n", - consoleOutputEnabled = consoleOutputEnabled - ) - } - } - self$.cat("", consoleOutputEnabled = consoleOutputEnabled) - } - self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) - - if (self$isAccrualTimeEnabled()) { - self$.showFormula(consoleOutputEnabled = consoleOutputEnabled) - self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) - - self$.showCase(consoleOutputEnabled = consoleOutputEnabled) - self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) - } - - self$.cat("Details:\n\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) - self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Generated parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - } - }, - .getFormula = function() { - s <- "" - for (i in 1:length(self$accrualTime)) { - if (i < length(self$accrualTime)) { - s <- paste0( - s, (round(self$accrualTime[i + 1], 4) - round(self$accrualTime[i], 4)), - " * ", round(self$accrualIntensity[i], 4) - ) - if (!self$absoluteAccrualIntensityEnabled && - (!self$maxNumberOfSubjectsIsUserDefined || !self$endOfAccrualIsUserDefined)) { - s <- paste0(s, " * c ") - } - if (i < length(self$accrualIntensity)) { - s <- paste0(s, " + ") - } - } - } - return(s) - }, - .validateFormula = function() { - if (is.na(self$maxNumberOfSubjects) || length(self$accrualTime) != length(self$accrualIntensity) + 1) { - return(invisible()) - } - - numberOfSubjects <- 0 - for (i in 1:length(self$accrualTime)) { - if (i < length(self$accrualTime)) { - numberOfSubjects <- numberOfSubjects + - (self$accrualTime[i + 1] - self$accrualTime[i]) * self$accrualIntensity[i] - } - } - if (!isTRUE(all.equal(numberOfSubjects, self$maxNumberOfSubjects, tolerance = 1e-03)) && - self$absoluteAccrualIntensityEnabled) { - stop( - C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, - "'maxNumberOfSubjects' (", self$maxNumberOfSubjects, ") disagrees with ", - "the defined accrual time and intensity: ", - self$.getFormula(), " = ", numberOfSubjects - ) - } - }, - .showWarningIfCaseIsNotAllowed = function() { - caseIsAllowed <- TRUE - if (!self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && - !self$absoluteAccrualIntensityEnabled) { - caseIsAllowed <- FALSE - } else if (!self$endOfAccrualIsUserDefined && !self$maxNumberOfSubjectsIsUserDefined && - self$followUpTimeMustBeUserDefined && !self$absoluteAccrualIntensityEnabled) { - caseIsAllowed <- FALSE - } - if (!caseIsAllowed) { - warning("The specified accrual time and intensity cannot be ", - "supplemented automatically with the missing information; ", - "therefore further calculations are not possible", - call. = FALSE - ) - } - }, - .showFormula = function(consoleOutputEnabled) { - self$.cat("Formula:\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) - self$.cat(" ", consoleOutputEnabled = consoleOutputEnabled) - self$.cat("maxNumberOfSubjects = ", consoleOutputEnabled = consoleOutputEnabled) - if (!is.na(self$maxNumberOfSubjects)) { - self$.cat(self$maxNumberOfSubjects, " = ", consoleOutputEnabled = consoleOutputEnabled) - } - self$.cat(self$.getFormula(), consoleOutputEnabled = consoleOutputEnabled) - if (length(self$accrualTime) == length(self$accrualIntensity)) { - self$.cat("(x - ", self$accrualTime[length(self$accrualTime)], ") * ", - self$accrualIntensity[length(self$accrualIntensity)], - consoleOutputEnabled = consoleOutputEnabled - ) - if (!self$absoluteAccrualIntensityEnabled && - (!self$maxNumberOfSubjectsIsUserDefined || !self$endOfAccrualIsUserDefined)) { - self$.cat(" * c ", consoleOutputEnabled = consoleOutputEnabled) - } - self$.cat(", where 'x' is the unknown last accrual time", - consoleOutputEnabled = consoleOutputEnabled - ) - if (!self$absoluteAccrualIntensityEnabled && - (!self$maxNumberOfSubjectsIsUserDefined || !self$endOfAccrualIsUserDefined)) { - self$.cat(" and 'c' a constant factor", consoleOutputEnabled = consoleOutputEnabled) - } - } else if (!self$absoluteAccrualIntensityEnabled && - (!self$maxNumberOfSubjectsIsUserDefined || !self$endOfAccrualIsUserDefined)) { - self$.cat(", where 'c' is a constant factor", consoleOutputEnabled = consoleOutputEnabled) - } - self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) - }, - .showCase = function(consoleOutputEnabled = TRUE) { - caseIsAllowed <- TRUE - - prefix <- " " - - # Case 1 - # example: getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(22, 33), - # maxNumberOfSubjects = 1000) - if (self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && - self$absoluteAccrualIntensityEnabled) { - self$.cat("Case (#1):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) - self$.cat(prefix, "End of accrual, absolute accrual intensity and 'maxNumberOfSubjects' are given, ", - " 'followUpTime'** shall be calculated.\n", - consoleOutputEnabled = consoleOutputEnabled - ) - self$.cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6, 30), ", - "accrualIntensity = c(22, 33), maxNumberOfSubjects = 924)\n", - consoleOutputEnabled = consoleOutputEnabled - ) - } - - # Case 2 - # example: getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(0.22, 0.33), - # maxNumberOfSubjects = 1000) - else if (self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && - !self$absoluteAccrualIntensityEnabled) { - self$.cat("Case (#2):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) - self$.cat(prefix, "End of accrual, relative accrual intensity and 'maxNumberOfSubjects' are given, ", - "absolute accrual intensity* and 'followUpTime'** shall be calculated.\n", - consoleOutputEnabled = consoleOutputEnabled - ) - self$.cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6, 30), ", - "accrualIntensity = c(0.22, 0.33), maxNumberOfSubjects = 1000)\n", - consoleOutputEnabled = consoleOutputEnabled - ) - } - - # Case 3 - # example: getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(22, 33)) - else if (self$endOfAccrualIsUserDefined && !self$maxNumberOfSubjectsIsUserDefined && - self$absoluteAccrualIntensityEnabled) { - self$.cat("Case (#3):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) - self$.cat(prefix, "End of accrual and absolute accrual intensity are given, ", - "'maxNumberOfSubjects'* and 'followUpTime'** shall be calculated.\n", - consoleOutputEnabled = consoleOutputEnabled - ) - self$.cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(22, 33))\n", - consoleOutputEnabled = consoleOutputEnabled - ) - } - - # Case 4 - # example: getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(0.22, 0.33)) - else if (self$endOfAccrualIsUserDefined && !self$maxNumberOfSubjectsIsUserDefined && - !self$absoluteAccrualIntensityEnabled) { - self$.cat("Case (#4):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) - self$.cat(prefix, "End of accrual, relative accrual intensity and 'followUpTime' are given, ", - "absolute accrual intensity** and 'maxNumberOfSubjects'** shall be calculated.\n", - consoleOutputEnabled = consoleOutputEnabled - ) - self$.cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(0.22, 0.33))\n", - consoleOutputEnabled = consoleOutputEnabled - ) - } - - # Case 5 - # example: getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(22, 33), - # maxNumberOfSubjects = 1000) - else if (!self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && - self$absoluteAccrualIntensityEnabled) { - self$.cat("Case (#5):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) - self$.cat(prefix, "'maxNumberOfSubjects' and absolute accrual intensity are given, ", - "end of accrual* and 'followUpTime'** shall be calculated\n", - consoleOutputEnabled = consoleOutputEnabled - ) - self$.cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6), ", - "accrualIntensity = c(22, 33), maxNumberOfSubjects = 1000)\n", - consoleOutputEnabled = consoleOutputEnabled - ) - } - - # Case 6 - # example: getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(0.22, 0.33), - # maxNumberOfSubjects = 1000) - else if (!self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && - !self$absoluteAccrualIntensityEnabled) { - caseIsAllowed <- FALSE - self$.cat("Case (#6):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) - self$.cat(prefix, "'maxNumberOfSubjects' and relative accrual intensity are given, ", - "absolute accrual intensity@, end of accrual* and 'followUpTime'** shall be calculated\n", - consoleOutputEnabled = consoleOutputEnabled - ) - self$.cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6), ", - "accrualIntensity = c(0.22, 0.33), maxNumberOfSubjects = 1000)\n", - consoleOutputEnabled = consoleOutputEnabled - ) - } - - # Case 7 - # example: getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(22, 33)) - else if (!self$endOfAccrualIsUserDefined && !self$maxNumberOfSubjectsIsUserDefined && - self$followUpTimeMustBeUserDefined && self$absoluteAccrualIntensityEnabled) { - self$.cat("Case (#7):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) - self$.cat(prefix, "'followUpTime' and absolute accrual intensity are given, ", - "end of accrual** and 'maxNumberOfSubjects'** shall be calculated\n", - consoleOutputEnabled = consoleOutputEnabled - ) - self$.cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(22, 33))\n", - consoleOutputEnabled = consoleOutputEnabled - ) - } - - # Case 8 - # example: getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(0.22, 0.33)) - else if (!self$endOfAccrualIsUserDefined && !self$maxNumberOfSubjectsIsUserDefined && - self$followUpTimeMustBeUserDefined && !self$absoluteAccrualIntensityEnabled) { - caseIsAllowed <- FALSE - self$.cat("Case (#8):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) - self$.cat(prefix, "'followUpTime' and relative accrual intensity are given, ", - "absolute accrual intensity@, end of accrual and 'maxNumberOfSubjects' shall be calculated\n", - consoleOutputEnabled = consoleOutputEnabled - ) - self$.cat(prefix, "Example: getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(0.22, 0.33))\n", - consoleOutputEnabled = consoleOutputEnabled - ) - } - - # .cat("\n", consoleOutputEnabled = consoleOutputEnabled) - if (!caseIsAllowed) { - self$.cat(prefix, "(@) Cannot be calculated.\n", - consoleOutputEnabled = consoleOutputEnabled - ) - } - self$.cat(prefix, "(*) Can be calculated directly.\n", - consoleOutputEnabled = consoleOutputEnabled - ) - self$.cat(prefix, "(**) Cannot be calculated directly but with ", - "'getSampleSizeSurvival()' or 'getPowerSurvival()'.\n", - consoleOutputEnabled = consoleOutputEnabled - ) - }, - .followUpTimeShallBeCalculated = function() { - # Case 1: 'followUpTime'** shall be calculated - if (self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && - self$absoluteAccrualIntensityEnabled) { - return(TRUE) - } - - # Case 2: 'followUpTime'** shall be calculated - else if (self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && - !self$absoluteAccrualIntensityEnabled) { - return(TRUE) - } - - # Case 3: 'followUpTime'** shall be calculated - else if (self$endOfAccrualIsUserDefined && !self$maxNumberOfSubjectsIsUserDefined && - self$absoluteAccrualIntensityEnabled) { - return(TRUE) - } - - - # Case 5: 'followUpTime'** shall be calculated - else if (!self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && - self$absoluteAccrualIntensityEnabled) { - return(TRUE) - } - - # Case 6: 'followUpTime'** shall be calculated - else if (!self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && - !self$absoluteAccrualIntensityEnabled) { - return(TRUE) - } - - # (**) Cannot be calculated directly but with 'getSampleSizeSurvival()' or 'getPowerSurvival()' - - return(FALSE) - }, - .validate = function() { - # Case 6 - if (!self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && - !self$absoluteAccrualIntensityEnabled) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "the calculation of 'followUpTime' for given 'maxNumberOfSubjects' ", - "and relative accrual intensities (< 1) ", - "can only be done if end of accrual is defined" - ) - } - - # Case 8 - else if (!self$endOfAccrualIsUserDefined && !self$maxNumberOfSubjectsIsUserDefined && - self$followUpTimeMustBeUserDefined && !self$absoluteAccrualIntensityEnabled) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "the calculation of 'maxNumberOfSubjects' for given 'followUpTime' ", - "and relative accrual intensities (< 1) ", - "can only be done if end of accrual is defined" - ) - } - }, - .toString = function(startWithUpperCase = FALSE) { - s <- "accrual time" - return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) - }, - .getAccrualTimeWithoutLeadingZero = function() { - if (length(self$accrualTime) <= 1) { - return(NA_real_) - } - - return(self$accrualTime[2:length(self$accrualTime)]) - }, - isAccrualTimeEnabled = function() { - if (length(self$accrualTime) == 0) { - return(FALSE) - } - - if (length(self$accrualTime) == 1 && is.na(self$accrualTime)) { - return(FALSE) - } - - return(TRUE) - }, - .initFromList = function(accrualTimeList) { - if (!is.list(accrualTimeList)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'accrualTime' must be a list") - } - - if (length(accrualTimeList) == 0) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'accrualTime' must contain at least one entry") - } - - if (is.null(names(accrualTimeList))) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'accrualTime' must be a named list where the names specify ", - "the time regions and the values the accrual time" - ) - } - - if (self$.showWarnings && !all(is.na(self$accrualIntensity)) && (length(self$accrualIntensity) != 1 || - self$accrualIntensity != C_ACCRUAL_INTENSITY_DEFAULT)) { - warning("'accrualIntensity' (", .arrayToString(self$accrualIntensity), - ") will be ignored because 'accrualTime' is a list", - call. = FALSE - ) - } - - self$accrualTime <- numeric(0) - self$accrualIntensity <- numeric(0) - timeRegions <- names(accrualTimeList) - endOfAccrualIsUndefined <- FALSE - self$accrualTime <- c(self$accrualTime, 0) - for (i in 1:length(timeRegions)) { - timePeriod <- timeRegions[i] - accrualTimeValue <- accrualTimeList[[timePeriod]] - .assertIsSingleNumber(accrualTimeValue, paste0("accrualTime[", i, "]")) - - settings <- self$.validateTimePeriod(timePeriod, i = i, n = length(timeRegions), accrualTimeMode = TRUE) - timePeriod <- settings$timePeriod - endOfAccrualIsUndefined <- settings$endOfAccrualIsUndefined - - if (i < length(timeRegions)) { - parts <- strsplit(timePeriod, "- *(< *)?", perl = TRUE)[[1]] - if (length(parts) != 2) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "all regions (", timePeriod, ") must have the format ", - "\"time_1 - = 2 && length(self$accrualTime) == length(self$accrualIntensity) + 1 && - !any(is.na(self$accrualTime)) && !any(is.na(self$accrualIntensity))) { - len <- length(self$accrualIntensity) - accrualIntensityAbsolute <- self$maxNumberOfSubjects / sum((self$accrualTime[2:(len + 1)] - - self$accrualTime[1:len]) * self$accrualIntensity) * self$accrualIntensity - if (!isTRUE(all.equal(accrualIntensityAbsolute, self$accrualIntensity, tolerance = 1e-06)) && - !isTRUE(all.equal(accrualIntensityAbsolute, 0, tolerance = 1e-06))) { - self$.validateAccrualTimeAndIntensity() - - if (self$absoluteAccrualIntensityEnabled && - self$.getParameterType("maxNumberOfSubjects") == C_PARAM_USER_DEFINED) { - if (self$.getParameterType("accrualTime") == C_PARAM_DEFAULT_VALUE) { - self$accrualTime <- self$maxNumberOfSubjects / self$accrualIntensity - self$.setParameterType("accrualTime", C_PARAM_GENERATED) - self$remainingTime <- self$accrualTime - self$accrualTime <- c(0, self$accrualTime) - } else { - stop( - C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, - "'maxNumberOfSubjects' (", self$maxNumberOfSubjects, ") disagrees with ", - "the defined accrual time (", .arrayToString(self$accrualTime), ") and intensity: ", - self$.getFormula(), " = ", self$.getSampleSize() - ) - } - } else { - if (!self$absoluteAccrualIntensityEnabled && # .isRelativeAccrualIntensity(accrualIntensity) - self$.getParameterType("accrualIntensity") == C_PARAM_USER_DEFINED && - self$.getParameterType("accrualTime") == C_PARAM_DEFAULT_VALUE && - self$.getParameterType("maxNumberOfSubjects") == C_PARAM_USER_DEFINED) { - if (self$.showWarnings) { - warning("'accrualIntensity' (", self$accrualIntensity, ") will be ignored", call. = FALSE) - } - self$accrualIntensityRelative <- C_ACCRUAL_INTENSITY_DEFAULT - self$accrualIntensity <- accrualIntensityAbsolute - self$.setParameterType("accrualIntensity", C_PARAM_GENERATED) - self$.setParameterType("remainingTime", C_PARAM_NOT_APPLICABLE) - } else { - self$accrualIntensityRelative <- self$accrualIntensity - self$accrualIntensity <- accrualIntensityAbsolute - self$.setParameterType("accrualIntensity", C_PARAM_GENERATED) - self$.setParameterType("accrualIntensityRelative", C_PARAM_USER_DEFINED) - } - } - } - } - }, - .isNoPiecewiseAccrualTime = function(accrualTimeArg) { - if (length(accrualTimeArg) == 0 || any(is.na(accrualTimeArg)) || - !all(is.numeric(accrualTimeArg))) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'accrualTimeArg' must a be valid numeric vector") - } - - if (length(accrualTimeArg) == 1) { - return(TRUE) - } - - if (length(accrualTimeArg) == 2 && accrualTimeArg[1] == 0) { - return(TRUE) - } - - return(FALSE) - }, - .init = function(accrualTimeArg) { - if (length(accrualTimeArg) == 0) { - stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'accrualTime' must be defined") - } - - if (length(accrualTimeArg) == 1 && is.numeric(accrualTimeArg) && is.na(accrualTimeArg)) { - accrualTimeArg <- C_ACCRUAL_TIME_DEFAULT - } - - calculateLastAccrualTimeEnabled <- FALSE - if (is.list(accrualTimeArg)) { - endOfAccrualIsUndefined <- self$.initFromList(accrualTimeArg) - calculateLastAccrualTimeEnabled <- endOfAccrualIsUndefined && - !is.null(self$maxNumberOfSubjects) && length(self$maxNumberOfSubjects) == 1 && - !is.na(self$maxNumberOfSubjects) - } else if (is.numeric(accrualTimeArg)) { - .assertIsNumericVector(accrualTimeArg, "accrualTime") - if (length(self$accrualIntensity) > 1) { - .assertIsNumericVector(self$accrualIntensity, "accrualIntensity") - } - - if (self$.isNoPiecewiseAccrualTime(accrualTimeArg) && - (length(self$accrualIntensity) == 0 || is.null(self$accrualIntensity) || - all(is.na(self$accrualIntensity)) || - all(self$accrualIntensity == C_ACCRUAL_INTENSITY_DEFAULT))) { - accrualTimeArg <- accrualTimeArg[length(accrualTimeArg)] - self$accrualTime <- c(0L, accrualTimeArg) - self$.setParameterType("accrualTime", ifelse( - identical(as.integer(self$accrualTime), C_ACCRUAL_TIME_DEFAULT), - C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - - self$accrualIntensity <- C_ACCRUAL_INTENSITY_DEFAULT - self$.setParameterType("accrualIntensity", C_PARAM_DEFAULT_VALUE) - - self$.setParameterType( - "maxNumberOfSubjects", - ifelse(length(self$maxNumberOfSubjects) == 1 && is.na(self$maxNumberOfSubjects), - C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - ) - ) - - self$endOfAccrualIsUserDefined <- length(self$accrualTime) == length(self$accrualIntensity) + 1 - self$maxNumberOfSubjectsIsUserDefined <- - self$.getParameterType("maxNumberOfSubjects") == C_PARAM_USER_DEFINED - self$followUpTimeMustBeUserDefined <- !self$endOfAccrualIsUserDefined && - !self$maxNumberOfSubjectsIsUserDefined - self$absoluteAccrualIntensityEnabled <- FALSE - - if (self$maxNumberOfSubjectsIsUserDefined) { - self$accrualIntensity <- self$maxNumberOfSubjects / self$accrualTime[length(self$accrualTime)] - self$.setParameterType("accrualIntensity", C_PARAM_GENERATED) - } - - return(invisible()) - } - - self$accrualTime <- accrualTimeArg - if (length(self$accrualTime) == 0) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'accrualTime' must contain at least one time value" - ) - } - - if (self$accrualTime[1] != 0) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "the first value of 'accrualTime' (", .arrayToString(self$accrualTime), ") must be 0" - ) - } - - self$.setParameterType("accrualTime", ifelse( - identical(as.integer(self$accrualTime), C_ACCRUAL_TIME_DEFAULT), - C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - self$.setParameterType("accrualIntensity", C_PARAM_USER_DEFINED) - } else { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'accrualTime' must be a list or a numeric vector") - } - - if (is.na(self$absoluteAccrualIntensityEnabled)) { - self$absoluteAccrualIntensityEnabled <- self$.isAbsoluteAccrualIntensity(self$accrualIntensity) - } - if (is.null(self$maxNumberOfSubjects) || length(self$maxNumberOfSubjects) == 0 || - any(is.na(self$maxNumberOfSubjects))) { - if (length(self$accrualTime) != length(self$accrualIntensity) + 1 || - !self$absoluteAccrualIntensityEnabled) { - self$maxNumberOfSubjectsCanBeCalculatedDirectly <- FALSE - } - - self$.setParameterType("maxNumberOfSubjects", C_PARAM_NOT_APPLICABLE) - } else { - if (!(length(self$accrualTime) %in% c( - length(self$accrualIntensity), - length(self$accrualIntensity) + 1 - ))) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "length of 'accrualTime' (", length(self$accrualTime), - ") must be equal to length of 'accrualIntensity' if the last 'accrualTime' ", - "shall be calculated ", - "based on 'maxNumberOfSubjects' or length of 'accrualIntensity' (", - length(self$accrualIntensity), ") + 1 otherwise" - ) - } - if (length(self$accrualTime) == length(self$accrualIntensity)) { - calculateLastAccrualTimeEnabled <- TRUE - } - - self$.setParameterType("maxNumberOfSubjects", C_PARAM_USER_DEFINED) - } - - self$endOfAccrualIsUserDefined <- length(self$accrualTime) == length(self$accrualIntensity) + 1 - - if (calculateLastAccrualTimeEnabled) { - self$.calculateRemainingTime() - } else if (self$maxNumberOfSubjectsCanBeCalculatedDirectly) { - if (length(self$accrualTime) == 1) { - if (length(self$maxNumberOfSubjects) > 0 && !is.na(self$maxNumberOfSubjects) && - self$maxNumberOfSubjects > 0 && self$maxNumberOfSubjects < self$accrualIntensity[1]) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'maxNumberOfSubjects' (", self$maxNumberOfSubjects, ") ", - "must be >= ", self$accrualIntensity[1], " ('accrualIntensity')" - ) - } - self$remainingTime <- self$accrualTime - self$.setParameterType("remainingTime", C_PARAM_USER_DEFINED) - } else if (length(self$accrualTime) > 1) { - sampleSize <- self$.getSampleSize() - if (!isTRUE(all.equal(sampleSize, self$maxNumberOfSubjects, tolerance = 1e-04))) { - if (length(self$maxNumberOfSubjects) == 1 && !is.na(self$maxNumberOfSubjects) && - self$maxNumberOfSubjects > 0 && self$maxNumberOfSubjects < sampleSize) { - if (length(self$accrualIntensity) == 1 && length(self$accrualTime) == 1) { - self$.setParameterType("maxNumberOfSubjects", C_PARAM_USER_DEFINED) - self$accrualTime <- 0 - self$.calculateRemainingTime() - } else { - if (length(self$accrualTime) == length(self$accrualIntensity) + 1 && - self$absoluteAccrualIntensityEnabled) { - stop( - C_EXCEPTION_TYPE_CONFLICTING_ARGUMENTS, - "'maxNumberOfSubjects' (", self$maxNumberOfSubjects, ") disagrees with ", - "the defined accrual time and intensity: ", - self$.getFormula(), " = ", sampleSize - ) - } else { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'maxNumberOfSubjects' (", - self$maxNumberOfSubjects, ") ", "must be >= ", sampleSize - ) - } - } - } else { - if ((length(self$maxNumberOfSubjects) != 1 || is.na(self$maxNumberOfSubjects)) && - self$absoluteAccrualIntensityEnabled) { - self$maxNumberOfSubjects <- sampleSize - self$.setParameterType("maxNumberOfSubjects", C_PARAM_GENERATED) - } - self$remainingTime <- self$accrualTime[length(self$accrualTime)] - self$accrualTime[length(self$accrualTime) - 1] - self$.setParameterType( - "remainingTime", - ifelse(!isTRUE(all.equal(0, self$remainingTime, tolerance = 1e-06)), - C_PARAM_GENERATED, C_PARAM_NOT_APPLICABLE - ) - ) - } - } - } - } - - self$.validateInitialization() - - self$maxNumberOfSubjectsIsUserDefined <- self$.getParameterType("maxNumberOfSubjects") == C_PARAM_USER_DEFINED - self$followUpTimeMustBeUserDefined <- !self$endOfAccrualIsUserDefined && !self$maxNumberOfSubjectsIsUserDefined - }, - .getSampleSize = function() { - if (length(self$accrualTime) < 2) { - return(0) - } - - sampleSize <- 0 - for (i in 2:length(self$accrualTime)) { - time <- self$accrualTime[i] - self$accrualTime[i - 1] - sampleSize <- sampleSize + time * self$accrualIntensity[i - 1] - } - return(sampleSize) - }, - .getValuesAfterDecimalPoint = function(x) { - values <- c() - for (value in x) { - baseLevel <- value - floor(value) - if (baseLevel == 0) { - baseLevel <- 1 - } - values <- c(values, baseLevel) - } - return(values) - }, - .getBaseLevel = function(x) { - return(min(self$.getValuesAfterDecimalPoint(x[x > 0]))) - }, - .calcSampleSize = function() { - if (length(self$accrualTime) <= 1) { - return(0) - } - - accrualTimeTemp <- self$accrualTime - accrualIntensityTemp <- self$accrualIntensity - - sampleSize <- 0 - for (i in 2:length(self$accrualTime)) { - time <- self$accrualTime[i] - self$accrualTime[i - 1] - sampleSize <- sampleSize + time * self$accrualIntensity[i - 1] - if (sampleSize >= self$maxNumberOfSubjects && - length(self$accrualTime) == length(self$accrualIntensity)) { - if (sampleSize > self$maxNumberOfSubjects) { - self$accrualTime <- self$accrualTime[1:(i - 1)] - } - - i2 <- i - if (length(self$accrualTime) == length(self$accrualIntensity) + 1) { - i2 <- i - 1 - } - self$accrualIntensity <- self$accrualIntensity[1:(i2 - 1)] - - while (length(self$accrualTime) > length(self$accrualIntensity) + 1) { - self$accrualTime <- self$accrualTime[1:(length(self$accrualTime) - 1)] - } - - sampleSize <- 0 - if (length(self$accrualTime) > 1) { - sampleSize <- self$.getSampleSize() - } - - if (self$.showWarnings) { - n1 <- length(accrualTimeTemp) - length(self$accrualTime) - n2 <- length(accrualIntensityTemp) - length(self$accrualIntensity) - - if (n1 == 1) { - warning("Last accrual time value (", - accrualTimeTemp[length(accrualTimeTemp)], ") ignored", - call. = FALSE - ) - } else if (n1 > 1) { - warning("Last ", n1, " accrual time values (", - .arrayToString(accrualTimeTemp[(length(accrualTimeTemp) - n1 + 1):length(accrualTimeTemp)]), - ") ignored", - call. = FALSE - ) - } - - if (n2 == 1) { - warning("Last accrual intensity value (", - accrualIntensityTemp[length(accrualIntensityTemp)], ") ignored", - call. = FALSE - ) - } else if (n2 > 1) { - warning("Last ", n2, " accrual intensity values (", - .arrayToString(accrualIntensityTemp[i2:length(accrualIntensityTemp)]), - ") ignored", - call. = FALSE - ) - } - } - - return(sampleSize) - } - } - return(sampleSize) - }, - .calculateRemainingTime = function(stopInCaseOfError = TRUE) { - .assertIsValidMaxNumberOfSubjects(self$maxNumberOfSubjects) - - sampleSize <- self$.calcSampleSize() - remainingSubjects <- self$maxNumberOfSubjects - sampleSize - if (remainingSubjects < 0) { - if (!stopInCaseOfError) { - return(invisible()) - } - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'maxNumberOfSubjects' (", self$maxNumberOfSubjects, ") ", - "is too small for the defined accrual time (minimum = ", sampleSize, ")" - ) - } - - lastAccrualIntensity <- self$accrualIntensity[length(self$accrualIntensity)] - self$remainingTime <- remainingSubjects / lastAccrualIntensity - self$.setParameterType( - "remainingTime", - ifelse(!isTRUE(all.equal(0, self$remainingTime, tolerance = 1e-06)), - C_PARAM_GENERATED, C_PARAM_NOT_APPLICABLE - ) - ) - if (length(self$accrualTime) == length(self$accrualIntensity)) { - self$accrualTime <- c(self$accrualTime, self$accrualTime[length(self$accrualTime)] + self$remainingTime) - } - # .setParameterType("accrualTime", C_PARAM_GENERATED) - if (any(self$accrualTime < 0)) { - if (!stopInCaseOfError) { - return(invisible()) - } - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'maxNumberOfSubjects' (", self$maxNumberOfSubjects, ") ", - "is too small for the defined accrual time" - ) - } - }, - .validateAccrualTimeAndIntensity = function() { - if ((length(self$accrualTime) >= 2 && any(self$accrualTime[2:length(self$accrualTime)] < 0))) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'accrualTime' (", .arrayToString(self$accrualTime), ") must be > 0" - ) - } - - .assertValuesAreStrictlyIncreasing(self$accrualTime, "accrualTime") - - if ((length(self$accrualTime) > 1) && any(self$accrualIntensity < 0)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'accrualIntensity' (", .arrayToString(self$accrualIntensity), ") must be >= 0" - ) - } - - if (length(self$accrualIntensity) == 1 && !is.na(self$accrualIntensity) && - self$accrualIntensity == 0) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "at least one 'accrualIntensity' value must be > 0" - ) - } - - if (length(self$accrualIntensity) > 0 && self$accrualIntensity[1] == 0) { - warning( - "It makes no sense to start 'accrualIntensity' (", - .arrayToString(self$accrualIntensity), ") with 0" - ) - } - }, - .validateInitialization = function() { - self$.validateAccrualTimeAndIntensity() - - self$piecewiseAccrualEnabled <- !self$.isNoPiecewiseAccrualTime(self$accrualTime) - } - ) -) diff --git a/R/f_design_utilities.R b/R/f_design_utilities.R index f5769e41..83eba71d 100644 --- a/R/f_design_utilities.R +++ b/R/f_design_utilities.R @@ -642,7 +642,7 @@ NULL ) } - setting <- PiecewiseSurvivalTime( + setting <- PiecewiseSurvivalTimeR6$new( piecewiseSurvivalTime = piecewiseSurvivalTime, lambda2 = piecewiseLambda, hazardRatio = 1, kappa = kappa, diff --git a/R/f_simulation_performance_score.R b/R/f_simulation_performance_score.R index 81e9fc5e..79edc011 100644 --- a/R/f_simulation_performance_score.R +++ b/R/f_simulation_performance_score.R @@ -156,8 +156,6 @@ getPerformanceScore <- function(simulationResult) { performanceScore <- mean(c(subscoreSampleSize, subscoreConditionalPower), na.rm = TRUE) return(c( - alternative = alternativeValue, - reference = referenceValue, locationSampleSize = locationSampleSize, variationSampleSize = variationSampleSize, subscoreSampleSize = subscoreSampleSize, diff --git a/tests/testthat/test-class_core_plot_settings.R b/tests/testthat/test-class_core_plot_settings.R index 7653b647..c2951c96 100644 --- a/tests/testthat/test-class_core_plot_settings.R +++ b/tests/testthat/test-class_core_plot_settings.R @@ -23,13 +23,7 @@ test_plan_section("Testing the Class 'PlotSettings'") test_that("Test plot settings", { - expect_error(PlotSubTitleItem()) - - expect_type(PlotSubTitleItems(), "S4") - expect_type(getPlotSettings(), "environment") - - expect_type(PlotSettings(), "S4") expect_error(PlotSubTitleItemR6$new()) diff --git a/tests/testthat/test-f_simulation_performance_score.R b/tests/testthat/test-f_simulation_performance_score.R index abe4d311..4b7d3277 100644 --- a/tests/testthat/test-f_simulation_performance_score.R +++ b/tests/testthat/test-f_simulation_performance_score.R @@ -129,14 +129,14 @@ test_that("getPerformanceScore handles non-two-stage designs", { test_that("getPerformanceScore handles non-null conditionalPower", { simulationResult <- createCorrectSimulationResultObject() simulationResult$conditionalPower <- 0.8 - suppressWarnings(expect_type(getPerformanceScore(simulationResult), "S4")) + suppressWarnings(expect_type(getPerformanceScore(simulationResult), "environment")) }) # 4. Test to verify the correctness of the performance score calculation. test_that("getPerformanceScore calculates performance score correctly", { simulationResult <- createCorrectSimulationResultObject() suppressWarnings(scores <- getPerformanceScore(simulationResult)) - expect_type(scores, "S4") + expect_type(scores, "environment") }) # 5. Test to verify that the warning about the function being experimental is issued. @@ -152,5 +152,5 @@ test_that("getPerformanceScore issues warning", { test_that("getPerformanceScore returns correct resultList", { simulationResult <- createCorrectSimulationResultObject() suppressWarnings(result <- getPerformanceScore(simulationResult)) - expect_type(result, "S4") + expect_type(result, "environment") }) From 629cc169ca319423262b527144b3d5bf842009b2 Mon Sep 17 00:00:00 2001 From: Till Luca Jensen Date: Wed, 28 Feb 2024 13:37:00 +0100 Subject: [PATCH 10/28] removed redundant r6 occurences --- R/class_analysis_dataset.R | 76 ++++----- R/class_analysis_results.R | 122 +++++++-------- R/class_analysis_stage_results.R | 50 +++--- R/class_core_parameter_set.R | 48 +++--- R/class_core_plot_settings.R | 16 +- R/class_design.R | 51 ++++--- R/class_design_plan.R | 32 ++-- R/class_design_power_and_asn.R | 6 +- R/class_design_set.R | 24 +-- R/class_event_probabilities.R | 22 +-- R/class_performance_score.R | 6 +- R/class_simulation_results.R | 120 +++++++-------- R/class_summary.R | 144 +++++++++--------- R/class_time.R | 28 ++-- R/f_analysis_base.R | 6 +- R/f_analysis_base_means.R | 12 +- R/f_analysis_base_rates.R | 10 +- R/f_analysis_base_survival.R | 10 +- R/f_analysis_enrichment_means.R | 10 +- R/f_analysis_enrichment_rates.R | 10 +- R/f_analysis_enrichment_survival.R | 8 +- R/f_analysis_multiarm.R | 4 +- R/f_analysis_multiarm_means.R | 12 +- R/f_analysis_multiarm_rates.R | 12 +- R/f_analysis_multiarm_survival.R | 12 +- R/f_core_assertions.R | 70 ++++----- R/f_core_constants.R | 10 +- R/f_core_plot.R | 36 ++--- R/f_core_utilities.R | 8 +- R/f_design_fisher_combination_test.R | 3 +- R/f_design_group_sequential.R | 8 +- R/f_design_sample_size_calculator.R | 10 +- R/f_design_utilities.R | 6 +- R/f_object_r_code.R | 84 +++++----- R/f_simulation_base_means.R | 2 +- R/f_simulation_base_rates.R | 2 +- R/f_simulation_base_survival.R | 2 +- R/f_simulation_calc_subjects_function.R | 10 +- R/f_simulation_enrichment.R | 6 +- R/f_simulation_multiarm.R | 6 +- R/f_simulation_performance_score.R | 12 +- R/f_simulation_utilities.R | 2 +- tests/testthat/helper-f_core_assertions.R | 2 +- .../testthat/test-class_core_plot_settings.R | 6 +- 44 files changed, 569 insertions(+), 567 deletions(-) diff --git a/R/class_analysis_dataset.R b/R/class_analysis_dataset.R index e0632487..0fea912a 100644 --- a/R/class_analysis_dataset.R +++ b/R/class_analysis_dataset.R @@ -509,7 +509,7 @@ writeDatasets <- function(datasets, file, ..., append = FALSE, quote = TRUE, sep enrichmentEnabled <- .isDataObjectEnrichment(...) if (.isDataObjectMeans(...)) { - return(DatasetMeansR6$new( + return(DatasetMeans$new( dataFrame = dataFrame, floatingPointNumbersEnabled = floatingPointNumbersEnabled, enrichmentEnabled = enrichmentEnabled, @@ -518,7 +518,7 @@ writeDatasets <- function(datasets, file, ..., append = FALSE, quote = TRUE, sep } if (.isDataObjectRates(...)) { - return(DatasetRatesR6$new( + return(DatasetRates$new( dataFrame = dataFrame, floatingPointNumbersEnabled = floatingPointNumbersEnabled, enrichmentEnabled = enrichmentEnabled, @@ -527,7 +527,7 @@ writeDatasets <- function(datasets, file, ..., append = FALSE, quote = TRUE, sep } if (.isDataObjectNonStratifiedEnrichmentSurvival(...)) { - return(DatasetEnrichmentSurvivalR6$new( + return(DatasetEnrichmentSurvival$new( dataFrame = dataFrame, floatingPointNumbersEnabled = floatingPointNumbersEnabled, enrichmentEnabled = enrichmentEnabled, @@ -536,7 +536,7 @@ writeDatasets <- function(datasets, file, ..., append = FALSE, quote = TRUE, sep } if (.isDataObjectSurvival(...)) { - return(DatasetSurvivalR6$new( + return(DatasetSurvival$new( dataFrame = dataFrame, floatingPointNumbersEnabled = floatingPointNumbersEnabled, enrichmentEnabled = enrichmentEnabled, @@ -839,7 +839,7 @@ getDataSet <- function(..., floatingPointNumbersEnabled = FALSE) { } for (arg in args) { - if (inherits(arg, "Dataset") || inherits(arg, "DatasetR6")) { + if (inherits(arg, "Dataset") || inherits(arg, "Dataset")) { return(TRUE) } } @@ -1360,9 +1360,9 @@ getDataSet <- function(..., floatingPointNumbersEnabled = FALSE) { #' #' @importFrom methods new #' -DatasetR6 <- R6Class("DatasetR6", - inherit = ParameterSetR6, - public = list( +Dataset <- R6Class("Dataset", + inherit = ParameterSet, + public = list( .data = NULL, .plotSettings = NULL, .id = NULL, @@ -1382,7 +1382,7 @@ DatasetR6 <- R6Class("DatasetR6", self$.enrichmentEnabled <- enrichmentEnabled self$.design <- .design - self$.plotSettings <- PlotSettingsR6$new() + self$.plotSettings <- PlotSettings$new() self$.parameterNames <- .getParameterNames(dataset = self) self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS @@ -1726,7 +1726,7 @@ DatasetR6 <- R6Class("DatasetR6", if (!survivalCorrectionEnabled) { return(length(levels(data$group))) } - return(length(levels(data$group)) + ifelse(inherits(self, "DatasetSurvival") || inherits(self, "DatasetSurvivalR6"), 1, 0)) + return(length(levels(data$group)) + ifelse(inherits(self, "DatasetSurvival") || inherits(self, "DatasetSurvival"), 1, 0)) }, getNumberOfStages = function(naOmitEnabled = TRUE) { if (naOmitEnabled) { @@ -1755,13 +1755,13 @@ DatasetR6 <- R6Class("DatasetR6", return(length(levels(self$.data$subset))) }, isDatasetMeans = function() { - return(inherits(self, "DatasetMeansR6")) + return(inherits(self, "DatasetMeans")) }, isDatasetRates = function() { - return(inherits(self, "DatasetRatesR6")) + return(inherits(self, "DatasetRates")) }, isDatasetSurvival = function() { - return(inherits(self, "DatasetSurvivalR6")) + return(inherits(self, "DatasetSurvival")) }, isStratified = function() { return(self$.enrichmentEnabled && "R" %in% levels(self$.data$subset)) @@ -1830,8 +1830,8 @@ DatasetR6 <- R6Class("DatasetR6", #' #' @importFrom methods new #' -DatasetMeansR6 <- R6Class("DatasetMeansR6", - inherit = DatasetR6, +DatasetMeans <- R6Class("DatasetMeans", + inherit = Dataset, public = list( sampleSizes = NULL, means = NULL, @@ -2525,7 +2525,7 @@ DatasetMeansR6 <- R6Class("DatasetMeansR6", #' #' @export #' -plot.DatasetR6 <- function(x, y, ..., main = "Dataset", xlab = "Stage", ylab = NA_character_, +plot.Dataset <- function(x, y, ..., main = "Dataset", xlab = "Stage", ylab = NA_character_, legendTitle = "Group", palette = "Set1", showSource = FALSE, plotSettings = NULL) { if (x$.enrichmentEnabled) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "plot of enrichment data is not implemented yet") @@ -2709,8 +2709,8 @@ plot.DatasetR6 <- function(x, y, ..., main = "Dataset", xlab = "Stage", ylab = N #' #' @importFrom methods new #' -DatasetRatesR6 <- R6Class("DatasetRatesR6", - inherit = DatasetR6, +DatasetRates <- R6Class("DatasetRates", + inherit = Dataset, public = list( sampleSizes = NULL, events = NULL, @@ -3183,8 +3183,8 @@ DatasetRatesR6 <- R6Class("DatasetRatesR6", #' #' @importFrom methods new #' -DatasetSurvivalR6 <- R6Class("DatasetSurvivalR6", - inherit = DatasetR6, +DatasetSurvival <- R6Class("DatasetSurvival", + inherit = Dataset, public = list( overallEvents = NULL, overallAllocationRatios = NULL, @@ -3255,7 +3255,7 @@ DatasetSurvivalR6 <- R6Class("DatasetSurvivalR6", .initByDataFrame = function(dataFrame) { super$.initByDataFrame(dataFrame) - if (inherits(self, "DatasetEnrichmentSurvivalR6")) { + if (inherits(self, "DatasetEnrichmentSurvival")) { if (self$.paramExists(dataFrame, C_KEY_WORDS_EXPECTED_EVENTS) || self$.paramExists(dataFrame, C_KEY_WORDS_VARIANCE_EVENTS)) { self$.inputType <- "stagewise" @@ -3449,17 +3449,17 @@ DatasetSurvivalR6 <- R6Class("DatasetSurvivalR6", self$.setParameterType("events", C_PARAM_USER_DEFINED) self$.setParameterType("allocationRatios", C_PARAM_USER_DEFINED) - if (!inherits(self, "DatasetEnrichmentSurvivalR6")) { + if (!inherits(self, "DatasetEnrichmentSurvival")) { self$.setParameterType("logRanks", C_PARAM_USER_DEFINED) } self$.setParameterType("overallEvents", C_PARAM_GENERATED) self$.setParameterType("overallAllocationRatios", C_PARAM_GENERATED) - if (!inherits(self, "DatasetEnrichmentSurvivalR6")) { + if (!inherits(self, "DatasetEnrichmentSurvival")) { self$.setParameterType("overallLogRanks", C_PARAM_GENERATED) } - if (!inherits(self, "DatasetEnrichmentSurvivalR6")) { + if (!inherits(self, "DatasetEnrichmentSurvival")) { self$.recreateDataFrame() self$.createOverallData() } @@ -3471,17 +3471,17 @@ DatasetSurvivalR6 <- R6Class("DatasetSurvivalR6", self$.setParameterType("events", C_PARAM_GENERATED) self$.setParameterType("allocationRatios", C_PARAM_GENERATED) - if (!inherits(self, "DatasetEnrichmentSurvivalR6")) { + if (!inherits(self, "DatasetEnrichmentSurvival")) { self$.setParameterType("logRanks", C_PARAM_GENERATED) } self$.setParameterType("overallEvents", C_PARAM_USER_DEFINED) self$.setParameterType("overallAllocationRatios", C_PARAM_USER_DEFINED) - if (!inherits(self, "DatasetEnrichmentSurvivalR6")) { + if (!inherits(self, "DatasetEnrichmentSurvival")) { self$.setParameterType("overallLogRanks", C_PARAM_USER_DEFINED) } - if (!inherits(self, "DatasetEnrichmentSurvivalR6")) { + if (!inherits(self, "DatasetEnrichmentSurvival")) { self$.recreateDataFrame() self$.createStageWiseData() } @@ -3490,7 +3490,7 @@ DatasetSurvivalR6 <- R6Class("DatasetSurvivalR6", .recreateDataFrame = function() { super$.recreateDataFrame() - if (inherits(self, "DatasetEnrichmentSurvivalR6")) { + if (inherits(self, "DatasetEnrichmentSurvival")) { self$.data <- cbind(self$.data, data.frame( overallEvent = self$overallEvents, overallExpectedEvent = self$overallExpectedEvents, @@ -3520,7 +3520,7 @@ DatasetSurvivalR6 <- R6Class("DatasetSurvivalR6", self$overallAllocationRatios <- self$.data$overallAllocationRatio self$events <- self$.data$event self$allocationRatios <- self$.data$allocationRatio - if (!inherits(self, "DatasetEnrichmentSurvivalR6")) { + if (!inherits(self, "DatasetEnrichmentSurvival")) { self$overallLogRanks <- self$.data$overallLogRank self$logRanks <- self$.data$logRank } @@ -3595,7 +3595,7 @@ DatasetSurvivalR6 <- R6Class("DatasetSurvivalR6", }, .createOverallData = function() { self$.data$overallEvent <- rep(NA_real_, nrow(self$.data)) - if (inherits(self, "DatasetEnrichmentSurvivalR6")) { + if (inherits(self, "DatasetEnrichmentSurvival")) { self$.data$overallExpectedEvent <- rep(NA_real_, nrow(self$.data)) self$.data$overallVarianceEvent <- rep(NA_real_, nrow(self$.data)) } else { @@ -3675,7 +3675,7 @@ DatasetSurvivalR6 <- R6Class("DatasetSurvivalR6", "Calculates stage-wise logrank statistics, events, and allocation ratios if cumulative data is available" self$.data$event <- rep(NA_real_, nrow(self$.data)) - if (inherits(self, "DatasetEnrichmentSurvivalR6")) { + if (inherits(self, "DatasetEnrichmentSurvival")) { self$.data$expectedEvent <- rep(NA_real_, nrow(self$.data)) self$.data$varianceEvent <- rep(NA_real_, nrow(self$.data)) } else { @@ -3710,7 +3710,7 @@ DatasetSurvivalR6 <- R6Class("DatasetSurvivalR6", } self$.data$event[indices] <- self$.getStageWiseEvents(self$.data$overallEvent[indices]) - if (inherits(self, "DatasetEnrichmentSurvivalR6")) { + if (inherits(self, "DatasetEnrichmentSurvival")) { self$.data$expectedEvent[indices] <- self$.getStageWiseEvents(self$.data$overallExpectedEvent[indices]) # .data$varianceEvent[indices] <<- # maybe implemented later } else { @@ -3734,8 +3734,8 @@ DatasetSurvivalR6 <- R6Class("DatasetSurvivalR6", #' #' @keywords internal #' -DatasetEnrichmentSurvivalR6 <- R6Class("DatasetEnrichmentSurvivalR6", - inherit = DatasetSurvivalR6, +DatasetEnrichmentSurvival <- R6Class("DatasetEnrichmentSurvival", + inherit = DatasetSurvival, public = list( expectedEvents = NULL, varianceEvents = NULL, @@ -3928,10 +3928,10 @@ DatasetEnrichmentSurvivalR6 <- R6Class("DatasetEnrichmentSurvivalR6", #' #' @keywords internal #' -summary.DatasetR6 <- function(object, ..., type = 1, digits = NA_integer_) { +summary.Dataset <- function(object, ..., type = 1, digits = NA_integer_) { .warnInCaseOfUnknownArguments(functionName = "summary", ...) - if (type == 1 && inherits(object, "SummaryFactoryR6")) { + if (type == 1 && inherits(object, "SummaryFactory")) { return(object) } @@ -3942,7 +3942,7 @@ summary.DatasetR6 <- function(object, ..., type = 1, digits = NA_integer_) { intervalFormat <- getOption("rpact.summary.intervalFormat", "[%s; %s]") .assertIsValidSummaryIntervalFormat(intervalFormat) - summaryFactory <- SummaryFactoryR6$new(object = object, intervalFormat = intervalFormat) + summaryFactory <- SummaryFactory$new(object = object, intervalFormat = intervalFormat) s <- object$.toString() @@ -4180,7 +4180,7 @@ summary.DatasetR6 <- function(object, ..., type = 1, digits = NA_integer_) { #' #' @keywords internal #' -print.DatasetR6 <- function(x, ..., markdown = FALSE, output = c("list", "long", "wide", "r", "rComplete")) { +print.Dataset <- function(x, ..., markdown = FALSE, output = c("list", "long", "wide", "r", "rComplete")) { fCall <- match.call(expand.dots = FALSE) datasetName <- deparse(fCall$x) diff --git a/R/class_analysis_results.R b/R/class_analysis_results.R index 244d5c1e..a86ee60c 100644 --- a/R/class_analysis_results.R +++ b/R/class_analysis_results.R @@ -45,8 +45,8 @@ library("R6") #' #' @importFrom methods new #' -ConditionalPowerResultsR6 <- R6Class("ConditionalPowerResultsR6", - inherit = ParameterSetR6, +ConditionalPowerResults <- R6Class("ConditionalPowerResults", + inherit = ParameterSet, public = list( .plotSettings = NULL, .design = NULL, @@ -69,7 +69,7 @@ ConditionalPowerResultsR6 <- R6Class("ConditionalPowerResultsR6", super$initialize(...) - self$.plotSettings <- PlotSettingsR6$new() + self$.plotSettings <- PlotSettings$new() self$.parameterNames <- C_PARAMETER_NAMES self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS @@ -156,8 +156,8 @@ ConditionalPowerResultsR6 <- R6Class("ConditionalPowerResultsR6", #' #' @importFrom methods new #' -ConditionalPowerResultsMeansR6 <- R6Class("ConditionalPowerResultsMeansR6", - inherit = ConditionalPowerResultsR6, +ConditionalPowerResultsMeans <- R6Class("ConditionalPowerResultsMeans", + inherit = ConditionalPowerResults, public = list( conditionalPower = NULL, thetaH1 = NULL, @@ -187,8 +187,8 @@ ConditionalPowerResultsMeansR6 <- R6Class("ConditionalPowerResultsMeansR6", ) ) -ConditionalPowerResultsMultiHypothesesR6 <- R6Class("ConditionalPowerResultsMultiHypothesesR6", - inherit = ConditionalPowerResultsR6, +ConditionalPowerResultsMultiHypotheses <- R6Class("ConditionalPowerResultsMultiHypotheses", + inherit = ConditionalPowerResults, public = list( conditionalPower = NULL, initialize = function(..., conditionalPower = NULL) { @@ -240,8 +240,8 @@ ConditionalPowerResultsMultiHypothesesR6 <- R6Class("ConditionalPowerResultsMult ) ) -ConditionalPowerResultsMultiArmMeansR6 <- R6Class("ConditionalPowerResultsMultiArmMeansR6", - inherit = ConditionalPowerResultsMultiHypothesesR6, +ConditionalPowerResultsMultiArmMeans <- R6Class("ConditionalPowerResultsMultiArmMeans", + inherit = ConditionalPowerResultsMultiHypotheses, public = list( thetaH1 = NULL, assumedStDevs = NULL, @@ -289,8 +289,8 @@ ConditionalPowerResultsMultiArmMeansR6 <- R6Class("ConditionalPowerResultsMultiA #' #' @importFrom methods new #' -ConditionalPowerResultsRatesR6 <- R6Class("ConditionalPowerResultsRatesR6", - inherit = ConditionalPowerResultsR6, +ConditionalPowerResultsRates <- R6Class("ConditionalPowerResultsRates", + inherit = ConditionalPowerResults, public = list( conditionalPower = NULL, pi1 = NULL, @@ -322,8 +322,8 @@ ConditionalPowerResultsRatesR6 <- R6Class("ConditionalPowerResultsRatesR6", ) ) -ConditionalPowerResultsMultiArmRatesR6 <- R6Class("ConditionalPowerResultsMultiArmRatesR6", - inherit = ConditionalPowerResultsMultiHypothesesR6, +ConditionalPowerResultsMultiArmRates <- R6Class("ConditionalPowerResultsMultiArmRates", + inherit = ConditionalPowerResultsMultiHypotheses, public = list( piTreatments = NULL, piControl = NULL, @@ -370,8 +370,8 @@ ConditionalPowerResultsMultiArmRatesR6 <- R6Class("ConditionalPowerResultsMultiA #' #' @importFrom methods new #' -ConditionalPowerResultsSurvivalR6 <- R6Class("ConditionalPowerResultsSurvivalR6", - inherit = ConditionalPowerResultsR6, +ConditionalPowerResultsSurvival <- R6Class("ConditionalPowerResultsSurvival", + inherit = ConditionalPowerResults, public = list( conditionalPower = NULL, thetaH1 = NULL, @@ -395,8 +395,8 @@ ConditionalPowerResultsSurvivalR6 <- R6Class("ConditionalPowerResultsSurvivalR6" ) ) -ConditionalPowerResultsMultiArmSurvivalR6 <- R6Class("ConditionalPowerResultsMultiArmSurvivalR6", - inherit = ConditionalPowerResultsMultiHypothesesR6, +ConditionalPowerResultsMultiArmSurvival <- R6Class("ConditionalPowerResultsMultiArmSurvival", + inherit = ConditionalPowerResultsMultiHypotheses, public = list( thetaH1 = NULL, initialize = function(..., thetaH1 = NULL) { @@ -439,8 +439,8 @@ ConditionalPowerResultsMultiArmSurvivalR6 <- R6Class("ConditionalPowerResultsMul #' #' @importFrom methods new #' -ConditionalPowerResultsEnrichmentMeansR6 <- R6Class("ConditionalPowerResultsEnrichmentMeansR6", - inherit = ConditionalPowerResultsMultiArmMeansR6 +ConditionalPowerResultsEnrichmentMeans <- R6Class("ConditionalPowerResultsEnrichmentMeans", + inherit = ConditionalPowerResultsMultiArmMeans ) #' @@ -469,8 +469,8 @@ ConditionalPowerResultsEnrichmentMeansR6 <- R6Class("ConditionalPowerResultsEnri #' #' @importFrom methods new #' -ConditionalPowerResultsEnrichmentRatesR6 <- R6Class("ConditionalPowerResultsEnrichmentRatesR6", - inherit = ConditionalPowerResultsMultiHypothesesR6, +ConditionalPowerResultsEnrichmentRates <- R6Class("ConditionalPowerResultsEnrichmentRates", + inherit = ConditionalPowerResultsMultiHypotheses, public = list( piTreatments = NULL, piControls = NULL, @@ -493,8 +493,8 @@ ConditionalPowerResultsEnrichmentRatesR6 <- R6Class("ConditionalPowerResultsEnri ) -ConditionalPowerResultsEnrichmentSurvivalR6 <- R6Class("ConditionalPowerResultsEnrichmentSurvivalR6", - inherit = ConditionalPowerResultsMultiArmSurvivalR6 +ConditionalPowerResultsEnrichmentSurvival <- R6Class("ConditionalPowerResultsEnrichmentSurvival", + inherit = ConditionalPowerResultsMultiArmSurvival ) #' @@ -524,8 +524,8 @@ ConditionalPowerResultsEnrichmentSurvivalR6 <- R6Class("ConditionalPowerResultsE #' #' @importFrom methods new #' -ClosedCombinationTestResultsR6 <- R6Class("ClosedCombinationTestResultsR6", - inherit = ParameterSetR6, +ClosedCombinationTestResults <- R6Class("ClosedCombinationTestResults", + inherit = ParameterSet, public = list( .plotSettings = NULL, .design = NULL, @@ -564,7 +564,7 @@ ClosedCombinationTestResultsR6 <- R6Class("ClosedCombinationTestResultsR6", super$initialize(...) - self$.plotSettings <- PlotSettingsR6$new() + self$.plotSettings <- PlotSettings$new() self$.parameterNames <- C_PARAMETER_NAMES self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS @@ -725,8 +725,8 @@ ClosedCombinationTestResultsR6 <- R6Class("ClosedCombinationTestResultsR6", #' #' @importFrom methods new #' -AnalysisResultsR6 <- R6Class("AnalysisResultsR6", - inherit = ParameterSetR6, +AnalysisResults <- R6Class("AnalysisResults", + inherit = ParameterSet, public = list( .plotSettings = NULL, .design = NULL, @@ -750,7 +750,7 @@ AnalysisResultsR6 <- R6Class("AnalysisResultsR6", super$initialize(...) - self$.plotSettings <- PlotSettingsR6$new() + self$.plotSettings <- PlotSettings$new() self$.parameterNames <- .getParameterNames(design = design, analysisResults = self) self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS }, @@ -911,9 +911,9 @@ AnalysisResultsR6 <- R6Class("AnalysisResultsR6", }, .toString = function(startWithUpperCase = FALSE) { str <- "analysis results" - if (inherits(self, "AnalysisResultsMultiArmR6")) { + if (inherits(self, "AnalysisResultsMultiArm")) { str <- paste0("multi-arm ", str) - } else if (inherits(self, "AnalysisResultsEnrichmentR6")) { + } else if (inherits(self, "AnalysisResultsEnrichment")) { str <- paste0("enrichment ", str) } if (startWithUpperCase) { @@ -960,8 +960,8 @@ AnalysisResultsR6 <- R6Class("AnalysisResultsR6", ) ) -AnalysisResultsBaseR6 <- R6Class("AnalysisResultsBaseR6", - inherit = AnalysisResultsR6, +AnalysisResultsBase <- R6Class("AnalysisResultsBase", + inherit = AnalysisResults, public = list( thetaH1 = NULL, assumedStDev = NULL, @@ -1039,8 +1039,8 @@ AnalysisResultsBaseR6 <- R6Class("AnalysisResultsBaseR6", #' #' @importFrom methods new #' -AnalysisResultsMultiHypothesesR6 <- R6Class("AnalysisResultsMultiHypothesesR6", - inherit = AnalysisResultsR6, +AnalysisResultsMultiHypotheses <- R6Class("AnalysisResultsMultiHypotheses", + inherit = AnalysisResults, public = list( .closedTestResults = NULL, thetaH1 = NULL, # means only @@ -1112,8 +1112,8 @@ AnalysisResultsMultiHypothesesR6 <- R6Class("AnalysisResultsMultiHypothesesR6", #' #' @importFrom methods new #' -AnalysisResultsMultiArmR6 <- R6Class("AnalysisResultsMultiArmR6", - inherit = AnalysisResultsMultiHypothesesR6, +AnalysisResultsMultiArm <- R6Class("AnalysisResultsMultiArm", + inherit = AnalysisResultsMultiHypotheses, public = list( piControl = NULL, # rates only initialize = function(design, dataInput, ..., piControl = NULL) { @@ -1165,8 +1165,8 @@ AnalysisResultsMultiArmR6 <- R6Class("AnalysisResultsMultiArmR6", #' #' @importFrom methods new #' -AnalysisResultsEnrichmentR6 <- R6Class("AnalysisResultsEnrichmentR6", - inherit = AnalysisResultsMultiHypothesesR6, +AnalysisResultsEnrichment <- R6Class("AnalysisResultsEnrichment", + inherit = AnalysisResultsMultiHypotheses, public = list( piControls = NULL, # rates only initialize = function(design, dataInput, ..., piControls = NULL) { @@ -1200,8 +1200,8 @@ AnalysisResultsEnrichmentR6 <- R6Class("AnalysisResultsEnrichmentR6", #' #' @keywords internal #' -summary.AnalysisResultsR6 <- function(object, ..., type = 1, digits = NA_integer_) { - return(summary.ParameterSetR6(object = object, ..., type = type, digits = digits)) +summary.AnalysisResults <- function(object, ..., type = 1, digits = NA_integer_) { + return(summary.ParameterSet(object = object, ..., type = type, digits = digits)) } #' @@ -1224,11 +1224,11 @@ summary.AnalysisResultsR6 <- function(object, ..., type = 1, digits = NA_integer #' #' @keywords internal #' -as.data.frame.AnalysisResultsR6 <- function(x, row.names = NULL, optional = FALSE, ..., +as.data.frame.AnalysisResults <- function(x, row.names = NULL, optional = FALSE, ..., niceColumnNamesEnabled = FALSE) { parametersToShow <- .getDesignParametersToShow(x) - if (inherits(x, "AnalysisResultsMultiArmR6")) { + if (inherits(x, "AnalysisResultsMultiArm")) { parametersToShow <- c(parametersToShow, ".closedTestResults$rejected") } parametersToShow <- c(parametersToShow, x$.getUserDefinedParameters()) @@ -1265,7 +1265,7 @@ as.data.frame.AnalysisResultsR6 <- function(x, row.names = NULL, optional = FALS #' #' @keywords internal #' -names.AnalysisResultsR6 <- function(x) { +names.AnalysisResults <- function(x) { namesToShow <- c(".design", ".dataInput", ".stageResults", ".conditionalPowerResults") if (.isMultiArmAnalysisResults(x)) { namesToShow <- c(namesToShow, ".closedTestResults") @@ -1321,8 +1321,8 @@ names.AnalysisResultsR6 <- function(x) { #' #' @importFrom methods new #' -AnalysisResultsGroupSequentialR6 <- R6Class("AnalysisResultsGroupSequentialR6", - inherit = AnalysisResultsBaseR6, +AnalysisResultsGroupSequential <- R6Class("AnalysisResultsGroupSequential", + inherit = AnalysisResultsBase, public = list( maxInformation = NULL, informationEpsilon = NULL, @@ -1383,8 +1383,8 @@ AnalysisResultsGroupSequentialR6 <- R6Class("AnalysisResultsGroupSequentialR6", #' #' @importFrom methods new #' -AnalysisResultsInverseNormalR6 <- R6Class("AnalysisResultsInverseNormalR6", - inherit = AnalysisResultsBaseR6 +AnalysisResultsInverseNormal <- R6Class("AnalysisResultsInverseNormal", + inherit = AnalysisResultsBase ) #' @@ -1429,8 +1429,8 @@ AnalysisResultsInverseNormalR6 <- R6Class("AnalysisResultsInverseNormalR6", #' #' @importFrom methods new #' -AnalysisResultsMultiArmInverseNormalR6 <- R6Class("AnalysisResultsMultiArmInverseNormalR6", - inherit = AnalysisResultsMultiArmR6 +AnalysisResultsMultiArmInverseNormal <- R6Class("AnalysisResultsMultiArmInverseNormal", + inherit = AnalysisResultsMultiArm ) #' @@ -1476,8 +1476,8 @@ AnalysisResultsMultiArmInverseNormalR6 <- R6Class("AnalysisResultsMultiArmInvers #' #' @importFrom methods new #' -AnalysisResultsEnrichmentInverseNormalR6 <- R6Class("AnalysisResultsEnrichmentInverseNormalR6", - inherit = AnalysisResultsEnrichmentR6, +AnalysisResultsEnrichmentInverseNormal <- R6Class("AnalysisResultsEnrichmentInverseNormal", + inherit = AnalysisResultsEnrichment, public = list( stratifiedAnalysis = NULL ) @@ -1531,8 +1531,8 @@ AnalysisResultsEnrichmentInverseNormalR6 <- R6Class("AnalysisResultsEnrichmentIn #' #' @importFrom methods new #' -AnalysisResultsFisherR6 <- R6Class("AnalysisResultsFisherR6", - inherit = AnalysisResultsBaseR6, +AnalysisResultsFisher <- R6Class("AnalysisResultsFisher", + inherit = AnalysisResultsBase, public = list( conditionalPowerSimulated = NULL, iterations = NULL, @@ -1589,8 +1589,8 @@ AnalysisResultsFisherR6 <- R6Class("AnalysisResultsFisherR6", #' #' @importFrom methods new #' -AnalysisResultsMultiArmFisherR6 <- R6Class("AnalysisResultsMultiArmFisherR6", - inherit = AnalysisResultsMultiArmR6, +AnalysisResultsMultiArmFisher <- R6Class("AnalysisResultsMultiArmFisher", + inherit = AnalysisResultsMultiArm, public = list( conditionalPowerSimulated = NULL, iterations = NULL, @@ -1643,8 +1643,8 @@ AnalysisResultsMultiArmFisherR6 <- R6Class("AnalysisResultsMultiArmFisherR6", #' #' @importFrom methods new #' -AnalysisResultsEnrichmentFisherR6 <- R6Class("AnalysisResultsEnrichmentFisherR6", - inherit = AnalysisResultsEnrichmentR6, +AnalysisResultsEnrichmentFisher <- R6Class("AnalysisResultsEnrichmentFisher", + inherit = AnalysisResultsEnrichment, public = list( conditionalPowerSimulated = NULL, iterations = NULL, @@ -1689,8 +1689,8 @@ AnalysisResultsEnrichmentFisherR6 <- R6Class("AnalysisResultsEnrichmentFisherR6" #' #' @importFrom methods new #' -AnalysisResultsConditionalDunnettR6 <- R6Class("AnalysisResultsConditionalDunnettR6", - inherit = AnalysisResultsMultiArmR6, +AnalysisResultsConditionalDunnett <- R6Class("AnalysisResultsConditionalDunnett", + inherit = AnalysisResultsMultiArm, public = list() ) @@ -1837,7 +1837,7 @@ AnalysisResultsConditionalDunnettR6 <- R6Class("AnalysisResultsConditionalDunnet #' #' @export #' -plot.AnalysisResultsR6 <- 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_, diff --git a/R/class_analysis_stage_results.R b/R/class_analysis_stage_results.R index 8edb30d0..59c48c51 100644 --- a/R/class_analysis_stage_results.R +++ b/R/class_analysis_stage_results.R @@ -63,8 +63,8 @@ library("R6") #' #' @importFrom methods new #' -StageResultsR6 <- R6Class("StageResultsR6", - inherit = ParameterSetR6, +StageResults <- R6Class("StageResults", + inherit = ParameterSet, public = list( .plotSettings = NULL, .design = NULL, @@ -90,7 +90,7 @@ StageResultsR6 <- R6Class("StageResultsR6", self$.design <- design self$.dataInput <- dataInput - self$.plotSettings <- PlotSettingsR6$new() + self$.plotSettings <- PlotSettings$new() if (!missing(design)) { self$stages <- c(1:design$kMax) if (design$kMax == C_KMAX_DEFAULT) { @@ -232,7 +232,7 @@ StageResultsR6 <- R6Class("StageResultsR6", }, getNumberOfStages = function() { if (self$.isMultiArm()) { - if (inherits(self, "StageResultsMultiArmRatesR6")) { + if (inherits(self, "StageResultsMultiArmRates")) { return(max( ncol(stats::na.omit(self$testStatistics)), ncol(stats::na.omit(self$separatePValues)) @@ -289,8 +289,8 @@ StageResultsR6 <- R6Class("StageResultsR6", #' #' @importFrom methods new #' -StageResultsMeansR6 <- R6Class("StageResultsMeansR6", - inherit = StageResultsR6, +StageResultsMeans <- R6Class("StageResultsMeans", + inherit = StageResults, public = list( combInverseNormal = NULL, combFisher = NULL, @@ -476,8 +476,8 @@ StageResultsMeansR6 <- R6Class("StageResultsMeansR6", #' #' @importFrom methods new #' -StageResultsMultiArmMeansR6 <- R6Class("StageResultsMultiArmMeansR6", - inherit = StageResultsR6, +StageResultsMultiArmMeans <- R6Class("StageResultsMultiArmMeans", + inherit = StageResults, public = list( combInverseNormal = NULL, combFisher = NULL, @@ -624,8 +624,8 @@ StageResultsMultiArmMeansR6 <- R6Class("StageResultsMultiArmMeansR6", #' #' @importFrom methods new #' -StageResultsRatesR6 <- R6Class("StageResultsRatesR6", - inherit = StageResultsR6, +StageResultsRates <- R6Class("StageResultsRates", + inherit = StageResults, public = list( combInverseNormal = NULL, combFisher = NULL, @@ -797,8 +797,8 @@ StageResultsRatesR6 <- R6Class("StageResultsRatesR6", #' #' @importFrom methods new #' -StageResultsMultiArmRatesR6 <- R6Class("StageResultsMultiArmRatesR6", - inherit = StageResultsR6, +StageResultsMultiArmRates <- R6Class("StageResultsMultiArmRates", + inherit = StageResults, public = list( stage = NULL, overallPiTreatments = NULL, @@ -944,8 +944,8 @@ StageResultsMultiArmRatesR6 <- R6Class("StageResultsMultiArmRatesR6", #' #' @importFrom methods new #' -StageResultsSurvivalR6 <- R6Class("StageResultsSurvivalR6", - inherit = StageResultsR6, +StageResultsSurvival <- R6Class("StageResultsSurvival", + inherit = StageResults, public = list( combInverseNormal = NULL, combFisher = NULL, @@ -1076,8 +1076,8 @@ StageResultsSurvivalR6 <- R6Class("StageResultsSurvivalR6", #' #' @importFrom methods new #' -StageResultsMultiArmSurvivalR6 <- R6Class("StageResultsMultiArmSurvivalR6", - inherit = StageResultsR6, +StageResultsMultiArmSurvival <- R6Class("StageResultsMultiArmSurvival", + inherit = StageResults, public = list( stage = NULL, combInverseNormal = NULL, @@ -1207,8 +1207,8 @@ StageResultsMultiArmSurvivalR6 <- R6Class("StageResultsMultiArmSurvivalR6", #' #' @importFrom methods new #' -StageResultsEnrichmentMeansR6 <- R6Class("StageResultsEnrichmentMeansR6", - inherit = StageResultsMultiArmMeansR6, +StageResultsEnrichmentMeans <- R6Class("StageResultsEnrichmentMeans", + inherit = StageResultsMultiArmMeans, public = list( .overallSampleSizes1 = NULL, .overallSampleSizes2 = NULL, @@ -1246,8 +1246,8 @@ StageResultsEnrichmentMeansR6 <- R6Class("StageResultsEnrichmentMeansR6", #' #' @importFrom methods new #' -StageResultsEnrichmentRatesR6 <- R6Class("StageResultsEnrichmentRatesR6", - inherit = StageResultsMultiArmRatesR6, +StageResultsEnrichmentRates <- R6Class("StageResultsEnrichmentRates", + inherit = StageResultsMultiArmRates, public = list( .overallSampleSizes1 = NULL, .overallSampleSizes2 = NULL, @@ -1289,8 +1289,8 @@ StageResultsEnrichmentRatesR6 <- R6Class("StageResultsEnrichmentRatesR6", #' #' @importFrom methods new #' -StageResultsEnrichmentSurvivalR6 <- R6Class("StageResultsEnrichmentSurvivalR6", - inherit = StageResultsMultiArmSurvivalR6, +StageResultsEnrichmentSurvival <- R6Class("StageResultsEnrichmentSurvival", + inherit = StageResultsMultiArmSurvival, public = list( stratifiedAnalysis = NULL, .overallEvents = NULL, @@ -1318,7 +1318,7 @@ StageResultsEnrichmentSurvivalR6 <- R6Class("StageResultsEnrichmentSurvivalR6", #' #' @keywords internal #' -names.StageResultsR6 <- function(x) { +names.StageResults <- function(x) { return(x$.getParametersToShow()) } @@ -1343,7 +1343,7 @@ names.StageResultsR6 <- function(x) { #' #' @keywords internal #' -as.data.frame.StageResultsR6 <- function(x, row.names = NULL, +as.data.frame.StageResults <- function(x, row.names = NULL, optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, type = 1, ...) { if (type == 1) { @@ -1518,7 +1518,7 @@ as.data.frame.StageResultsR6 <- function(x, row.names = NULL, #' #' @export #' -plot.StageResultsR6 <- function(x, y, ..., type = 1L, +plot.StageResults <- function(x, y, ..., type = 1L, nPlanned, allocationRatioPlanned = 1, # C_ALLOCATION_RATIO_DEFAULT main = NA_character_, xlab = NA_character_, ylab = NA_character_, legendTitle = NA_character_, palette = "Set1", legendPosition = NA_integer_, diff --git a/R/class_core_parameter_set.R b/R/class_core_parameter_set.R index 48691d31..0f30d03f 100644 --- a/R/class_core_parameter_set.R +++ b/R/class_core_parameter_set.R @@ -24,7 +24,7 @@ library("R6") NULL #' -#' @name FieldSetR6 +#' @name FieldSet #' #' @title #' Field Set @@ -41,7 +41,7 @@ NULL #' #' @importFrom methods new #' -FieldSetR6 <- R6Class("FieldSetR6", +FieldSet <- R6Class("FieldSet", public = list( .parameterTypes = NULL, .parameterNames = NULL, @@ -169,7 +169,7 @@ FieldSetR6 <- R6Class("FieldSetR6", ) #' -#' @name ParameterSetR6 +#' @name ParameterSet #' #' @title #' Parameter Set @@ -189,8 +189,8 @@ FieldSetR6 <- R6Class("FieldSetR6", #' #' @importFrom methods new #' -ParameterSetR6 <- R6Class("ParameterSetR6", - inherit = FieldSetR6, +ParameterSet <- R6Class("ParameterSet", + inherit = FieldSet, public = list( initialize = function(..., .showParameterTypeEnabled = TRUE) { self$.showParameterTypeEnabled <- .showParameterTypeEnabled @@ -581,7 +581,7 @@ ParameterSetR6 <- R6Class("ParameterSetR6", } if (!is.null(category) && !is.na(category)) { if (.isMultiArmSimulationResults(self) && paramName == "singleNumberOfEventsPerStage") { - if (!(inherits(self, "SimulationResultsEnrichmentSurvival") || inherits(self, "SimulationResultsEnrichmentSurvivalR6")) && + if (!(inherits(self, "SimulationResultsEnrichmentSurvival") || inherits(self, "SimulationResultsEnrichmentSurvival")) && !is.na(numberOfCategories) && numberOfCategories == category) { category <- "control" } @@ -638,7 +638,7 @@ ParameterSetR6 <- R6Class("ParameterSetR6", } } } else if (.isMultiArmAnalysisResults(self) || grepl("StageResultsMultiArm", .getClassName(self)) || - ((inherits(self, "SimulationResults") || inherits(self, "SimulationResultsR6")) && paramName == "effectMatrix") || + ((inherits(self, "SimulationResults") || inherits(self, "SimulationResults")) && paramName == "effectMatrix") || (inherits(self, "ClosedCombinationTestResults") && paramName %in% c("rejected", "separatePValues"))) { paramCaption <- paste0(paramCaption, " (", matrixRow, ")") @@ -1293,7 +1293,7 @@ ParameterSetR6 <- R6Class("ParameterSetR6", parametersToIgnore <- c(parametersToIgnore, "hazardRatio") } - if (!(inherits(parameterSet, "AccrualTime") || !inherits(parameterSet, "AccrualTimeR6"))) { + if (!(inherits(parameterSet, "AccrualTime") || !inherits(parameterSet, "AccrualTime"))) { accrualTime <- parameterSet[["accrualTime"]] if (!is.null(accrualTime) && length(accrualTime) > 1) { parametersToIgnore <- c(parametersToIgnore, c("accrualTime", "accrualIntensity")) @@ -1367,7 +1367,7 @@ ParameterSetR6 <- R6Class("ParameterSetR6", #' #' @keywords internal #' -names.FieldSetR6 <- function(x) { +names.FieldSet <- function(x) { return(x$.getVisibleFieldNames()) } @@ -1388,7 +1388,7 @@ names.FieldSetR6 <- function(x) { #' #' @keywords internal #' -print.FieldSetR6 <- function(x, ...) { +print.FieldSet <- function(x, ...) { x$show() invisible(x) } @@ -1414,7 +1414,7 @@ print.FieldSetR6 <- function(x, ...) { #' #' @keywords internal #' -as.data.frame.ParameterSetR6 <- function(x, row.names = NULL, +as.data.frame.ParameterSet <- function(x, row.names = NULL, optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ...) { .warnInCaseOfUnknownArguments(functionName = "as.data.frame", ...) @@ -1470,9 +1470,9 @@ as.data.frame.ParameterSetR6 <- function(x, row.names = NULL, #' #' @export #' -kable.ParameterSetR6 <- function(x, ...) { +kable.ParameterSet <- function(x, ...) { fCall <- match.call(expand.dots = FALSE) - if (inherits(x, "ParameterSetR6")) { + if (inherits(x, "ParameterSet")) { objName <- deparse(fCall$x) if (all(grepl("^ *print\\(", objName))) { stop( @@ -1510,7 +1510,7 @@ kable.ParameterSetR6 <- function(x, ...) { #' #' @export #' -setGeneric("kable", kable.ParameterSetR6) +setGeneric("kable", kable.ParameterSet) #' #' @title @@ -1534,7 +1534,7 @@ setGeneric("kable", kable.ParameterSetR6) #' #' @keywords internal #' -as.matrix.FieldSetR6 <- function(x, ..., enforceRowNames = TRUE, niceColumnNamesEnabled = TRUE) { +as.matrix.FieldSet <- function(x, ..., enforceRowNames = TRUE, niceColumnNamesEnabled = TRUE) { dataFrame <- as.data.frame(x, niceColumnNamesEnabled = niceColumnNamesEnabled) dataFrame <- .setStagesAsFirstColumn(dataFrame) result <- as.matrix(dataFrame) @@ -1543,7 +1543,7 @@ as.matrix.FieldSetR6 <- function(x, ..., enforceRowNames = TRUE, niceColumnNames return(result) } - if (inherits(x, "PowerAndAverageSampleNumberResult") || inherits(x, "PowerAndAverageSampleNumberResultR6")) { + if (inherits(x, "PowerAndAverageSampleNumberResult") || inherits(x, "PowerAndAverageSampleNumberResult")) { dimnames(result)[[1]] <- rep("", nrow(result)) return(result) } @@ -1614,17 +1614,17 @@ as.matrix.FieldSetR6 <- function(x, ..., enforceRowNames = TRUE, niceColumnNames #' #' @keywords internal #' -summary.ParameterSetR6 <- function(object, ..., type = 1, digits = NA_integer_, output = c("all", "title", "overview", "body")) { +summary.ParameterSet <- function(object, ..., type = 1, digits = NA_integer_, output = c("all", "title", "overview", "body")) { .warnInCaseOfUnknownArguments(functionName = "summary", ...) - if (type == 1 && (inherits(object, "SummaryFactory") || inherits(object, "SummaryFactoryR6"))) { + if (type == 1 && (inherits(object, "SummaryFactory") || inherits(object, "SummaryFactory"))) { return(object) } - if (type == 1 && (inherits(object, "TrialDesign") || inherits(object, "TrialDesignR6") || inherits(object, "TrialDesignPlan") || inherits(object, "TrialDesignPlanR6") || - inherits(object, "SimulationResults") || inherits(object, "SimulationResultsR6") || (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) || - inherits(object, "TrialDesignCharacteristics") || inherits(object, "TrialDesignCharacteristicsR6") || - inherits(object, "PerformanceScore") || inherits(object, "PerformanceScoreR6"))) { + if (type == 1 && (inherits(object, "TrialDesign") || inherits(object, "TrialDesign") || inherits(object, "TrialDesignPlan") || inherits(object, "TrialDesignPlan") || + inherits(object, "SimulationResults") || inherits(object, "SimulationResults") || (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResults")) || + inherits(object, "TrialDesignCharacteristics") || inherits(object, "TrialDesignCharacteristics") || + inherits(object, "PerformanceScore") || inherits(object, "PerformanceScore"))) { output <- match.arg(output) return(.createSummary(object, digits = digits, output = output)) } @@ -1673,7 +1673,7 @@ summary.ParameterSetR6 <- function(object, ..., type = 1, digits = NA_integer_, #' #' @keywords internal #' -print.ParameterSetR6 <- function(x, ..., markdown = FALSE) { +print.ParameterSet <- function(x, ..., markdown = FALSE) { if (markdown) { x$.catMarkdownText() return(invisible(x)) @@ -1709,7 +1709,7 @@ print.ParameterSetR6 <- function(x, ..., markdown = FALSE) { #' #' @export #' -plot.ParameterSetR6 <- function(x, y, ..., main = NA_character_, +plot.ParameterSet <- function(x, y, ..., main = NA_character_, xlab = NA_character_, ylab = NA_character_, type = 1L, palette = "Set1", legendPosition = NA_integer_, showSource = FALSE, plotSettings = NULL) { .assertGgplotIsInstalled() diff --git a/R/class_core_plot_settings.R b/R/class_core_plot_settings.R index a4fdc5e1..d8a1f573 100644 --- a/R/class_core_plot_settings.R +++ b/R/class_core_plot_settings.R @@ -18,7 +18,7 @@ ## | Last changed by: $Author: pahlke $ ## | -PlotSubTitleItemR6 <- R6Class("PlotSubTitleItemR6", +PlotSubTitleItem <- R6Class("PlotSubTitleItem", public = list( title = NULL, subscript = NULL, @@ -60,7 +60,7 @@ PlotSubTitleItemR6 <- R6Class("PlotSubTitleItemR6", ) ) -PlotSubTitleItemsR6 <- R6Class("PlotSubTitleItemsR6", +PlotSubTitleItems <- R6Class("PlotSubTitleItems", public = list( title = NULL, subtitle = NULL, @@ -96,7 +96,7 @@ PlotSubTitleItemsR6 <- R6Class("PlotSubTitleItemsR6", } else { titleTemp <- paste0(titleTemp, " ") } - self$addItem(PlotSubTitleItemR6$new(title = titleTemp, value = value, subscript = subscript, digits = digits)) + self$addItem(PlotSubTitleItem$new(title = titleTemp, value = value, subscript = subscript, digits = digits)) }, toString = function() { if (is.null(self$items) || length(self$items) == 0) { @@ -256,7 +256,7 @@ getPlotSettings <- function(lineSize = 0.8, axesTextFontSize = 10, legendFontSize = 11, scalingFactor = 1) { - return(PlotSettingsR6$new( + return(PlotSettings$new( lineSize = lineSize, pointSize = pointSize, pointColor = pointColor, @@ -293,8 +293,8 @@ getPlotSettings <- function(lineSize = 0.8, #' #' @importFrom methods new #' -PlotSettingsR6 <- R6Class("PlotSettingsR6", - inherit = ParameterSetR6, +PlotSettings <- R6Class("PlotSettings", + inherit = ParameterSet, public = list( .legendLineBreakIndex = NULL, .pointSize = NULL, @@ -357,7 +357,7 @@ PlotSettingsR6 <- R6Class("PlotSettingsR6", ) }, #clone = function() { - # return(PlotSettingsR6$new( + # return(PlotSettings$new( # lineSize = self$lineSize, # pointSize = self$pointSize, # pointColor = self$pointColor, @@ -574,7 +574,7 @@ PlotSettingsR6 <- R6Class("PlotSettingsR6", "Sets the main title" caption <- NA_character_ - if (!is.null(mainTitle) && (inherits(mainTitle, "PlotSubTitleItems") || inherits(mainTitle, "PlotSubTitleItemsR6"))) { + if (!is.null(mainTitle) && (inherits(mainTitle, "PlotSubTitleItems") || inherits(mainTitle, "PlotSubTitleItems"))) { plotLabsType <- getOption("rpact.plot.labs.type", "quote") if (plotLabsType == "quote") { mainTitle <- mainTitle$toQuote() diff --git a/R/class_design.R b/R/class_design.R index 9644fd29..631dc7c4 100644 --- a/R/class_design.R +++ b/R/class_design.R @@ -63,8 +63,8 @@ NULL #' #' @importFrom methods new #' -TrialDesignR6 <- R6Class("TrialDesignR6", - inherit = ParameterSetR6, +TrialDesign <- R6Class("TrialDesign", + inherit = ParameterSet, public = list( .plotSettings = NULL, kMax = NULL, @@ -100,9 +100,9 @@ TrialDesignR6 <- R6Class("TrialDesignR6", self$tolerance <- tolerance super$initialize(...) - self$.plotSettings <- PlotSettingsR6$new() + self$.plotSettings <- PlotSettings$new() - if (inherits(self, "TrialDesignConditionalDunnettR6")) { + if (inherits(self, "TrialDesignConditionalDunnett")) { self$.parameterNames <- C_PARAMETER_NAMES } else { self$.parameterNames <- self$.getSubListByNames(.getParameterNames(design = self), c(#TODO @@ -183,7 +183,7 @@ TrialDesignR6 <- R6Class("TrialDesignR6", } }, .isDelayedResponseDesign = function() { - return((inherits(self, "TrialDesignGroupSequentialR6") || inherits(self, "TrialDesignInverseNormalR6")) && + return((inherits(self, "TrialDesignGroupSequential") || inherits(self, "TrialDesignInverseNormal")) && self$kMax > 1 && !is.null(self[["delayedInformation"]]) &&#TODO !any(is.na(self$delayedInformation)) && any(self$delayedInformation > 0)) @@ -226,8 +226,8 @@ TrialDesignR6 <- R6Class("TrialDesignR6", #' #' @importFrom methods new #' -TrialDesignCharacteristicsR6 <- R6Class("TrialDesignCharacteristicsR6", - inherit = ParameterSetR6, +TrialDesignCharacteristics <- R6Class("TrialDesignCharacteristics", + inherit = ParameterSet, public = list( .design = NULL, .probs = NULL, @@ -311,11 +311,11 @@ TrialDesignCharacteristicsR6 <- R6Class("TrialDesignCharacteristicsR6", #' #' @export #' -print.TrialDesignCharacteristicsR6 <- function(x, ..., markdown = FALSE, showDesign = TRUE) { +print.TrialDesignCharacteristics <- function(x, ..., markdown = FALSE, showDesign = TRUE) { if (showDesign) { - print.ParameterSetR6(x$.design, ..., markdown = markdown) + print.ParameterSet(x$.design, ..., markdown = markdown) } - print.ParameterSetR6(x, ..., markdown = markdown) + print.ParameterSet(x, ..., markdown = markdown) } #' @@ -342,7 +342,7 @@ print.TrialDesignCharacteristicsR6 <- function(x, ..., markdown = FALSE, showDes #' #' @keywords internal #' -as.data.frame.TrialDesignCharacteristicsR6 <- function(x, row.names = NULL, +as.data.frame.TrialDesignCharacteristics <- function(x, row.names = NULL, optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ...) { if (x$.design$kMax > 1) { parameterNamesToBeExcluded <- c("nFixed", "shift") @@ -401,8 +401,8 @@ as.data.frame.TrialDesignCharacteristicsR6 <- function(x, row.names = NULL, #' #' @importFrom methods new #' -TrialDesignFisherR6 <- R6Class("TrialDesignFisherR6", - inherit = TrialDesignR6, +TrialDesignFisher <- R6Class("TrialDesignFisher", + inherit = TrialDesign, public = list( method = NULL, alpha0Vec = NULL, @@ -422,6 +422,7 @@ TrialDesignFisherR6 <- R6Class("TrialDesignFisherR6", iterations = 0L, seed = NA_real_, tolerance = C_ANALYSIS_TOLERANCE_FISHER_DEFAULT) { + self$method <- method self$alpha0Vec <- alpha0Vec @@ -429,10 +430,10 @@ TrialDesignFisherR6 <- R6Class("TrialDesignFisherR6", self$nonStochasticCurtailment <- nonStochasticCurtailment self$sided <- sided self$simAlpha <- simAlpha + super$initialize(...)#TODO dont move to first line of constructor self$iterations <- iterations self$seed <- seed self$tolerance <- tolerance - super$initialize(...) self$.parameterNames <- c(self$.parameterNames, self$.getSubListByNames( .getParameterNames(design = self), c( @@ -571,8 +572,8 @@ TrialDesignFisherR6 <- R6Class("TrialDesignFisherR6", #' #' @importFrom methods new #' -TrialDesignInverseNormalR6 <- R6Class("TrialDesignInverseNormalR6", - inherit = TrialDesignR6, +TrialDesignInverseNormal <- R6Class("TrialDesignInverseNormal", + inherit = TrialDesign, public = list( typeOfDesign = NULL, beta = NULL, @@ -895,8 +896,8 @@ TrialDesignInverseNormalR6 <- R6Class("TrialDesignInverseNormalR6", #' #' @importFrom methods new #' -TrialDesignGroupSequentialR6 <- R6Class("TrialDesignGroupSequentialR6", - inherit = TrialDesignInverseNormalR6, +TrialDesignGroupSequential <- R6Class("TrialDesignGroupSequential", + inherit = TrialDesignInverseNormal, public = list( initialize = function(...) { self$.parameterFormatFunctions$criticalValues <- ".formatCriticalValues" @@ -947,8 +948,8 @@ TrialDesignGroupSequentialR6 <- R6Class("TrialDesignGroupSequentialR6", #' #' @seealso \code{\link{getDesignConditionalDunnett}} for creating a conditional Dunnett test design. #' -TrialDesignConditionalDunnettR6 <- R6Class("TrialDesignConditionalDunnettR6", - inherit = TrialDesignR6, +TrialDesignConditionalDunnett <- R6Class("TrialDesignConditionalDunnett", + inherit = TrialDesign, public = list( informationAtInterim = NULL, secondStageConditioning = NULL, @@ -1026,7 +1027,7 @@ getDesignConditionalDunnett <- function(alpha = 0.025, # C_ALPHA_DEFAULT .assertIsValidAlpha(alpha) .assertIsSingleNumber(informationAtInterim, "informationAtInterim") .assertIsInOpenInterval(informationAtInterim, "informationAtInterim", 0, 1) - return(TrialDesignConditionalDunnettR6$new( + return(TrialDesignConditionalDunnett$new( alpha = alpha, informationAtInterim = informationAtInterim, secondStageConditioning = secondStageConditioning @@ -1103,7 +1104,7 @@ getDesignConditionalDunnett <- function(alpha = 0.025, # C_ALPHA_DEFAULT #' #' @export #' -plot.TrialDesignR6 <- function(x, y, ..., main = NA_character_, +plot.TrialDesign <- function(x, y, ..., main = NA_character_, xlab = NA_character_, ylab = NA_character_, type = 1L, palette = "Set1", theta = seq(-1, 1, 0.01), nMax = NA_integer_, plotPointsEnabled = NA, legendPosition = NA_integer_, showSource = FALSE, @@ -1150,7 +1151,7 @@ plot.TrialDesignR6 <- function(x, y, ..., main = NA_character_, #' @rdname plot.TrialDesign #' @export -plot.TrialDesignCharacteristicsR6 <- function(x, y, ...) { +plot.TrialDesignCharacteristics <- function(x, y, ...) { plot(x = x$.design, y = y, ...) } @@ -1194,7 +1195,7 @@ plot.TrialDesignCharacteristicsR6 <- function(x, y, ...) { } designSet <- getDesignSet(designs = c(x, y), variedParameters = variedParameters) } else { - designSet <- TrialDesignSetR6$new(design = x, singleDesign = TRUE) + designSet <- TrialDesignSet$new(design = x, singleDesign = TRUE) if (!is.null(plotSettings)) { designSet$.plotSettings <- plotSettings } @@ -1232,7 +1233,7 @@ plot.TrialDesignCharacteristicsR6 <- function(x, y, ...) { #' #' @keywords internal #' -as.data.frame.TrialDesignR6 <- function(x, row.names = NULL, +as.data.frame.TrialDesign <- function(x, row.names = NULL, optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ...) { .assertIsTrialDesign(x) diff --git a/R/class_design_plan.R b/R/class_design_plan.R index 476aa28c..5425c9d0 100644 --- a/R/class_design_plan.R +++ b/R/class_design_plan.R @@ -94,8 +94,8 @@ C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_SURVIVAL <- list( #' #' @importFrom methods new #' -TrialDesignPlanR6 <- R6Class("TrialDesignPlanR6", - inherit = ParameterSetR6, +TrialDesignPlan <- R6Class("TrialDesignPlan", + inherit = ParameterSet, public = list( .plotSettings = NULL, .design = NULL, @@ -105,7 +105,7 @@ TrialDesignPlanR6 <- R6Class("TrialDesignPlanR6", super$initialize(...)#TODO - self$.plotSettings <- PlotSettingsR6$new() + self$.plotSettings <- PlotSettings$new() self$.parameterNames <- .getParameterNames(design = design, designPlan = self) self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS @@ -190,12 +190,12 @@ TrialDesignPlanR6 <- R6Class("TrialDesignPlanR6", self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - if (inherits(self, "TrialDesignPlanSurvival") || inherits(self, "TrialDesignPlanSurvivalR6") || self$groups == 2 || self$.design$kMax > 1) {#TODO Groups???? + if (inherits(self, "TrialDesignPlanSurvival") || inherits(self, "TrialDesignPlanSurvival") || self$groups == 2 || self$.design$kMax > 1) {#TODO Groups???? self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled ) - if (inherits(self, "TrialDesignPlanSurvival") || inherits(self, "TrialDesignPlanSurvivalR6") || self$groups == 2) { + if (inherits(self, "TrialDesignPlanSurvival") || inherits(self, "TrialDesignPlanSurvival") || self$groups == 2) { self$.cat(" (i): values of treatment arm i\n", consoleOutputEnabled = consoleOutputEnabled ) @@ -265,7 +265,7 @@ TrialDesignPlanR6 <- R6Class("TrialDesignPlanR6", #' #' @keywords internal #' -as.data.frame.TrialDesignPlanR6 <- function(x, row.names = NULL, +as.data.frame.TrialDesignPlan <- function(x, row.names = NULL, optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ...) { return(.getAsDataFrame( parameterSet = x, @@ -335,8 +335,8 @@ as.data.frame.TrialDesignPlanR6 <- function(x, row.names = NULL, #' #' @importFrom methods new #' -TrialDesignPlanMeansR6 <- R6Class("TrialDesignPlanMeansR6", - inherit = TrialDesignPlanR6, +TrialDesignPlanMeans <- R6Class("TrialDesignPlanMeans", + inherit = TrialDesignPlan, public = list( meanRatio = NULL, thetaH0 = NULL, @@ -484,8 +484,8 @@ TrialDesignPlanMeansR6 <- R6Class("TrialDesignPlanMeansR6", #' #' @importFrom methods new #' -TrialDesignPlanRatesR6 <- R6Class("TrialDesignPlanRatesR6", - inherit = TrialDesignPlanR6, +TrialDesignPlanRates <- R6Class("TrialDesignPlanRates", + inherit = TrialDesignPlan, public = list( riskRatio = NULL, thetaH0 = NULL, @@ -657,8 +657,8 @@ TrialDesignPlanRatesR6 <- R6Class("TrialDesignPlanRatesR6", #' #' @importFrom methods new #' -TrialDesignPlanSurvivalR6 <- R6Class("TrialDesignPlanSurvivalR6", - inherit = TrialDesignPlanR6, +TrialDesignPlanSurvival <- R6Class("TrialDesignPlanSurvival", + inherit = TrialDesignPlan, public = list( .piecewiseSurvivalTime = NULL, .accrualTime = NULL, @@ -1076,7 +1076,7 @@ TrialDesignPlanSurvivalR6 <- R6Class("TrialDesignPlanSurvivalR6", } } - designSet <- TrialDesignSetR6$new(design = designMaster, singleDesign = TRUE) + designSet <- TrialDesignSet$new(design = designMaster, singleDesign = TRUE) designSet$.plotSettings <- designPlan$.plotSettings designPlanName <- paste0(designPlanName, "$.design") return(.plotTrialDesignSet( @@ -1250,7 +1250,7 @@ TrialDesignPlanSurvivalR6 <- R6Class("TrialDesignPlanSurvivalR6", } else { xParameterName <- "informationRates" yParameterNames <- "stageLevels" - designPlan <- TrialDesignSetR6$new(design = designMaster, singleDesign = TRUE) + designPlan <- TrialDesignSet$new(design = designMaster, singleDesign = TRUE) xParameterNameSrc <- ".design$informationRates" yParameterNamesSrc <- ".design$stageLevels" } @@ -1282,7 +1282,7 @@ TrialDesignPlanSurvivalR6 <- R6Class("TrialDesignPlanSurvivalR6", } else { xParameterName <- "informationRates" yParameterNames <- "alphaSpent" - designPlan <- TrialDesignSetR6$new(design = designMaster, singleDesign = TRUE) + designPlan <- TrialDesignSet$new(design = designMaster, singleDesign = TRUE) xParameterNameSrc <- ".design$informationRates" yParameterNamesSrc <- ".design$alphaSpent" } @@ -2093,7 +2093,7 @@ TrialDesignPlanSurvivalR6 <- R6Class("TrialDesignPlanSurvivalR6", #' #' @export #' -plot.TrialDesignPlanR6 <- function(x, y, ..., main = NA_character_, +plot.TrialDesignPlan <- function(x, y, ..., main = NA_character_, xlab = NA_character_, ylab = NA_character_, type = ifelse(x$.design$kMax == 1, 5L, 1L), palette = "Set1", theta = seq(-1, 1, 0.01), plotPointsEnabled = NA, diff --git a/R/class_design_power_and_asn.R b/R/class_design_power_and_asn.R index 537681bc..531c1391 100644 --- a/R/class_design_power_and_asn.R +++ b/R/class_design_power_and_asn.R @@ -50,8 +50,8 @@ #' #' @importFrom methods new #' -PowerAndAverageSampleNumberResultR6 <- R6Class("PowerAndAverageSampleNumberResultR6", - inherit = ParameterSetR6, +PowerAndAverageSampleNumberResult <- R6Class("PowerAndAverageSampleNumberResult", + inherit = ParameterSet, public = list( .design = NULL, nMax = NULL, @@ -314,7 +314,7 @@ PowerAndAverageSampleNumberResultR6 <- R6Class("PowerAndAverageSampleNumberResul #' #' @keywords internal #' -as.data.frame.PowerAndAverageSampleNumberResultR6 <- function(x, row.names = NULL, +as.data.frame.PowerAndAverageSampleNumberResult <- function(x, row.names = NULL, optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ...) { parameterNames <- x$.getVisibleFieldNames() parameterNames <- parameterNames[parameterNames != "nMax"] diff --git a/R/class_design_set.R b/R/class_design_set.R index 1578415a..a3737d07 100644 --- a/R/class_design_set.R +++ b/R/class_design_set.R @@ -52,8 +52,8 @@ NULL #' #' @importFrom methods new #' -TrialDesignSetR6 <- R6Class("TrialDesignSetR6", - inherit = FieldSetR6, +TrialDesignSet <- R6Class("TrialDesignSet", + inherit = FieldSet, public = list( .plotSettings = NULL, designs = NULL, @@ -62,7 +62,7 @@ TrialDesignSetR6 <- R6Class("TrialDesignSetR6", # @param ... 'designs' OR 'design' and one or more design parameters, e.g., deltaWT = c(0.1, 0.3, 0.4) # initialize = function(...) { - self$.plotSettings <- PlotSettingsR6$new() + self$.plotSettings <- PlotSettings$new() self$designs <- list() self$variedParameters <- character(0) if (length(list(...)) > 0) { @@ -70,7 +70,7 @@ TrialDesignSetR6 <- R6Class("TrialDesignSetR6", } if (length(self$designs) > 0) { masterDesign <- self$designs[[1]] - if (inherits(masterDesign, "ParameterSet") || inherits(masterDesign, "ParameterSetR6")) { + if (inherits(masterDesign, "ParameterSet") || inherits(masterDesign, "ParameterSet")) { self$.plotSettings <- masterDesign$.plotSettings } } @@ -502,7 +502,7 @@ TrialDesignSetR6 <- R6Class("TrialDesignSetR6", #' @export #' getDesignSet <- function(...) { - return(TrialDesignSetR6$new(...)) + return(TrialDesignSet$new(...)) } #' @@ -528,8 +528,8 @@ getDesignSet <- function(...) { #' #' @keywords internal #' -summary.TrialDesignSetR6 <- function(object, ..., type = 1, digits = NA_integer_) { - .warnInCaseOfUnknownArguments(functionName = "summary.TrialDesignSetR6", ...) +summary.TrialDesignSet <- function(object, ..., type = 1, digits = NA_integer_) { + .warnInCaseOfUnknownArguments(functionName = "summary.TrialDesignSet", ...) .assertIsTrialDesignSet(object)#TODO if (object$isEmpty()) { @@ -566,7 +566,7 @@ summary.TrialDesignSetR6 <- function(object, ..., type = 1, digits = NA_integer_ #' #' @keywords internal #' -names.TrialDesignSetR6 <- function(x) { +names.TrialDesignSet <- function(x) { return(x$.getVisibleFieldNames()) } @@ -593,7 +593,7 @@ names.TrialDesignSetR6 <- function(x) { #' #' @keywords internal #' -length.TrialDesignSetR6 <- function(x) { +length.TrialDesignSet <- function(x) { return(length(x$designs)) } @@ -626,7 +626,7 @@ length.TrialDesignSetR6 <- function(x) { #' #' @keywords internal #' -as.data.frame.TrialDesignSetR6 <- function(x, row.names = NULL, +as.data.frame.TrialDesignSet <- function(x, row.names = NULL, optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, addPowerAndAverageSampleNumber = FALSE, theta = seq(-1, 1, 0.02), nMax = NA_integer_, ...) { .assertIsTrialDesignSet(x) @@ -679,7 +679,7 @@ as.data.frame.TrialDesignSetR6 <- function(x, row.names = NULL, } if (addPowerAndAverageSampleNumber) { - results <- PowerAndAverageSampleNumberResultR6$new(design, theta = theta, nMax = nMax) + results <- PowerAndAverageSampleNumberResult$new(design, theta = theta, nMax = nMax) suppressWarnings(df2 <- as.data.frame(results, niceColumnNamesEnabled = niceColumnNamesEnabled, includeAllParameters = includeAllParameters @@ -762,7 +762,7 @@ as.data.frame.TrialDesignSetR6 <- function(x, row.names = NULL, #' #' @export #' -plot.TrialDesignSetR6 <- function(x, y, ..., type = 1L, main = NA_character_, +plot.TrialDesignSet <- function(x, y, ..., type = 1L, main = NA_character_, xlab = NA_character_, ylab = NA_character_, palette = "Set1", theta = seq(-1, 1, 0.02), nMax = NA_integer_, plotPointsEnabled = NA, legendPosition = NA_integer_, showSource = FALSE, diff --git a/R/class_event_probabilities.R b/R/class_event_probabilities.R index 83399b60..7ccd5fe8 100644 --- a/R/class_event_probabilities.R +++ b/R/class_event_probabilities.R @@ -56,8 +56,8 @@ #' #' @keywords internal #' -EventProbabilitiesR6 <- R6Class("EventProbabilitiesR6", - inherit = ParameterSetR6, +EventProbabilities <- R6Class("EventProbabilities", + inherit = ParameterSet, public = list( .piecewiseSurvivalTime = NULL, .accrualTime = NULL, @@ -113,7 +113,7 @@ EventProbabilitiesR6 <- R6Class("EventProbabilitiesR6", #TODO callSuper(...) super$initialize() - self$.plotSettings <- PlotSettingsR6$new() + self$.plotSettings <- PlotSettings$new() self$.parameterNames <- C_PARAMETER_NAMES self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS self$.setParameterType("overallEventProbabilities", C_PARAM_NOT_APPLICABLE) # deprecated @@ -182,8 +182,8 @@ EventProbabilitiesR6 <- R6Class("EventProbabilitiesR6", #' #' @keywords internal #' -NumberOfSubjectsR6 <- R6Class("NumberOfSubjectsR6", - inherit = ParameterSetR6, +NumberOfSubjects <- R6Class("NumberOfSubjects", + inherit = ParameterSet, public = list( .accrualTime = NULL, .plotSettings = NULL, @@ -208,7 +208,7 @@ NumberOfSubjectsR6 <- R6Class("NumberOfSubjectsR6", #TODO callSuper(...) super$initialize() - self$.plotSettings <- PlotSettingsR6$new() + self$.plotSettings <- PlotSettings$new() self$.parameterNames <- C_PARAMETER_NAMES self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS }, @@ -279,7 +279,7 @@ NumberOfSubjectsR6 <- R6Class("NumberOfSubjectsR6", #' #' @export #' -plot.EventProbabilitiesR6 <- function(x, y, ..., +plot.EventProbabilities <- function(x, y, ..., allocationRatioPlanned = x$allocationRatioPlanned, main = NA_character_, xlab = NA_character_, ylab = NA_character_, type = 1L, legendTitle = NA_character_, palette = "Set1", @@ -295,7 +295,7 @@ plot.EventProbabilitiesR6 <- function(x, y, ..., # .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) numberOfSubjectsObject <- NULL - if (!missing(y) && inherits(y, "NumberOfSubjectsR6")) { + if (!missing(y) && inherits(y, "NumberOfSubjects")) { numberOfSubjectsObject <- y yObjectName <- deparse(fCall$y) } @@ -455,7 +455,7 @@ plot.EventProbabilitiesR6 <- function(x, y, ..., #' #' @export #' -plot.NumberOfSubjectsR6 <- function(x, y, ..., +plot.NumberOfSubjects <- function(x, y, ..., allocationRatioPlanned = NA_real_, main = NA_character_, xlab = NA_character_, ylab = NA_character_, type = 1L, legendTitle = NA_character_, palette = "Set1", @@ -466,8 +466,8 @@ plot.NumberOfSubjectsR6 <- function(x, y, ..., # .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) - if (!missing(y) && inherits(y, "EventProbabilitiesR6")) { - return(plot.EventProbabilitiesR6( + if (!missing(y) && inherits(y, "EventProbabilities")) { + return(plot.EventProbabilities( x = y, y = x, allocationRatioPlanned = ifelse(is.na(allocationRatioPlanned), y$allocationRatioPlanned, allocationRatioPlanned), main = main, xlab = xlab, ylab = ylab, type = type, diff --git a/R/class_performance_score.R b/R/class_performance_score.R index 6430692b..52259c1a 100644 --- a/R/class_performance_score.R +++ b/R/class_performance_score.R @@ -41,8 +41,8 @@ #' #' @importFrom methods new #' -PerformanceScoreR6 <- R6Class("PerformanceScoreR6", - inherit = ParameterSetR6, +PerformanceScore <- R6Class("PerformanceScore", + inherit = ParameterSet, public = list( .simulationResults = NULL, .plotSettings = NULL, @@ -57,7 +57,7 @@ PerformanceScoreR6 <- R6Class("PerformanceScoreR6", initialize = function(simulationResults, ...) { super$initialize(...) self$.simulationResults <- simulationResults - self$.plotSettings <- PlotSettingsR6$new() + self$.plotSettings <- PlotSettings$new() self$.parameterNames <- C_PARAMETER_NAMES self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS }, diff --git a/R/class_simulation_results.R b/R/class_simulation_results.R index 0bc177df..7e3b936a 100644 --- a/R/class_simulation_results.R +++ b/R/class_simulation_results.R @@ -39,9 +39,9 @@ NULL #' #' @keywords internal #' -names.SimulationResultsR6 <- function(x) { +names.SimulationResults <- function(x) { namesToShow <- c(".design", ".data", ".rawData") - if (inherits(x, "SimulationResultsSurvival") || inherits(x, "SimulationResultsSurvivalR6")) { + if (inherits(x, "SimulationResultsSurvival") || inherits(x, "SimulationResultsSurvival")) { namesToShow <- c(namesToShow, ".piecewiseSurvivalTime", ".accrualTime") } namesToShow <- c(namesToShow, x$.getVisibleFieldNames()) @@ -86,8 +86,8 @@ names.SimulationResultsR6 <- function(x) { #' #' @importFrom methods new #' -SimulationResultsR6 <- R6Class("SimulationResultsR6", - inherit = ParameterSetR6, +SimulationResults <- R6Class("SimulationResults", + inherit = ParameterSet, public = list( .plotSettings = NULL, .design = NULL, @@ -106,7 +106,7 @@ SimulationResultsR6 <- R6Class("SimulationResultsR6", self$.design <- design self$.showStatistics <- showStatistics - self$.plotSettings <- PlotSettingsR6$new() + self$.plotSettings <- PlotSettings$new() self$.parameterNames <- .getParameterNames(design = design, designPlan = self) self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS }, @@ -155,7 +155,7 @@ SimulationResultsR6 <- R6Class("SimulationResultsR6", ) userDefinedParameters <- self$.getUserDefinedParameters() - if ((inherits(self, "SimulationResultsSurvival") || inherits(self, "SimulationResultsSurvivalR6")) && + if ((inherits(self, "SimulationResultsSurvival") || inherits(self, "SimulationResultsSurvival")) && self$.piecewiseSurvivalTime$delayedResponseEnabled) { userDefinedParameters <- c( userDefinedParameters, @@ -185,19 +185,19 @@ SimulationResultsR6 <- R6Class("SimulationResultsR6", (is.character(showStatistics) && showStatistics == "exclusive")) { self$.cat("Simulated data:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) params <- c() - if (inherits(self, "SimulationResultsMeans") || inherits(self, "SimulationResultsMeansR6")) { + if (inherits(self, "SimulationResultsMeans") || inherits(self, "SimulationResultsMeans")) { params <- c( "effectMeasure", "numberOfSubjects", "testStatistic" ) - } else if (inherits(self, "SimulationResultsRates") || inherits(self, "SimulationResultsRatesR6")) { + } else if (inherits(self, "SimulationResultsRates") || inherits(self, "SimulationResultsRates")) { params <- c( "effectMeasure", "numberOfSubjects", "testStatistic" ) - } else if (inherits(self, "SimulationResultsSurvival") || inherits(self, "SimulationResultsSurvivalR6")) { + } else if (inherits(self, "SimulationResultsSurvival") || inherits(self, "SimulationResultsSurvival")) { params <- c( "effectMeasure", "analysisTime", @@ -209,8 +209,8 @@ SimulationResultsR6 <- R6Class("SimulationResultsR6", "logRankStatistic", "hazardRatioEstimateLR" ) - } else if (inherits(self, "SimulationResultsMultiArmMeans") || inherits(self, "SimulationResultsMultiArmMeansR6") || - inherits(self, "SimulationResultsMultiArmRates") || inherits(self, "SimulationResultsMultiArmRatesR6")) { + } else if (inherits(self, "SimulationResultsMultiArmMeans") || inherits(self, "SimulationResultsMultiArmMeans") || + inherits(self, "SimulationResultsMultiArmRates") || inherits(self, "SimulationResultsMultiArmRates")) { params <- c( "effectMeasure", "subjectsActiveArm", @@ -220,8 +220,8 @@ SimulationResultsR6 <- R6Class("SimulationResultsR6", "successStop", "futilityPerStage" ) - } else if (inherits(self, "SimulationResultsEnrichmentMeans") || inherits(self, "SimulationResultsEnrichmentMeansR6") || - inherits(self, "SimulationResultsEnrichmentRates") || inherits(self, "SimulationResultsEnrichmentRatesR6")) { + } else if (inherits(self, "SimulationResultsEnrichmentMeans") || inherits(self, "SimulationResultsEnrichmentMeans") || + inherits(self, "SimulationResultsEnrichmentRates") || inherits(self, "SimulationResultsEnrichmentRates")) { params <- c( "effectMeasure", "subjectsPopulation", @@ -231,8 +231,8 @@ SimulationResultsR6 <- R6Class("SimulationResultsR6", "successStop", "futilityPerStage" ) - } else if (inherits(self, "SimulationResultsMultiArmSurvival") || inherits(self, "SimulationResultsMultiArmSurvivalR6") || - inherits(self, "SimulationResultsEnrichmentSurvival") || inherits(self, "SimulationResultsEnrichmentSurvivalR6")) { + } else if (inherits(self, "SimulationResultsMultiArmSurvival") || inherits(self, "SimulationResultsMultiArmSurvival") || + inherits(self, "SimulationResultsEnrichmentSurvival") || inherits(self, "SimulationResultsEnrichmentSurvival")) { params <- c( "effectMeasure", "numberOfEvents", @@ -315,8 +315,8 @@ SimulationResultsR6 <- R6Class("SimulationResultsR6", self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) } - twoGroupsEnabled <- !(inherits(self, "SimulationResultsMeans") || inherits(self, "SimulationResultsMeansR6")) - multiArmSurvivalEnabled <- inherits(self, "SimulationResultsMultiArmSurvival") || inherits(self, "SimulationResultsMultiArmSurvivalR6") + twoGroupsEnabled <- !(inherits(self, "SimulationResultsMeans") || inherits(self, "SimulationResultsMeans")) + multiArmSurvivalEnabled <- inherits(self, "SimulationResultsMultiArmSurvival") || inherits(self, "SimulationResultsMultiArmSurvival") enrichmentEnabled <- grepl("SimulationResultsEnrichment", .getClassName(self)) if (!is.null(performanceScore)) { @@ -361,9 +361,9 @@ SimulationResultsR6 <- R6Class("SimulationResultsR6", }, .getVariedParameterName = function(number = 1) { if (number == 2) { - if (!(inherits(self, "SimulationResultsMeans") || inherits(self, "SimulationResultsMeansR6")) && - !(inherits(self, "SimulationResultsRates") || inherits(self, "SimulationResultsRatesR6")) && - !(inherits(self, "SimulationResultsSurvival") || inherits(self, "SimulationResultsSurvivalR6")) && + if (!(inherits(self, "SimulationResultsMeans") || inherits(self, "SimulationResultsMeans")) && + !(inherits(self, "SimulationResultsRates") || inherits(self, "SimulationResultsRates")) && + !(inherits(self, "SimulationResultsSurvival") || inherits(self, "SimulationResultsSurvival")) && grepl("MultiArm", .getClassName(self))) { return("armNumber") } @@ -371,16 +371,16 @@ SimulationResultsR6 <- R6Class("SimulationResultsR6", } variedParameterName1 <- NA_character_ - if (inherits(self, "SimulationResultsMeans") || inherits(self, "SimulationResultsMeansR6")) { + if (inherits(self, "SimulationResultsMeans") || inherits(self, "SimulationResultsMeans")) { variedParameterName1 <- "alternative" - } else if (inherits(self, "SimulationResultsRates") || inherits(self, "SimulationResultsRatesR6") || inherits(self, "SimulationResultsSurvival") || inherits(self, "SimulationResultsSurvivalR6")) { + } else if (inherits(self, "SimulationResultsRates") || inherits(self, "SimulationResultsRates") || inherits(self, "SimulationResultsSurvival") || inherits(self, "SimulationResultsSurvival")) { variedParameterName1 <- "pi1" } else if (grepl("MultiArm", .getClassName(self))) { - if (inherits(self, "SimulationResultsMultiArmMeans") || inherits(self, "SimulationResultsMultiArmMeansR6")) { + if (inherits(self, "SimulationResultsMultiArmMeans") || inherits(self, "SimulationResultsMultiArmMeans")) { variedParameterName1 <- "muMax" - } else if (inherits(self, "SimulationResultsMultiArmRates") || inherits(self, "SimulationResultsMultiArmRatesR6")) { + } else if (inherits(self, "SimulationResultsMultiArmRates") || inherits(self, "SimulationResultsMultiArmRates")) { variedParameterName1 <- "piMax" - } else if (inherits(self, "SimulationResultsMultiArmSurvival") || inherits(self, "SimulationResultsMultiArmSurvivalR6")) { + } else if (inherits(self, "SimulationResultsMultiArmSurvival") || inherits(self, "SimulationResultsMultiArmSurvival")) { variedParameterName1 <- "omegaMax" } } @@ -487,11 +487,11 @@ SimulationResultsR6 <- R6Class("SimulationResultsR6", s <- paste(s, "enrichment") } - if (inherits(self, "SimulationResultsBaseMeans") || inherits(self, "SimulationResultsBaseMeansR6")) { + if (inherits(self, "SimulationResultsBaseMeans") || inherits(self, "SimulationResultsBaseMeans")) { s <- paste(s, "means") - } else if (inherits(self, "SimulationResultsBaseRates") || inherits(self, "SimulationResultsBaseRatesR6")) { + } else if (inherits(self, "SimulationResultsBaseRates") || inherits(self, "SimulationResultsBaseRates")) { s <- paste(s, "rates") - } else if (inherits(self, "SimulationResultsBaseSurvival") || inherits(self, "SimulationResultsBaseSurvivalR6")) { + } else if (inherits(self, "SimulationResultsBaseSurvival") || inherits(self, "SimulationResultsBaseSurvival")) { s <- paste(s, "survival data") } else { s <- paste(s, "results") @@ -557,8 +557,8 @@ SimulationResultsR6 <- R6Class("SimulationResultsR6", ) ) -SimulationResultsBaseMeansR6 <- R6Class("SimulationResultsBaseMeansR6", - inherit = SimulationResultsR6, +SimulationResultsBaseMeans <- R6Class("SimulationResultsBaseMeans", + inherit = SimulationResults, public = list( stDev =NULL, plannedSubjects =NULL, @@ -647,8 +647,8 @@ SimulationResultsBaseMeansR6 <- R6Class("SimulationResultsBaseMeansR6", #' #' @importFrom methods new #' -SimulationResultsMeansR6 <- R6Class("SimulationResultsMeansR6", - inherit = SimulationResultsBaseMeansR6, +SimulationResultsMeans <- R6Class("SimulationResultsMeans", + inherit = SimulationResultsBaseMeans, public = list( meanRatio =NULL, thetaH0 =NULL, @@ -731,8 +731,8 @@ SimulationResultsMeansR6 <- R6Class("SimulationResultsMeansR6", #' #' @importFrom methods new #' -SimulationResultsMultiArmMeansR6 <- R6Class("SimulationResultsMultiArmMeansR6", - inherit = SimulationResultsBaseMeansR6, +SimulationResultsMultiArmMeans <- R6Class("SimulationResultsMultiArmMeans", + inherit = SimulationResultsBaseMeans, public = list( activeArms = NULL, effectMatrix = NULL, @@ -773,8 +773,8 @@ SimulationResultsMultiArmMeansR6 <- R6Class("SimulationResultsMultiArmMeansR6", ) ) -SimulationResultsBaseRatesR6 <- R6Class("SimulationResultsBaseRatesR6", - inherit = SimulationResultsR6, +SimulationResultsBaseRates <- R6Class("SimulationResultsBaseRates", + inherit = SimulationResults, public = list( directionUpper = NULL, plannedSubjects = NULL, @@ -862,8 +862,8 @@ SimulationResultsBaseRatesR6 <- R6Class("SimulationResultsBaseRatesR6", #' #' @importFrom methods new #' -SimulationResultsRatesR6 <- R6Class("SimulationResultsRatesR6", - inherit = SimulationResultsBaseRatesR6, +SimulationResultsRates <- R6Class("SimulationResultsRates", + inherit = SimulationResultsBaseRates, public = list( riskRatio = NULL, thetaH0 = NULL, @@ -969,8 +969,8 @@ SimulationResultsRatesR6 <- R6Class("SimulationResultsRatesR6", #' #' @importFrom methods new #' -SimulationResultsMultiArmRatesR6 <- R6Class("SimulationResultsMultiArmRatesR6", - inherit = SimulationResultsBaseRatesR6, +SimulationResultsMultiArmRates <- R6Class("SimulationResultsMultiArmRates", + inherit = SimulationResultsBaseRates, public = list( activeArms = NULL, effectMatrix = NULL, @@ -1014,8 +1014,8 @@ SimulationResultsMultiArmRatesR6 <- R6Class("SimulationResultsMultiArmRatesR6", ) ) -SimulationResultsBaseSurvivalR6 <- R6Class("SimulationResultsBaseSurvivalR6", - inherit = SimulationResultsR6, +SimulationResultsBaseSurvival <- R6Class("SimulationResultsBaseSurvival", + inherit = SimulationResults, public = list( directionUpper = NULL, plannedEvents = NULL, @@ -1122,8 +1122,8 @@ SimulationResultsBaseSurvivalR6 <- R6Class("SimulationResultsBaseSurvivalR6", #' #' @importFrom methods new #' -SimulationResultsSurvivalR6 <- R6Class("SimulationResultsSurvivalR6", - inherit = SimulationResultsBaseSurvivalR6, +SimulationResultsSurvival <- R6Class("SimulationResultsSurvival", + inherit = SimulationResultsBaseSurvival, public = list( .piecewiseSurvivalTime = NULL, .accrualTime = NULL, @@ -1250,8 +1250,8 @@ SimulationResultsSurvivalR6 <- R6Class("SimulationResultsSurvivalR6", #' #' @importFrom methods new #' -SimulationResultsMultiArmSurvivalR6 <- R6Class("SimulationResultsMultiArmSurvivalR6", - inherit = SimulationResultsBaseSurvivalR6, +SimulationResultsMultiArmSurvival <- R6Class("SimulationResultsMultiArmSurvival", + inherit = SimulationResultsBaseSurvival, public = list( activeArms = NULL, effectMatrix = NULL, @@ -1354,8 +1354,8 @@ SimulationResultsMultiArmSurvivalR6 <- R6Class("SimulationResultsMultiArmSurviva #' #' @importFrom methods new #' -SimulationResultsEnrichmentMeansR6 <- R6Class("SimulationResultsEnrichmentMeansR6", - inherit = SimulationResultsBaseMeansR6, +SimulationResultsEnrichmentMeans <- R6Class("SimulationResultsEnrichmentMeans", + inherit = SimulationResultsBaseMeans, public = list( populations = NULL, effectList = NULL, @@ -1453,8 +1453,8 @@ SimulationResultsEnrichmentMeansR6 <- R6Class("SimulationResultsEnrichmentMeansR #' #' @importFrom methods new #' -SimulationResultsEnrichmentRatesR6 <- R6Class("SimulationResultsEnrichmentRatesR6", - inherit = SimulationResultsBaseRatesR6, +SimulationResultsEnrichmentRates <- R6Class("SimulationResultsEnrichmentRates", + inherit = SimulationResultsBaseRates, public = list( populations = NULL, effectList = NULL, @@ -1555,8 +1555,8 @@ SimulationResultsEnrichmentRatesR6 <- R6Class("SimulationResultsEnrichmentRatesR #' #' @importFrom methods new #' -SimulationResultsEnrichmentSurvivalR6 <- R6Class("SimulationResultsEnrichmentSurvivalR6", - inherit = SimulationResultsBaseSurvivalR6, +SimulationResultsEnrichmentSurvival <- R6Class("SimulationResultsEnrichmentSurvival", + inherit = SimulationResultsBaseSurvival, public = list( populations = NULL, effectList = NULL, @@ -1597,7 +1597,7 @@ SimulationResultsEnrichmentSurvivalR6 <- R6Class("SimulationResultsEnrichmentSur ) .assertIsValidVariedParameterVectorForSimulationResultsPlotting <- function(simulationResults, plotType) { - if (inherits(simulationResults, "SimulationResultsMeans") || inherits(simulationResults, "SimulationResultsMeansR6")) { + if (inherits(simulationResults, "SimulationResultsMeans") || inherits(simulationResults, "SimulationResultsMeans")) { if (is.null(simulationResults$alternative) || any(is.na(simulationResults$alternative)) || length(simulationResults$alternative) <= 1) { @@ -1606,7 +1606,7 @@ SimulationResultsEnrichmentSurvivalR6 <- R6Class("SimulationResultsEnrichmentSur " is only available if 'alternative' with length > 1 is defined" ) } - } else if (inherits(simulationResults, "SimulationResultsRates") || inherits(simulationResults, "SimulationResultsRatesR6")) { + } else if (inherits(simulationResults, "SimulationResultsRates") || inherits(simulationResults, "SimulationResultsRates")) { if (is.null(simulationResults$pi1) || any(is.na(simulationResults$pi1)) || length(simulationResults$pi1) <= 1) { @@ -1615,7 +1615,7 @@ SimulationResultsEnrichmentSurvivalR6 <- R6Class("SimulationResultsEnrichmentSur " is only available if 'pi1' with length > 1 is defined" ) } - } else if (inherits(simulationResults, "SimulationResultsSurvival") || inherits(simulationResults, "SimulationResultsSurvivalR6")) { + } else if (inherits(simulationResults, "SimulationResultsSurvival") || inherits(simulationResults, "SimulationResultsSurvival")) { if (is.null(simulationResults$hazardRatio) || any(is.na(simulationResults$hazardRatio)) || length(simulationResults$hazardRatio) <= 1) { @@ -2536,7 +2536,7 @@ SimulationResultsEnrichmentSurvivalR6 <- R6Class("SimulationResultsEnrichmentSur #' #' @export #' -plot.SimulationResultsR6 <- function(x, y, ..., main = NA_character_, +plot.SimulationResults <- function(x, y, ..., main = NA_character_, xlab = NA_character_, ylab = NA_character_, type = 1L, palette = "Set1", theta = seq(-1, 1, 0.01), plotPointsEnabled = NA, legendPosition = NA_integer_, showSource = FALSE, @@ -2600,7 +2600,7 @@ plot.SimulationResultsR6 <- function(x, y, ..., main = NA_character_, #' #' @keywords internal #' -print.SimulationResultsR6 <- function(x, ..., showStatistics = FALSE, markdown = FALSE) { +print.SimulationResults <- function(x, ..., showStatistics = FALSE, markdown = FALSE) { if (markdown) { x$.catMarkdownText(showStatistics = showStatistics) return(invisible(x)) @@ -2674,7 +2674,7 @@ print.SimulationResultsR6 <- function(x, ..., showStatistics = FALSE, markdown = #' @export #' getData <- function(x) { - if (!(inherits(x, "SimulationResults") || inherits(x, "SimulationResultsR6"))) { # or 'Dataset' + if (!(inherits(x, "SimulationResults") || inherits(x, "SimulationResults"))) { # or 'Dataset' stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'x' must be a 'SimulationResults' object; for example, use getSimulationMeans() to create one" @@ -2686,7 +2686,7 @@ getData <- function(x) { #' @rdname getData #' @export -getData.SimulationResultsR6 <- function(x) { +getData.SimulationResults <- function(x) { return(x$.data) } @@ -2817,7 +2817,7 @@ getData.SimulationResultsR6 <- function(x) { #' @export #' getRawData <- function(x, aggregate = FALSE) { - if (!(inherits(x, "SimulationResultsSurvival") || inherits(x, "SimulationResultsSurvivalR6"))) { + if (!(inherits(x, "SimulationResultsSurvival") || inherits(x, "SimulationResultsSurvival"))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'x' must be a 'SimulationResultsSurvival' object; use getSimulationSurvival() to create one" diff --git a/R/class_summary.R b/R/class_summary.R index e4e6aa41..794858e6 100644 --- a/R/class_summary.R +++ b/R/class_summary.R @@ -23,7 +23,7 @@ NULL -SummaryItemR6 <- R6Class("SummaryItemR6", +SummaryItem <- R6Class("SummaryItem", public = list( title = NULL, values = NULL, @@ -72,7 +72,7 @@ SummaryItemR6 <- R6Class("SummaryItemR6", #' #' @export #' -plot.SummaryFactoryR6 <- function(x, y, ..., showSummary = FALSE) { +plot.SummaryFactory <- function(x, y, ..., showSummary = FALSE) { fCall <- match.call(expand.dots = FALSE) if (isTRUE(showSummary) || .isSummaryPipe(fCall)) { markdown <- .getOptionalArgument("markdown", ..., optionalArgumentDefaultValue = NA) @@ -114,7 +114,7 @@ plot.SummaryFactoryR6 <- function(x, y, ..., showSummary = FALSE) { #' #' @export #' -knit_print.SummaryFactoryR6 <- function(x, ...) { +knit_print.SummaryFactory <- function(x, ...) { result <- paste0(utils::capture.output(x$.catMarkdownText()), collapse = "\n") if (isTRUE(base::attr(x$object, "printObject"))) { @@ -147,7 +147,7 @@ knit_print.SummaryFactoryR6 <- function(x, ...) { #' #' @export #' -print.SummaryFactoryR6 <- function(x, ..., +print.SummaryFactory <- function(x, ..., markdown = NA, sep = "\n-----\n\n") { @@ -176,8 +176,8 @@ print.SummaryFactoryR6 <- function(x, ..., #' #' @importFrom methods new #' -SummaryFactoryR6 <- R6Class("SummaryFactoryR6", - inherit = ParameterSetR6, +SummaryFactory <- R6Class("SummaryFactory", + inherit = ParameterSet, public = list( object = NULL, title = NULL, @@ -298,7 +298,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", } tryCatch( { - self$addSummaryItem(SummaryItemR6$new(title = title, values = values, legendEntry = legendEntry)) + self$addSummaryItem(SummaryItem$new(title = title, values = values, legendEntry = legendEntry)) }, error = function(e) { stop( @@ -309,7 +309,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", ) }, addSummaryItem = function(summaryItem) { - if (!(inherits(summaryItem, "SummaryItem") || inherits(summaryItem, "SummaryItemR6"))) { + if (!(inherits(summaryItem, "SummaryItem") || inherits(summaryItem, "SummaryItem"))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'summaryItem' must be an instance of class 'SummaryItem' (was '", .getClassName(summaryItem), "')" @@ -348,7 +348,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", parameterCaptionSingle = parameterCaption, legendEntry = list(), enforceFirstCase = FALSE, formatRepeatedPValues = FALSE) { if (!is.null(parameterName) && length(parameterName) == 1 && - (inherits(parameterSet, "ParameterSet") || inherits(parameterSet, "ParameterSetR6")) && + (inherits(parameterSet, "ParameterSet") || inherits(parameterSet, "ParameterSet")) && parameterSet$.getParameterType(parameterName) == C_PARAM_NOT_APPLICABLE) { if (.getLogicalEnvironmentVariable("RPACT_DEVELOPMENT_MODE")) { warning( @@ -408,7 +408,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", parameterNames <- "" numberOfVariants <- 1 numberOfStages <- ifelse(is.matrix(values), ncol(values), length(values)) - if (inherits(parameterSet, "ParameterSet") || inherits(parameterSet, "ParameterSetR6")) { + if (inherits(parameterSet, "ParameterSet") || inherits(parameterSet, "ParameterSet")) { parameterNames <- parameterSet$.getVisibleFieldNamesOrdered() numberOfVariants <- .getMultidimensionalNumberOfVariants(parameterSet, parameterNames) numberOfStages <- parameterSet$.getMultidimensionalNumberOfStages(parameterNames) @@ -418,7 +418,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", if (is.null(stages) && !is.null(parameterSet[[".stageResults"]])) { stages <- parameterSet[[".stageResults"]][["stages"]] } - if (is.null(stages) && (inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResultsR6"))) { + if (is.null(stages) && (inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResults"))) { stages <- parameterSet[[".design"]][["stages"]] } if (!is.null(stages) && length(stages) > 0) { @@ -498,7 +498,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", valuesToShow <- self$.getFormattedParameterValue(valuesToShow, valuesToShow2) self$addItem(parameterCaptionSingle, valuesToShow, legendEntry) } else { - if (!(inherits(parameterSet, "ParameterSet") || inherits(parameterSet, "ParameterSetR6"))) { + if (!(inherits(parameterSet, "ParameterSet") || inherits(parameterSet, "ParameterSet"))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "for varied values 'parameterSet' must be an instance of ", @@ -511,9 +511,9 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", userDefinedEffectMatrix <- FALSE if (grepl("MultiArm|Enrichment", .getClassName(parameterSet)) || - (inherits(parameterSet, "AnalysisResultsConditionalDunnett") || inherits(parameterSet, "AnalysisResultsConditionalDunnettR6")) || - (inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResultsR6")) || - (inherits(parameterSet, "ConditionalPowerResults") || inherits(parameterSet, "ConditionalPowerResultsR6"))) { + (inherits(parameterSet, "AnalysisResultsConditionalDunnett") || inherits(parameterSet, "AnalysisResultsConditionalDunnett")) || + (inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResults")) || + (inherits(parameterSet, "ConditionalPowerResults") || inherits(parameterSet, "ConditionalPowerResults"))) { if (grepl("SimulationResults(MultiArm|Enrichment)", .getClassName(parameterSet)) && parameterName %in% c( "rejectAtLeastOne", @@ -578,25 +578,25 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", numberOfVariants <- length(variedParameterValues) legendEntry[["S[i]"]] <- "population i" legendEntry[["F"]] <- "full population" - } else if (!(inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResultsR6")) || + } else if (!(inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResults")) || parameterName %in% c("rejected", "separatePValues")) { - if ((inherits(parameterSet, "AnalysisResultsConditionalDunnett") || inherits(parameterSet, "AnalysisResultsConditionalDunnettR6")) && + if ((inherits(parameterSet, "AnalysisResultsConditionalDunnett") || inherits(parameterSet, "AnalysisResultsConditionalDunnett")) && (!is.matrix(values) || ncol(values) > 1)) { transposed <- TRUE } - if ((inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResultsR6")) && + if ((inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResults")) && parameterSet$.getParameterType("adjustedStageWisePValues") != "g" && parameterName == "separatePValues") { transposed <- TRUE } - if ((inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResultsR6")) && + if ((inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResults")) && parameterName %in% c("rejected")) { transposed <- TRUE } - if ((inherits(parameterSet, "ConditionalPowerResults") || inherits(parameterSet, "ConditionalPowerResultsR6")) && + if ((inherits(parameterSet, "ConditionalPowerResults") || inherits(parameterSet, "ConditionalPowerResults")) && parameterName %in% c("conditionalPower", "values")) { transposed <- TRUE } @@ -614,7 +614,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", } else { if (inherits(parameterSet, "Dataset")) { variedParameter <- "groups" - } else if (inherits(parameterSet, "PerformanceScore") || inherits(parameterSet, "PerformanceScoreR6")) { + } else if (inherits(parameterSet, "PerformanceScore") || inherits(parameterSet, "PerformanceScore")) { variedParameter <- ".alternative" } else { variedParameter <- parameterSet$.getVariedParameter(parameterNames, numberOfVariants) @@ -679,9 +679,9 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", } else if ( (grepl("MultiArm|Enrichment", .getClassName(parameterSet)) && !grepl("Simulation", .getClassName(parameterSet))) || - (inherits(parameterSet, "AnalysisResultsConditionalDunnett") || inherits(parameterSet, "AnalysisResultsConditionalDunnettR6")) || - (inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResultsR6")) || - (inherits(parameterSet, "ConditionalPowerResults") || inherits(parameterSet, "ConditionalPowerResultsR6"))) { + (inherits(parameterSet, "AnalysisResultsConditionalDunnett") || inherits(parameterSet, "AnalysisResultsConditionalDunnett")) || + (inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResults")) || + (inherits(parameterSet, "ConditionalPowerResults") || inherits(parameterSet, "ConditionalPowerResults"))) { spacePrefix <- ifelse(parameterCaption %in% c("pi", "lambda", "median"), "", " ") self$addItem(paste0( parameterCaption, spacePrefix, @@ -712,7 +712,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", .isEnrichmentAnalysisResults(parameterSet) || .isEnrichmentStageResults(parameterSet) || .isEnrichmentConditionalPowerResults(parameterSet) || - ((inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResultsR6")) && + ((inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResults")) && isTRUE(parameterSet$.enrichment)) ) }, @@ -880,7 +880,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", if (inherits(fieldSet, "Dataset") && grepl("samplesize|event", tolower(parameterName))) { } else { - if (inherits(fieldSet, "FieldSet") || inherits(fieldSet, "FieldSetR6")) { + if (inherits(fieldSet, "FieldSet") || inherits(fieldSet, "FieldSet")) { formatFunctionName <- fieldSet$.parameterFormatFunctions[[parameterName]] } if (is.null(formatFunctionName)) { @@ -914,10 +914,10 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", designPlan <- NULL if (inherits(object, "TrialDesignCharacteristics")) { design <- object$.design - } else if (.isTrialDesignPlan(object) || inherits(object, "SimulationResults") || inherits(object, "SimulationResultsR6")) { + } else if (.isTrialDesignPlan(object) || inherits(object, "SimulationResults") || inherits(object, "SimulationResults")) { design <- object$.design designPlan <- object - } else if (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) { + } else if (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResults")) { return(.createSummaryTitleAnalysisResults(object$.design, object)) } else if (.isTrialDesign(object)) { design <- object @@ -984,7 +984,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", title <- paste0(title, "Sequential analysis with a maximum of ", kMax, " looks") } if (!is.null(designPlan)) { - if (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")) { + if (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResults")) { title <- "Simulation of a " } else if (designPlan$.isSampleSizeObject()) { title <- "Sample size calculation for a " @@ -1035,7 +1035,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", simulationEnabled <- grepl("Simulation", .getClassName(object)) ratioEnabled <- FALSE populations <- NA_integer_ - if ((inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) || (inherits(object, "StageResults") || inherits(object, "StageResultsR6"))) { + if ((inherits(object, "AnalysisResults") || inherits(object, "AnalysisResults")) || (inherits(object, "StageResults") || inherits(object, "StageResults"))) { groups <- object$.dataInput$getNumberOfGroups() meansEnabled <- grepl("Means", .getClassName(object$.dataInput)) ratesEnabled <- grepl("Rates", .getClassName(object$.dataInput)) @@ -1070,8 +1070,8 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", } .createSummaryHypothesisText <- function(object, summaryFactory) { - if (!(inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) && !(inherits(object, "TrialDesignPlan") || inherits(object, "TrialDesignPlanR6")) && - !(inherits(object, "SimulationResults") || inherits(object, "SimulationResultsR6"))) { + if (!(inherits(object, "AnalysisResults") || inherits(object, "AnalysisResults")) && !(inherits(object, "TrialDesignPlan") || inherits(object, "TrialDesignPlan")) && + !(inherits(object, "SimulationResults") || inherits(object, "SimulationResults"))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'object' must be an instance of class 'AnalysisResults', 'TrialDesignPlan' ", @@ -1093,7 +1093,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", comparisonH0 <- " = " comparisonH1 <- NA_character_ - if ((inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) && !is.null(directionUpper)) { + if ((inherits(object, "AnalysisResults") || inherits(object, "AnalysisResults")) && !is.null(directionUpper)) { comparisonH1 <- ifelse(sided == 2, " != ", ifelse(directionUpper, " > ", " < ")) } @@ -1181,7 +1181,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", return("") } - if (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) { + if (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResults")) { return("") } @@ -1227,11 +1227,11 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", return(.createSummaryHeaderDesign(object$.design, NULL, summaryFactory)) } - if (.isTrialDesignPlan(object) || (inherits(object, "SimulationResults") || inherits(object, "SimulationResultsR6"))) { + if (.isTrialDesignPlan(object) || (inherits(object, "SimulationResults") || inherits(object, "SimulationResults"))) { return(.createSummaryHeaderDesign(object$.design, object, summaryFactory)) } - if (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) { + if (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResults")) { return(.createSummaryHeaderAnalysisResults(object$.design, object, summaryFactory, digits)) } @@ -1245,9 +1245,9 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", .addAllocationRatioToHeader <- function(parameterSet, header, sep = ", ") { if (!.isTrialDesignPlanSurvival(parameterSet) && !grepl("Simulation", .getClassName(parameterSet))) { numberOfGroups <- 1 - if (inherits(parameterSet, "TrialDesignPlan") || inherits(parameterSet, "TrialDesignPlanR6")) { + if (inherits(parameterSet, "TrialDesignPlan") || inherits(parameterSet, "TrialDesignPlan")) { numberOfGroups <- parameterSet$groups - } else if (inherits(parameterSet, "AnalysisResults") || inherits(parameterSet, "AnalysisResultsR6")) { + } else if (inherits(parameterSet, "AnalysisResults") || inherits(parameterSet, "AnalysisResults")) { numberOfGroups <- parameterSet$.dataInput$getNumberOfGroups() } if (numberOfGroups == 1) { @@ -1378,7 +1378,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", } } - if ((inherits(stageResults, "StageResultsMeans") || inherits(stageResults, "StageResultsMeansR6")) && (dataInput$getNumberOfGroups() == 2)) { + if ((inherits(stageResults, "StageResultsMeans") || inherits(stageResults, "StageResultsMeans")) && (dataInput$getNumberOfGroups() == 2)) { if (stageResults$equalVariances) { header <- .concatenateSummaryText(header, "equal variances option") } else { @@ -1732,9 +1732,9 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", header <- paste0(header, "\n") - header <- paste0(header, "The ", ifelse((inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")) || + header <- paste0(header, "The ", ifelse((inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResults")) || designPlan$.isPowerObject(), "results were ", "sample size was ")) - header <- paste0(header, ifelse(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6"), "simulated", "calculated")) + header <- paste0(header, ifelse(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResults"), "simulated", "calculated")) header <- paste0(header, " for a ") settings <- .getSummaryObjectSettings(designPlan) if (settings$meansEnabled) { @@ -1781,7 +1781,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", ifelse(settings$populations == 1, "", "s") )) } - if (!is.null(designPlan) && (.isTrialDesignPlan(designPlan) || (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6"))) && + if (!is.null(designPlan) && (.isTrialDesignPlan(designPlan) || (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResults"))) && !settings$multiArmEnabled && !settings$enrichmentEnabled && !settings$survivalEnabled) { if (settings$ratesEnabled) { if (settings$groups == 1) { @@ -1801,7 +1801,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", header <- .concatenateSummaryText(header, paste0("(", part, ")"), sep = " ") } if (settings$meansEnabled && (.isTrialDesignInverseNormalOrGroupSequential(design) || - (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")))) { + (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResults")))) { header <- .concatenateSummaryText(header, .createSummaryHypothesisText(designPlan, summaryFactory)) if (!is.null(designPlan[["alternative"]]) && length(designPlan$alternative) == 1) { alternativeText <- paste0("H1: effect = ", round(designPlan$alternative, 3)) @@ -1840,7 +1840,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", } header <- .addAdditionalArgumentsToHeader(header, designPlan, settings) } else if (settings$ratesEnabled && (.isTrialDesignInverseNormalOrGroupSequential(design) || - (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")))) { + (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResults")))) { if (settings$groups == 1) { if (!is.null(designPlan[["pi1"]]) && length(designPlan$pi1) == 1) { treatmentRateText <- paste0("H1: treatment rate pi = ", round(designPlan$pi1, 3)) @@ -1902,7 +1902,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", header <- .addAdditionalArgumentsToHeader(header, designPlan, settings) } } else if (settings$survivalEnabled && (.isTrialDesignInverseNormalOrGroupSequential(design) || - (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")))) { + (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResults")))) { parameterNames <- designPlan$.getVisibleFieldNamesOrdered() numberOfVariants <- .getMultidimensionalNumberOfVariants(designPlan, parameterNames) @@ -1938,7 +1938,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", } else if (!is.null(designPlan[["omegaMaxVector"]]) && length(designPlan$omegaMaxVector) == 1) { treatmentRateText <- paste0("H1: omega_max = ", round(designPlan$omegaMaxVector, 3)) } else if (!is.null(designPlan[["hazardRatio"]]) && (length(designPlan$hazardRatio) == 1) || - ((inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")) && !is.null(designPlan[[".piecewiseSurvivalTime"]]) && + ((inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResults")) && !is.null(designPlan[[".piecewiseSurvivalTime"]]) && designPlan$.piecewiseSurvivalTime$piecewiseSurvivalEnabled)) { treatmentRateText <- paste0( "H1: hazard ratio = ", @@ -1984,12 +1984,12 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", header <- .addEnrichmentEffectListToHeader(header, designPlan) header <- .addAdditionalArgumentsToHeader(header, designPlan, settings) } - if (!(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")) && designPlan$.isSampleSizeObject()) { + if (!(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResults")) && designPlan$.isSampleSizeObject()) { header <- .concatenateSummaryText(header, paste0("power ", round(100 * (1 - design$beta), 1), "%")) } - if (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")) { + if (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResults")) { header <- .concatenateSummaryText(header, paste0("simulation runs = ", designPlan$maxNumberOfIterations)) header <- .concatenateSummaryText(header, paste0("seed = ", designPlan$seed)) } @@ -2286,19 +2286,19 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", .createSummary <- function(object, digits = NA_integer_, output = c("all", "title", "overview", "body")) { output <- match.arg(output) - if (inherits(object, "TrialDesignCharacteristics") || inherits(object, "TrialDesignCharacteristicsR6")) { + if (inherits(object, "TrialDesignCharacteristics") || inherits(object, "TrialDesignCharacteristics")) { return(.createSummaryDesignPlan(object, digits = digits, output = output, showStageLevels = TRUE)) } - if (.isTrialDesign(object) || .isTrialDesignPlan(object) || inherits(object, "SimulationResults") || inherits(object, "SimulationResultsR6")) { + if (.isTrialDesign(object) || .isTrialDesignPlan(object) || inherits(object, "SimulationResults") || inherits(object, "SimulationResults")) { return(.createSummaryDesignPlan(object, digits = digits, output = output, showStageLevels = !.isTrialDesignPlan(object))) } - if (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6")) { + if (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResults")) { return(.createSummaryAnalysisResults(object, digits = digits, output = output)) } - if (inherits(object, "PerformanceScore") || inherits(object, "PerformanceScoreR6")) { + if (inherits(object, "PerformanceScore") || inherits(object, "PerformanceScore")) { return(.createSummaryPerformanceScore(object, digits = digits, output = output)) } @@ -2338,7 +2338,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", #' .createSummaryAnalysisResults <- function(object, digits = NA_integer_, output = c("all", "title", "overview", "body")) { output <- match.arg(output) - if (!(inherits(object, "AnalysisResults") || inherits(object, "AnalysisResultsR6"))) { + if (!(inherits(object, "AnalysisResults") || inherits(object, "AnalysisResults"))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'object' must be a valid analysis result object (is class ", .getClassName(object), ")" @@ -2375,7 +2375,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", summaryFactory <- NULL if(is.R6(object)) { - summaryFactory <- SummaryFactoryR6$new(object = object, intervalFormat = intervalFormat, output = output) + summaryFactory <- SummaryFactory$new(object = object, intervalFormat = intervalFormat, output = output) } else { summaryFactory <- SummaryFactory(object = object, intervalFormat = intervalFormat, output = output) } @@ -2437,8 +2437,8 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", parameterCaption <- ifelse(stageResults$isOneSampleDataset(), "Cumulative standard deviation", "Cumulative (pooled) standard deviation" ) - parameterName <- ifelse((inherits(stageResults, "StageResultsMultiArmMeans") || inherits(stageResults, "StageResultsMultiArmMeansR6")) && - !(inherits(stageResults, "StageResultsEnrichmentMeans") || inherits(stageResults, "StageResultsEnrichmentMeansR6")), + parameterName <- ifelse((inherits(stageResults, "StageResultsMultiArmMeans") || inherits(stageResults, "StageResultsMultiArmMeans")) && + !(inherits(stageResults, "StageResultsEnrichmentMeans") || inherits(stageResults, "StageResultsEnrichmentMeans")), "overallPooledStDevs", "overallStDevs" ) summaryFactory$addParameter(stageResults, @@ -2743,10 +2743,10 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", return(invisible(summaryFactory)) } - informationRatesCaption <- ifelse(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6") || - (inherits(designPlan, "AnalysisResults") || inherits(designPlan, "AnalysisResultsR6")), "Fixed weight", "Information") + informationRatesCaption <- ifelse(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResults") || + (inherits(designPlan, "AnalysisResults") || inherits(designPlan, "AnalysisResults")), "Fixed weight", "Information") - if (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6") || (inherits(designPlan, "AnalysisResults") || inherits(designPlan, "AnalysisResultsR6"))) { + if (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResults") || (inherits(designPlan, "AnalysisResults") || inherits(designPlan, "AnalysisResults"))) { if (.isTrialDesignFisher(design)) { weights <- .getWeightsFisher(design) } else if (.isTrialDesignInverseNormal(design)) { @@ -2759,7 +2759,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", summaryFactory$addItem( paste0( informationRatesCaption, - ifelse(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6"), "", " rate") + ifelse(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResults"), "", " rate") ), .getSummaryValuesInPercent(design$informationRates) ) @@ -2773,7 +2773,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", .addDesignParameterToSummary <- function(design, designPlan, designCharacteristics, summaryFactory, digitsGeneral, digitsProbabilities) { - if (design$kMax > 1 && !(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")) && + if (design$kMax > 1 && !(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResults")) && !.isTrialDesignConditionalDunnett(design)) { summaryFactory$addParameter(design, parameterName = "alphaSpent", @@ -2792,7 +2792,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", if (!is.null(designPlan)) { if (!grepl("SimulationResults(MultiArm|Enrichment)", .getClassName(designPlan))) { outputSize <- getOption("rpact.summary.output.size", C_SUMMARY_OUTPUT_SIZE_DEFAULT) - if (outputSize == "large" && (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6"))) { + if (outputSize == "large" && (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResults"))) { summaryFactory$addParameter(designPlan, parameterName = "conditionalPowerAchieved", parameterCaption = "Conditional power (achieved)", @@ -2859,7 +2859,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", parameterName = "alpha", parameterCaption = "Significance level", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) - } else if (!is.null(designPlan) && !(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6"))) { + } else if (!is.null(designPlan) && !(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResults"))) { summaryFactory$addParameter(design, parameterName = "stageLevels", twoSided = design$sided == 2, @@ -2880,10 +2880,10 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", performanceScore = NULL) { output <- match.arg(output) designPlan <- NULL - if (.isTrialDesignPlan(object) || (inherits(object, "SimulationResults") || inherits(object, "SimulationResultsR6"))) { + if (.isTrialDesignPlan(object) || (inherits(object, "SimulationResults") || inherits(object, "SimulationResults"))) { design <- object$.design designPlan <- object - } else if (inherits(object, "TrialDesignCharacteristics") || inherits(object, "TrialDesignCharacteristicsR6")) { + } else if (inherits(object, "TrialDesignCharacteristics") || inherits(object, "TrialDesignCharacteristics")) { design <- object$.design # designPlan <- object } else if (.isTrialDesign(object)) { @@ -2909,7 +2909,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", summaryFactory <- NULL if(is.R6(object)) { - summaryFactory <- SummaryFactoryR6$new(object = object, intervalFormat = intervalFormat, output = output) + summaryFactory <- SummaryFactory$new(object = object, intervalFormat = intervalFormat, output = output) } else { summaryFactory <- SummaryFactory(object = object, intervalFormat = intervalFormat, output = output) } @@ -3007,7 +3007,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", futilityPerStage = designPlan$futilityPerStage ) numberOfVariants <- 1 - if ((inherits(designPlan, "ParameterSet") || inherits(designPlan, "ParameterSetR6"))) { + if ((inherits(designPlan, "ParameterSet") || inherits(designPlan, "ParameterSet"))) { parameterNames <- designPlan$.getVisibleFieldNamesOrdered() numberOfVariants <- .getMultidimensionalNumberOfVariants(designPlan, parameterNames) } @@ -3172,7 +3172,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", ) } - if (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")) { + if (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResults")) { parameterName1 <- ifelse(survivalEnabled, "numberOfSubjects", "sampleSizes") parameterName2 <- "eventsPerStage" } else { @@ -3191,7 +3191,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", if (design$kMax > 1) { summaryFactory$addParameter(designPlan, - parameterName = ifelse((inherits(designPlan, "TrialDesignPlan") || inherits(designPlan, "TrialDesignPlanR6")) && designPlan$.isSampleSizeObject(), + parameterName = ifelse((inherits(designPlan, "TrialDesignPlan") || inherits(designPlan, "TrialDesignPlan")) && designPlan$.isSampleSizeObject(), "expectedNumberOfSubjectsH1", "expectedNumberOfSubjects" ), parameterCaption = "Expected number of subjects", @@ -3200,7 +3200,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", } if (outputSize %in% c("medium", "large")) { - subjectsCaption <- ifelse(design$kMax > 1 && (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResultsR6")) && + subjectsCaption <- ifelse(design$kMax > 1 && (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResults")) && !survivalEnabled, "Stagewise number of subjects", "Number of subjects") summaryFactory$addParameter(designPlan, parameterName = parameterName1, @@ -3209,7 +3209,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", } if (survivalEnabled) { - if (design$kMax > 1 && !((inherits(designPlan, "TrialDesignPlanSurvival") || inherits(designPlan, "TrialDesignPlanSurvivalR6")) && designPlan$.isSampleSizeObject())) { + if (design$kMax > 1 && !((inherits(designPlan, "TrialDesignPlanSurvival") || inherits(designPlan, "TrialDesignPlanSurvival")) && designPlan$.isSampleSizeObject())) { summaryFactory$addParameter(designPlan, parameterName = "expectedNumberOfEvents", parameterCaption = "Expected number of events", @@ -3505,7 +3505,7 @@ SummaryFactoryR6 <- R6Class("SummaryFactoryR6", treatmentCaption <- ifelse(numberOfGroups > 2, paste0("Treatment arm ", groupNumber), "Treatment arm") if (!grepl("Survival", .getClassName(designPlan)) || - ((inherits(designPlan, "SimulationResultsMultiArmSurvival") || inherits(designPlan, "SimulationResultsMultiArmSurvivalR6")) && + ((inherits(designPlan, "SimulationResultsMultiArmSurvival") || inherits(designPlan, "SimulationResultsMultiArmSurvival")) && parameterName == "singleNumberOfEventsPerStage")) { return(ifelse(groupNumber == numberOfGroups, paste0(listItemPrefix, "Control arm"), diff --git a/R/class_time.R b/R/class_time.R index 5efb3c07..5252e401 100644 --- a/R/class_time.R +++ b/R/class_time.R @@ -23,8 +23,8 @@ C_REGEXP_SMALLER <- "< ?" C_REGEXP_SMALLER_OR_EQUAL <- "<= ?" C_REGEXP_DECIMAL_NUMBER <- "\\d*(\\.{1}\\d*)?" -TimeDefinitionR6 <- R6Class("TimeDefinitionR6", - inherit = ParameterSetR6, +TimeDefinition <- R6Class("TimeDefinition", + inherit = ParameterSet, public = list( initialize = function(...) { super$initialize() @@ -214,11 +214,11 @@ getPiecewiseSurvivalTime <- function(piecewiseSurvivalTime = NA_real_, ignore = c(".pi1Default", ".lambdaBased", ".silent"), exceptionEnabled = TRUE ) - if (inherits(piecewiseSurvivalTime, "TrialDesignPlanSurvival") || inherits(piecewiseSurvivalTime, "TrialDesignPlanSurvivalR6")) { + if (inherits(piecewiseSurvivalTime, "TrialDesignPlanSurvival") || inherits(piecewiseSurvivalTime, "TrialDesignPlanSurvival")) { piecewiseSurvivalTime <- piecewiseSurvivalTime$.piecewiseSurvivalTime } - if (inherits(piecewiseSurvivalTime, "PiecewiseSurvivalTime") || inherits(piecewiseSurvivalTime, "PiecewiseSurvivalTimeR6")) { + if (inherits(piecewiseSurvivalTime, "PiecewiseSurvivalTime") || inherits(piecewiseSurvivalTime, "PiecewiseSurvivalTime")) { lambdaBased <- .getOptionalArgument(".lambdaBased", ...) if (!is.null(lambdaBased) && isTRUE(lambdaBased) && !piecewiseSurvivalTime$.isLambdaBased()) { stop( @@ -249,7 +249,7 @@ getPiecewiseSurvivalTime <- function(piecewiseSurvivalTime = NA_real_, .assertIsValidKappa(kappa) .assertIsSingleLogical(delayedResponseAllowed, "delayedResponseAllowed") - return(PiecewiseSurvivalTimeR6$new( + return(PiecewiseSurvivalTime$new( piecewiseSurvivalTime = piecewiseSurvivalTime, lambda1 = lambda1, lambda2 = lambda2, @@ -307,19 +307,19 @@ getAccrualTime <- function(accrualTime = NA_real_, ignore = c("showWarnings") ) - if (inherits(accrualTime, "AccrualTime") || inherits(accrualTime, "AccrualTimeR6") || - inherits(accrualTime, "TrialDesignPlanSurvival") || inherits(accrualTime, "TrialDesignPlanSurvivalR6")) { + if (inherits(accrualTime, "AccrualTime") || inherits(accrualTime, "AccrualTime") || + inherits(accrualTime, "TrialDesignPlanSurvival") || inherits(accrualTime, "TrialDesignPlanSurvival")) { if (!identical(accrualIntensity, C_ACCRUAL_INTENSITY_DEFAULT)) { .warnInCaseOfUnusedArgument(accrualIntensity, "accrualIntensity", NA_real_, "getAccrualTime") } .warnInCaseOfUnusedArgument(maxNumberOfSubjects, "maxNumberOfSubjects", NA_real_, "getAccrualTime") } - if (inherits(accrualTime, "AccrualTime") || inherits(accrualTime, "AccrualTimeR6")) { + if (inherits(accrualTime, "AccrualTime") || inherits(accrualTime, "AccrualTime")) { return(accrualTime) } - if (inherits(accrualTime, "TrialDesignPlanSurvival") || inherits(accrualTime, "TrialDesignPlanSurvivalR6")) { + if (inherits(accrualTime, "TrialDesignPlanSurvival") || inherits(accrualTime, "TrialDesignPlanSurvival")) { return(accrualTime$.accrualTime) } @@ -348,7 +348,7 @@ getAccrualTime <- function(accrualTime = NA_real_, showWarnings <- TRUE } - return(AccrualTimeR6$new( + return(AccrualTime$new( accrualTime = accrualTime, accrualIntensity = accrualIntensity, maxNumberOfSubjects = maxNumberOfSubjects, @@ -392,8 +392,8 @@ getAccrualTime <- function(accrualTime = NA_real_, #' #' @importFrom methods new #' -PiecewiseSurvivalTimeR6 <- R6Class("PiecewiseSurvivalTimeR6", - inherit = TimeDefinitionR6, +PiecewiseSurvivalTime <- R6Class("PiecewiseSurvivalTime", + inherit = TimeDefinition, public = list( .pi1Default = NULL, .lambdaBased = NULL, @@ -1351,8 +1351,8 @@ PiecewiseSurvivalTimeR6 <- R6Class("PiecewiseSurvivalTimeR6", #' #' @importFrom methods new #' -AccrualTimeR6 <- R6Class("AccrualTimeR6", - inherit = TimeDefinitionR6, +AccrualTime <- R6Class("AccrualTime", + inherit = TimeDefinition, public = list( .showWarnings = NULL, endOfAccrualIsUserDefined = NULL, diff --git a/R/f_analysis_base.R b/R/f_analysis_base.R index ae88f5d0..18f206ba 100644 --- a/R/f_analysis_base.R +++ b/R/f_analysis_base.R @@ -28,15 +28,15 @@ NULL stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, sQuote("dataInput"), " must be specified") } - if (missing(dataInput) && !missing(design) && (inherits(design, "Dataset") || inherits(design, "DatasetR6"))) { + if (missing(dataInput) && !missing(design) && (inherits(design, "Dataset") || inherits(design, "Dataset"))) { dataInput <- design - if (!is.null(dataInput$.design) && (inherits(dataInput$.design, "TrialDesign") || inherits(dataInput$.design, "TrialDesignR6"))) { + if (!is.null(dataInput$.design) && (inherits(dataInput$.design, "TrialDesign") || inherits(dataInput$.design, "TrialDesign"))) { design <- dataInput$.design } else { design <- .getDefaultDesign(..., type = "analysis") } } else if (!missing(dataInput) && missing(design)) { - if (!is.null(dataInput$.design) && (inherits(dataInput$.design, "TrialDesign") || inherits(dataInput$.design, "TrialDesignR6"))) { + if (!is.null(dataInput$.design) && (inherits(dataInput$.design, "TrialDesign") || inherits(dataInput$.design, "TrialDesign"))) { design <- dataInput$.design } else { design <- .getDefaultDesign(..., type = "analysis") diff --git a/R/f_analysis_base_means.R b/R/f_analysis_base_means.R index e9065fd1..d347617d 100644 --- a/R/f_analysis_base_means.R +++ b/R/f_analysis_base_means.R @@ -64,7 +64,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsInverseNormalR6$new(design = design, dataInput = dataInput) + results <- AnalysisResultsInverseNormal$new(design = design, dataInput = dataInput) .getAnalysisResultsMeansAll( results = results, design = design, dataInput = dataInput, @@ -93,7 +93,7 @@ NULL ), c("stage", "stDevH1")), ... ) - results <- AnalysisResultsGroupSequentialR6$new(design = design, dataInput = dataInput) + results <- AnalysisResultsGroupSequential$new(design = design, dataInput = dataInput) stDevH1 <- .getOptionalArgument("stDevH1", ...) if (!is.null(stDevH1)) { @@ -135,7 +135,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsFisherR6$new(design = design, dataInput = dataInput) + results <- AnalysisResultsFisher$new(design = design, dataInput = dataInput) .setValueAndParameterType(results, "iterations", as.integer(iterations), C_ITERATIONS_DEFAULT) .setValueAndParameterType(results, "seed", seed, NA_real_) @@ -474,7 +474,7 @@ NULL } if (dataInput$getNumberOfGroups() == 1) { - stageResults <- StageResultsMeansR6$new( + stageResults <- StageResultsMeans$new( design = design, dataInput = dataInput, stage = as.integer(stage), @@ -500,7 +500,7 @@ NULL equalVariances = equalVariances ) } else if (dataInput$getNumberOfGroups() == 2) { - stageResults <- StageResultsMeansR6$new( + stageResults <- StageResultsMeans$new( design = design, dataInput = dataInput, stage = as.integer(stage), @@ -1190,7 +1190,7 @@ NULL design <- stageResults$.design - results <- ConditionalPowerResultsMeansR6$new( + results <- ConditionalPowerResultsMeans$new( .stageResults = stageResults, .design = design, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaH1, assumedStDev = assumedStDev diff --git a/R/f_analysis_base_rates.R b/R/f_analysis_base_rates.R index b0b4f034..7c244d31 100644 --- a/R/f_analysis_base_rates.R +++ b/R/f_analysis_base_rates.R @@ -76,7 +76,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsInverseNormalR6$new(design = design, dataInput = dataInput)#R6$new + results <- AnalysisResultsInverseNormal$new(design = design, dataInput = dataInput)#R6$new .getAnalysisResultsRatesAll( results = results, design = design, dataInput = dataInput, @@ -105,7 +105,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsGroupSequentialR6$new(design = design, dataInput = dataInput)#R6$new + results <- AnalysisResultsGroupSequential$new(design = design, dataInput = dataInput)#R6$new .getAnalysisResultsRatesAll( results = results, design = design, dataInput = dataInput, @@ -136,7 +136,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsFisherR6$new(design = design, dataInput = dataInput)#R6$new + results <- AnalysisResultsFisher$new(design = design, dataInput = dataInput)#R6$new .setValueAndParameterType(results, "iterations", as.integer(iterations), C_ITERATIONS_DEFAULT) .setValueAndParameterType(results, "seed", seed, NA_real_) @@ -570,7 +570,7 @@ NULL direction <- ifelse(directionUpper, C_DIRECTION_UPPER, C_DIRECTION_LOWER) - stageResults <- StageResultsRatesR6$new(#R6$new + stageResults <- StageResultsRates$new(#R6$new design = design, dataInput = dataInput, stage = as.integer(stage), @@ -1102,7 +1102,7 @@ NULL pi2 <- .assertIsValidPi2(pi2, stageResults, stage) } - results <- ConditionalPowerResultsRatesR6$new(#R6$new + results <- ConditionalPowerResultsRates$new(#R6$new .stageResults = stageResults, .design = stageResults$.design, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, pi1 = pi1, pi2 = pi2 diff --git a/R/f_analysis_base_survival.R b/R/f_analysis_base_survival.R index 20dfadf7..4cd6a4ed 100644 --- a/R/f_analysis_base_survival.R +++ b/R/f_analysis_base_survival.R @@ -61,7 +61,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsInverseNormalR6$new(design = design, dataInput = dataInput) + results <- AnalysisResultsInverseNormal$new(design = design, dataInput = dataInput) .getAnalysisResultsSurvivalAll( results = results, design = design, dataInput = dataInput, @@ -89,7 +89,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsGroupSequentialR6$new(design = design, dataInput = dataInput) + results <- AnalysisResultsGroupSequential$new(design = design, dataInput = dataInput) .getAnalysisResultsSurvivalAll( results = results, design = design, dataInput = dataInput, @@ -119,7 +119,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsFisherR6$new(design = design, dataInput = dataInput) + results <- AnalysisResultsFisher$new(design = design, dataInput = dataInput) .setValueAndParameterType(results, "iterations", as.integer(iterations), C_ITERATIONS_DEFAULT) .setValueAndParameterType(results, "seed", seed, NA_real_) @@ -348,7 +348,7 @@ NULL combFisher[k] <- prod(pValues[1:k]^weightsFisher[1:k]) } - stageResults <- StageResultsSurvivalR6$new( + stageResults <- StageResultsSurvival$new( design = design, dataInput = dataInput, stage = as.integer(stage), @@ -903,7 +903,7 @@ NULL .getConditionalPowerSurvival <- function(..., stageResults, nPlanned = NA_real_, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, thetaH1 = NA_real_) { - results <- ConditionalPowerResultsSurvivalR6$new( + results <- ConditionalPowerResultsSurvival$new( .stageResults = stageResults, .design = stageResults$.design, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, thetaH1 = thetaH1 diff --git a/R/f_analysis_enrichment_means.R b/R/f_analysis_enrichment_means.R index a481f38b..4052763e 100644 --- a/R/f_analysis_enrichment_means.R +++ b/R/f_analysis_enrichment_means.R @@ -253,7 +253,7 @@ NULL ) } - stageResults <- StageResultsEnrichmentMeansR6$new( + stageResults <- StageResultsEnrichmentMeans$new( design = design, dataInput = dataInput, thetaH0 = thetaH0, @@ -444,7 +444,7 @@ NULL ignore = c(.getDesignArgumentsToIgnoreAtUnknownArgumentCheck(design, powerCalculationEnabled = TRUE), "stage"), ... ) - results <- AnalysisResultsEnrichmentInverseNormalR6$new(design = design, dataInput = dataInput) + results <- AnalysisResultsEnrichmentInverseNormal$new(design = design, dataInput = dataInput) results <- .getAnalysisResultsMeansEnrichmentAll( results = results, design = design, dataInput = dataInput, @@ -486,7 +486,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsEnrichmentFisherR6$new(design = design, dataInput = dataInput) + results <- AnalysisResultsEnrichmentFisher$new(design = design, dataInput = dataInput) .setValueAndParameterType(results, "iterations", as.integer(iterations), C_ITERATIONS_DEFAULT) .setValueAndParameterType(results, "seed", seed, NA_real_) @@ -965,7 +965,7 @@ NULL assumedStDevs <- stDevsH1 } - results <- ConditionalPowerResultsEnrichmentMeansR6$new( + results <- ConditionalPowerResultsEnrichmentMeans$new( .design = design, .stageResults = stageResults, thetaH1 = thetaH1, @@ -1291,7 +1291,7 @@ NULL stdErr <- stageResults$overallStDevs[stage] * sqrt(1 / stageResults$.overallSampleSizes1[, stage] + 1 / stageResults$.overallSampleSizes2[, stage]) - results <- ConditionalPowerResultsEnrichmentMeansR6$new( + results <- ConditionalPowerResultsEnrichmentMeans$new( .design = design, .stageResults = stageResults, assumedStDevs = assumedStDevs, diff --git a/R/f_analysis_enrichment_rates.R b/R/f_analysis_enrichment_rates.R index 3f71dddd..0e3df259 100644 --- a/R/f_analysis_enrichment_rates.R +++ b/R/f_analysis_enrichment_rates.R @@ -234,7 +234,7 @@ NULL ) } - stageResults <- StageResultsEnrichmentRatesR6$new( + stageResults <- StageResultsEnrichmentRates$new( design = design, dataInput = dataInput, thetaH0 = thetaH0, @@ -391,7 +391,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsEnrichmentInverseNormalR6$new(design = design, dataInput = dataInput) + results <- AnalysisResultsEnrichmentInverseNormal$new(design = design, dataInput = dataInput) results <- .getAnalysisResultsRatesEnrichmentAll( results = results, design = design, dataInput = dataInput, @@ -428,7 +428,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsEnrichmentFisherR6$new(design = design, dataInput = dataInput) + results <- AnalysisResultsEnrichmentFisher$new(design = design, dataInput = dataInput) .setValueAndParameterType(results, "iterations", as.integer(iterations), C_ITERATIONS_DEFAULT) .setValueAndParameterType(results, "seed", seed, NA_real_) @@ -825,7 +825,7 @@ NULL piControl <- piControlH1 } - results <- ConditionalPowerResultsEnrichmentRatesR6$new( + results <- ConditionalPowerResultsEnrichmentRates$new( .design = design, .stageResults = stageResults, piControls = piControls, @@ -1165,7 +1165,7 @@ NULL stdErr <- sqrt(stageResults$overallPisTreatment[, stage] * (1 - stageResults$overallPisTreatment[, stage])) / sqrt(stageResults$.overallSampleSizes2[, stage]) - results <- ConditionalPowerResultsEnrichmentRatesR6$new( + results <- ConditionalPowerResultsEnrichmentRates$new( .design = design, .stageResults = stageResults, piControls = piControls, diff --git a/R/f_analysis_enrichment_survival.R b/R/f_analysis_enrichment_survival.R index a71adfda..f9913aa5 100644 --- a/R/f_analysis_enrichment_survival.R +++ b/R/f_analysis_enrichment_survival.R @@ -173,7 +173,7 @@ NULL ) } - stageResults <- StageResultsEnrichmentSurvivalR6$new( + stageResults <- StageResultsEnrichmentSurvival$new( design = design, dataInput = dataInput, intersectionTest = intersectionTest, @@ -335,7 +335,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsEnrichmentInverseNormalR6$new(design = design, dataInput = dataInput) + results <- AnalysisResultsEnrichmentInverseNormal$new(design = design, dataInput = dataInput) results <- .getAnalysisResultsSurvivalEnrichmentAll( results = results, design = design, dataInput = dataInput, @@ -373,7 +373,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsEnrichmentFisherR6$new(design = design, dataInput = dataInput) + results <- AnalysisResultsEnrichmentFisher$new(design = design, dataInput = dataInput) .setValueAndParameterType(results, "iterations", as.integer(iterations), C_ITERATIONS_DEFAULT) .setValueAndParameterType(results, "seed", seed, NA_real_) @@ -781,7 +781,7 @@ NULL gMax <- stageResults$getGMax() kMax <- design$kMax - results <- ConditionalPowerResultsEnrichmentSurvivalR6$new( + results <- ConditionalPowerResultsEnrichmentSurvival$new( .design = design, .stageResults = stageResults, thetaH1 = thetaH1, diff --git a/R/f_analysis_multiarm.R b/R/f_analysis_multiarm.R index 265e1d6f..401cdca2 100644 --- a/R/f_analysis_multiarm.R +++ b/R/f_analysis_multiarm.R @@ -426,7 +426,7 @@ getClosedCombinationTestResults <- function(stageResults) { .assertIsTrialDesignInverseNormalOrFisher(stageResults$.design) result <- .performClosedCombinationTest(stageResults = stageResults) - return(ClosedCombinationTestResultsR6$new( + return(ClosedCombinationTestResults$new( .design = result$.design, .enrichment = grepl("Enrichment", .getClassName(stageResults)), intersectionTest = result$intersectionTest, @@ -683,7 +683,7 @@ getClosedConditionalDunnettTestResults <- function(stageResults, ..., stage = st .assertIsTrialDesignConditionalDunnett(design) result <- .getClosedConditionalDunnettTestResults(stageResults = stageResults, design = design, stage = stage) - return(ClosedCombinationTestResultsR6$new( + return(ClosedCombinationTestResults$new( .design = result$.design, .enrichment = grepl("Enrichment", .getClassName(stageResults)), intersectionTest = result$intersectionTest, diff --git a/R/f_analysis_multiarm_means.R b/R/f_analysis_multiarm_means.R index b3abac04..d995c239 100644 --- a/R/f_analysis_multiarm_means.R +++ b/R/f_analysis_multiarm_means.R @@ -59,7 +59,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsMultiArmInverseNormalR6$new(design = design, dataInput = dataInput) + results <- AnalysisResultsMultiArmInverseNormal$new(design = design, dataInput = dataInput) results <- .getAnalysisResultsMeansMultiArmAll( results = results, design = design, dataInput = dataInput, @@ -97,7 +97,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsMultiArmFisherR6$new(design = design, dataInput = dataInput) + results <- AnalysisResultsMultiArmFisher$new(design = design, dataInput = dataInput) results <- .getAnalysisResultsMeansMultiArmAll( results = results, design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, directionUpper = directionUpper, @@ -133,7 +133,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsConditionalDunnettR6$new(design = design, dataInput = dataInput) + results <- AnalysisResultsConditionalDunnett$new(design = design, dataInput = dataInput) results <- .getAnalysisResultsMeansMultiArmAll( results = results, design = design, @@ -327,7 +327,7 @@ NULL select 'varianceOption' = \"overallPooled\"", call. = FALSE) } - stageResults <- StageResultsMultiArmMeansR6$new( + stageResults <- StageResultsMultiArmMeans$new( design = design, dataInput = dataInput, thetaH0 = thetaH0, @@ -1001,7 +1001,7 @@ NULL gMax <- stageResults$getGMax() kMax <- design$kMax - results <- ConditionalPowerResultsMultiArmMeansR6$new( + results <- ConditionalPowerResultsMultiArmMeans$new( .design = design, .stageResults = stageResults, thetaH1 = thetaH1, @@ -1380,7 +1380,7 @@ NULL sqrt(1 / stageResults$.dataInput$getOverallSampleSizes(stage = stage, group = gMax + 1) + 1 / stageResults$.dataInput$getOverallSampleSizes(stage = stage, group = (1:gMax))) - results <- ConditionalPowerResultsMultiArmMeansR6$new( + results <- ConditionalPowerResultsMultiArmMeans$new( .design = design, .stageResults = stageResults, assumedStDevs = assumedStDevs, diff --git a/R/f_analysis_multiarm_rates.R b/R/f_analysis_multiarm_rates.R index 17c5cffb..3cd7cff1 100644 --- a/R/f_analysis_multiarm_rates.R +++ b/R/f_analysis_multiarm_rates.R @@ -80,7 +80,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsMultiArmInverseNormalR6$new(design = design, dataInput = dataInput) + results <- AnalysisResultsMultiArmInverseNormal$new(design = design, dataInput = dataInput) results <- .getAnalysisResultsRatesMultiArmAll( results = results, design = design, dataInput = dataInput, @@ -115,7 +115,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsMultiArmFisherR6$new(design = design, dataInput = dataInput) + results <- AnalysisResultsMultiArmFisher$new(design = design, dataInput = dataInput) results <- .getAnalysisResultsRatesMultiArmAll( results = results, design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, directionUpper = directionUpper, @@ -147,7 +147,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsConditionalDunnettR6$new(design = design, dataInput = dataInput) + results <- AnalysisResultsConditionalDunnett$new(design = design, dataInput = dataInput) results <- .getAnalysisResultsRatesMultiArmAll( results = results, design = design, @@ -328,7 +328,7 @@ NULL ) } - stageResults <- StageResultsMultiArmRatesR6$new( + stageResults <- StageResultsMultiArmRates$new( design = design, dataInput = dataInput, intersectionTest = intersectionTest, @@ -923,7 +923,7 @@ NULL piControl <- piControlH1 } - results <- ConditionalPowerResultsMultiArmRatesR6$new( + results <- ConditionalPowerResultsMultiArmRates$new( .design = design, .stageResults = stageResults, piControl = piControl, @@ -1331,7 +1331,7 @@ NULL stdErr <- sqrt(stageResults$overallPiTreatments[, stage] * (1 - stageResults$overallPiTreatments[, stage])) / sqrt(stageResults$.dataInput$getOverallSampleSizes(stage = stage, group = (1:gMax))) - results <- ConditionalPowerResultsMultiArmRatesR6$new( + results <- ConditionalPowerResultsMultiArmRates$new( .design = design, .stageResults = stageResults, piControl = piControl, diff --git a/R/f_analysis_multiarm_survival.R b/R/f_analysis_multiarm_survival.R index ad99d895..2d895294 100644 --- a/R/f_analysis_multiarm_survival.R +++ b/R/f_analysis_multiarm_survival.R @@ -79,7 +79,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsMultiArmInverseNormalR6$new(design = design, dataInput = dataInput) + results <- AnalysisResultsMultiArmInverseNormal$new(design = design, dataInput = dataInput) results <- .getAnalysisResultsSurvivalMultiArmAll( results = results, design = design, dataInput = dataInput, @@ -113,7 +113,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsMultiArmFisherR6$new(design = design, dataInput = dataInput) + results <- AnalysisResultsMultiArmFisher$new(design = design, dataInput = dataInput) results <- .getAnalysisResultsSurvivalMultiArmAll( results = results, design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, directionUpper = directionUpper, @@ -145,7 +145,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsConditionalDunnettR6$new(design = design, dataInput = dataInput) + results <- AnalysisResultsConditionalDunnett$new(design = design, dataInput = dataInput) results <- .getAnalysisResultsSurvivalMultiArmAll( results = results, design = design, @@ -286,7 +286,7 @@ NULL ) .assertIsValidIntersectionTestMultiArm(design, intersectionTest) - stageResults <- StageResultsMultiArmSurvivalR6$new( + stageResults <- StageResultsMultiArmSurvival$new( design = design, dataInput = dataInput, intersectionTest = intersectionTest, @@ -801,7 +801,7 @@ NULL gMax <- stageResults$getGMax() kMax <- design$kMax - results <- ConditionalPowerResultsMultiArmSurvivalR6$new( + results <- ConditionalPowerResultsMultiArmSurvival$new( .design = design, .stageResults = stageResults, thetaH1 = thetaH1, @@ -1144,7 +1144,7 @@ NULL stdErr <- 2 / sqrt(stageResults$.dataInput$getOverallEvents(stage = stage, group = (1:gMax))) - results <- ConditionalPowerResultsMultiArmSurvivalR6$new( + results <- ConditionalPowerResultsMultiArmSurvival$new( .design = design, .stageResults = stageResults, nPlanned = nPlanned, diff --git a/R/f_core_assertions.R b/R/f_core_assertions.R index 84f99389..69f8707a 100644 --- a/R/f_core_assertions.R +++ b/R/f_core_assertions.R @@ -39,7 +39,7 @@ NULL } .isParameterSet <- function(x) { - return((isS4(x) || R6::is.R6(x)) && (inherits(x, "ParameterSet") || inherits(x, "ParameterSetR6"))) + return((isS4(x) || R6::is.R6(x)) && (inherits(x, "ParameterSet") || inherits(x, "ParameterSet"))) } .assertIsParameterSetClass <- function(x, objectName = "x") { @@ -61,23 +61,23 @@ NULL } .isTrialDesignSet <- function(x) { - return(.getClassName(x) == "TrialDesignSet" || .getClassName(x) == "TrialDesignSetR6") + return(.getClassName(x) == "TrialDesignSet" || .getClassName(x) == "TrialDesignSet") } .isTrialDesignGroupSequential <- function(design) { - return(.getClassName(design) == C_CLASS_NAME_TRIAL_DESIGN_GROUP_SEQUENTIAL || .getClassName(design) == "TrialDesignGroupSequentialR6") + return(.getClassName(design) == C_CLASS_NAME_TRIAL_DESIGN_GROUP_SEQUENTIAL || .getClassName(design) == "TrialDesignGroupSequential") } .isTrialDesignInverseNormal <- function(design) { - return(.getClassName(design) == C_CLASS_NAME_TRIAL_DESIGN_INVERSE_NORMAL || .getClassName(design) == "TrialDesignInverseNormalR6") + return(.getClassName(design) == C_CLASS_NAME_TRIAL_DESIGN_INVERSE_NORMAL || .getClassName(design) == "TrialDesignInverseNormal") } .isTrialDesignFisher <- function(design) { - return(.getClassName(design) == C_CLASS_NAME_TRIAL_DESIGN_FISHER || .getClassName(design) == "TrialDesignFisherR6") + return(.getClassName(design) == C_CLASS_NAME_TRIAL_DESIGN_FISHER || .getClassName(design) == "TrialDesignFisher") } .isTrialDesignConditionalDunnett <- function(design) { - return(.getClassName(design) == C_CLASS_NAME_TRIAL_DESIGN_CONDITIONAL_DUNNETT || .getClassName(design) == "TrialDesignConditionalDunnettR6") + return(.getClassName(design) == C_CLASS_NAME_TRIAL_DESIGN_CONDITIONAL_DUNNETT || .getClassName(design) == "TrialDesignConditionalDunnett") } .isTrialDesignInverseNormalOrGroupSequential <- function(design) { @@ -94,15 +94,15 @@ NULL } .isTrialDesignPlanMeans <- function(designPlan) { - return(.getClassName(designPlan) == "TrialDesignPlanMeans" || .getClassName(designPlan) == "TrialDesignPlanMeansR6") + return(.getClassName(designPlan) == "TrialDesignPlanMeans" || .getClassName(designPlan) == "TrialDesignPlanMeans") } .isTrialDesignPlanRates <- function(designPlan) { - return(.getClassName(designPlan) == "TrialDesignPlanRates" || .getClassName(designPlan) == "TrialDesignPlanRatesR6") + return(.getClassName(designPlan) == "TrialDesignPlanRates" || .getClassName(designPlan) == "TrialDesignPlanRates") } .isTrialDesignPlanSurvival <- function(designPlan) { - return(.getClassName(designPlan) == "TrialDesignPlanSurvival" || .getClassName(designPlan) == "TrialDesignPlanSurvivalR6") + return(.getClassName(designPlan) == "TrialDesignPlanSurvival" || .getClassName(designPlan) == "TrialDesignPlanSurvival") } .isTrialDesignPlan <- function(designPlan) { @@ -197,7 +197,7 @@ NULL } .isSimulationResults <- function(simulationResults) { - return(inherits(simulationResults, "SimulationResults") || inherits(simulationResults, "SimulationResultsR6")) + return(inherits(simulationResults, "SimulationResults") || inherits(simulationResults, "SimulationResults")) } .assertIsSimulationResults <- function(simulationResults) { @@ -210,23 +210,23 @@ NULL } .isStageResults <- function(stageResults) { - return(inherits(stageResults, "StageResults") || inherits(stageResults, "StageResultsR6")) + return(inherits(stageResults, "StageResults") || inherits(stageResults, "StageResults")) } .isStageResultsMultiArmMeans <- function(stageResults) { - return(.getClassName(stageResults) == "StageResultsMultiArmMeans" || .getClassName(stageResults) == "StageResultsMultiArmMeansR6") + return(.getClassName(stageResults) == "StageResultsMultiArmMeans" || .getClassName(stageResults) == "StageResultsMultiArmMeans") } .isStageResultsMultiArmSurvival <- function(stageResults) { - return(.getClassName(stageResults) == "StageResultsMultiArmSurvival" || .getClassName(stageResults) == "StageResultsMultiArmSurvivalR6") + return(.getClassName(stageResults) == "StageResultsMultiArmSurvival" || .getClassName(stageResults) == "StageResultsMultiArmSurvival") } .isStageResultsEnrichmentMeans <- function(stageResults) { - return(.getClassName(stageResults) == "StageResultsEnrichmentMeans" || .getClassName(stageResults) == "StageResultsEnrichmentMeansR6") + return(.getClassName(stageResults) == "StageResultsEnrichmentMeans" || .getClassName(stageResults) == "StageResultsEnrichmentMeans") } .isStageResultsEnrichmentSurvival <- function(stageResults) { - return(.getClassName(stageResults) == "StageResultsEnrichmentSurvival" || .getClassName(stageResults) == "StageResultsEnrichmentSurvivalR6") + return(.getClassName(stageResults) == "StageResultsEnrichmentSurvival" || .getClassName(stageResults) == "StageResultsEnrichmentSurvival") } .assertIsStageResults <- function(stageResults) { @@ -447,15 +447,15 @@ NULL } .isDatasetMeans <- function(dataInput) { - return(inherits(dataInput, "DatasetMeans") || inherits(dataInput, "DatasetMeansR6")) + return(inherits(dataInput, "DatasetMeans") || inherits(dataInput, "DatasetMeans")) } .isDatasetRates <- function(dataInput) { - return(inherits(dataInput, "DatasetRates") || inherits(dataInput, "DatasetRatesR6")) + return(inherits(dataInput, "DatasetRates") || inherits(dataInput, "DatasetRates")) } .isDatasetSurvival <- function(dataInput) { - return(inherits(dataInput, "DatasetSurvival") || inherits(dataInput, "DatasetSurvivalR6") || inherits(dataInput, "DatasetEnrichmentSurvival") || inherits(dataInput, "DatasetEnrichmentSurvivalR6")) + return(inherits(dataInput, "DatasetSurvival") || inherits(dataInput, "DatasetSurvival") || inherits(dataInput, "DatasetEnrichmentSurvival") || inherits(dataInput, "DatasetEnrichmentSurvival")) } .assertIsNumericVector <- function(x, argumentName, ..., naAllowed = FALSE, noDefaultAvailable = FALSE, call. = TRUE) { @@ -1340,7 +1340,7 @@ NULL for (i in 1:length(args)) { arg <- args[[i]] argName <- ifelse(is.null(argNames[i]) || argNames[i] == "", - ifelse(inherits(arg, "StageResults") || inherits(arg, "StageResultsR6"), "stageResultsName", paste0("%param", i, "%")), + ifelse(inherits(arg, "StageResults") || inherits(arg, "StageResults"), "stageResultsName", paste0("%param", i, "%")), argNames[i] ) if (!(argName %in% ignore) && !grepl("^\\.", argName)) { @@ -2146,24 +2146,24 @@ NULL } .isMultiArmDataset <- function(dataInput) { - return((inherits(dataInput, "Dataset") || inherits(dataInput, "DatasetR6")) && dataInput$getNumberOfGroups() > 2) + return((inherits(dataInput, "Dataset") || inherits(dataInput, "Dataset")) && dataInput$getNumberOfGroups() > 2) } .isMultiArmStageResults <- function(stageResults) { - return((inherits(stageResults, "StageResults") || inherits(stageResults, "StageResultsR6")) && grepl("MultiArm", .getClassName(stageResults))) + return((inherits(stageResults, "StageResults") || inherits(stageResults, "StageResults")) && grepl("MultiArm", .getClassName(stageResults))) } .isEnrichmentStageResults <- function(stageResults) { - return((inherits(stageResults, "StageResults") || inherits(stageResults, "StageResultsR6")) && grepl("Enrichment", .getClassName(stageResults))) + return((inherits(stageResults, "StageResults") || inherits(stageResults, "StageResults")) && grepl("Enrichment", .getClassName(stageResults))) } .isEnrichmentConditionalPowerResults <- function(conditionalPowerResults) { - return((inherits(conditionalPowerResults, "ConditionalPowerResults") || inherits(conditionalPowerResults, "ConditionalPowerResultsR6")) && + return((inherits(conditionalPowerResults, "ConditionalPowerResults") || inherits(conditionalPowerResults, "ConditionalPowerResults")) && grepl("Enrichment", .getClassName(conditionalPowerResults))) } .isMultiArmAnalysisResults <- function(analysisResults) { - return((inherits(analysisResults, "AnalysisResultsMultiArm") || inherits(analysisResults, "AnalysisResultsMultiArmR6"))) + return((inherits(analysisResults, "AnalysisResultsMultiArm") || inherits(analysisResults, "AnalysisResultsMultiArm"))) } .isMultiHypothesesAnalysisResults <- function(x) { @@ -2171,23 +2171,23 @@ NULL } .isEnrichmentDataset <- function(dataInput) { - return((inherits(dataInput, "Dataset") || inherits(dataInput, "DatasetR6")) && dataInput$.enrichmentEnabled) + return((inherits(dataInput, "Dataset") || inherits(dataInput, "Dataset")) && dataInput$.enrichmentEnabled) } .isEnrichmentAnalysisResults <- function(analysisResults) { - return(inherits(analysisResults, "AnalysisResultsEnrichment") || inherits(analysisResults, "AnalysisResultsEnrichmentR6")) + return(inherits(analysisResults, "AnalysisResultsEnrichment") || inherits(analysisResults, "AnalysisResultsEnrichment")) } .isMultiArmSimulationResults <- function(simulationResults) { - return((inherits(simulationResults, "SimulationResults") || inherits(simulationResults, "SimulationResultsR6")) && grepl("MultiArm", .getClassName(simulationResults))) + return((inherits(simulationResults, "SimulationResults") || inherits(simulationResults, "SimulationResults")) && grepl("MultiArm", .getClassName(simulationResults))) } .isEnrichmentSimulationResults <- function(simulationResults) { - return((inherits(simulationResults, "SimulationResults") || inherits(simulationResults, "SimulationResultsR6")) && grepl("Enrichment", .getClassName(simulationResults))) + return((inherits(simulationResults, "SimulationResults") || inherits(simulationResults, "SimulationResults")) && grepl("Enrichment", .getClassName(simulationResults))) } .assertIsStageResultsMultiArm <- function(stageResults) { - if (!(inherits(stageResults, "StageResults") || inherits(stageResults, "StageResultsR6"))) { + if (!(inherits(stageResults, "StageResults") || inherits(stageResults, "StageResults"))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'stageResults' must be a multi-arm stage results object (is ", .getClassName(stageResults), ")" @@ -2203,14 +2203,14 @@ NULL } .assertIsStageResultsNonMultiHypotheses <- function(stageResults) { - if ((inherits(stageResults, "StageResults") || inherits(stageResults, "StageResultsR6")) && .isMultiArmStageResults(stageResults)) { + if ((inherits(stageResults, "StageResults") || inherits(stageResults, "StageResults")) && .isMultiArmStageResults(stageResults)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'stageResults' must be a non-multi-arm object (is ", .getClassName(stageResults), ")" ) } - if ((inherits(stageResults, "StageResults") || inherits(stageResults, "StageResultsR6")) && .isEnrichmentStageResults(stageResults)) { + if ((inherits(stageResults, "StageResults") || inherits(stageResults, "StageResults")) && .isEnrichmentStageResults(stageResults)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'stageResults' must be a non-enrichment object (is ", .getClassName(stageResults), ")" @@ -2221,9 +2221,9 @@ NULL "StageResultsMeans", "StageResultsRates", "StageResultsSurvival", - "StageResultsMeansR6", - "StageResultsRatesR6", - "StageResultsSurvivalR6" + "StageResultsMeans", + "StageResultsRates", + "StageResultsSurvival" ) if (!(.getClassName(stageResults) %in% allowedClasses)) { stop( @@ -2250,7 +2250,7 @@ NULL } .assertIsAnalysisResults <- function(analysisResults) { - if (!(inherits(analysisResults, "AnalysisResults") || inherits(analysisResults, "AnalysisResultsR6"))) { + if (!(inherits(analysisResults, "AnalysisResults") || inherits(analysisResults, "AnalysisResults"))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'analysisResults' must be a valid 'AnalysisResults' object ", " (is '", .getClassName(analysisResults), "')" diff --git a/R/f_core_constants.R b/R/f_core_constants.R index ca96ac42..1f30350b 100644 --- a/R/f_core_constants.R +++ b/R/f_core_constants.R @@ -1025,7 +1025,7 @@ C_TABLE_COLUMN_NAMES <- list( parameterNames$futilityBounds <- captionList[[parameterNameFutilityBounds]] } - if (!is.null(designPlan) && (inherits(designPlan, "TrialDesignPlanSurvival") || inherits(designPlan, "TrialDesignPlanSurvivalR6")) && + if (!is.null(designPlan) && (inherits(designPlan, "TrialDesignPlanSurvival") || inherits(designPlan, "TrialDesignPlanSurvival")) && !is.null(designPlan$.piecewiseSurvivalTime) && designPlan$.piecewiseSurvivalTime$piecewiseSurvivalEnabled) { parameterNames$lambda2 <- "Piecewise survival lambda (2)" @@ -1033,12 +1033,12 @@ C_TABLE_COLUMN_NAMES <- list( } if (!is.null(designPlan) && - (inherits(designPlan, "TrialDesignPlanSurvival") || inherits(designPlan, "TrialDesignPlanSurvivalR6")) && + (inherits(designPlan, "TrialDesignPlanSurvival") || inherits(designPlan, "TrialDesignPlanSurvival")) && identical(designPlan$.design$kMax, 1L)) { parameterNames$maxNumberOfEvents <- "Number of events" } - if (!is.null(designPlan) && (inherits(designPlan, "TrialDesignPlan") || inherits(designPlan, "TrialDesignPlanR6")) && + if (!is.null(designPlan) && (inherits(designPlan, "TrialDesignPlan") || inherits(designPlan, "TrialDesignPlan")) && identical(designPlan$.design$kMax, 1L)) { parameterNames$studyDuration <- "Study duration" } @@ -1059,8 +1059,8 @@ C_TABLE_COLUMN_NAMES <- list( } if (!is.null(designPlan) && - ((inherits(designPlan, "TrialDesignPlanMeans") || inherits(designPlan, "TrialDesignPlanMeansR6")) || - (inherits(designPlan, "SimulationResultsMeans") || inherits(designPlan, "SimulationResultsMeansR6"))) && + ((inherits(designPlan, "TrialDesignPlanMeans") || inherits(designPlan, "TrialDesignPlanMeans")) || + (inherits(designPlan, "SimulationResultsMeans") || inherits(designPlan, "SimulationResultsMeans"))) && isTRUE(designPlan$meanRatio)) { parameterNames$stDev <- "Coefficient of variation" } diff --git a/R/f_core_plot.R b/R/f_core_plot.R index 599bc86c..912fdb14 100644 --- a/R/f_core_plot.R +++ b/R/f_core_plot.R @@ -36,7 +36,7 @@ NULL .assertIsSingleInteger(type, "type", validateType = FALSE) - if (inherits(obj, "TrialDesignPlan") || inherits(obj, "TrialDesignPlanR6")) { + if (inherits(obj, "TrialDesignPlan") || inherits(obj, "TrialDesignPlan")) { if (type == 1) { if (.isTrialDesignPlanSurvival(obj)) { return(.addNumberToPlotCaption("Boundaries Z Scale", type, numberInCaptionEnabled)) @@ -76,11 +76,11 @@ NULL "Rejected Populations per Stage", "Rejected Populations" ), type, numberInCaptionEnabled)) } - } else if ((inherits(obj, "SimulationResults") || inherits(obj, "SimulationResultsR6")) && type == 4) { + } else if ((inherits(obj, "SimulationResults") || inherits(obj, "SimulationResults")) && type == 4) { return(.addNumberToPlotCaption("Reject per Stage", type, numberInCaptionEnabled)) } - if (inherits(obj, "TrialDesignPlan") || inherits(obj, "TrialDesignPlanR6") || inherits(obj, "SimulationResults") || inherits(obj, "SimulationResultsR6")) { + if (inherits(obj, "TrialDesignPlan") || inherits(obj, "TrialDesignPlan") || inherits(obj, "SimulationResults") || inherits(obj, "SimulationResults")) { if (type == 5) { if (obj$.isSampleSizeObject()) { return(.addNumberToPlotCaption("Sample Size", type, numberInCaptionEnabled)) @@ -92,7 +92,7 @@ NULL } } else if (type == 6) { return(.addNumberToPlotCaption(ifelse(.isTrialDesignPlanSurvival(obj) || - inherits(obj, "SimulationResultsSurvival") || inherits(obj, "SimulationResultsSurvivalR6"), + inherits(obj, "SimulationResultsSurvival") || inherits(obj, "SimulationResultsSurvival"), "Number of Events", "Sample Size" ), type, numberInCaptionEnabled)) } else if (type == 7) { @@ -101,7 +101,7 @@ NULL return(.addNumberToPlotCaption("Overall Early Stopping", type, numberInCaptionEnabled)) } else if (type == 9) { if (.isTrialDesignPlanSurvival(obj) || - inherits(obj, "SimulationResultsSurvival") || inherits(obj, "SimulationResultsSurvivalR6")) { + inherits(obj, "SimulationResultsSurvival") || inherits(obj, "SimulationResultsSurvival")) { return(.addNumberToPlotCaption("Expected Number of Events", type, numberInCaptionEnabled)) } else { return(.addNumberToPlotCaption("Expected Sample Size", type, numberInCaptionEnabled)) @@ -117,7 +117,7 @@ NULL } else if (type == 14) { return(.addNumberToPlotCaption("Survival Function", type, numberInCaptionEnabled)) } - } else if (inherits(obj, "TrialDesign") || inherits(obj, "TrialDesignSet") || inherits(obj, "TrialDesignR6") || inherits(obj, "TrialDesignSetR6")) { + } else if (inherits(obj, "TrialDesign") || inherits(obj, "TrialDesignSet") || inherits(obj, "TrialDesign") || inherits(obj, "TrialDesignSet")) { if (type == 1) { return(.addNumberToPlotCaption("Boundaries", type, numberInCaptionEnabled)) } else if (type == 3) { @@ -138,7 +138,7 @@ NULL } else if (type == 9) { return(.addNumberToPlotCaption("Average Sample Size", type, numberInCaptionEnabled)) } - } else if (inherits(obj, "AnalysisResults") || inherits(obj, "AnalysisResultsR6")) { + } else if (inherits(obj, "AnalysisResults") || inherits(obj, "AnalysisResults")) { if (type == 1) { return(.addNumberToPlotCaption(C_PLOT_MAIN_CONDITIONAL_POWER_WITH_LIKELIHOOD, type, numberInCaptionEnabled)) } else if (type == 2) { @@ -399,7 +399,7 @@ getAvailablePlotTypes <- function(obj, output = c("numeric", "caption", "numcap" } types <- integer(0) - if (inherits(obj, "TrialDesignPlan") || inherits(obj, "TrialDesignPlanR6")) { + if (inherits(obj, "TrialDesignPlan") || inherits(obj, "TrialDesignPlan")) { if (obj$.design$kMax > 1) { types <- c(types, 1:4) } @@ -415,7 +415,7 @@ getAvailablePlotTypes <- function(obj, output = c("numeric", "caption", "numcap" } } types <- .removeInvalidPlotTypes(obj, types, c(5:14)) - } else if (inherits(obj, "SimulationResults") || inherits(obj, "SimulationResultsR6")) { + } else if (inherits(obj, "SimulationResults") || inherits(obj, "SimulationResults")) { if (grepl("Enrichment", .getClassName(obj)) && !.getSimulationEnrichmentEffectData( obj, validatePlotCapability = FALSE @@ -446,7 +446,7 @@ getAvailablePlotTypes <- function(obj, output = c("numeric", "caption", "numcap" if (!grepl("MultiArm", .getClassName(obj)) || obj$.design$kMax > 1) { types <- c(types, 9) } - if (inherits(obj, "SimulationResultsSurvival") || inherits(obj, "SimulationResultsSurvivalR6")) { + if (inherits(obj, "SimulationResultsSurvival") || inherits(obj, "SimulationResultsSurvival")) { types <- c(types, 10:14) } plotTypesToCheck <- c(4:14) @@ -454,9 +454,9 @@ getAvailablePlotTypes <- function(obj, output = c("numeric", "caption", "numcap" plotTypesToCheck <- c(1:14) } types <- .removeInvalidPlotTypes(obj, types, plotTypesToCheck) - } else if (inherits(obj, "TrialDesign") || inherits(obj, "TrialDesignR6") || inherits(obj, "TrialDesignSet") || inherits(obj, "TrialDesignSetR6")) { + } else if (inherits(obj, "TrialDesign") || inherits(obj, "TrialDesign") || inherits(obj, "TrialDesignSet") || inherits(obj, "TrialDesignSet")) { design <- obj - if (inherits(obj, "TrialDesignSet") || inherits(obj, "TrialDesignSetR6")) { + if (inherits(obj, "TrialDesignSet") || inherits(obj, "TrialDesignSet")) { design <- obj$getDesignMaster() } if (design$kMax > 1) { @@ -710,7 +710,7 @@ getAvailablePlotTypes <- function(obj, output = c("numeric", "caption", "numcap" ) } - if (inherits(parameterSet, "TrialDesignSet") || inherits(parameterSet, "TrialDesignSetR6")) { + if (inherits(parameterSet, "TrialDesignSet") || inherits(parameterSet, "TrialDesignSet")) { suppressWarnings(data <- as.data.frame(parameterSet, niceColumnNamesEnabled = FALSE, includeAllParameters = TRUE, @@ -842,12 +842,12 @@ getAvailablePlotTypes <- function(obj, output = c("numeric", "caption", "numcap" ) } } - if (is.null(plotSettings) || !inherits(plotSettings, "PlotSettingsR6")) { + if (is.null(plotSettings) || !inherits(plotSettings, "PlotSettings")) { plotSettings <- parameterSet$getPlotSettings() } } else { - if (is.null(plotSettings) || !inherits(plotSettings, "PlotSettingsR6")) { - plotSettings <- PlotSettingsR6$new() + if (is.null(plotSettings) || !inherits(plotSettings, "PlotSettings")) { + plotSettings <- PlotSettings$new() } } @@ -1235,7 +1235,7 @@ getAvailablePlotTypes <- function(obj, output = c("numeric", "caption", "numcap" } if (is.null(plotSettings)) { - plotSettings <- PlotSettingsR6$new() + plotSettings <- PlotSettings$new() } nRow <- nrow(data) @@ -1592,7 +1592,7 @@ saveLastPlot <- function(filename, outputPath = .getRelativeFigureOutputPath()) plotSettings <- x$.plotSettings if (is.null(plotSettings)) { - plotSettings <- PlotSettingsR6$new() + plotSettings <- PlotSettings$new() } else { plotSettings <- plotSettings$clone() } diff --git a/R/f_core_utilities.R b/R/f_core_utilities.R index 82c3936e..9ea1cf02 100644 --- a/R/f_core_utilities.R +++ b/R/f_core_utilities.R @@ -1043,10 +1043,10 @@ getParameterCaption <- function(obj, parameterName) { design <- NULL designPlan <- NULL - if (inherits(obj, "TrialDesignPlan") || inherits(obj, "TrialDesignPlanR6")) { + if (inherits(obj, "TrialDesignPlan") || inherits(obj, "TrialDesignPlan")) { designPlan <- obj design <- obj$.design - } else if (inherits(obj, "TrialDesign") || inherits(obj, "TrialDesignR6")) { + } else if (inherits(obj, "TrialDesign") || inherits(obj, "TrialDesign")) { design <- obj } else { design <- obj[[".design"]] @@ -1092,10 +1092,10 @@ getParameterName <- function(obj, parameterCaption) { design <- NULL designPlan <- NULL - if (inherits(obj, "TrialDesignPlan") || inherits(obj, "TrialDesignPlanR6")) { + if (inherits(obj, "TrialDesignPlan") || inherits(obj, "TrialDesignPlan")) { designPlan <- obj design <- obj$.design - } else if (inherits(obj, "TrialDesign") || inherits(obj, "TrialDesignR6")) { + } else if (inherits(obj, "TrialDesign") || inherits(obj, "TrialDesign")) { design <- obj } else { design <- obj[[".design"]] diff --git a/R/f_design_fisher_combination_test.R b/R/f_design_fisher_combination_test.R index 1121b165..79b46e31 100644 --- a/R/f_design_fisher_combination_test.R +++ b/R/f_design_fisher_combination_test.R @@ -145,7 +145,7 @@ getDesignFisher <- function(..., warning("'bindingFutility' (", bindingFutility, ") will be ignored", call. = FALSE) } - design <- TrialDesignFisherR6$new( + design <- TrialDesignFisher$new( kMax = kMax, alpha = alpha, method = method, @@ -329,6 +329,7 @@ getDesignFisher <- function(..., } if (!all(is.na(design$stageLevels)) && any(na.omit(design$stageLevels[1:(design$kMax - 1)]) > design$alpha)) { + print(design$tolerance) stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'alpha' (", design$alpha, ") not correctly specified" diff --git a/R/f_design_group_sequential.R b/R/f_design_group_sequential.R index 53987f6c..de32f213 100644 --- a/R/f_design_group_sequential.R +++ b/R/f_design_group_sequential.R @@ -324,12 +324,12 @@ getGroupSequentialProbabilities <- function(decisionMatrix, informationRates) { .assertIsInClosedInterval(delayedInformation, "delayedInformation", lower = 0, upper = NULL, naAllowed = TRUE) if (designClass == C_CLASS_NAME_TRIAL_DESIGN_INVERSE_NORMAL) { - design <- TrialDesignInverseNormalR6$new( + design <- TrialDesignInverseNormal$new( kMax = kMax, bindingFutility = bindingFutility, delayedInformation = delayedInformation ) } else if (designClass == C_CLASS_NAME_TRIAL_DESIGN_GROUP_SEQUENTIAL) { - design <- TrialDesignGroupSequentialR6$new( + design <- TrialDesignGroupSequential$new( kMax = kMax, bindingFutility = bindingFutility, delayedInformation = delayedInformation ) @@ -1768,7 +1768,7 @@ getDesignCharacteristics <- function(design = NULL, ...) { writeToDesign = FALSE, twoSidedWarningForDefaultValues = FALSE ) - designCharacteristics <- TrialDesignCharacteristicsR6$new(design = design) + designCharacteristics <- TrialDesignCharacteristics$new(design = design) designCharacteristics$rejectionProbabilities <- rep(NA_real_, design$kMax) designCharacteristics$.setParameterType("rejectionProbabilities", C_PARAM_NOT_APPLICABLE) @@ -2115,7 +2115,7 @@ getPowerAndAverageSampleNumber <- function(design, theta = seq(-1, 1, 0.02), nMa .assertIsTrialDesign(design) .assertIsSingleNumber(nMax, "nMax") .assertIsInClosedInterval(nMax, "nMax", lower = 1, upper = NULL) - return(PowerAndAverageSampleNumberResultR6$new(design = design, theta = theta, nMax = nMax)) + return(PowerAndAverageSampleNumberResult$new(design = design, theta = theta, nMax = nMax)) } .getSimulatedRejectionsDelayedResponse <- function(delta, informationRates, delayedInformation, diff --git a/R/f_design_sample_size_calculator.R b/R/f_design_sample_size_calculator.R index 3e784d50..d1bf5f6a 100644 --- a/R/f_design_sample_size_calculator.R +++ b/R/f_design_sample_size_calculator.R @@ -1366,7 +1366,7 @@ getSampleSizeSurvival <- function(design = NULL, ..., } .assertIsValidAllocationRatioPlannedSampleSize(allocationRatioPlanned, maxNumberOfSubjects) - designPlan <- TrialDesignPlanSurvivalR6$new( + designPlan <- TrialDesignPlanSurvival$new( design = design, typeOfComputation = typeOfComputation, thetaH0 = thetaH0, @@ -2936,7 +2936,7 @@ getEventProbabilities <- function(time, ..., stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all rates (lambda2) must be > 0") } - eventProbabilities <- EventProbabilitiesR6$new( + eventProbabilities <- EventProbabilities$new( .piecewiseSurvivalTime = setting, .accrualTime = accrualSetup, time = time, @@ -3102,7 +3102,7 @@ getNumberOfSubjects <- function(time, ..., accrualIntensity = accrualIntensity, maxNumberOfSubjects = maxNumberOfSubjects ) - result <- NumberOfSubjectsR6$new( + result <- NumberOfSubjects$new( .accrualTime = accrualSetup, time = time, accrualTime = accrualTime, @@ -3933,7 +3933,7 @@ getNumberOfSubjects <- function(time, ..., } } - designPlan <- TrialDesignPlanMeansR6$new(design = design, meanRatio = meanRatio) + designPlan <- TrialDesignPlanMeans$new(design = design, meanRatio = meanRatio) designPlan$.setSampleSizeObject(objectType) designPlan$criticalValuesPValueScale <- matrix(design$stageLevels, ncol = 1) @@ -4124,7 +4124,7 @@ getNumberOfSubjects <- function(time, ..., } } - designPlan <- TrialDesignPlanRatesR6$new(design = design) + designPlan <- TrialDesignPlanRates$new(design = design) designPlan$.setSampleSizeObject(objectType) designPlan$criticalValuesPValueScale <- matrix(design$stageLevels, ncol = 1) diff --git a/R/f_design_utilities.R b/R/f_design_utilities.R index 83eba71d..f91e40a6 100644 --- a/R/f_design_utilities.R +++ b/R/f_design_utilities.R @@ -642,7 +642,7 @@ NULL ) } - setting <- PiecewiseSurvivalTimeR6$new( + setting <- PiecewiseSurvivalTime$new( piecewiseSurvivalTime = piecewiseSurvivalTime, lambda2 = piecewiseLambda, hazardRatio = 1, kappa = kappa, @@ -1020,12 +1020,12 @@ getMedianByPi <- function(piValue, designParametersToShow <- c(designParametersToShow, ".design$stageLevels") } if (design$sided == 2 && !grepl("Analysis|Simulation", .getClassName(parameterSet)) && - (!(inherits(parameterSet, "TrialDesignPlan") || inherits(parameterSet, "TrialDesignPlanR6")) || parameterSet$.isSampleSizeObject())) { + (!(inherits(parameterSet, "TrialDesignPlan") || inherits(parameterSet, "TrialDesignPlan")) || parameterSet$.isSampleSizeObject())) { designParametersToShow <- c(designParametersToShow, ".design$twoSidedPower") } designParametersToShow <- c(designParametersToShow, ".design$alpha") if (!grepl("Analysis|Simulation", .getClassName(parameterSet)) && - (!(inherits(parameterSet, "TrialDesignPlan") || inherits(parameterSet, "TrialDesignPlanR6")) || parameterSet$.isSampleSizeObject())) { + (!(inherits(parameterSet, "TrialDesignPlan") || inherits(parameterSet, "TrialDesignPlan")) || parameterSet$.isSampleSizeObject())) { designParametersToShow <- c(designParametersToShow, ".design$beta") } diff --git a/R/f_object_r_code.R b/R/f_object_r_code.R index 7df3b150..f5ad0f4a 100644 --- a/R/f_object_r_code.R +++ b/R/f_object_r_code.R @@ -125,7 +125,7 @@ NULL } .getGeneratorFunctionName <- function(obj) { - if ("TrialDesignPlanMeans" == .getClassName(obj) || "TrialDesignPlanMeansR6" == .getClassName(obj)) { + if ("TrialDesignPlanMeans" == .getClassName(obj) || "TrialDesignPlanMeans" == .getClassName(obj)) { if (obj$.isSampleSizeObject()) { return("getSampleSizeMeans") } @@ -133,7 +133,7 @@ NULL return("getPowerMeans") } - if ("TrialDesignPlanRates" == .getClassName(obj) || "TrialDesignPlanRatesR6" == .getClassName(obj)) { + if ("TrialDesignPlanRates" == .getClassName(obj) || "TrialDesignPlanRates" == .getClassName(obj)) { if (obj$.isSampleSizeObject()) { return("getSampleSizeRates") } @@ -141,7 +141,7 @@ NULL return("getPowerRates") } - if ("TrialDesignPlanSurvival" == .getClassName(obj) || "TrialDesignPlanSurvivalR6" == .getClassName(obj)) { + if ("TrialDesignPlanSurvival" == .getClassName(obj) || "TrialDesignPlanSurvival" == .getClassName(obj)) { if (obj$.isSampleSizeObject()) { return("getSampleSizeSurvival") } @@ -149,95 +149,95 @@ NULL return("getPowerSurvival") } - if (inherits(obj, "TrialDesign") || inherits(obj, "TrialDesignR6")) { + if (inherits(obj, "TrialDesign") || inherits(obj, "TrialDesign")) { #TODO return(paste0("get", sub("^Trial", "", sub("R6","",.getClassName(obj))))) } - if (inherits(obj, "Dataset") || inherits(obj, "DatasetR6")) { + if (inherits(obj, "Dataset") || inherits(obj, "Dataset")) { return("getDataset") } - if (inherits(obj, "AnalysisResults") || inherits(obj, "AnalysisResultsR6")) { + if (inherits(obj, "AnalysisResults") || inherits(obj, "AnalysisResults")) { return("getAnalysisResults") } - if ("TrialDesignSet" == .getClassName(obj) || "TrialDesignSetR6" == .getClassName(obj)) { + if ("TrialDesignSet" == .getClassName(obj) || "TrialDesignSet" == .getClassName(obj)) { return("getDesignSet") } - if ("TrialDesignCharacteristics" == .getClassName(obj) || "TrialDesignCharacteristicsR6" == .getClassName(obj)) { + if ("TrialDesignCharacteristics" == .getClassName(obj) || "TrialDesignCharacteristics" == .getClassName(obj)) { return("getDesignCharacteristics") } - if (inherits(obj, "SimulationResultsMeans") || inherits(obj, "SimulationResultsMeansR6")) { + if (inherits(obj, "SimulationResultsMeans") || inherits(obj, "SimulationResultsMeans")) { return("getSimulationMeans") } - if (inherits(obj, "SimulationResultsRates") || inherits(obj, "SimulationResultsRatesR6")) { + if (inherits(obj, "SimulationResultsRates") || inherits(obj, "SimulationResultsRates")) { return("getSimulationRates") } - if (inherits(obj, "SimulationResultsSurvival") || inherits(obj, "SimulationResultsSurvivalR6")) { + if (inherits(obj, "SimulationResultsSurvival") || inherits(obj, "SimulationResultsSurvival")) { return("getSimulationSurvival") } - if (inherits(obj, "SimulationResultsMultiArmMeans") || inherits(obj, "SimulationResultsMultiArmMeansR6")) { + if (inherits(obj, "SimulationResultsMultiArmMeans") || inherits(obj, "SimulationResultsMultiArmMeans")) { return("getSimulationMultiArmMeans") } - if (inherits(obj, "SimulationResultsMultiArmRates") || inherits(obj, "SimulationResultsMultiArmRatesR6")) { + if (inherits(obj, "SimulationResultsMultiArmRates") || inherits(obj, "SimulationResultsMultiArmRates")) { return("getSimulationMultiArmRates") } - if (inherits(obj, "SimulationResultsMultiArmSurvival") || inherits(obj, "SimulationResultsMultiArmSurvivalR6")) { + if (inherits(obj, "SimulationResultsMultiArmSurvival") || inherits(obj, "SimulationResultsMultiArmSurvival")) { return("getSimulationMultiArmSurvival") } - if (inherits(obj, "SimulationResultsEnrichmentMeans") || inherits(obj, "SimulationResultsEnrichmentMeansR6")) { + if (inherits(obj, "SimulationResultsEnrichmentMeans") || inherits(obj, "SimulationResultsEnrichmentMeans")) { return("getSimulationEnrichmentMeans") } - if (inherits(obj, "SimulationResultsEnrichmentRates") || inherits(obj, "SimulationResultsEnrichmentRatesR6")) { + if (inherits(obj, "SimulationResultsEnrichmentRates") || inherits(obj, "SimulationResultsEnrichmentRates")) { return("getSimulationEnrichmentRates") } - if (inherits(obj, "SimulationResultsEnrichmentSurvival") || inherits(obj, "SimulationResultsEnrichmentSurvivalR6")) { + if (inherits(obj, "SimulationResultsEnrichmentSurvival") || inherits(obj, "SimulationResultsEnrichmentSurvival")) { return("getSimulationEnrichmentSurvival") } - if (inherits(obj, "PiecewiseSurvivalTime") || inherits(obj, "PiecewiseSurvivalTimeR6")) { + if (inherits(obj, "PiecewiseSurvivalTime") || inherits(obj, "PiecewiseSurvivalTime")) { return("getPiecewiseSurvivalTime") } - if (inherits(obj, "AccrualTime") || inherits(obj, "AccrualTimeR6")) { + if (inherits(obj, "AccrualTime") || inherits(obj, "AccrualTime")) { return("getAccrualTime") } - if (inherits(obj, "StageResults") || inherits(obj, "StageResultsR6")) { + if (inherits(obj, "StageResults") || inherits(obj, "StageResults")) { return("getStageResults") } - if (inherits(obj, "ConditionalPowerResults") || inherits(obj, "ConditionalPowerResultsR6")) { + if (inherits(obj, "ConditionalPowerResults") || inherits(obj, "ConditionalPowerResults")) { return("getConditionalPower") } - if (inherits(obj, "PowerAndAverageSampleNumberResult") || inherits(obj, "PowerAndAverageSampleNumberResultR6")) { + if (inherits(obj, "PowerAndAverageSampleNumberResult") || inherits(obj, "PowerAndAverageSampleNumberResult")) { return("getPowerAndAverageSampleNumber") } - if (inherits(obj, "EventProbabilities") || inherits(obj, "EventProbabilitiesR6")) { + if (inherits(obj, "EventProbabilities") || inherits(obj, "EventProbabilities")) { return("getEventProbabilities") } - if (inherits(obj, "NumberOfSubjects") || inherits(obj, "NumberOfSubjectsR6")) { + if (inherits(obj, "NumberOfSubjects") || inherits(obj, "NumberOfSubjects")) { return("getNumberOfSubjects") } - if (inherits(obj, "PerformanceScore") || inherits(obj, "PerformanceScoreR6")) { + if (inherits(obj, "PerformanceScore") || inherits(obj, "PerformanceScore")) { return("gePerformanceScore") } - if (inherits(obj, "SummaryFactory") || "SummaryFactory" == .getClassName(obj) || inherits(obj, "SummaryFactoryR6") || "SummaryFactoryR6" == .getClassName(obj)) { + if (inherits(obj, "SummaryFactory") || "SummaryFactory" == .getClassName(obj) || inherits(obj, "SummaryFactory") || "SummaryFactory" == .getClassName(obj)) { return(.getGeneratorFunctionName(obj$object)) } @@ -391,7 +391,7 @@ getObjectRCode <- function(obj, ..., if (is.null(leadingArguments)) { leadingArguments <- character(0) } - if (!(inherits(obj, "ConditionalPowerResults") || inherits(obj, "ConditionalPowerResultsR6")) && + if (!(inherits(obj, "ConditionalPowerResults") || inherits(obj, "ConditionalPowerResults")) && !is.null(obj[[".design"]]) && (is.null(leadingArguments) || !any(grepl("design", leadingArguments)))) { preconditionDesign <- getObjectRCode(obj$.design, @@ -411,7 +411,7 @@ getObjectRCode <- function(obj, ..., } } } - if (inherits(obj, "PerformanceScore") || inherits(obj, "PerformanceScoreR6")) { + if (inherits(obj, "PerformanceScore") || inherits(obj, "PerformanceScore")) { preconditionSimulationResults <- getObjectRCode(obj$.simulationResults, prefix = ifelse(pipeOperator == "none", "simulationResults <- ", ""), postfix = pipeOperatorPostfix, @@ -497,7 +497,7 @@ getObjectRCode <- function(obj, ..., } leadingArguments <- c(leadingArguments, "selectArmsFunction = selectArmsFunction") } - if ((inherits(obj, "ConditionalPowerResults") || inherits(obj, "ConditionalPowerResultsR6")) && + if ((inherits(obj, "ConditionalPowerResults") || inherits(obj, "ConditionalPowerResults")) && !is.null(obj[[".stageResults"]]) && (is.null(leadingArguments) || !any(grepl("stageResults", leadingArguments)))) { precond <- getObjectRCode(obj$.stageResults, @@ -532,7 +532,7 @@ getObjectRCode <- function(obj, ..., precondition <- unique(precondition) - if (inherits(obj, "SummaryFactory") || inherits(obj, "SummaryFactoryR6") || "SummaryFactory" == .getClassName(obj) || "SummaryFactoryR6" == .getClassName(obj)) { + if (inherits(obj, "SummaryFactory") || inherits(obj, "SummaryFactory") || "SummaryFactory" == .getClassName(obj) || "SummaryFactory" == .getClassName(obj)) { return(getObjectRCode(obj$object, prefix = ifelse(pipeOperator == "none", "summary(", ""), postfix = { @@ -554,7 +554,7 @@ getObjectRCode <- function(obj, ..., objNames <- objNames[objNames != "effectList"] - if (inherits(obj, "ParameterSet") || inherits(obj, "ParameterSetR6")) { + if (inherits(obj, "ParameterSet") || inherits(obj, "ParameterSet")) { if (includeDefaultParameters) { objNames <- obj$.getInputParameters() } else { @@ -564,23 +564,23 @@ getObjectRCode <- function(obj, ..., } - if ((inherits(obj, "TrialDesign") || inherits(obj, "TrialDesignR6")) && !(inherits(obj, "TrialDesignConditionalDunnett") || inherits(obj, "TrialDesignConditionalDunnettR6")) && + if ((inherits(obj, "TrialDesign") || inherits(obj, "TrialDesign")) && !(inherits(obj, "TrialDesignConditionalDunnett") || inherits(obj, "TrialDesignConditionalDunnett")) && !("informationRates" %in% objNames) && !("kMax" %in% objNames) && obj$kMax != 3) { objNames <- c("kMax", objNames) } thetaH0 <- NA_real_ - if ((inherits(obj, "SimulationResultsSurvival") || inherits(obj, "SimulationResultsSurvivalR6")) && + if ((inherits(obj, "SimulationResultsSurvival") || inherits(obj, "SimulationResultsSurvival")) && obj$.getParameterType("thetaH1") == "g") { objNames <- c(objNames, "thetaH1") thetaH0 <- obj[["thetaH0"]] } - if (inherits(obj, "SimulationResultsSurvival") || inherits(obj, "SimulationResultsSurvivalR6")) { + if (inherits(obj, "SimulationResultsSurvival") || inherits(obj, "SimulationResultsSurvival")) { objNames <- objNames[objNames != "allocationRatioPlanned"] # allocation1 and allocation2 are used instead } - if ((inherits(obj, "AnalysisResults") || inherits(obj, "AnalysisResultsR6")) && grepl("Fisher", .getClassName(obj))) { + if ((inherits(obj, "AnalysisResults") || inherits(obj, "AnalysisResults")) && grepl("Fisher", .getClassName(obj))) { if (!is.null(obj[["seed"]]) && length(obj$seed) == 1 && !is.na(obj$seed)) { if (!("iterations" %in% objNames)) { objNames <- c(objNames, "iterations") @@ -627,7 +627,7 @@ getObjectRCode <- function(obj, ..., objNames <- c(objNames, defaultParams) } - if ((inherits(obj, "TrialDesign") || inherits(obj, "TrialDesignR6")) && "informationRates" %in% objNames && + if ((inherits(obj, "TrialDesign") || inherits(obj, "TrialDesign")) && "informationRates" %in% objNames && !("informationRates" %in% newArgumentValueNames)) { informationRates <- obj[["informationRates"]] if (!is.null(informationRates) && length(informationRates) > 0) { @@ -644,7 +644,7 @@ getObjectRCode <- function(obj, ..., } } - if (inherits(obj, "Dataset") || inherits(obj, "DatasetR6")) { + if (inherits(obj, "Dataset") || inherits(obj, "Dataset")) { lines <- .getDatasetArgumentsRCodeLines(obj, complete = FALSE, digits = NA_integer_) argumentsRCode <- paste0(lines, collapse = ", ") } else { @@ -659,7 +659,7 @@ getObjectRCode <- function(obj, ..., value <- obj[[name]] } - if (name == "accrualTime" && (inherits(obj, "AccrualTime") || inherits(obj, "AccrualTimeR6")) && + if (name == "accrualTime" && (inherits(obj, "AccrualTime") || inherits(obj, "AccrualTime")) && !isTRUE(obj$endOfAccrualIsUserDefined) && isTRUE(length(obj$accrualIntensity) < length(value))) { value <- value[1:(length(value) - 1)] @@ -685,7 +685,7 @@ getObjectRCode <- function(obj, ..., optimumAllocationRatio <- obj[["optimumAllocationRatio"]] if (!is.null(optimumAllocationRatio) && isTRUE(optimumAllocationRatio)) { value <- 0 - } else if ((inherits(obj, "ParameterSet") || inherits(obj, "ParameterSetR6"))) { + } else if ((inherits(obj, "ParameterSet") || inherits(obj, "ParameterSet"))) { if (obj$.getParameterType("allocationRatioPlanned") == "g") { value <- 0 } @@ -729,7 +729,7 @@ getObjectRCode <- function(obj, ..., } } - if (inherits(obj, "TrialDesignPlanSurvival") || inherits(obj, "TrialDesignPlanSurvivalR6")) { + if (inherits(obj, "TrialDesignPlanSurvival") || inherits(obj, "TrialDesignPlanSurvival")) { if (!("accrualTime" %in% objNames) && obj$.getParameterType("accrualTime") == "g" && !all(is.na(obj$accrualTime))) { # case 2: follow-up time and absolute intensity given @@ -773,9 +773,9 @@ getObjectRCode <- function(obj, ..., .getArgumentValueRCode(obj$maxNumberOfSubjects[1], "maxNumberOfSubjects") )) } - } else if (inherits(obj, "AnalysisResults") || inherits(obj, "AnalysisResultsR6")) { + } else if (inherits(obj, "AnalysisResults") || inherits(obj, "AnalysisResults")) { arguments <- c(arguments, paste0("stage = ", obj$.stageResults$stage)) - } else if (inherits(obj, "StageResults") || inherits(obj, "StageResultsR6")) { + } else if (inherits(obj, "StageResults") || inherits(obj, "StageResults")) { arguments <- c(arguments, paste0("stage = ", obj$stage)) } diff --git a/R/f_simulation_base_means.R b/R/f_simulation_base_means.R index 80312bbd..e0c348d1 100644 --- a/R/f_simulation_base_means.R +++ b/R/f_simulation_base_means.R @@ -218,7 +218,7 @@ getSimulationMeans <- function(design = NULL, ..., .assertIsSingleLogical(normalApproximation, "normalApproximation", naAllowed = FALSE) .assertIsValidPlannedSubjectsOrEvents(design, plannedSubjects, parameterName = "plannedSubjects") - simulationResults <- SimulationResultsMeansR6$new(design, showStatistics = showStatistics) + simulationResults <- SimulationResultsMeans$new(design, showStatistics = showStatistics) if (design$sided == 2) { stop( diff --git a/R/f_simulation_base_rates.R b/R/f_simulation_base_rates.R index 1a2168dd..851435c2 100644 --- a/R/f_simulation_base_rates.R +++ b/R/f_simulation_base_rates.R @@ -258,7 +258,7 @@ getSimulationRates <- function(design = NULL, ..., ) } - simulationResults <- SimulationResultsRatesR6$new(design, showStatistics = showStatistics) + simulationResults <- SimulationResultsRates$new(design, showStatistics = showStatistics) conditionalPower <- .ignoreParameterIfNotUsed( "conditionalPower", diff --git a/R/f_simulation_base_survival.R b/R/f_simulation_base_survival.R index d8a250e5..8420f4da 100644 --- a/R/f_simulation_base_survival.R +++ b/R/f_simulation_base_survival.R @@ -377,7 +377,7 @@ getSimulationSurvival <- function(design = NULL, ..., endpoint = "survival", calcSubjectsFunctionEnabled = FALSE ) - simulationResults <- SimulationResultsSurvivalR6$new(design, showStatistics = showStatistics) + simulationResults <- SimulationResultsSurvival$new(design, showStatistics = showStatistics) if (!is.na(conditionalPower)) { if (design$kMax > 1) { if (any(maxNumberOfEventsPerStage - minNumberOfEventsPerStage < 0) && diff --git a/R/f_simulation_calc_subjects_function.R b/R/f_simulation_calc_subjects_function.R index d536eb64..0a652f65 100644 --- a/R/f_simulation_calc_subjects_function.R +++ b/R/f_simulation_calc_subjects_function.R @@ -322,13 +322,13 @@ C_SIMULATION_CALC_SUBJECTS_FUNCTION_ARGUMENTS[[C_SIMULATION_CALC_SUBJECTS_FUNCTI .assertIsSingleLogical(cppEnabled, "cppEnabled") cppCodeBodyType <- NA_character_ - if (inherits(simulationResults, "SimulationResultsMeans") || inherits(simulationResults, "SimulationResultsMeansR6")) { + if (inherits(simulationResults, "SimulationResultsMeans") || inherits(simulationResults, "SimulationResultsMeans")) { cppCodeBodyType <- C_SIMULATION_CALC_SUBJECTS_FUNCTION_BASE_MEANS } - if (inherits(simulationResults, "SimulationResultsRates") || inherits(simulationResults, "SimulationResultsRatesR6")) { + if (inherits(simulationResults, "SimulationResultsRates") || inherits(simulationResults, "SimulationResultsRates")) { cppCodeBodyType <- C_SIMULATION_CALC_SUBJECTS_FUNCTION_BASE_RATES } - if (inherits(simulationResults, "SimulationResultsSurvival") || inherits(simulationResults, "SimulationResultsSurvivalR6")) { + if (inherits(simulationResults, "SimulationResultsSurvival") || inherits(simulationResults, "SimulationResultsSurvival")) { cppCodeBodyType <- C_SIMULATION_CALC_SUBJECTS_FUNCTION_BASE_SURVIVAL } if (is.na(cppCodeBodyType)) { @@ -338,7 +338,7 @@ C_SIMULATION_CALC_SUBJECTS_FUNCTION_ARGUMENTS[[C_SIMULATION_CALC_SUBJECTS_FUNCTI ) } - functionFieldName <- ifelse(inherits(simulationResults, "SimulationResultsSurvival") || inherits(simulationResults, "SimulationResultsSurvivalR6"), + functionFieldName <- ifelse(inherits(simulationResults, "SimulationResultsSurvival") || inherits(simulationResults, "SimulationResultsSurvival"), "calcEventsFunction", "calcSubjectsFunction" ) @@ -397,7 +397,7 @@ C_SIMULATION_CALC_SUBJECTS_FUNCTION_ARGUMENTS[[C_SIMULATION_CALC_SUBJECTS_FUNCTI if (.isCppCode(calcFunction)) { tryCatch( { - survivalEnabled <- inherits(simulationResults, "SimulationResultsSurvival") || inherits(simulationResults, "SimulationResultsSurvivalR6") + survivalEnabled <- inherits(simulationResults, "SimulationResultsSurvival") || inherits(simulationResults, "SimulationResultsSurvival") expectedFunctionName <- ifelse(survivalEnabled, "calcEventsFunctionCppTemp", "calcSubjectsFunctionCppTemp" ) diff --git a/R/f_simulation_enrichment.R b/R/f_simulation_enrichment.R index 40c8e682..4fbaaf25 100644 --- a/R/f_simulation_enrichment.R +++ b/R/f_simulation_enrichment.R @@ -351,11 +351,11 @@ NULL effectMeasure <- .assertIsValidEffectMeasure(effectMeasure) if (endpoint == "means") { - simulationResults <- SimulationResultsEnrichmentMeansR6$new(design, showStatistics = showStatistics) + simulationResults <- SimulationResultsEnrichmentMeans$new(design, showStatistics = showStatistics) } else if (endpoint == "rates") { - simulationResults <- SimulationResultsEnrichmentRatesR6$new(design, showStatistics = showStatistics) + simulationResults <- SimulationResultsEnrichmentRates$new(design, showStatistics = showStatistics) } else if (endpoint == "survival") { - simulationResults <- SimulationResultsEnrichmentSurvivalR6$new(design, showStatistics = showStatistics) + simulationResults <- SimulationResultsEnrichmentSurvival$new(design, showStatistics = showStatistics) } effectList <- .getValidatedEffectList(effectList, endpoint = endpoint) diff --git a/R/f_simulation_multiarm.R b/R/f_simulation_multiarm.R index 151d36dd..0c756c8e 100644 --- a/R/f_simulation_multiarm.R +++ b/R/f_simulation_multiarm.R @@ -468,11 +468,11 @@ NULL effectMeasure <- .assertIsValidEffectMeasure(effectMeasure) if (endpoint == "means") { - simulationResults <- SimulationResultsMultiArmMeansR6$new(design, showStatistics = showStatistics) + simulationResults <- SimulationResultsMultiArmMeans$new(design, showStatistics = showStatistics) } else if (endpoint == "rates") { - simulationResults <- SimulationResultsMultiArmRatesR6$new(design, showStatistics = showStatistics) + simulationResults <- SimulationResultsMultiArmRates$new(design, showStatistics = showStatistics) } else if (endpoint == "survival") { - simulationResults <- SimulationResultsMultiArmSurvivalR6$new(design, showStatistics = showStatistics) + simulationResults <- SimulationResultsMultiArmSurvival$new(design, showStatistics = showStatistics) } gMax <- activeArms diff --git a/R/f_simulation_performance_score.R b/R/f_simulation_performance_score.R index 79edc011..2c5214cd 100644 --- a/R/f_simulation_performance_score.R +++ b/R/f_simulation_performance_score.R @@ -50,7 +50,7 @@ getPerformanceScore <- function(simulationResult) { design <- simulationResult$.design - if (!(inherits(simulationResult, "SimulationResultsMeans") || inherits(simulationResult, "SimulationResultsMeansR6"))) { + if (!(inherits(simulationResult, "SimulationResultsMeans") || inherits(simulationResult, "SimulationResultsMeans"))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "performance score so far implemented only for single comparisons with continuous endpoints" @@ -94,10 +94,10 @@ getPerformanceScore <- function(simulationResult) { referenceValue <- NA_real_ # simulated alternative values - if (methods::is(simulationResult, "SimulationResultsMeans") || methods::is(simulationResult, "SimulationResultsMeansR6")) { + if (methods::is(simulationResult, "SimulationResultsMeans") || methods::is(simulationResult, "SimulationResultsMeans")) { alternativeParamName <- "alternative" referenceValue <- 0 - } else if (methods::is(simulationResult, "SimulationResultsRates") || methods::is(simulationResult, "SimulationResultsRatesR6")) { + } else if (methods::is(simulationResult, "SimulationResultsRates") || methods::is(simulationResult, "SimulationResultsRates")) { alternativeParamName <- "pi1" referenceValue <- simulationResult$pi2 args$pi2 <- referenceValue @@ -116,9 +116,9 @@ getPerformanceScore <- function(simulationResult) { if (alternativeValue == referenceValue) { singleStageSampleSize <- plannedSubjects[2] - plannedSubjects[1] - } else if (methods::is(simulationResult, "SimulationResultsMeans") || methods::is(simulationResult, "SimulationResultsMeansR6")) { + } else if (methods::is(simulationResult, "SimulationResultsMeans") || methods::is(simulationResult, "SimulationResultsMeans")) { singleStageSampleSize <- do.call(getSampleSizeMeans, args)$numberOfSubjects - } else if (methods::is(simulationResult, "SimulationResultsRates") || methods::is(simulationResult, "SimulationResultsRatesR6")) { + } else if (methods::is(simulationResult, "SimulationResultsRates") || methods::is(simulationResult, "SimulationResultsRates")) { singleStageSampleSize <- do.call(getSampleSizeRates, args)$numberOfSubjects } @@ -166,7 +166,7 @@ getPerformanceScore <- function(simulationResult) { )) }) - performanceScore <- PerformanceScoreR6$new(simulationResult) + performanceScore <- PerformanceScore$new(simulationResult) performanceScore$.alternative <- alternativeValues paramNames <- rownames(resultMatrix) for (k in 1:nrow(resultMatrix)) { diff --git a/R/f_simulation_utilities.R b/R/f_simulation_utilities.R index c800c718..69c7e641 100644 --- a/R/f_simulation_utilities.R +++ b/R/f_simulation_utilities.R @@ -95,7 +95,7 @@ NULL stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'data' must be a valid data.frame or a simulation result object") } - if (inherits(data, "SimulationResults") || inherits(data, "SimulationResultsR6")) { + if (inherits(data, "SimulationResults") || inherits(data, "SimulationResults")) { data <- data[[".data"]] } diff --git a/tests/testthat/helper-f_core_assertions.R b/tests/testthat/helper-f_core_assertions.R index 5cb587b3..fbff883f 100644 --- a/tests/testthat/helper-f_core_assertions.R +++ b/tests/testthat/helper-f_core_assertions.R @@ -21,7 +21,7 @@ getAssertionTestDesign <- function(..., kMax = NA_integer_, informationRates = NA_real_, futilityBounds = NA_real_, designClass = "TrialDesignInverseNormal") { if (designClass == "TrialDesignFisher") { - return(TrialDesignFisherR6$new( + return(TrialDesignFisher$new( kMax = kMax, alpha = 0.025, method = "equalAlpha", diff --git a/tests/testthat/test-class_core_plot_settings.R b/tests/testthat/test-class_core_plot_settings.R index c2951c96..4021660e 100644 --- a/tests/testthat/test-class_core_plot_settings.R +++ b/tests/testthat/test-class_core_plot_settings.R @@ -25,9 +25,9 @@ test_plan_section("Testing the Class 'PlotSettings'") test_that("Test plot settings", { expect_type(getPlotSettings(), "environment") - expect_error(PlotSubTitleItemR6$new()) + expect_error(PlotSubTitleItem$new()) - expect_type(PlotSubTitleItemsR6$new(), "environment") + expect_type(PlotSubTitleItems$new(), "environment") - expect_type(PlotSettingsR6$new(), "environment") + expect_type(PlotSettings$new(), "environment") }) From a6494faaa6924a7ec9d6246c3358dcba227bc5e5 Mon Sep 17 00:00:00 2001 From: Friedrich Pahlke Date: Tue, 12 Mar 2024 08:28:36 +0100 Subject: [PATCH 11/28] .assertIsValidBeta improved --- DESCRIPTION | 4 ++-- R/f_core_assertions.R | 27 +++++++++++++++------------ man/getSimulationSurvival.Rd | 6 +++--- 3 files changed, 20 insertions(+), 17 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 19805d63..a48047d4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: rpact Title: Confirmatory Adaptive Clinical Trial Design and Analysis -Version: 3.5.2.9232 -Date: 2024-03-07 +Version: 3.5.2.9233 +Date: 2024-03-12 Authors@R: c( person( given = "Gernot", diff --git a/R/f_core_assertions.R b/R/f_core_assertions.R index cc49d407..75407f98 100644 --- a/R/f_core_assertions.R +++ b/R/f_core_assertions.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7703 $ -## | Last changed: $Date: 2024-03-07 13:38:48 +0100 (Do, 07 Mrz 2024) $ +## | File version: $Revision: 7712 $ +## | Last changed: $Date: 2024-03-12 08:24:58 +0100 (Di, 12 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -786,7 +786,8 @@ NULL upperBound = NA_real_, spendingFunctionName = NA_character_, closedLowerBound = TRUE, - closedUpperBound = TRUE) { + closedUpperBound = TRUE, + suffix = NA_character_) { .assertIsSingleNumber(lowerBound, "lowerBound", naAllowed = TRUE) .assertIsSingleNumber(upperBound, "upperBound", naAllowed = TRUE) @@ -824,16 +825,22 @@ NULL spendingFunctionName <- "" } + if (is.na(suffix)) { + suffix <- "" + } else { + suffix <- paste0(" ", trimws(suffix)) + } + type <- getOption("rpact.out.of.validated.bounds.message.type", "warning") if (identical(type, "warning")) { warning("The parameter ", sQuote(parameterName), " (", parameterValue, ") ", spendingFunctionName, "is out of validated bounds ", - bracketLowerBound, lowerBound, "; ", upperBound, bracketUpperBound, call. = FALSE) + bracketLowerBound, lowerBound, "; ", upperBound, bracketUpperBound, suffix, call. = FALSE) } else if (identical(type, "message")) { message("Note that parameter ", sQuote(parameterName), " (", parameterValue, ") ", spendingFunctionName, "is out of validated bounds ", - bracketLowerBound, lowerBound, "; ", upperBound, bracketUpperBound) + bracketLowerBound, lowerBound, "; ", upperBound, bracketUpperBound, suffix) } } } @@ -916,13 +923,9 @@ NULL .assertIsSingleNumber(beta, "beta") .assertIsSingleNumber(alpha, "alpha") .assertIsInOpenInterval(beta, "beta", lower = 0, upper = NULL) - if (beta < 1e-04 || beta >= 1 - alpha) { - warning( - C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, - "'beta' (", beta, ") is out of validated bounds [1e-04; ", (1 - alpha), "); ", - "condition: 1e-05 <= alpha < 1 - beta <= 1 - 1e-04", - call. = FALSE) - } + .showParameterOutOfValidatedBoundsMessage(beta, "beta", lowerBound = 1e-04, + upperBound = 1 - alpha, closedUpperBound = FALSE, + suffix = "condition: 1e-06 <= alpha < 1 - beta <= 1 - 1e-04") } .assertIsValidAlphaAndBeta <- function(alpha, beta) { diff --git a/man/getSimulationSurvival.Rd b/man/getSimulationSurvival.Rd index 4bec6d51..02d39c30 100644 --- a/man/getSimulationSurvival.Rd +++ b/man/getSimulationSurvival.Rd @@ -587,14 +587,14 @@ myCalcEventsFunction <- function(..., if (stage == 2) { requiredStageEvents <- max(0, conditionalCriticalValue + qnorm(conditionalPower))^2 * 4 / log(theta)^2 - requiredStageEvents <- min( + requiredOverallStageEvents <- min( max(minNumberOfEventsPerStage[stage], requiredStageEvents), maxNumberOfEventsPerStage[stage] ) + eventsOverStages[stage - 1] } else { - requiredStageEvents <- 2 * eventsOverStages[stage - 1] - eventsOverStages[1] + requiredOverallStageEvents <- 2 * eventsOverStages[stage - 1] - eventsOverStages[1] } - return(requiredStageEvents) + return(requiredOverallStageEvents) } resultsWithSSR <- getSimulationSurvival( design = designIN, From 2871f64dd569ebd325081e42eb1259ab367e0adc Mon Sep 17 00:00:00 2001 From: Till Jensen Date: Thu, 14 Mar 2024 11:07:39 +0100 Subject: [PATCH 12/28] adjusted to 3.5.2 --- .Rbuildignore | 1 + .gitignore | 2 + DESCRIPTION | 4 +- NAMESPACE | 2 - NEWS.md | 13 +- R/class_analysis_dataset.R | 10 +- R/class_analysis_results.R | 10 +- R/class_analysis_stage_results.R | 331 +- R/class_core_parameter_set.R | 1549 +-- R/class_core_plot_settings.R | 19 +- R/class_design.R | 100 +- R/class_design_plan.R | 220 +- R/class_design_set.R | 258 +- R/class_simulation_results.R | 56 +- R/class_summary.R | 132 +- R/class_time.R | 18 +- R/f_analysis_base.R | 6 +- R/f_core_assertions.R | 170 +- R/f_core_plot.R | 24 +- R/f_core_utilities.R | 57 +- R/f_design_fisher_combination_test.R | 1 - R/f_design_general_utilities.R | 5 +- R/f_design_group_sequential.R | 59 +- R/f_design_plan_count_data.R | 2 +- R/f_design_plan_means.R | 2 +- R/f_design_plan_plot.R | 48 +- R/f_design_plan_rates.R | 2 +- R/f_design_plan_survival.R | 6 +- R/f_object_r_code.R | 92 +- R/f_parameter_set_utilities.R | 2 +- R/f_simulation_calc_subjects_function.R | 10 +- R/f_simulation_enrichment_rates.R | 6 +- R/f_simulation_performance_score.R | 23 +- R/f_simulation_plot.R | 24 +- R/f_simulation_utilities.R | 2 +- inst/doc/rpact_getting_started.html | 4 +- man-roxygen/examples_get_performance_score.R | 14 +- .../examples_get_simulation_survival.R | 8 +- man/AnalysisResults.Rd | 18 +- man/AnalysisResultsConditionalDunnett.Rd | 45 +- man/AnalysisResultsEnrichment.Rd | 12 +- man/AnalysisResultsEnrichmentFisher.Rd | 49 +- man/AnalysisResultsEnrichmentInverseNormal.Rd | 47 +- man/AnalysisResultsFisher.Rd | 57 +- man/AnalysisResultsGroupSequential.Rd | 55 +- man/AnalysisResultsInverseNormal.Rd | 51 +- man/AnalysisResultsMultiArm.Rd | 13 +- man/AnalysisResultsMultiArmInverseNormal.Rd | 45 +- man/AnalysisResultsMultiHypotheses.Rd | 12 +- man/ClosedCombinationTestResults.Rd | 27 +- man/ConditionalPowerResults.Rd | 25 +- man/ConditionalPowerResultsEnrichmentMeans.Rd | 25 +- man/ConditionalPowerResultsEnrichmentRates.Rd | 25 +- man/ConditionalPowerResultsMeans.Rd | 25 +- man/ConditionalPowerResultsRates.Rd | 25 +- man/ConditionalPowerResultsSurvival.Rd | 23 +- man/StageResults.Rd | 37 +- man/StageResultsEnrichmentMeans.Rd | 51 +- man/StageResultsEnrichmentRates.Rd | 27 +- man/StageResultsEnrichmentSurvival.Rd | 27 +- man/StageResultsMeans.Rd | 39 +- man/StageResultsMultiArmMeans.Rd | 55 +- man/StageResultsMultiArmRates.Rd | 49 +- man/StageResultsMultiArmSurvival.Rd | 47 +- man/StageResultsRates.Rd | 39 +- man/StageResultsSurvival.Rd | 45 +- man/getPerformanceScore.Rd | 11 +- man/getRawData.Rd | 4 +- man/getSimulationSurvival.Rd | 8 +- man/kable.Rd | 9 +- man/t-FieldSet-method.Rd | 9 +- src/f_simulation_base_means.cpp | 10 +- src/f_simulation_base_survival.cpp | 8 +- .../testthat/test-class_core_plot_settings.R | 4 +- tests/testthat/test-class_design_plan.R | 16 +- tests/testthat/test-class_design_set.R | 2 +- tests/testthat/test-class_summary.R | 1169 +- tests/testthat/test-class_time.R | 5469 ++++---- tests/testthat/test-f_analysis_base_rates.R | 4867 +++---- .../test-f_analysis_enrichment_rates.R | 1335 +- .../test-f_analysis_enrichment_survival.R | 1065 +- .../test-f_analysis_input_validation.R | 229 +- .../testthat/test-f_analysis_multiarm_means.R | 11100 ++++++++-------- tests/testthat/test-f_core_assertions.R | 507 +- tests/testthat/test-f_core_output_formats.R | 885 +- tests/testthat/test-f_core_plot.R | 231 +- .../test-f_design_fisher_combination_test.R | 1129 +- .../testthat/test-f_design_group_sequential.R | 4217 +++--- tests/testthat/test-f_design_plan_plot.R | 133 +- .../testthat/test-f_parameter_set_utilities.R | 173 +- tests/testthat/test-f_simulation_base_means.R | 4747 ++++--- ...test-f_simulation_calc_subjects_function.R | 2 +- .../test-f_simulation_performance_score.R | 60 +- tests/testthat/test-f_simulation_plot.R | 89 +- tests/testthat/test-f_simulation_utilities.R | 4 +- tests/testthat/test-generic_functions.R | 319 +- 96 files changed, 20410 insertions(+), 21688 deletions(-) diff --git a/.Rbuildignore b/.Rbuildignore index 4358a98d..90147d2b 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -48,3 +48,4 @@ testthat-problems\.rds ^inst/\.covrignore$ ^README\.html$ ^codecov\.yml$ +Rplots\.pdf diff --git a/.gitignore b/.gitignore index 68cdac39..f8f170a7 100644 --- a/.gitignore +++ b/.gitignore @@ -31,3 +31,5 @@ testthat-problems.rds /src/*.gcno /src/*.gcov /README.html +/tests/testthat/Rplots.pdf +/tests/testthat/index.txt diff --git a/DESCRIPTION b/DESCRIPTION index f91acd88..a48047d4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: rpact Title: Confirmatory Adaptive Clinical Trial Design and Analysis -Version: 3.5.1 -Date: 2024-02-27 +Version: 3.5.2.9233 +Date: 2024-03-12 Authors@R: c( person( given = "Gernot", diff --git a/NAMESPACE b/NAMESPACE index 64368ebe..ea80189c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -130,8 +130,6 @@ export(testPackage) export(test_plan_section) export(writeDataset) export(writeDatasets) -exportMethods("[") -exportMethods(t) import(graphics) import(methods) import(stats) diff --git a/NEWS.md b/NEWS.md index 5e051441..0e9f1842 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,15 @@ +# rpact 3.5.2 + +## New features + +* Extension of the function `getPerformanceScore()` for sample size recalculation rules to the setting of binary endpoints according to [Bokelmann et al. (2024)](https://doi.org/10.1186/s12874-024-02150-4) + +## Improvements, issues, and changes + +* Issue [#25](https://github.com/rpact-com/rpact/issues/25) fixed + + # rpact 3.5.1 * The internal fields `.parameterNames` and `.parameterFormatFunctions` were removed from all rpact result objects in favor of a more efficient solution @@ -40,7 +51,7 @@ ## New features -* The new function `getPerformanceScore()` calculates the conditional performance score, its sub-scores and components according to Herrmann et al. (2020) for a given simulation result from a two-stage design +* The new function `getPerformanceScore()` calculates the conditional performance score, its sub-scores and components according to [Herrmann et al. (2020)](https://doi.org/10.1002/sim.8534) for a given simulation result from a two-stage design * `allocationRatioPlanned` for simulating multi-arm and enrichment designs can be a vector of length kMax, the number of stages * `getObjectRCode()` (short: `rcmd()`): with the new arguments `pipeOperator` and `output` many new output variants can be specified, e.g., the native R pipe operator or the magrittr pipe operator can be used * Generic function `knitr::knit_print` for all result objects implemented and automatic code chunk option `results = 'asis'` activated diff --git a/R/class_analysis_dataset.R b/R/class_analysis_dataset.R index 2e386109..25cdd6fc 100644 --- a/R/class_analysis_dataset.R +++ b/R/class_analysis_dataset.R @@ -839,7 +839,7 @@ getDataSet <- function(..., floatingPointNumbersEnabled = FALSE) { } for (arg in args) { - if (inherits(arg, "Dataset") || inherits(arg, "Dataset")) { + if (inherits(arg, "Dataset")) { return(TRUE) } } @@ -909,7 +909,7 @@ getDataSet <- function(..., floatingPointNumbersEnabled = FALSE) { emptySubsetNames <- validSubsetNames[!(validSubsetNames %in% subsetNames)] for (subsetName in subsetNames) { subset <- args[[subsetName]] - if (is.null(subset) || (!(isS4(subset) || is.R6(subset)) && is.na(subset))) { + if (is.null(subset) || (!is.R6(subset) && is.na(subset))) { emptySubsetNames <- c(emptySubsetNames, subsetName) } else { if (!.isDataset(subset)) { @@ -1376,7 +1376,7 @@ Dataset <- R6Class("Dataset", groups = NULL, subsets = NULL, initialize = function(dataFrame, ..., floatingPointNumbersEnabled = FALSE, enrichmentEnabled = FALSE, .design = NULL) { - super$initialize() + super$initialize(...) self$.floatingPointNumbersEnabled <- floatingPointNumbersEnabled self$.enrichmentEnabled <- enrichmentEnabled @@ -3044,7 +3044,7 @@ DatasetRates <- R6Class("DatasetRates", numberOfEvents <- self$getEvent(stage = stage, group = group, subset = subset) randomIndices <- sample(x = c(1:n), size = numberOfEvents, replace = FALSE) randomData <- rep(0, n) - randomData[randomIndices] <- 1#TODO indices -> indizes + randomData[randomIndices] <- 1 row <- data.frame( stage = stage, @@ -3191,7 +3191,7 @@ DatasetSurvival <- R6Class("DatasetSurvival", overallLogRanks = NULL, events = NULL, allocationRatios = NULL, - logRanks = NULL, + logRanks = numeric(), getEvent = function(stage, group = 1, subset = NA_character_) { return(self$.data$event[self$.getIndices(stage = stage, group = group, subset = subset)]) }, diff --git a/R/class_analysis_results.R b/R/class_analysis_results.R index fe969299..24371c45 100644 --- a/R/class_analysis_results.R +++ b/R/class_analysis_results.R @@ -863,10 +863,11 @@ AnalysisResults <- R6Class("AnalysisResults", c("assumedStDevs", "thetaH1", "pi1", "pi2", "piTreatments", "piTreatments", "piControl", "piControls"))] if (grepl("(MultiArm|Dunnett|Enrichment)", .getClassName(self))) { - if (all(c("conditionalPowerSimulated", "conditionalRejectionProbabilities") %in% generatedParams)) { - generatedParams <- .moveValue(generatedParams, - "conditionalPowerSimulated", "conditionalRejectionProbabilities") + generatedParams <- .moveValue( + generatedParams, + "conditionalPowerSimulated", "conditionalRejectionProbabilities" + ) } self$.showParametersOfOneGroup(generatedParams, "Further analysis results", @@ -882,7 +883,8 @@ AnalysisResults <- R6Class("AnalysisResults", if (grepl("(MultiArm|Dunnett)", .getClassName(self))) { self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) - self$.cat(paste0( + self$.cat( + paste0( " (i): results of treatment arm i vs. control group ", self$.dataInput$getNumberOfGroups(), "\n" ), diff --git a/R/class_analysis_stage_results.R b/R/class_analysis_stage_results.R index 0fdf6321..1abf61fb 100644 --- a/R/class_analysis_stage_results.R +++ b/R/class_analysis_stage_results.R @@ -98,9 +98,7 @@ StageResults <- R6Class("StageResults", } else { self$.setParameterType("stages", C_PARAM_USER_DEFINED) } - self$.parameterNames <- .getParameterNames(design = design) } - self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS self$.setParameterType("stage", C_PARAM_NOT_APPLICABLE) @@ -147,7 +145,8 @@ StageResults <- R6Class("StageResults", self$.cat(paste0(" F: full population\n"), consoleOutputEnabled = consoleOutputEnabled) } else if (grepl("MultiArm", .getClassName(self))) { self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) - self$.cat(paste0( + self$.cat( + paste0( " (i): results of treatment arm i vs. control group ", self$.dataInput$getNumberOfGroups(), "\n" ), @@ -1518,36 +1517,57 @@ as.data.frame.StageResults <- function(x, row.names = NULL, #' @export #' plot.StageResults <- function(x, y, ..., type = 1L, - nPlanned, allocationRatioPlanned = 1, # C_ALLOCATION_RATIO_DEFAULT - main = NA_character_, xlab = NA_character_, ylab = NA_character_, - legendTitle = NA_character_, palette = "Set1", legendPosition = NA_integer_, - showSource = FALSE, plotSettings = NULL) { - fCall <- match.call(expand.dots = FALSE) - - .assertGgplotIsInstalled() - .assertIsStageResults(x) - .assertIsValidLegendPosition(legendPosition) - if (.isConditionalPowerEnabled(nPlanned)) { - .assertIsValidAllocationRatioPlanned(allocationRatioPlanned, x$.dataInput$getNumberOfGroups()) - } - .stopInCaseOfIllegalStageDefinition2(...) - - if (x$.design$kMax == 1) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "cannot plot stage results of a fixed design") - } - - if (!is.logical(showSource) || isTRUE(showSource)) { - stageResultsName <- .getOptionalArgument("stageResultsName", ...) - if (is.null(stageResultsName)) { - stageResultsName <- deparse(fCall$x) + nPlanned, allocationRatioPlanned = 1, # C_ALLOCATION_RATIO_DEFAULT + main = NA_character_, xlab = NA_character_, ylab = NA_character_, + legendTitle = NA_character_, palette = "Set1", legendPosition = NA_integer_, + showSource = FALSE, plotSettings = NULL) { + fCall <- match.call(expand.dots = FALSE) + + .assertGgplotIsInstalled() + .assertIsStageResults(x) + .assertIsValidLegendPosition(legendPosition) + if (.isConditionalPowerEnabled(nPlanned)) { + .assertIsValidAllocationRatioPlanned(allocationRatioPlanned, x$.dataInput$getNumberOfGroups()) + } + .stopInCaseOfIllegalStageDefinition2(...) + + if (x$.design$kMax == 1) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "cannot plot stage results of a fixed design") + } + + if (!is.logical(showSource) || isTRUE(showSource)) { + stageResultsName <- .getOptionalArgument("stageResultsName", ...) + if (is.null(stageResultsName)) { + stageResultsName <- deparse(fCall$x) + } + cat("Source data of the plot:\n") + cat(" Use getConditionalPower(..., addPlotData = TRUE) to create the data.\n", sep = "") + cat("Simple plot command example:\n", sep = "") + + cmd <- paste0( + "condPow <- getConditionalPower(", stageResultsName, + ", nPlanned = ", .arrayToString(nPlanned, vectorLookAndFeelEnabled = TRUE) + ) + if (.isConditionalPowerEnabled(nPlanned) && allocationRatioPlanned != C_ALLOCATION_RATIO_DEFAULT) { + cmd <- paste0(cmd, ", allocationRatioPlanned = ", allocationRatioPlanned) + } + if (grepl("Means|Survival", .getClassName(x))) { + cmd <- paste0(cmd, ", thetaRange = seq(0, 1, 0.1)") + } else if (grepl("Rates", .getClassName(x))) { + cmd <- paste0(cmd, ", piTreatmentRange = seq(0, 1, 0.1)") + } + cmd <- paste0(cmd, ", addPlotData = TRUE)") + + cat(" ", cmd, "\n", sep = "") + cat(" plotData <- condPow$.plotData # get plot data list\n", sep = "") + cat(" plotData # show plot data list\n", sep = "") + cat(" plot(plotData$xValues, plotData$condPowerValues)\n", sep = "") + cat(" plot(plotData$xValues, plotData$likelihoodValues)\n", sep = "") } - cat("Source data of the plot:\n") - cat(" Use getConditionalPower(..., addPlotData = TRUE) to create the data.\n", sep = "") - cat("Simple plot command example:\n", sep = "") - - cmd <- paste0( - "condPow <- getConditionalPower(", stageResultsName, - ", nPlanned = ", .arrayToString(nPlanned, vectorLookAndFeelEnabled = TRUE) + + plotData <- .getConditionalPowerPlot( + stageResults = x, nPlanned = nPlanned, + allocationRatioPlanned = allocationRatioPlanned, ... ) yParameterName1 <- "Conditional power" @@ -1651,159 +1671,116 @@ plot.StageResults <- function(x, y, ..., type = 1L, )) } } - } else { - data <- rbind(data, data.frame( - xValues = c( - plotData$xValues[populationIndices], - plotData$xValues[populationIndices] - ), - yValues = c( - plotData$condPowerValues[populationIndices], - plotData$likelihoodValues[populationIndices] - ), - categories = c( - rep(legend1, length(plotData$xValues[populationIndices])), - rep(legend2, length(plotData$xValues[populationIndices])) - ), - populations = c( - rep(population, length(plotData$xValues[populationIndices])), - rep(population, length(plotData$xValues[populationIndices])) - ) - )) - } - } - } else { - if (all(is.na(plotData$condPowerValues))) { - legendPosition <- -1 - data <- data.frame( - xValues = plotData$xValues, - yValues = plotData$likelihoodValues, - categories = rep(yParameterName2, length(plotData$xValues)) - ) } else { - data <- data.frame( - xValues = c(plotData$xValues, plotData$xValues), - yValues = c(plotData$condPowerValues, plotData$likelihoodValues), - categories = c( - rep(yParameterName1, length(plotData$xValues)), - rep(yParameterName2, length(plotData$xValues)) - ) - ) + if (all(is.na(plotData$condPowerValues))) { + legendPosition <- -1 + data <- data.frame( + xValues = plotData$xValues, + yValues = plotData$likelihoodValues, + categories = rep(yParameterName2, length(plotData$xValues)) + ) + } else { + data <- data.frame( + xValues = c(plotData$xValues, plotData$xValues), + yValues = c(plotData$condPowerValues, plotData$likelihoodValues), + categories = c( + rep(yParameterName1, length(plotData$xValues)), + rep(yParameterName2, length(plotData$xValues)) + ) + ) + } } - } - - data$categories <- factor(data$categories, levels = unique(data$categories)) - - main <- ifelse(is.na(main), C_PLOT_MAIN_CONDITIONAL_POWER_WITH_LIKELIHOOD, main) - ylab <- ifelse(is.na(ylab), C_PLOT_YLAB_CONDITIONAL_POWER_WITH_LIKELIHOOD, ylab) - - if (is.na(legendTitle)) { - legendTitle <- "Parameter" - } - - return(.createAnalysisResultsPlotObject(x, - data = data, plotData = plotData, main = main, xlab = xlab, ylab = ylab, - legendTitle = legendTitle, palette = palette, legendPosition = legendPosition, numberOfPairedLines = 2L, - plotSettings = plotSettings - )) + + data$categories <- factor(data$categories, levels = unique(data$categories)) + + main <- ifelse(is.na(main), C_PLOT_MAIN_CONDITIONAL_POWER_WITH_LIKELIHOOD, main) + ylab <- ifelse(is.na(ylab), C_PLOT_YLAB_CONDITIONAL_POWER_WITH_LIKELIHOOD, ylab) + + if (is.na(legendTitle)) { + legendTitle <- "Parameter" + } + + return(.createAnalysisResultsPlotObject(x, + data = data, plotData = plotData, main = main, xlab = xlab, ylab = ylab, + legendTitle = legendTitle, palette = palette, legendPosition = legendPosition, numberOfPairedLines = 2L, + plotSettings = plotSettings + )) } .createAnalysisResultsPlotObject <- function(x, ..., data, plotData, - main = NA_character_, xlab = NA_character_, ylab = NA_character_, - legendTitle = NA_character_, palette = "Set1", legendPosition = NA_integer_, - numberOfPairedLines = NA_integer_, plotSettings = NULL) { - ciModeEnabled <- !is.null(data[["lower"]]) && !is.null(data[["upper"]]) - - if (!ciModeEnabled) { - p <- ggplot2::ggplot(data, ggplot2::aes( - x = .data[["xValues"]], y = .data[["yValues"]], - colour = factor(.data[["categories"]]), - linetype = factor(.data[["categories"]]) - )) - } else { - p <- ggplot2::ggplot(data, ggplot2::aes( - x = .data[["xValues"]], y = .data[["yValues"]], - colour = factor(.data[["categories"]]) - )) - } - - if (is.null(plotSettings)) { - plotSettings <- x$getPlotSettings() - } - - p <- plotSettings$setTheme(p) - p <- plotSettings$hideGridLines(p) - - # set main title - mainTitle <- ifelse(!is.call(main) && !isS4(main) && is.na(main), plotData$main, main) - p <- plotSettings$setMainTitle(p, mainTitle, subtitle = plotData$sub) - - # set legend - if (is.na(legendPosition)) { - legendPosition <- C_POSITION_LEFT_TOP - } - p <- plotSettings$setLegendPosition(p, legendPosition = legendPosition) - p <- plotSettings$setLegendBorder(p) - p <- plotSettings$setLegendTitle(p, legendTitle) - p <- plotSettings$setLegendLabelSize(p) - - # set axes labels - p <- plotSettings$setAxesLabels(p, - xAxisLabel = plotData$xlab, yAxisLabel1 = plotData$ylab, - xlab = xlab, ylab = ylab - ) - - # plot lines and points - if (!ciModeEnabled) { - if (is.na(numberOfPairedLines)) { - numberOfPairedLines <- 2 - if (x$.isMultiArm()) { - numberOfPairedLines <- length(unique(data$treatmentArms)) - 1 - } else if (x$.isEnrichment()) { - numberOfPairedLines <- length(unique(data$populations)) - 1 - } - } - - p <- plotSettings$plotValues(p, plotPointsEnabled = FALSE, pointBorder = 1) - n <- length(unique(data$categories)) / numberOfPairedLines - if (n > 1) { - lineTypeValues <- rep(1:numberOfPairedLines, n) - colorTypes <- sort(rep(1:n, numberOfPairedLines)) - for (i in c(1, 3)) { - colorTypes[colorTypes >= i] <- colorTypes[colorTypes >= i] + 1 - } - p <- p + ggplot2::scale_color_manual(name = legendTitle, values = colorTypes) - p <- p + ggplot2::scale_linetype_manual(name = legendTitle, values = lineTypeValues) + main = NA_character_, xlab = NA_character_, ylab = NA_character_, + legendTitle = NA_character_, palette = "Set1", legendPosition = NA_integer_, + numberOfPairedLines = NA_integer_, plotSettings = NULL) { + ciModeEnabled <- !is.null(data[["lower"]]) && !is.null(data[["upper"]]) + + if (!ciModeEnabled) { + p <- ggplot2::ggplot(data, ggplot2::aes( + x = .data[["xValues"]], y = .data[["yValues"]], + colour = factor(.data[["categories"]]), + linetype = factor(.data[["categories"]]) + )) } else { - colorValues <- c(2, 4) - if (!x$.isMultiArm()) { - colorValues <- c(2, 2) # use only one color - } - p <- p + ggplot2::scale_color_manual(name = legendTitle, values = colorValues) - p <- p + ggplot2::scale_linetype_manual(name = legendTitle, values = c(1, 2)) + p <- ggplot2::ggplot(data, ggplot2::aes( + x = .data[["xValues"]], y = .data[["yValues"]], + colour = factor(.data[["categories"]]) + )) } - } - - # plot confidence intervall - else { - pd <- ggplot2::position_dodge(0.15) - - p <- p + ggplot2::geom_errorbar( - data = data, - ggplot2::aes(ymin = .data[["lower"]], ymax = .data[["upper"]]), - width = 0.15, position = pd, size = 0.8 + + if (is.null(plotSettings)) { + plotSettings <- x$getPlotSettings() + } + + p <- plotSettings$setTheme(p) + p <- plotSettings$hideGridLines(p) + + # set main title + mainTitle <- ifelse(!is.call(main) && !isS4(main) && !R6::is.R6(main) && is.na(main), plotData$main, main) + p <- plotSettings$setMainTitle(p, mainTitle, subtitle = plotData$sub) + + # set legend + if (is.na(legendPosition)) { + legendPosition <- C_POSITION_LEFT_TOP + } + p <- plotSettings$setLegendPosition(p, legendPosition = legendPosition) + p <- plotSettings$setLegendBorder(p) + p <- plotSettings$setLegendTitle(p, legendTitle) + p <- plotSettings$setLegendLabelSize(p) + + # set axes labels + p <- plotSettings$setAxesLabels(p, + xAxisLabel = plotData$xlab, yAxisLabel1 = plotData$ylab, + xlab = xlab, ylab = ylab ) - p <- p + ggplot2::geom_line(position = pd, linetype = "longdash") - p <- p + ggplot2::geom_point(position = pd, size = 2.0) - - - stage <- unique(data$xValues) - kMax <- list(...)[["kMax"]] - if (length(stage) == 1 && !is.null(kMax)) { - stages <- 1:kMax - p <- p + ggplot2::scale_x_continuous(breaks = stages) - } else if (length(stage) > 1 && all(stage %in% 1:10)) { - p <- p + ggplot2::scale_x_continuous(breaks = stage) + + # plot lines and points + if (!ciModeEnabled) { + if (is.na(numberOfPairedLines)) { + numberOfPairedLines <- 2 + if (x$.isMultiArm()) { + numberOfPairedLines <- length(unique(data$treatmentArms)) - 1 + } else if (x$.isEnrichment()) { + numberOfPairedLines <- length(unique(data$populations)) - 1 + } + } + + p <- plotSettings$plotValues(p, plotPointsEnabled = FALSE, pointBorder = 1) + n <- length(unique(data$categories)) / numberOfPairedLines + if (n > 1) { + lineTypeValues <- rep(1:numberOfPairedLines, n) + colorTypes <- sort(rep(1:n, numberOfPairedLines)) + for (i in c(1, 3)) { + colorTypes[colorTypes >= i] <- colorTypes[colorTypes >= i] + 1 + } + p <- p + ggplot2::scale_color_manual(name = legendTitle, values = colorTypes) + p <- p + ggplot2::scale_linetype_manual(name = legendTitle, values = lineTypeValues) + } else { + colorValues <- c(2, 4) + if (!x$.isMultiArm()) { + colorValues <- c(2, 2) # use only one color + } + p <- p + ggplot2::scale_color_manual(name = legendTitle, values = colorValues) + p <- p + ggplot2::scale_linetype_manual(name = legendTitle, values = c(1, 2)) + } } # plot confidence intervall diff --git a/R/class_core_parameter_set.R b/R/class_core_parameter_set.R index 8068305f..a13f40e2 100644 --- a/R/class_core_parameter_set.R +++ b/R/class_core_parameter_set.R @@ -54,90 +54,107 @@ FieldSet <- R6Class("FieldSet", .getVisibleFieldNames = function() { fieldNames <- self$.getFieldNames() fieldNames <- fieldNames[!startsWith(fieldNames, ".")] - fieldNames <- fieldNames[!(fieldNames %in% .deprecatedFieldNames)] + fieldNames <- fieldNames[!(fieldNames %in% self$.deprecatedFieldNames)] return(fieldNames) }, .resetCat = function() { self$.catLines <- character() }, - .cat = function(..., file = "", sep = "", fill = FALSE, labels = NULL, - append = FALSE, heading = 0, tableColumns = 0, consoleOutputEnabled = TRUE, - na = NA_character_) { - if (consoleOutputEnabled) { - cat(..., file = file, sep = sep, fill = fill, labels = labels, append = append) - return(invisible()) - } - - args <- list(...) - line <- "" - if (length(args) > 0) { - if (tableColumns > 0) { - values <- unlist(args, use.names = FALSE) - values <- values[values != "\n"] - for (i in 1:length(values)) { - values[i] <- gsub("\n", "", values[i]) - } - if (!is.null(na) && length(na) == 1 && !is.na(na)) { - len <- min(nchar(values)) - naStr <- paste0(trimws(na), " ") - while (nchar(naStr) < len) { - naStr <- paste0(" ", naStr) - } - values[is.na(values) | nchar(trimws(values)) == 0] <- naStr - } - line <- paste0(values, collapse = "| ") - if (trimws(line) != "" && !grepl("\\| *$", line)) { - line <- paste0(line, "|") - } - line <- paste0("| ", line) - extraCells <- tableColumns - length(values) - if (extraCells > 0 && trimws(line) != "") { - line <- paste0(line, paste0(rep(" |", extraCells), collapse = "")) - } - line <- paste0(line, "\n") - } else { - line <- paste0(args, collapse = sep) - listItemEnabled <- grepl("^ ", line) - - headingBaseNumber <- as.integer(getOption("rpact.print.heading.base.number", 0L)) - if (is.na(headingBaseNumber)) { - headingBaseNumber <- 0L - } - if (headingBaseNumber < -2) { - warning( - "Illegal option ", sQuote("rpact.print.heading.base.number"), - " (", headingBaseNumber, ") was set to 0" - ) - headingBaseNumber <- 0L - } - if (headingBaseNumber > 4) { - warning( - "Illgeal option ", sQuote("rpact.print.heading.base.number"), - " (", headingBaseNumber, ") was set to 4 becasue it was too large" - ) - headingBaseNumber <- 4L - } - - if (heading > 0) { - if (headingBaseNumber %in% c(-1, -2)) { - lineBreak <- "" - if (grepl("\n *$", line)) { - lineBreak <- "\n\n" - } - fontStyle <- ifelse(headingBaseNumber == -1, "**", "*") - line <- paste0(fontStyle, sub(": *", "", trimws(line)), fontStyle, lineBreak) - } else { - headingCmd <- paste0(rep("#", heading + headingBaseNumber + 1), collapse = "") - lineBreak <- "" - if (grepl("\n *$", line)) { - lineBreak <- "\n\n" + .cat = function(..., file = "", sep = "", fill = FALSE, labels = NULL, + append = FALSE, heading = 0, tableColumns = 0, consoleOutputEnabled = TRUE, + na = NA_character_) { + if (consoleOutputEnabled) { + cat(..., file = file, sep = sep, fill = fill, labels = labels, append = append) + return(invisible()) + } + + args <- list(...) + line <- "" + if (length(args) > 0) { + if (tableColumns > 0) { + values <- unlist(args, use.names = FALSE) + values <- values[values != "\n"] + for (i in 1:length(values)) { + values[i] <- gsub("\n", "", values[i]) + } + if (!is.null(na) && length(na) == 1 && !is.na(na)) { + len <- min(nchar(values)) + naStr <- paste0(trimws(na), " ") + while (nchar(naStr) < len) { + naStr <- paste0(" ", naStr) + } + values[is.na(values) | nchar(trimws(values)) == 0] <- naStr + } + line <- paste0(values, collapse = "| ") + if (trimws(line) != "" && !grepl("\\| *$", line)) { + line <- paste0(line, "|") + } + line <- paste0("| ", line) + extraCells <- tableColumns - length(values) + if (extraCells > 0 && trimws(line) != "") { + line <- paste0(line, paste0(rep(" |", extraCells), collapse = "")) + } + line <- paste0(line, "\n") + } else { + line <- paste0(args, collapse = sep) + listItemEnabled <- grepl("^ ", line) + + headingBaseNumber <- as.integer(getOption("rpact.print.heading.base.number", 0L)) + if (is.na(headingBaseNumber)) { + headingBaseNumber <- 0L + } + if (headingBaseNumber < -2) { + warning( + "Illegal option ", sQuote("rpact.print.heading.base.number"), + " (", headingBaseNumber, ") was set to 0" + ) + headingBaseNumber <- 0L + } + if (headingBaseNumber > 4) { + warning( + "Illgeal option ", sQuote("rpact.print.heading.base.number"), + " (", headingBaseNumber, ") was set to 4 becasue it was too large" + ) + headingBaseNumber <- 4L + } + + if (heading > 0) { + if (headingBaseNumber %in% c(-1, -2)) { + lineBreak <- "" + if (grepl("\n *$", line)) { + lineBreak <- "\n\n" } - if (length(self$.catLines) == 0) { - self$.catLines <- line - } else { - self$.catLines <- c(self$.catLines, line) + fontStyle <- ifelse(headingBaseNumber == -1, "**", "*") + line <- paste0(fontStyle, sub(": *", "", trimws(line)), fontStyle, lineBreak) + } else { + headingCmd <- paste0(rep("#", heading + headingBaseNumber + 1), collapse = "") + lineBreak <- "" + if (grepl("\n *$", line)) { + lineBreak <- "\n\n" } - return(invisible()) + line <- paste0(headingCmd, " ", sub(": *", "", trimws(line)), lineBreak) + } + } else { + parts <- strsplit(line, " *: ")[[1]] + if (length(parts) == 2) { + line <- paste0("*", trimws(parts[1]), "*: ", parts[2]) + } + } + if (listItemEnabled) { + if (grepl("^ ", line)) { + line <- sub("^ ", "* ", line) + } else { + line <- paste0("* ", line) + } + } + } + } + if (length(.catLines) == 0) { + .catLines <<- line + } else { + .catLines <<- c(.catLines, line) + } + return(invisible()) }, .getFields = function(values) { flds <- self$.getFieldNames() @@ -150,7 +167,7 @@ FieldSet <- R6Class("FieldSet", } return(result) } - ) + ) ) #' @@ -180,8 +197,8 @@ ParameterSet <- R6Class("ParameterSet", initialize = function(..., .showParameterTypeEnabled = TRUE) { self$.showParameterTypeEnabled <- .showParameterTypeEnabled self$.parameterTypes <- list() - self$.deprecatedFieldNames <- character() self$.catLines <- character() + self$.deprecatedFieldNames <- character() }, .toString = function(startWithUpperCase = FALSE) { s <- .formatCamelCase(.getClassName(self)) @@ -274,7 +291,7 @@ ParameterSet <- R6Class("ParameterSet", return(self[[parameterName]]) } - parameterType <- .self$getRefClass()$fields()[[parameterName]] + parameterType <- self$getRefClass()$fields()[[parameterName]] if (parameterType == "numeric") { return(NA_real_) } @@ -292,7 +309,6 @@ ParameterSet <- R6Class("ParameterSet", .getParametersOfOneGroup = function(parameterType) { if (length(parameterType) == 1) { parameterNames <- names(self$.parameterTypes[self$.parameterTypes == parameterType]) - } else { parameterNames <- names(self$.parameterTypes[which(self$.parameterTypes %in% parameterType)]) } @@ -389,13 +405,13 @@ ParameterSet <- R6Class("ParameterSet", .showParameter = function(parameterName, showParameterType = FALSE, consoleOutputEnabled = TRUE) { tryCatch( { - params <- .getParameterValueFormatted(obj = .self, parameterName = parameterName) + params <- .getParameterValueFormatted(obj = self, parameterName = parameterName) if (is.null(params) || !is.list(params)) { return(invisible("")) } if (!is.null(names(params)) && "paramValue" %in% names(params)) { - return(.showParameterSingle( + return(self$.showParameterSingle( param = params, parameterName = parameterName, showParameterType = showParameterType, @@ -413,13 +429,13 @@ ParameterSet <- R6Class("ParameterSet", param$paramName <- parameterName category <- parts[2] - categoryCaption <- .getParameterCaption(category, .self) + categoryCaption <- .getParameterCaption(category, self) if (is.null(categoryCaption)) { categoryCaption <- paste0("%", category, "%") } category <- categoryCaption } - outputPart <- .showParameterSingle( + outputPart <- self$.showParameterSingle( param = param, parameterName = parameterName, category = category, @@ -460,7 +476,7 @@ ParameterSet <- R6Class("ParameterSet", index <- 1 for (i in 1:numberOfEntries) { for (j in 1:numberOfRows) { - output <- paste0(output, .showParameterFormatted( + output <- paste0(output, self$.showParameterFormatted( paramName = param$paramName, paramValue = param$paramValue[j, , i], paramValueFormatted = param$paramValueFormatted[[index]], @@ -471,406 +487,38 @@ ParameterSet <- R6Class("ParameterSet", paramNameRaw = parameterName, numberOfCategories = numberOfEntries )) - } - self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) - output <- paste0(output, "\n") - invisible(output) - } - }, - .showParameter = function(parameterName, showParameterType = FALSE, consoleOutputEnabled = TRUE) { - tryCatch( - { - - params <- .getParameterValueFormatted(obj = self, parameterName = parameterName) - if (is.null(params) || !is.list(params)) { - return(invisible("")) - } - - if (!is.null(names(params)) && "paramValue" %in% names(params)) { - return(self$.showParameterSingle( - param = params, - parameterName = parameterName, - showParameterType = showParameterType, - consoleOutputEnabled = consoleOutputEnabled - )) - } - - output <- "" - for (i in 1:length(params)) { - param <- params[[i]] - category <- NULL - parts <- strsplit(param$paramName, "$", fixed = TRUE)[[1]] - if (length(parts) == 2) { - parameterName <- parts[1] - param$paramName <- parameterName - - category <- parts[2] - categoryCaption <- self$.parameterNames[[category]] - if (is.null(categoryCaption)) { - categoryCaption <- paste0("%", category, "%") - } - category <- categoryCaption - } - outputPart <- self$.showParameterSingle( - param = param, - parameterName = parameterName, - category = category, - showParameterType = showParameterType, - consoleOutputEnabled = consoleOutputEnabled - ) - if (nchar(output) > 0) { - output <- paste0(output, "\n", outputPart) - } else { - output <- outputPart - } - } - return(invisible(output)) - }, - error = function(e) { - if (consoleOutputEnabled) { - warning("Failed to show parameter '", parameterName, "': ", e$message) - } - } - ) - }, - .showParameterSingle = function(param, - parameterName, ..., - category = NULL, - showParameterType = FALSE, - consoleOutputEnabled = TRUE) { - if (is.null(param)) { - return(invisible("")) - } - - output <- "" - tryCatch( - { - if (param$type == "array" && length(dim(param$paramValue)) == 3) { - numberOfEntries <- dim(param$paramValue)[3] - numberOfRows <- dim(param$paramValue)[1] - if (numberOfEntries > 0 && numberOfRows > 0) { - index <- 1 - for (i in 1:numberOfEntries) { - for (j in 1:numberOfRows) { - output <- paste0(output, self$.showParameterFormatted( - paramName = param$paramName, - paramValue = param$paramValue[j, , i], - paramValueFormatted = param$paramValueFormatted[[index]], - showParameterType = showParameterType, - category = i, - matrixRow = ifelse(numberOfRows == 1, NA_integer_, j), - consoleOutputEnabled = consoleOutputEnabled, - paramNameRaw = parameterName, - numberOfCategories = numberOfEntries - )) - index <- index + 1 - } - } - } - } else if (param$type %in% c("matrix", "array")) { - n <- length(param$paramValueFormatted) - if (n > 0) { - for (i in 1:n) { - paramValue <- param$paramValue - if (is.array(paramValue) && - length(dim(paramValue)) == 3 && - dim(paramValue)[3] == 1) { - paramValue <- paramValue[i, , 1] - } else if (dim(paramValue)[1] > 1 || dim(paramValue)[2] > 1) { - paramValue <- paramValue[i, ] - } - - output <- paste0(output, self$.showParameterFormatted( - paramName = param$paramName, - paramValue = paramValue, - paramValueFormatted = param$paramValueFormatted[[i]], - showParameterType = showParameterType, - category = category, - matrixRow = ifelse(n == 1, NA_integer_, i), - consoleOutputEnabled = consoleOutputEnabled, - paramNameRaw = parameterName, - numberOfCategories = n - )) - } - } - } else { - output <- self$.showParameterFormatted( - paramName = param$paramName, - paramValue = param$paramValue, - paramValueFormatted = param$paramValueFormatted, - showParameterType = showParameterType, - category = category, - consoleOutputEnabled = consoleOutputEnabled, - paramNameRaw = parameterName - ) - } - }, - error = function(e) { - if (consoleOutputEnabled) { - warning("Failed to show single parameter '", parameterName, "' (", param$type, "): ", e$message) - } - } - ) - return(invisible(output)) - }, - .extractParameterNameAndValue = function(parameterName) { - d <- regexpr(paste0("\\..+\\$"), parameterName) - if (d[1] != 1) { - return(list(parameterName = parameterName, paramValue = self[[parameterName]])) - } - - index <- attr(d, "match.length") - objectName <- substr(parameterName, 1, index - 1) - parameterName <- substr(parameterName, index + 1, nchar(parameterName)) - paramValue <- self[[objectName]][[parameterName]] - - # .closedTestResults$rejected - 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)) - }, - .showUnknownParameters = function(consoleOutputEnabled = TRUE) { - params <- self$.getUndefinedParameters() - if (length(params) > 0) { - self$.showParametersOfOneGroup(params, "ISSUES (parameters with undefined type)", - consoleOutputEnabled = consoleOutputEnabled - ) - } - }, - .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 <- self$.parameterNames[[paramNameRaw]] - } - if (is.null(paramCaption)) { - paramCaption <- self$.parameterNames[[paramName]] - } - if (is.null(paramCaption)) { - paramCaption <- paste0("%", paramName, "%") - } - if (!is.null(category) && !is.na(category)) { - if (.isMultiArmSimulationResults(self) && paramName == "singleNumberOfEventsPerStage") { - if (!(inherits(self, "SimulationResultsEnrichmentSurvival") || inherits(self, "SimulationResultsEnrichmentSurvival")) && - !is.na(numberOfCategories) && numberOfCategories == category) { - category <- "control" - } - paramCaption <- paste0(paramCaption, " {", category, "}") - } else if (paramName == "effectList") { - paramCaption <- paste0(paramCaption, " [", category, "]") - } else if (.isEnrichmentSimulationResults(self)) { - categoryCaption <- .getCategoryCaptionEnrichment(self, paramName, category) - paramCaption <- paste0(paramCaption, " (", categoryCaption, ")") - } else { - paramCaption <- paste0(paramCaption, " (", category, ")") - } - - if (!is.na(matrixRow)) { - if (paramName == "effectList") { - paramCaption <- paste0(paramCaption, " (", matrixRow, ")") - } else { - paramCaption <- paste0(paramCaption, " [", matrixRow, "]") - } - } - } else if (!is.na(matrixRow)) { - if (.isMultiArmAnalysisResults(self) && paramName %in% - c( - "conditionalErrorRate", "secondStagePValues", - "adjustedStageWisePValues", "overallAdjustedTestStatistics" - )) { - treatments <- self$.closedTestResults$.getHypothesisTreatmentArmVariants()[matrixRow] - paramCaption <- paste0( - "Treatment", ifelse(grepl(",", treatments), "s", ""), " ", - treatments, " vs. control" - ) - } else if (.isEnrichmentAnalysisResults(self) || .isEnrichmentStageResults(self) || - (inherits(self, "ClosedCombinationTestResults") && isTRUE(self$.enrichment))) { - if (paramName %in% c( - "indices", "conditionalErrorRate", "secondStagePValues", - "adjustedStageWisePValues", "overallAdjustedTestStatistics", "rejectedIntersections" - )) { - if (.isEnrichmentAnalysisResults(self)) { - populations <- self$.closedTestResults$.getHypothesisPopulationVariants()[matrixRow] - } else if (inherits(self, "ClosedCombinationTestResults")) { - populations <- self$.getHypothesisPopulationVariants()[matrixRow] - } else { - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, "only ClosedCombinationTestResults ", - "supports function .getHypothesisPopulationVariants() (object is ", .getClassName(self), ")" - ) - } - paramCaption <- paste0(paramCaption, " ", populations) - } else { - if (!is.na(numberOfCategories) && numberOfCategories == matrixRow) { - paramCaption <- paste0(paramCaption, " F") - } else { - paramCaption <- paste0(paramCaption, " S", matrixRow) - } - } - } else if (.isMultiArmAnalysisResults(self) || grepl("StageResultsMultiArm", .getClassName(self)) || - ((inherits(self, "SimulationResults") || inherits(self, "SimulationResults")) && paramName == "effectMatrix") || - (inherits(self, "ClosedCombinationTestResults") && - paramName %in% c("rejected", "separatePValues"))) { - paramCaption <- paste0(paramCaption, " (", matrixRow, ")") - } else { - paramCaption <- paste0(paramCaption, " [", matrixRow, "]") - } - } - if (is.null(paramValueFormatted) || length(paramValueFormatted) == 0 || - is.na(paramValueFormatted)) { - paramValueFormatted <- paramValue - } - if (is.list(paramValueFormatted)) { - paramValueFormatted <- .listToString(paramValueFormatted) - } - if (is.function(paramValue) || grepl("Function$", paramName)) { - paramValueFormatted <- ifelse( - self$.getParameterType(paramName) == C_PARAM_USER_DEFINED, - ifelse(.isCppCode(paramValueFormatted), "user defined (C++)", "user defined"), - "default" - ) - } - prefix <- ifelse(showParameterType, self$.showParameterType(paramName), "") - variableNameFormatted <- .getFormattedVariableName( - name = paramCaption, - n = self$.getNChar(), prefix = prefix - ) - - output <- paste(variableNameFormatted, paramValueFormatted, "\n") - self$.cat(output, consoleOutputEnabled = consoleOutputEnabled) - invisible(output) - }, - .getNChar = function() { - if (length(self$.parameterNames) == 0) { - return(40) - } - - return(min(40, max(nchar(self$.parameterNames))) + 4) - }, - .showParameterTypeDescription = function(consoleOutputEnabled = consoleOutputEnabled) { - self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) - self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) - self$.cat(" ", C_PARAM_USER_DEFINED, ": user defined\n", consoleOutputEnabled = consoleOutputEnabled) - self$.cat(" ", C_PARAM_DERIVED, ": derived value\n", consoleOutputEnabled = consoleOutputEnabled) - self$.cat(" ", C_PARAM_DEFAULT_VALUE, ": default value\n", consoleOutputEnabled = consoleOutputEnabled) - self$.cat(" ", C_PARAM_GENERATED, ": generated/calculated value\n", consoleOutputEnabled = consoleOutputEnabled) - self$.cat(" ", C_PARAM_NOT_APPLICABLE, ": not applicable or hidden\n", consoleOutputEnabled = consoleOutputEnabled) - }, - .printAsDataFrame = function(parameterNames, niceColumnNamesEnabled = FALSE, - includeAllParameters = FALSE, handleParameterNamesAsToBeExcluded = FALSE, - lineBreakEnabled = FALSE) { - if (.isTrialDesign(self)) { - tableColumnNames <- .getTableColumnNames(design = self) - } else { - tableColumnNames <- C_TABLE_COLUMN_NAMES - } - - if (.isTrialDesignPlan(self)) { - parameterNames <- NULL - } - - dataFrame <- .getAsDataFrame( - parameterSet = self, - parameterNames = parameterNames, - niceColumnNamesEnabled = niceColumnNamesEnabled, - includeAllParameters = includeAllParameters, - handleParameterNamesAsToBeExcluded = handleParameterNamesAsToBeExcluded, - returnParametersAsCharacter = TRUE, - tableColumnNames = tableColumnNames - ) - - result <- as.matrix(dataFrame) - if (.isTrialDesignPlan(self)) { - dimnames(result)[[1]] <- paste(" ", c(1:nrow(dataFrame))) - } else if (!is.null(dataFrame[["stages"]])) { - dimnames(result)[[1]] <- paste(" Stage", dataFrame$stages) - } - - print(result, quote = FALSE, right = FALSE) - }, - .getNumberOfRows = function(parameterNames) { - numberOfRows <- 1 - for (parameterName in parameterNames) { - parameterValues <- self[[parameterName]] - if (is.vector(parameterValues) && length(parameterValues) > numberOfRows) { - numberOfRows <- length(parameterValues) - } else if (is.matrix(parameterValues) && (nrow(parameterValues) == 1 || ncol(parameterValues) == 1) && - length(parameterValues) > numberOfRows) { - numberOfRows <- length(parameterValues) - } - } - return(numberOfRows) - }, - .containsMultidimensionalParameters = function(parameterNames) { - for (parameterName in parameterNames) { - parameterValues <- self[[parameterName]] - if (!is.null(parameterValues) && is.matrix(parameterValues) && - nrow(parameterValues) > 0 && ncol(parameterValues) > 0) { - return(TRUE) - } - } - return(FALSE) - }, - .getMultidimensionalNumberOfStages = function(parameterNames) { - if (!is.null(self[[".design"]])) { - return(self$.design$kMax) - } - - n <- 1 - for (parameterName in parameterNames) { - parameterValues <- self[[parameterName]] - if (!is.null(parameterValues) && is.matrix(parameterValues) && - ncol(parameterValues) > 0 && nrow(parameterValues) > n) { - n <- nrow(parameterValues) - } - } - return(n) - }, - .getVariedParameter = function(parameterNames, numberOfVariants) { - - # search for user defined parameters - for (parameterName in parameterNames) { - parameterValues <- self[[parameterName]] - if (!is.null(parameterValues) && !is.matrix(parameterValues) && - length(parameterValues) == numberOfVariants && - parameterName %in% C_VARIABLE_DESIGN_PLAN_PARAMETERS && - self$.getParameterType(parameterName) == C_PARAM_USER_DEFINED) { - return(parameterName) - } - } - - # search for default values - for (parameterName in parameterNames) { - parameterValues <- self[[parameterName]] - if (!is.null(parameterValues) && !is.matrix(parameterValues) && - length(parameterValues) == numberOfVariants && - parameterName %in% C_VARIABLE_DESIGN_PLAN_PARAMETERS && - self$.getParameterType(parameterName) == C_PARAM_DEFAULT_VALUE) { - return(parameterName) - } + index <- index + 1 } - - return(NULL) - }, - .getDataFrameColumnCaption = function(parameterName, tableColumnNames, niceColumnNamesEnabled) { - if (length(parameterName) == 0 || parameterName == "") { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'parameterName' must be a valid parameter name") + } + } + } else if (param$type %in% c("matrix", "array")) { + n <- length(param$paramValueFormatted) + if (n > 0) { + for (i in 1:n) { + paramValue <- param$paramValue + if (is.array(paramValue) && + length(dim(paramValue)) == 3 && + dim(paramValue)[3] == 1) { + paramValue <- paramValue[i, , 1] + } else if (dim(paramValue)[1] > 1 || dim(paramValue)[2] > 1) { + paramValue <- paramValue[i, ] } - - tableColumnName <- tableColumnNames[[parameterName]] - return(ifelse(niceColumnNamesEnabled && !is.null(tableColumnName), - tableColumnName, parameterName + + output <- paste0(output, self$.showParameterFormatted( + paramName = param$paramName, + paramValue = paramValue, + paramValueFormatted = param$paramValueFormatted[[i]], + showParameterType = showParameterType, + category = category, + matrixRow = ifelse(n == 1, NA_integer_, i), + consoleOutputEnabled = consoleOutputEnabled, + paramNameRaw = parameterName, + numberOfCategories = n )) } } } else { - output <- .showParameterFormatted( + output <- self$.showParameterFormatted( paramName = param$paramName, paramValue = param$paramValue, paramValueFormatted = param$paramValueFormatted, @@ -894,7 +542,7 @@ ParameterSet <- R6Class("ParameterSet", if (d[1] != 1) { return(list( parameterName = parameterName, - paramValue = base::get(parameterName, envir = .self) + paramValue = base::get(parameterName, envir = self) )) } @@ -915,9 +563,9 @@ ParameterSet <- R6Class("ParameterSet", return(list(parameterName = parameterName, paramValue = paramValue)) }, .showUnknownParameters = function(consoleOutputEnabled = TRUE) { - params <- .getUndefinedParameters() + params <- self$.getUndefinedParameters() if (length(params) > 0) { - .showParametersOfOneGroup(params, "ISSUES (parameters with undefined type)", + self$.showParametersOfOneGroup(params, "ISSUES (parameters with undefined type)", consoleOutputEnabled = consoleOutputEnabled ) } @@ -926,25 +574,25 @@ ParameterSet <- R6Class("ParameterSet", showParameterType = FALSE, category = NULL, matrixRow = NA_integer_, consoleOutputEnabled = TRUE, paramNameRaw = NA_character_, numberOfCategories = NA_integer_) { if (!is.na(paramNameRaw)) { - paramCaption <- .getParameterCaption(paramNameRaw, .self) + paramCaption <- .getParameterCaption(paramNameRaw, self) } if (is.null(paramCaption)) { - paramCaption <- .getParameterCaption(paramName, .self) + paramCaption <- .getParameterCaption(paramName, self) } if (is.null(paramCaption)) { paramCaption <- paste0("%", paramName, "%") } if (!is.null(category) && !is.na(category)) { - if (.isMultiArmSimulationResults(.self) && paramName == "singleEventsPerArmAndStage") { - if (!inherits(.self, "SimulationResultsEnrichmentSurvival") && + if (.isMultiArmSimulationResults(self) && paramName == "singleEventsPerArmAndStage") { + if (!inherits(self, "SimulationResultsEnrichmentSurvival") && !is.na(numberOfCategories) && numberOfCategories == category) { category <- "control" } paramCaption <- paste0(paramCaption, " {", category, "}") } else if (paramName == "effectList") { paramCaption <- paste0(paramCaption, " [", category, "]") - } else if (.isEnrichmentSimulationResults(.self)) { - categoryCaption <- .getCategoryCaptionEnrichment(.self, paramName, category) + } else if (.isEnrichmentSimulationResults(self)) { + categoryCaption <- .getCategoryCaptionEnrichment(self, paramName, category) paramCaption <- paste0(paramCaption, " (", categoryCaption, ")") } else { paramCaption <- paste0(paramCaption, " (", category, ")") @@ -958,7 +606,7 @@ ParameterSet <- R6Class("ParameterSet", } } } else if (!is.na(matrixRow)) { - if (.isMultiArmAnalysisResults(.self) && paramName %in% + if (.isMultiArmAnalysisResults(self) && paramName %in% c( "conditionalErrorRate", "secondStagePValues", "adjustedStageWisePValues", "overallAdjustedTestStatistics" @@ -968,20 +616,20 @@ ParameterSet <- R6Class("ParameterSet", "Treatment", ifelse(grepl(",", treatments), "s", ""), " ", treatments, " vs. control" ) - } else if (.isEnrichmentAnalysisResults(.self) || .isEnrichmentStageResults(.self) || - (inherits(.self, "ClosedCombinationTestResults") && isTRUE(.self$.enrichment))) { + } else if (.isEnrichmentAnalysisResults(self) || .isEnrichmentStageResults(self) || + (inherits(self, "ClosedCombinationTestResults") && isTRUE(self$.enrichment))) { if (paramName %in% c( "indices", "conditionalErrorRate", "secondStagePValues", "adjustedStageWisePValues", "overallAdjustedTestStatistics", "rejectedIntersections" )) { - if (.isEnrichmentAnalysisResults(.self)) { + if (.isEnrichmentAnalysisResults(self)) { populations <- .closedTestResults$.getHypothesisPopulationVariants()[matrixRow] - } else if (inherits(.self, "ClosedCombinationTestResults")) { - populations <- .self$.getHypothesisPopulationVariants()[matrixRow] + } else if (inherits(self, "ClosedCombinationTestResults")) { + populations <- self$.getHypothesisPopulationVariants()[matrixRow] } else { stop( C_EXCEPTION_TYPE_RUNTIME_ISSUE, "only ClosedCombinationTestResults ", - "supports function .getHypothesisPopulationVariants() (object is ", .getClassName(.self), ")" + "supports function .getHypothesisPopulationVariants() (object is ", .getClassName(self), ")" ) } paramCaption <- paste0(paramCaption, " ", populations) @@ -992,9 +640,9 @@ ParameterSet <- R6Class("ParameterSet", paramCaption <- paste0(paramCaption, " S", matrixRow) } } - } else if (.isMultiArmAnalysisResults(.self) || grepl("StageResultsMultiArm", .getClassName(.self)) || - (inherits(.self, "SimulationResults") && paramName == "effectMatrix") || - (inherits(.self, "ClosedCombinationTestResults") && + } else if (.isMultiArmAnalysisResults(self) || grepl("StageResultsMultiArm", .getClassName(self)) || + (inherits(self, "SimulationResults") && paramName == "effectMatrix") || + (inherits(self, "ClosedCombinationTestResults") && paramName %in% c("rejected", "separatePValues"))) { paramCaption <- paste0(paramCaption, " (", matrixRow, ")") } else { @@ -1010,52 +658,52 @@ ParameterSet <- R6Class("ParameterSet", } if (is.function(paramValue) || grepl("Function$", paramName)) { paramValueFormatted <- ifelse( - .getParameterType(paramName) == C_PARAM_USER_DEFINED, + self$.getParameterType(paramName) == C_PARAM_USER_DEFINED, ifelse(.isCppCode(paramValueFormatted), "user defined (C++)", "user defined"), "default" ) } - prefix <- ifelse(showParameterType, .showParameterType(paramName), "") + prefix <- ifelse(showParameterType, self$.showParameterType(paramName), "") variableNameFormatted <- .getFormattedVariableName( name = paramCaption, - n = .getNChar(), prefix = prefix + n = self$.getNChar(), prefix = prefix ) output <- paste(variableNameFormatted, paramValueFormatted, "\n") - .cat(output, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(output, consoleOutputEnabled = consoleOutputEnabled) invisible(output) }, .getNChar = function() { - fieldNames <- .getVisibleFieldNames() + fieldNames <- self$.getVisibleFieldNames() if (length(fieldNames) == 0) { return(40) } fieldCaptions <- character() for (parameterName in fieldNames) { - fieldCaptions <- c(fieldCaptions, .getParameterCaption(parameterName, .self)) + fieldCaptions <- c(fieldCaptions, .getParameterCaption(parameterName, self)) } return(min(40, max(nchar(fieldCaptions))) + 4) }, .showParameterTypeDescription = function(consoleOutputEnabled = consoleOutputEnabled) { - .cat("\n", consoleOutputEnabled = consoleOutputEnabled) - .cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) - .cat(" ", C_PARAM_USER_DEFINED, ": user defined\n", consoleOutputEnabled = consoleOutputEnabled) - .cat(" ", C_PARAM_DERIVED, ": derived value\n", consoleOutputEnabled = consoleOutputEnabled) - .cat(" ", C_PARAM_DEFAULT_VALUE, ": default value\n", consoleOutputEnabled = consoleOutputEnabled) - .cat(" ", C_PARAM_GENERATED, ": generated/calculated value\n", consoleOutputEnabled = consoleOutputEnabled) - .cat(" ", C_PARAM_NOT_APPLICABLE, ": not applicable or hidden\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" ", C_PARAM_USER_DEFINED, ": user defined\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" ", C_PARAM_DERIVED, ": derived value\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" ", C_PARAM_DEFAULT_VALUE, ": default value\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" ", C_PARAM_GENERATED, ": generated/calculated value\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" ", C_PARAM_NOT_APPLICABLE, ": not applicable or hidden\n", consoleOutputEnabled = consoleOutputEnabled) }, .printAsDataFrame = function(parameterNames, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, handleParameterNamesAsToBeExcluded = FALSE, lineBreakEnabled = FALSE) { - if (.isTrialDesignPlan(.self)) { + if (.isTrialDesignPlan(self)) { parameterNames <- NULL } dataFrame <- .getAsDataFrame( - parameterSet = .self, + parameterSet = self, parameterNames = parameterNames, niceColumnNamesEnabled = niceColumnNamesEnabled, includeAllParameters = includeAllParameters, @@ -1063,7 +711,7 @@ ParameterSet <- R6Class("ParameterSet", returnParametersAsCharacter = TRUE ) result <- as.matrix(dataFrame) - if (.isTrialDesignPlan(.self)) { + if (.isTrialDesignPlan(self)) { dimnames(result)[[1]] <- paste(" ", c(1:nrow(dataFrame))) } else if (!is.null(dataFrame[["stages"]])) { dimnames(result)[[1]] <- paste(" Stage", dataFrame$stages) @@ -1074,7 +722,7 @@ ParameterSet <- R6Class("ParameterSet", .getNumberOfRows = function(parameterNames) { numberOfRows <- 1 for (parameterName in parameterNames) { - parameterValues <- .self[[parameterName]] + parameterValues <- self[[parameterName]] if (is.vector(parameterValues) && length(parameterValues) > numberOfRows) { numberOfRows <- length(parameterValues) } else if (is.matrix(parameterValues) && (nrow(parameterValues) == 1 || ncol(parameterValues) == 1) && @@ -1086,7 +734,7 @@ ParameterSet <- R6Class("ParameterSet", }, .containsMultidimensionalParameters = function(parameterNames) { for (parameterName in parameterNames) { - parameterValues <- .self[[parameterName]] + parameterValues <- self[[parameterName]] if (!is.null(parameterValues) && is.matrix(parameterValues) && nrow(parameterValues) > 0 && ncol(parameterValues) > 0) { return(TRUE) @@ -1095,13 +743,13 @@ ParameterSet <- R6Class("ParameterSet", return(FALSE) }, .getMultidimensionalNumberOfStages = function(parameterNames) { - if (!is.null(.self[[".design"]])) { - return(.self$.design$kMax) + if (!is.null(self[[".design"]])) { + return(self$.design$kMax) } n <- 1 for (parameterName in parameterNames) { - parameterValues <- .self[[parameterName]] + parameterValues <- self[[parameterName]] if (!is.null(parameterValues) && is.matrix(parameterValues) && ncol(parameterValues) > 0 && nrow(parameterValues) > n) { n <- nrow(parameterValues) @@ -1112,22 +760,22 @@ ParameterSet <- R6Class("ParameterSet", .getVariedParameter = function(parameterNames, numberOfVariants) { # search for user defined parameters for (parameterName in parameterNames) { - parameterValues <- .self[[parameterName]] + parameterValues <- self[[parameterName]] if (!is.null(parameterValues) && !is.matrix(parameterValues) && length(parameterValues) == numberOfVariants && parameterName %in% C_VARIABLE_DESIGN_PLAN_PARAMETERS && - .getParameterType(parameterName) == C_PARAM_USER_DEFINED) { + self$.getParameterType(parameterName) == C_PARAM_USER_DEFINED) { return(parameterName) } } # search for default values for (parameterName in parameterNames) { - parameterValues <- .self[[parameterName]] + parameterValues <- self[[parameterName]] if (!is.null(parameterValues) && !is.matrix(parameterValues) && length(parameterValues) == numberOfVariants && parameterName %in% C_VARIABLE_DESIGN_PLAN_PARAMETERS && - .getParameterType(parameterName) == C_PARAM_DEFAULT_VALUE) { + self$.getParameterType(parameterName) == C_PARAM_DEFAULT_VALUE) { return(parameterName) } } @@ -1143,13 +791,13 @@ ParameterSet <- R6Class("ParameterSet", return(parameterName) } - tableColumnName <- .getParameterCaption(parameterName, .self, tableOutputEnabled = TRUE) + tableColumnName <- .getParameterCaption(parameterName, self, tableOutputEnabled = TRUE) return(ifelse(!is.null(tableColumnName), tableColumnName, parameterName)) }, .getUnidimensionalNumberOfStages = function(parameterNames) { - kMax <- .self[["kMax"]] - if (is.null(kMax) && !is.null(.self[[".design"]])) { - kMax <- .self[[".design"]][["kMax"]] + kMax <- self[["kMax"]] + if (is.null(kMax) && !is.null(self[[".design"]])) { + kMax <- self[[".design"]][["kMax"]] } if (!is.null(kMax) && length(kMax) == 1 && is.integer(kMax)) { return(kMax) @@ -1157,7 +805,7 @@ ParameterSet <- R6Class("ParameterSet", n <- 1 for (parameterName in parameterNames) { - parameterValues <- .self[[parameterName]] + parameterValues <- self[[parameterName]] if (!is.null(parameterValues) && !is.matrix(parameterValues) && length(parameterValues) > n) { n <- length(parameterValues) @@ -1169,7 +817,7 @@ ParameterSet <- R6Class("ParameterSet", parameterName, parameterValues, parameterCaption) { tryCatch( { - formatFunctionName <- .getParameterFormatFunction(parameterName, .self) + formatFunctionName <- .getParameterFormatFunction(parameterName, self) if (!is.null(formatFunctionName)) { parameterValuesFormatted <- eval(call(formatFunctionName, parameterValues)) } else { @@ -1198,7 +846,7 @@ ParameterSet <- R6Class("ParameterSet", .logError(paste0( "Error in '.getAsDataFrame'. Failed to show parameter '%s' ", "(class '%s'): %s" - ), parameterName, .getClassName(.self), e) + ), parameterName, .getClassName(self), e) } ) }, @@ -1226,203 +874,203 @@ ParameterSet <- R6Class("ParameterSet", return(x[which(names(x) %in% listEntryNames)]) }, .isMultiHypothesesObject = function() { - return(.isEnrichmentAnalysisResults(.self) || .isEnrichmentStageResults(.self) || - .isMultiArmAnalysisResults(.self) || .isMultiArmStageResults(.self)) + return(.isEnrichmentAnalysisResults(self) || .isEnrichmentStageResults(self) || + .isMultiArmAnalysisResults(self) || .isMultiArmStageResults(self)) }, .isEnrichmentObject = function() { - return(.isEnrichmentAnalysisResults(.self) || .isEnrichmentStageResults(.self)) + return(.isEnrichmentAnalysisResults(self) || .isEnrichmentStageResults(self)) } ) ) .getMultidimensionalNumberOfVariants <- function(parameterSet, parameterNames) { - if (!is.null(parameterSet[["effectList"]])) { - effectMatrixName <- .getSimulationEnrichmentEffectMatrixName(parameterSet) - return(nrow(parameterSet$effectList[[effectMatrixName]])) - } - - parameterNames <- parameterNames[!(parameterNames %in% c( - "accrualTime", "accrualIntensity", - "plannedSubjects", "plannedEvents", - "minNumberOfSubjectsPerStage", "maxNumberOfSubjectsPerStage", - "minNumberOfEventsPerStage", "maxNumberOfEventsPerStage", - "piecewiseSurvivalTime", "lambda2", "adaptations", - "adjustedStageWisePValues", "overallAdjustedTestStatistics" - ))] - if (!is.null(parameterSet[[".piecewiseSurvivalTime"]]) && - parameterSet$.piecewiseSurvivalTime$piecewiseSurvivalEnabled) { - parameterNames <- parameterNames[!(parameterNames %in% c("lambda1"))] - } - - n <- 1 - for (parameterName in parameterNames) { - parameterValues <- parameterSet[[parameterName]] - if (!is.null(parameterValues) && (is.matrix(parameterValues) || !is.array(parameterValues))) { - if (is.matrix(parameterValues)) { - if (parameterSet$.isMultiHypothesesObject()) { - if (nrow(parameterValues) > n && ncol(parameterValues) > 0) { - n <- nrow(parameterValues) - } - } else if (nrow(parameterValues) > 0 && ncol(parameterValues) > n) { - n <- ncol(parameterValues) + if (!is.null(parameterSet[["effectList"]])) { + effectMatrixName <- .getSimulationEnrichmentEffectMatrixName(parameterSet) + return(nrow(parameterSet$effectList[[effectMatrixName]])) + } + + parameterNames <- parameterNames[!(parameterNames %in% c( + "accrualTime", "accrualIntensity", + "plannedSubjects", "plannedEvents", + "minNumberOfSubjectsPerStage", "maxNumberOfSubjectsPerStage", + "minNumberOfEventsPerStage", "maxNumberOfEventsPerStage", + "piecewiseSurvivalTime", "lambda2", "adaptations", + "adjustedStageWisePValues", "overallAdjustedTestStatistics" + ))] + if (!is.null(parameterSet[[".piecewiseSurvivalTime"]]) && + parameterSet$.piecewiseSurvivalTime$piecewiseSurvivalEnabled) { + parameterNames <- parameterNames[!(parameterNames %in% c("lambda1"))] + } + + n <- 1 + for (parameterName in parameterNames) { + parameterValues <- parameterSet[[parameterName]] + if (!is.null(parameterValues) && (is.matrix(parameterValues) || !is.array(parameterValues))) { + if (is.matrix(parameterValues)) { + if (parameterSet$.isMultiHypothesesObject()) { + if (nrow(parameterValues) > n && ncol(parameterValues) > 0) { + n <- nrow(parameterValues) + } + } else if (nrow(parameterValues) > 0 && ncol(parameterValues) > n) { + n <- ncol(parameterValues) + } + } else if (length(parameterValues) > n && + !parameterSet$.isMultiHypothesesObject()) { + n <- length(parameterValues) + } } - } else if (length(parameterValues) > n && - !parameterSet$.isMultiHypothesesObject()) { - n <- length(parameterValues) - } } - } - return(n) + return(n) } .getDataFrameColumnValues <- function(parameterSet, - parameterName, - numberOfVariants, - numberOfStages, - includeAllParameters, - mandatoryParameterNames) { - if (parameterSet$.getParameterType(parameterName) == C_PARAM_TYPE_UNKNOWN && - parameterName != "futilityStop") { - return(NULL) - } - - if (!includeAllParameters && - parameterSet$.getParameterType(parameterName) == C_PARAM_NOT_APPLICABLE && - !(parameterName %in% mandatoryParameterNames)) { - return(NULL) - } - - parameterValues <- parameterSet[[parameterName]] - if (is.null(parameterValues) || length(parameterValues) == 0) { - return(NULL) - } - - if (is.function(parameterValues)) { - return(NULL) - } - - if (is.array(parameterValues) && !is.matrix(parameterValues)) { - return(NULL) - } - - if (parameterName %in% c("adjustedStageWisePValues", "overallAdjustedTestStatistics")) { - return(NULL) - } - - if (!is.matrix(parameterValues)) { - if (length(parameterValues) == 1) { - return(rep(parameterValues, numberOfVariants * numberOfStages)) + parameterName, + numberOfVariants, + numberOfStages, + includeAllParameters, + mandatoryParameterNames) { + if (parameterSet$.getParameterType(parameterName) == C_PARAM_TYPE_UNKNOWN && + parameterName != "futilityStop") { + return(NULL) } - - if (parameterSet$.isMultiHypothesesObject()) { - if (length(parameterValues) == numberOfStages) { - return(as.vector(sapply(FUN = rep, X = parameterValues, times = numberOfVariants))) - } + + if (!includeAllParameters && + parameterSet$.getParameterType(parameterName) == C_PARAM_NOT_APPLICABLE && + !(parameterName %in% mandatoryParameterNames)) { + return(NULL) } - - if (length(parameterValues) == numberOfVariants) { - return(rep(parameterValues, numberOfStages)) + + parameterValues <- parameterSet[[parameterName]] + if (is.null(parameterValues) || length(parameterValues) == 0) { + return(NULL) } - - if (length(parameterValues) == numberOfStages && - parameterName %in% c( - "plannedEvents", "plannedSubjects", - "minNumberOfEventsPerStage", "maxNumberOfEventsPerStage", - "minNumberOfSubjectsPerStage", "maxNumberOfSubjectsPerStage", - "allocationRatioPlanned" - )) { - values <- c() - for (stage in 1:numberOfStages) { - values <- c(values, rep(parameterValues[stage], numberOfVariants)) - } - return(values) + + if (is.function(parameterValues)) { + return(NULL) } - - if (parameterName %in% c( - "accrualTime", "accrualIntensity", - "plannedEvents", "plannedSubjects", - "minNumberOfEventsPerStage", "maxNumberOfEventsPerStage", - "minNumberOfSubjectsPerStage", "maxNumberOfSubjectsPerStage", - "piecewiseSurvivalTime", "lambda2" - )) { - return(NULL) + + if (is.array(parameterValues) && !is.matrix(parameterValues)) { + return(NULL) } - - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, - "parameter '", parameterName, "' has an invalid ", - "dimension (length is ", length(parameterValues), ")" - ) - } else if (parameterName == "effectMatrix") { - # return effect matrix row if 'effectMatrix' is user defined - if (parameterSet$.getParameterType("effectMatrix") == C_PARAM_USER_DEFINED) { - return(1:ncol(parameterValues)) + + if (parameterName %in% c("adjustedStageWisePValues", "overallAdjustedTestStatistics")) { + return(NULL) } - - return(parameterValues[nrow(parameterValues), ]) - } - - if (grepl("futility|alpha0Vec|earlyStop", parameterName) && - nrow(parameterValues) == numberOfStages - 1) { - parameterValues <- rbind(parameterValues, rep(NA_real_, ncol(parameterValues))) - } - - if (nrow(parameterValues) == numberOfStages && ncol(parameterValues) == 1) { - columnValues <- c() - for (parameterValue in parameterValues) { - columnValues <- c(columnValues, rep(parameterValue, numberOfVariants)) + + if (!is.matrix(parameterValues)) { + if (length(parameterValues) == 1) { + return(rep(parameterValues, numberOfVariants * numberOfStages)) + } + + if (parameterSet$.isMultiHypothesesObject()) { + if (length(parameterValues) == numberOfStages) { + return(as.vector(sapply(FUN = rep, X = parameterValues, times = numberOfVariants))) + } + } + + if (length(parameterValues) == numberOfVariants) { + return(rep(parameterValues, numberOfStages)) + } + + if (length(parameterValues) == numberOfStages && + parameterName %in% c( + "plannedEvents", "plannedSubjects", + "minNumberOfEventsPerStage", "maxNumberOfEventsPerStage", + "minNumberOfSubjectsPerStage", "maxNumberOfSubjectsPerStage", + "allocationRatioPlanned" + )) { + values <- c() + for (stage in 1:numberOfStages) { + values <- c(values, rep(parameterValues[stage], numberOfVariants)) + } + return(values) + } + + if (parameterName %in% c( + "accrualTime", "accrualIntensity", + "plannedEvents", "plannedSubjects", + "minNumberOfEventsPerStage", "maxNumberOfEventsPerStage", + "minNumberOfSubjectsPerStage", "maxNumberOfSubjectsPerStage", + "piecewiseSurvivalTime", "lambda2" + )) { + return(NULL) + } + + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, + "parameter '", parameterName, "' has an invalid ", + "dimension (length is ", length(parameterValues), ")" + ) + } else if (parameterName == "effectMatrix") { + # return effect matrix row if 'effectMatrix' is user defined + if (parameterSet$.getParameterType("effectMatrix") == C_PARAM_USER_DEFINED) { + return(1:ncol(parameterValues)) + } + + return(parameterValues[nrow(parameterValues), ]) + } + + if (grepl("futility|alpha0Vec|earlyStop", parameterName) && + nrow(parameterValues) == numberOfStages - 1) { + parameterValues <- rbind(parameterValues, rep(NA_real_, ncol(parameterValues))) } - return(columnValues) - } - - if (nrow(parameterValues) == numberOfStages && ncol(parameterValues) == numberOfVariants) { - columnValues <- c() - for (i in 1:nrow(parameterValues)) { - for (j in 1:ncol(parameterValues)) { - columnValues <- c(columnValues, parameterValues[i, j]) - } + + if (nrow(parameterValues) == numberOfStages && ncol(parameterValues) == 1) { + columnValues <- c() + for (parameterValue in parameterValues) { + columnValues <- c(columnValues, rep(parameterValue, numberOfVariants)) + } + return(columnValues) } - return(columnValues) - } - - # applicable for analysis enrichment - if (parameterSet$.isMultiHypothesesObject()) { - if (nrow(parameterValues) %in% c(1, numberOfVariants) && - ncol(parameterValues) %in% c(1, numberOfStages)) { - columnValues <- c() - for (j in 1:ncol(parameterValues)) { + + if (nrow(parameterValues) == numberOfStages && ncol(parameterValues) == numberOfVariants) { + columnValues <- c() for (i in 1:nrow(parameterValues)) { - columnValues <- c(columnValues, parameterValues[i, j]) + for (j in 1:ncol(parameterValues)) { + columnValues <- c(columnValues, parameterValues[i, j]) + } } - } - if (nrow(parameterValues) == 1) { - columnValues <- as.vector(sapply(FUN = rep, X = columnValues, times = numberOfVariants)) - } - if (ncol(parameterValues) == 1) { - columnValues <- rep(columnValues, numberOfStages) - } - return(columnValues) + return(columnValues) + } + + # applicable for analysis enrichment + if (parameterSet$.isMultiHypothesesObject()) { + if (nrow(parameterValues) %in% c(1, numberOfVariants) && + ncol(parameterValues) %in% c(1, numberOfStages)) { + columnValues <- c() + for (j in 1:ncol(parameterValues)) { + for (i in 1:nrow(parameterValues)) { + columnValues <- c(columnValues, parameterValues[i, j]) + } + } + if (nrow(parameterValues) == 1) { + columnValues <- as.vector(sapply(FUN = rep, X = columnValues, times = numberOfVariants)) + } + if (ncol(parameterValues) == 1) { + columnValues <- rep(columnValues, numberOfStages) + } + return(columnValues) + } + } + + if (nrow(parameterValues) == 1 && ncol(parameterValues) == 1) { + return(rep(parameterValues[1, 1], numberOfStages * numberOfVariants)) + } + + if (nrow(parameterValues) == 1 && ncol(parameterValues) == numberOfVariants) { + return(rep(parameterValues[1, ], numberOfStages)) } - } - - if (nrow(parameterValues) == 1 && ncol(parameterValues) == 1) { - return(rep(parameterValues[1, 1], numberOfStages * numberOfVariants)) - } - - if (nrow(parameterValues) == 1 && ncol(parameterValues) == numberOfVariants) { - return(rep(parameterValues[1, ], numberOfStages)) - } - - if (nrow(parameterValues) == numberOfStages && ncol(parameterValues) == 1) { - return(rep(parameterValues[, 1], numberOfVariants)) - } - - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, - "parameter '", parameterName, "' has an invalid ", - "dimension (", nrow(parameterValues), " x ", ncol(parameterValues), "); ", - "expected was (", numberOfStages, " x ", numberOfVariants, ")" - ) + + if (nrow(parameterValues) == numberOfStages && ncol(parameterValues) == 1) { + return(rep(parameterValues[, 1], numberOfVariants)) + } + + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, + "parameter '", parameterName, "' has an invalid ", + "dimension (", nrow(parameterValues), " x ", ncol(parameterValues), "); ", + "expected was (", numberOfStages, " x ", numberOfVariants, ")" + ) } .getAsDataFrameMultidimensional <- function(parameterSet, @@ -1451,35 +1099,8 @@ ParameterSet <- R6Class("ParameterSet", "populations", niceColumnNamesEnabled) names(dataFrame) <- c(stagesCaption, populationsCaption) } - dataFrame$populations <- rep(populations, numberOfStages) - populationsCaption <- parameterSet$.getDataFrameColumnCaption( - "populations", - tableColumnNames, niceColumnNamesEnabled - ) - names(dataFrame) <- c(stagesCaption, populationsCaption) - } - - variedParameter <- parameterSet$.getVariedParameter(parameterNames, numberOfVariants) - tryCatch( - { - if (!is.null(variedParameter) && variedParameter != "stages") { - variedParameterCaption <- parameterSet$.getDataFrameColumnCaption( - variedParameter, - tableColumnNames, niceColumnNamesEnabled - ) - dataFrame[[variedParameterCaption]] <- rep(parameterSet[[variedParameter]], numberOfStages) - } - }, - error = function(e) { - warning( - ".getAsDataFrameMultidimensional: ", - "failed to add 'variedParameterCaption' to data.frame; ", e$message - ) - } - ) - - usedParameterNames <- character(0) - for (parameterName in parameterNames) { + + variedParameter <- parameterSet$.getVariedParameter(parameterNames, numberOfVariants) tryCatch( { if (!is.null(variedParameter) && variedParameter != "stages") { @@ -1543,29 +1164,6 @@ ParameterSet <- R6Class("ParameterSet", sQuote(parameterName), " to data.frame; ", e$message ) } - usedParameterNames <- c(usedParameterNames, parameterName) - } - } - - if (parameterName == "effectList") { - effectMatrixName <- .getSimulationEnrichmentEffectMatrixName(parameterSet) - effectMatrixNameSingular <- sub("s$", "", effectMatrixName) - effectMatrix <- parameterSet$effectList[[effectMatrixName]] - if (ncol(effectMatrix) == 1) { - dataFrame[[effectMatrixNameSingular]] <- rep(effectMatrix, numberOfStages) - } else { - for (j in 1:ncol(effectMatrix)) { - dataFrame[[paste0(effectMatrixNameSingular, j)]] <- rep(effectMatrix[, j], numberOfStages) - } - } - dataFrame$situation <- rep(1:nrow(effectMatrix), numberOfStages) - usedParameterNames <- c(usedParameterNames, parameterName) - } - }, - error = function(e) { - warning( - ".getAsDataFrameMultidimensional: failed to add parameter ", - sQuote(parameterName), " to data.frame; ", e$message ) } @@ -1600,24 +1198,10 @@ ParameterSet <- R6Class("ParameterSet", ) } ) - - if (length(value) == 1) { - dataFrame[[columnCaption]] <- rep(value, nrow(dataFrame)) - } else { - dataFrame[[columnCaption]] <- rep(.arrayToString(value, maxLength = 10), nrow(dataFrame)) - } - } } - }, error = function(e) { - warning( - ".getAsDataFrameMultidimensional: failed to add extra parameter ", - sQuote(parameterName), " to data.frame; ", e$message - ) - }) } - } - - return(dataFrame) + + return(dataFrame) } .getAsDataFrameUnidimensional <- function(parameterSet, parameterNames, niceColumnNamesEnabled, @@ -1666,41 +1250,9 @@ ParameterSet <- R6Class("ParameterSet", .logError("Failed to add parameter '%s' to data.frame: %s", parameterName, e) } ) - parameterValues <- parameterSet[[parameterName]] - if (parameterName == "futilityBounds") { - parameterValues[parameterValues == C_FUTILITY_BOUNDS_DEFAULT] <- -Inf - } - if (length(parameterValues) == 1) { - parameterValues <- rep(parameterValues, numberOfStages) - } else { - while (length(parameterValues) < numberOfStages) { - parameterValues <- c(parameterValues, NA) - } - } - if (includeAllParameters || ( - parameterSet$.getParameterType(parameterName) != C_PARAM_NOT_APPLICABLE && - sum(is.na(parameterValues)) < length(parameterValues))) { - if (is.null(dataFrame)) { - dataFrame <- data.frame(x = parameterValues) - names(dataFrame) <- parameterCaption - } else { - dataFrame[[parameterCaption]] <- parameterValues - } - } - if (returnParametersAsCharacter) { - parameterSet$.formatDataFrameParametersAsCharacter( - dataFrame, - parameterName, parameterValues, parameterCaption - ) - } - }, - error = function(e) { - .logError("Failed to add parameter '%s' to data.frame: %s", parameterName, e) - } - ) - } - - return(dataFrame) + } + + return(dataFrame) } .getAsDataFrame <- function(..., @@ -1776,24 +1328,6 @@ ParameterSet <- R6Class("ParameterSet", parameterSet, parameterNames, niceColumnNamesEnabled, includeAllParameters, returnParametersAsCharacter ))) - } - - # remove matrices - for (parameterName in parameterNames) { - parameterValues <- parameterSet[[parameterName]] - if (is.matrix(parameterValues) && nrow(parameterValues) != 1 && ncol(parameterValues) != 1) { - parameterNames <- parameterNames[parameterNames != parameterName] - } - } - - if (length(parameterNames) == 0) { - return(data.frame()) - } - - return(.addDelayedInformationRates(.getAsDataFrameUnidimensional( - parameterSet, parameterNames, niceColumnNamesEnabled, - includeAllParameters, returnParametersAsCharacter, tableColumnNames - ))) } .getCategoryCaptionEnrichment <- function(parameterSet, parameterName, categoryNumber) { @@ -1811,14 +1345,7 @@ ParameterSet <- R6Class("ParameterSet", categoryCaption <- ifelse(categoryNumber == parameterSet$populations, "F", paste0("S", categoryNumber)) } } - } else { - if (parameterSet$populations <= 2) { - categoryCaption <- ifelse(categoryNumber == parameterSet$populations, "F", "S") - } else { - categoryCaption <- ifelse(categoryNumber == parameterSet$populations, "F", paste0("S", categoryNumber)) - } - } - return(categoryCaption) + return(categoryCaption) } #' @@ -1840,7 +1367,7 @@ ParameterSet <- R6Class("ParameterSet", #' @keywords internal #' names.FieldSet <- function(x) { - return(x$.getVisibleFieldNames()) + return(x$.getVisibleFieldNames()) } #' @@ -1861,8 +1388,8 @@ names.FieldSet <- function(x) { #' @keywords internal #' print.FieldSet <- function(x, ...) { - x$show() - invisible(x) + x$show() + invisible(x) } #' @@ -1887,103 +1414,17 @@ print.FieldSet <- function(x, ...) { #' @keywords internal #' as.data.frame.ParameterSet <- function(x, row.names = NULL, - optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ...) { - .warnInCaseOfUnknownArguments(functionName = "as.data.frame", ...) - - return(.getAsDataFrame( - parameterSet = x, - parameterNames = NULL, - niceColumnNamesEnabled = niceColumnNamesEnabled, - includeAllParameters = includeAllParameters - )) + optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ...) { + .warnInCaseOfUnknownArguments(functionName = "as.data.frame", ...) + + return(.getAsDataFrame( + parameterSet = x, + parameterNames = NULL, + niceColumnNamesEnabled = niceColumnNamesEnabled, + includeAllParameters = includeAllParameters + )) } -#' -#' @title -#' Field Set Transpose -#' -#' @description -#' Given a \code{FieldSet} \code{x}, t returns the transpose of \code{x}. -#' -#' @param x A \code{FieldSet}. -#' -#' @details -#' Implementation of the base R generic function \code{\link[base]{t}} -#' -#' @keywords internal -#' -#' @export -#' -#setMethod( -# "t", "FieldSet",#TODO -# function(x) { -# x <- as.matrix(x, niceColumnNamesEnabled = TRUE) -# return(t(x)) -# } -#) - -#' -#' @title -#' Create output in Markdown -#' -#' @description -#' The \code{kable()} function returns the output of the specified object formatted in Markdown. -#' -#' @param x A \code{ParameterSet}. If x does not inherit from class \code{\link{ParameterSet}}, -#' \code{knitr::kable(x)} will be returned. -#' @param ... Other arguments (see \code{\link[knitr]{kable}}). -#' -#' @details -#' 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. -#' -#' @export -#' -kable.ParameterSet <- function(x, ...) { - fCall <- match.call(expand.dots = FALSE) - if (inherits(x, "ParameterSet")) { - objName <- deparse(fCall$x) - if (all(grepl("^ *print\\(", objName))) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "kable(", objName, ") does not work correctly. ", - "Use ", sub("print", "kable", objName), " without 'print' instead or ", sub("\\)", ", markdown = TRUE)", objName) - ) - } - - if (.isSimulationResults(x)) { - showStatistics <- .getOptionalArgument("showStatistics", optionalArgumentDefaultValue = FALSE, ...) - if (isTRUE(showStatistics)) { - return(print(x, markdown = TRUE, showStatistics = TRUE)) - } - } - - return(print(x, markdown = TRUE)) - } - - .assertPackageIsInstalled("knitr") - knitr::kable(x, ...) -} - -#' -#' @title -#' Create tables in Markdown -#' -#' @description -#' The \code{kable()} function returns a single table for a single object that inherits from class \code{\link{ParameterSet}}. -#' -#' @details -#' Generic to represent a parameter set in Markdown. -#' -#' @param x The object that inherits from \code{\link{ParameterSet}}. -#' @param ... Other arguments (see \code{\link[knitr]{kable}}). -#' -#' @export -#' -setGeneric("kable", kable.ParameterSet) - #' #' @title #' Coerce Field Set to a Matrix @@ -2007,60 +1448,60 @@ setGeneric("kable", kable.ParameterSet) #' @keywords internal #' as.matrix.FieldSet <- function(x, ..., enforceRowNames = TRUE, niceColumnNamesEnabled = TRUE) { - dataFrame <- as.data.frame(x, niceColumnNamesEnabled = niceColumnNamesEnabled) - dataFrame <- .setStagesAsFirstColumn(dataFrame) - result <- as.matrix(dataFrame) - - if (nrow(result) == 0) { - return(result) - } - - if (inherits(x, "PowerAndAverageSampleNumberResult") || inherits(x, "PowerAndAverageSampleNumberResult")) { - dimnames(result)[[1]] <- rep("", nrow(result)) - return(result) - } - - 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))]), ] - if (length(intersect(names(dfDesign), names(dfStageResults))) == 1) { - dfTemp <- merge(dfDesign, dfStageResults) - if (length(intersect(names(dfTemp), names(dataFrame))) >= 1) { - dataFrame <- merge(dfTemp, dataFrame, all.x = FALSE, all.y = TRUE) - dataFrame <- .setStagesAsFirstColumn(dataFrame) - result <- as.matrix(dataFrame) - } - } else if (length(intersect(names(dfStageResults), names(dataFrame))) >= 1) { - dataFrame <- merge(dfStageResults, dataFrame, all.x = FALSE, all.y = TRUE) - dataFrame <- .setStagesAsFirstColumn(dataFrame) - result <- as.matrix(dataFrame) + dataFrame <- as.data.frame(x, niceColumnNamesEnabled = niceColumnNamesEnabled) + dataFrame <- .setStagesAsFirstColumn(dataFrame) + result <- as.matrix(dataFrame) + + if (nrow(result) == 0) { + return(result) + } + + if (inherits(x, "PowerAndAverageSampleNumberResult")) { + dimnames(result)[[1]] <- rep("", nrow(result)) + return(result) + } + + 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))]), ] + if (length(intersect(names(dfDesign), names(dfStageResults))) == 1) { + dfTemp <- merge(dfDesign, dfStageResults) + if (length(intersect(names(dfTemp), names(dataFrame))) >= 1) { + dataFrame <- merge(dfTemp, dataFrame, all.x = FALSE, all.y = TRUE) + dataFrame <- .setStagesAsFirstColumn(dataFrame) + result <- as.matrix(dataFrame) + } + } else if (length(intersect(names(dfStageResults), names(dataFrame))) >= 1) { + dataFrame <- merge(dfStageResults, dataFrame, all.x = FALSE, all.y = TRUE) + dataFrame <- .setStagesAsFirstColumn(dataFrame) + result <- as.matrix(dataFrame) + } + } + + if (any(grepl("^(S|s)tages?$", colnames(result)))) { + dimnames(result)[[1]] <- rep("", nrow(result)) } - } - - if (any(grepl("^(S|s)tages?$", colnames(result)))) { - dimnames(result)[[1]] <- rep("", nrow(result)) - } - - return(result) + + return(result) } .setStagesAsFirstColumn <- function(data) { - columnNames <- colnames(data) - index <- grep("^(S|s)tages?$", columnNames) - if (length(index) == 0 || index == 1) { - return(data) - } - - stageName <- columnNames[index[1]] - stageNumbers <- data[, stageName] - if (is.null(stageNumbers) || length(stageNumbers) == 0) { + columnNames <- colnames(data) + index <- grep("^(S|s)tages?$", columnNames) + if (length(index) == 0 || index == 1) { + return(data) + } + + stageName <- columnNames[index[1]] + stageNumbers <- data[, stageName] + if (is.null(stageNumbers) || length(stageNumbers) == 0) { + return(data) + } + + data <- data[, c(stageName, columnNames[columnNames != stageName])] + return(data) - } - - data <- data[, c(stageName, columnNames[columnNames != stageName])] - - return(data) } #' @@ -2072,6 +1513,9 @@ as.matrix.FieldSet <- function(x, ..., enforceRowNames = TRUE, niceColumnNamesEn #' #' @param object A \code{\link{ParameterSet}} object. #' @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. #' @inheritParams param_three_dots #' #' @details @@ -2115,22 +1559,26 @@ summary.ParameterSet <- function(object, ..., # create technical summary object$show(showType = 2) object$.cat("\n") - } - - if (!is.null(object[[".accrualTime"]])) { - object$.accrualTime$show() - object$.cat("\n") - } - - object$.cat(object$.toString(startWithUpperCase = TRUE), " table:\n", heading = 1) - parametersToShow <- object$.getParametersToShow() - for (parameter in parametersToShow) { - if (length(object[[parameter]]) == 1) { - parametersToShow <- parametersToShow[parametersToShow != parameter] + + if (!is.null(object[[".piecewiseSurvivalTim"]])) { + object$.piecewiseSurvivalTime$show() + object$.cat("\n") + } + + if (!is.null(object[[".accrualTime"]])) { + object$.accrualTime$show() + object$.cat("\n") + } + + object$.cat(object$.toString(startWithUpperCase = TRUE), " table:\n", heading = 1) + parametersToShow <- object$.getParametersToShow() + for (parameter in parametersToShow) { + if (length(object[[parameter]]) == 1) { + parametersToShow <- parametersToShow[parametersToShow != parameter] + } } - } - object$.printAsDataFrame(parameterNames = parametersToShow, niceColumnNamesEnabled = TRUE) - invisible(object) + object$.printAsDataFrame(parameterNames = parametersToShow, niceColumnNamesEnabled = TRUE) + invisible(object) } #' @@ -2165,10 +1613,6 @@ print.ParameterSet <- function(x, ..., markdown = NA) { } return(invisible(x)) - } - - x$show() - invisible(x) } #' @@ -2198,12 +1642,101 @@ print.ParameterSet <- function(x, ..., markdown = NA) { #' @export #' plot.ParameterSet <- function(x, y, ..., main = NA_character_, - xlab = NA_character_, ylab = NA_character_, type = 1L, palette = "Set1", - legendPosition = NA_integer_, showSource = FALSE, plotSettings = NULL) { - .assertGgplotIsInstalled() - - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, - "sorry, function 'plot' is not implemented yet for class '", .getClassName(x), "'" - ) + xlab = NA_character_, ylab = NA_character_, type = 1L, palette = "Set1", + legendPosition = NA_integer_, showSource = FALSE, plotSettings = NULL) { + .assertGgplotIsInstalled() + + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, + "sorry, function 'plot' is not implemented yet for class '", .getClassName(x), "'" + ) } + +#' +#' @title +#' Print Parameter Set in Markdown Code Chunks +#' +#' @description +#' The function `knit_print.ParameterSet` is the default printing function for rpact result objects in knitr. +#' The chunk option `render` uses this function by default. +#' To fall back to the normal printing behavior set the chunk option `render = normal_print`. +#' For more information see \code{\link[knitr]{knit_print}}. +#' +#' @param x A \code{ParameterSet}. +#' @param ... Other arguments (see \code{\link[knitr]{knit_print}}). +#' +#' @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. +#' +#' @export +#' +knit_print.ParameterSet <- function(x, ...) { + result <- paste0(utils::capture.output(x$.catMarkdownText()), collapse = "\n") + return(knitr::asis_output(result)) +} + +#' +#' @title +#' Create output in Markdown +#' +#' @description +#' The \code{kable()} function returns the output of the specified object formatted in Markdown. +#' +#' @param x A \code{ParameterSet}. If x does not inherit from class \code{\link{ParameterSet}}, +#' \code{knitr::kable(x)} will be returned. +#' @param ... Other arguments (see \code{\link[knitr]{kable}}). +#' +#' @details +#' 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. +#' +#' @export +#' +kable.ParameterSet <- function(x, ...) { + fCall <- match.call(expand.dots = FALSE) + if (inherits(x, "ParameterSet")) { + objName <- deparse(fCall$x) + if (length(objName) > 0) { + if (length(objName) > 1) { + objName <- paste0(objName[1], "...") + } + if (grepl("^ *print\\(", objName)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "kable(", objName, ") ", + "does not work correctly. ", + "Use ", sub("print", "kable", objName), " without 'print' ", + "instead or ", sub("\\)", ", markdown = TRUE)", objName) + ) + } + } + + return(knit_print.ParameterSet(x = x, ...)) + } + + .assertPackageIsInstalled("knitr") + knitr::kable(x, ...) +} + +#' +#' @title +#' Create tables in Markdown +#' +#' @description +#' The \code{kable()} function returns a single table for a single object that inherits from class \code{\link{ParameterSet}}. +#' +#' @details +#' Generic to represent a parameter set in Markdown. +#' +#' @param x The object that inherits from \code{\link{ParameterSet}}. +#' @param ... Other arguments (see \code{\link[knitr]{kable}}). +#' +#' @export +#' +setGeneric("kable", kable.ParameterSet) diff --git a/R/class_core_plot_settings.R b/R/class_core_plot_settings.R index d6e13252..70979916 100644 --- a/R/class_core_plot_settings.R +++ b/R/class_core_plot_settings.R @@ -25,11 +25,6 @@ PlotSubTitleItem <- R6Class("PlotSubTitleItem", value = NULL, digits = NULL, initialize = function(..., title, value, subscript = NA_character_, digits = 3L) { - #callSuper( - # title = trimws(title), value = value, - # subscript = trimws(subscript), digits = digits, ... - #)#TODO - self$title <- trimws(title) self$value <- value self$subscript <- trimws(subscript) @@ -322,7 +317,7 @@ PlotSettings <- R6Class("PlotSettings", legendFontSize = 11, scalingFactor = 1, ...) { - super$initialize() + super$initialize(...) self$lineSize <- lineSize self$pointSize <- pointSize self$pointColor <- pointColor @@ -338,16 +333,6 @@ PlotSettings <- R6Class("PlotSettings", self$.scalingEnabled <- TRUE self$.pointScalingCorrectionEnabled <- TRUE self$.pointBorderEnabled <- TRUE - - self$.parameterNames <- list( - "lineSize" = "Line size", - "pointSize" = "Point size", - "pointColor" = "Point color", - "mainTitleFontSize" = "Main title font size", - "axesTextFontSize" = "Axes text font size", - "legendFontSize" = "Legend font size", - "scalingFactor" = "Scaling factor" - ) }, show = function(showType = 1, digits = NA_integer_) { self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) @@ -556,7 +541,7 @@ PlotSettings <- R6Class("PlotSettings", "Sets the main title" caption <- NA_character_ - if (!is.null(mainTitle) && (inherits(mainTitle, "PlotSubTitleItems") || inherits(mainTitle, "PlotSubTitleItems"))) { + if (!is.null(mainTitle) && inherits(mainTitle, "PlotSubTitleItems")) { plotLabsType <- getOption("rpact.plot.labs.type", "quote") if (plotLabsType == "quote") { mainTitle <- mainTitle$toQuote() diff --git a/R/class_design.R b/R/class_design.R index 63ac48fa..0095db0a 100644 --- a/R/class_design.R +++ b/R/class_design.R @@ -64,63 +64,43 @@ NULL #' @importFrom methods new #' TrialDesign <- R6Class("TrialDesign", - inherit = ParameterSet, - public = list( - .plotSettings = NULL, - kMax = NULL, - alpha = NULL, - stages = NULL, - informationRates = NULL, - userAlphaSpending = NULL, - criticalValues = NULL, - stageLevels = NULL, - alphaSpent = NULL, - bindingFutility = NULL, - tolerance = NULL, - initialize = function(..., - kMax = NA_integer_, - alpha = NA_real_, - informationRates = NA_real_, - userAlphaSpending = NA_real_, - criticalValues = NA_real_, - stageLevels = NA_real_, - alphaSpent = NA_real_, - bindingFutility = NA, - tolerance = 1e-06 # C_ANALYSIS_TOLERANCE_DEFAULT - ) { - - self$kMax <- kMax #NEW - self$alpha <- alpha - self$informationRates <- informationRates - self$userAlphaSpending <- userAlphaSpending - self$criticalValues <- criticalValues - self$stageLevels <- stageLevels - self$alphaSpent <- alphaSpent - self$bindingFutility <- bindingFutility - self$tolerance <- tolerance - super$initialize(...) - - self$.plotSettings <- PlotSettings$new() - - if (inherits(self, "TrialDesignConditionalDunnett")) { - self$.parameterNames <- C_PARAMETER_NAMES - } else { - self$.parameterNames <- self$.getSubListByNames(.getParameterNames(design = self), c(#TODO - "stages", - "kMax", - "alpha", - "informationRates", - "userAlphaSpending", - "criticalValues", - "stageLevels", - "alphaSpent", - "bindingFutility", - "tolerance" - )) - } - - self$.parameterFormatFunctions <- C_PARAMETER_FORMAT_FUNCTIONS - + inherit = ParameterSet, + public = list( + .plotSettings = NULL, + kMax = NULL, + alpha = NULL, + stages = NULL, + informationRates = NULL, + userAlphaSpending = NULL, + criticalValues = NULL, + stageLevels = NULL, + alphaSpent = NULL, + bindingFutility = NULL, + tolerance = NULL, + initialize = function(..., + kMax = NA_integer_, + alpha = NA_real_, + informationRates = NA_real_, + userAlphaSpending = NA_real_, + criticalValues = NA_real_, + stageLevels = NA_real_, + alphaSpent = NA_real_, + bindingFutility = NA, + tolerance = 1e-06 # C_ANALYSIS_TOLERANCE_DEFAULT + ) { + self$kMax <- kMax #NEW + self$alpha <- alpha + self$informationRates <- informationRates + self$userAlphaSpending <- userAlphaSpending + self$criticalValues <- criticalValues + self$stageLevels <- stageLevels + self$alphaSpent <- alphaSpent + self$bindingFutility <- bindingFutility + self$tolerance <- tolerance + super$initialize(...) + + self$.plotSettings <- PlotSettings$new() + self$.initStages() }, show = function(showType = 1, digits = NA_integer_) { @@ -854,7 +834,6 @@ TrialDesignGroupSequential <- R6Class("TrialDesignGroupSequential", inherit = TrialDesignInverseNormal, public = list( initialize = function(...) { - self$.parameterFormatFunctions$criticalValues <- ".formatCriticalValues" super$initialize(...) self$.initStages() }, @@ -910,7 +889,8 @@ TrialDesignConditionalDunnett <- R6Class("TrialDesignConditionalDunnett", sided = NULL, initialize = function(...,informationAtInterim = NULL, secondStageConditioning = NULL) { super$initialize(...) - + self$informationAtInterim <- informationAtInterim + self$secondStageConditioning <- secondStageConditioning notApplicableParameters <- c( "kMax", "stages", @@ -1112,7 +1092,7 @@ plot.TrialDesignCharacteristics <- function(x, y, ...) { .plotTrialDesign <- function(..., x, y, main, xlab, ylab, type, palette, theta, nMax, plotPointsEnabled, - legendPosition, showSource, designName, plotSettings = NULL) {#TODO + legendPosition, showSource, designName, plotSettings = NULL) { .assertGgplotIsInstalled() .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) diff --git a/R/class_design_plan.R b/R/class_design_plan.R index 3ec92701..08da9e20 100644 --- a/R/class_design_plan.R +++ b/R/class_design_plan.R @@ -119,7 +119,7 @@ TrialDesignPlan <- R6Class("TrialDesignPlan", defaultValueList <- C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES } else if (.isTrialDesignPlanSurvival(self)) { defaultValueList <- C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_SURVIVAL - } else if (.isTrialDesignPlanCountData(.self)) { + } else if (.isTrialDesignPlanCountData(self)) { defaultValueList <- C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_COUNT_DATA } for (parameterName in self$.getVisibleFieldNames()) { @@ -197,12 +197,12 @@ TrialDesignPlan <- R6Class("TrialDesignPlan", self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - if (inherits(self, "TrialDesignPlanSurvival") || inherits(self, "TrialDesignPlanSurvival") || self$groups == 2 || self$.design$kMax > 1) {#TODO Groups???? + if (inherits(self, "TrialDesignPlanSurvival") || self$groups == 2 || self$.design$kMax > 1) {#TODO Groups???? self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled ) - if (inherits(self, "TrialDesignPlanSurvival") || inherits(self, "TrialDesignPlanSurvival") || self$groups == 2) { + if (inherits(self, "TrialDesignPlanSurvival") || self$groups == 2) { self$.cat(" (i): values of treatment arm i\n", consoleOutputEnabled = consoleOutputEnabled ) @@ -355,6 +355,12 @@ TrialDesignPlanMeans <- R6Class("TrialDesignPlanMeans", optimumAllocationRatio = NULL, directionUpper = NULL, effect = NULL, + maxNumberOfSubjects = NULL, + maxNumberOfSubjects1 = NULL, + maxNumberOfSubjects2 = NULL, + numberOfSubjects = NULL, + numberOfSubjects1 = NULL, + numberOfSubjects2 = NULL, overallReject = NULL, rejectPerStage = NULL, futilityStop = NULL, @@ -365,16 +371,10 @@ TrialDesignPlanMeans <- R6Class("TrialDesignPlanMeans", nFixed1 = NULL, nFixed2 = NULL, informationRates = NULL, - maxNumberOfSubjects = NULL, - maxNumberOfSubjects1 = NULL, - maxNumberOfSubjects2 = NULL, - numberOfSubjects = NULL, - numberOfSubjects1 = NULL, - numberOfSubjects2 = NULL, expectedNumberOfSubjectsH0 = NULL, expectedNumberOfSubjectsH01 = NULL, expectedNumberOfSubjectsH1 = NULL, - criticalValuesEffectScale = NULL, + criticalValuesEffectScale = matrix(), criticalValuesEffectScaleLower = NULL, criticalValuesEffectScaleUpper = NULL, criticalValuesPValueScale = NULL, @@ -504,26 +504,26 @@ TrialDesignPlanRates <- R6Class("TrialDesignPlanRates", optimumAllocationRatio = NULL, directionUpper = NULL, effect = NULL, - expectedNumberOfSubjects = NULL, - nFixed = NULL, - nFixed1 = NULL, - nFixed2 = NULL, - overallReject = NULL, - rejectPerStage = NULL, - futilityStop = NULL, - futilityPerStage = NULL, - earlyStop = NULL, - informationRates = NULL, maxNumberOfSubjects = NULL, maxNumberOfSubjects1 = NULL, maxNumberOfSubjects2 = NULL, numberOfSubjects = NULL, numberOfSubjects1 = NULL, numberOfSubjects2 = NULL, + overallReject = NULL, + rejectPerStage = NULL, + futilityStop = NULL, + futilityPerStage = NULL, + earlyStop = NULL, + expectedNumberOfSubjects = NULL, + nFixed = NULL, + nFixed1 = NULL, + nFixed2 = NULL, + informationRates = NULL, expectedNumberOfSubjectsH0 = NULL, expectedNumberOfSubjectsH01 = NULL, expectedNumberOfSubjectsH1 = NULL, - criticalValuesEffectScale = NULL, + criticalValuesEffectScale = matrix(), criticalValuesEffectScaleLower = NULL, criticalValuesEffectScaleUpper = NULL, criticalValuesPValueScale = NULL, @@ -540,7 +540,6 @@ TrialDesignPlanRates <- R6Class("TrialDesignPlanRates", groups = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["groups"]], allocationRatioPlanned = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["allocationRatioPlanned"]]) { super$initialize(...) #TODO - self$normalApproximation <- normalApproximation self$riskRatio <- riskRatio self$thetaH0 <- thetaH0 @@ -727,7 +726,7 @@ TrialDesignPlanSurvival <- R6Class("TrialDesignPlanSurvival", expectedEventsH1 = NULL, expectedNumberOfSubjectsH1 = NULL, expectedNumberOfSubjects = NULL, - criticalValuesEffectScale = NULL, + criticalValuesEffectScale = matrix(), criticalValuesEffectScaleLower = NULL, criticalValuesEffectScaleUpper = NULL, criticalValuesPValueScale = NULL, @@ -884,48 +883,46 @@ TrialDesignPlanSurvival <- R6Class("TrialDesignPlanSurvival", #' #' @importFrom methods new #' -TrialDesignPlanCountData <- setRefClass("TrialDesignPlanCountData", - contains = "TrialDesignPlan", - fields = list( - .designCharacteristics = "ANY", - thetaH0 = "numeric", - groups = "integer", - allocationRatioPlanned = "numeric", - optimumAllocationRatio = "logical", - directionUpper = "logical", - lambda1 = "numeric", - lambda2 = "numeric", - lambda = "numeric", - theta = "numeric", - nFixed = "numeric", - nFixed1 = "numeric", - nFixed2 = "numeric", - maxNumberOfSubjects = "numeric", - maxNumberOfSubjects1 = "numeric", - maxNumberOfSubjects2 = "numeric", - overallReject = "numeric", - rejectPerStage = "matrix", - futilityStop = "numeric", - futilityPerStage = "matrix", - earlyStop = "numeric", - overdispersion = "numeric", - fixedExposureTime = "numeric", - accrualTime = "numeric", - accrualIntensity = "numeric", - followUpTime = "numeric", - calendarTime = "matrix", - expectedStudyDurationH1 = "numeric", - studyTime = "numeric", - numberOfSubjects = "matrix", - expectedNumberOfSubjectsH1 = "numeric", - informationOverStages = "matrix", - expectedInformationH0 = "numeric", - expectedInformationH01 = "numeric", - expectedInformationH1 = "numeric", - maxInformation = "numeric", - futilityBoundsPValueScale = "matrix" - ), - methods = list( +TrialDesignPlanCountData <- R6Class("TrialDesignPlanCountData", + inherit = TrialDesignPlan, + public = list( + .designCharacteristics = NULL, + thetaH0 = NULL, + groups = NULL, + allocationRatioPlanned = NULL, + optimumAllocationRatio = NULL, + directionUpper = NULL, + lambda1 = NULL, + lambda2 = NULL, + lambda = NULL, + theta = NULL, + nFixed = NULL, + nFixed1 = NULL, + nFixed2 = NULL, + maxNumberOfSubjects = NULL, + maxNumberOfSubjects1 = NULL, + maxNumberOfSubjects2 = NULL, + overallReject = NULL, + rejectPerStage = NULL, + futilityStop = NULL, + futilityPerStage = NULL, + earlyStop = NULL, + overdispersion = NULL, + fixedExposureTime = NULL, + accrualTime = NULL, + accrualIntensity = NULL, + followUpTime = NULL, + calendarTime = NULL, + expectedStudyDurationH1 = NULL, + studyTime = NULL, + numberOfSubjects = NULL, + expectedNumberOfSubjectsH1 = NULL, + informationOverStages = NULL, + expectedInformationH0 = NULL, + expectedInformationH01 = NULL, + expectedInformationH1 = NULL, + maxInformation = NULL, + futilityBoundsPValueScale = NULL, initialize = function(..., designCharacteristics, lambda1 = NA_real_, @@ -939,84 +936,29 @@ TrialDesignPlanCountData <- setRefClass("TrialDesignPlanCountData", accrualIntensity = NA_real_, followUpTime = NA_real_, allocationRatioPlanned = NA_real_) { - callSuper(..., - .designCharacteristics = designCharacteristics, - lambda1 = lambda1, - lambda2 = lambda2, - lambda = lambda, - theta = theta, - thetaH0 = thetaH0, - overdispersion = overdispersion, - fixedExposureTime = fixedExposureTime, - accrualTime = accrualTime, - accrualIntensity = accrualIntensity, - followUpTime = followUpTime, - allocationRatioPlanned = allocationRatioPlanned - ) - - groups <<- 2L - optimumAllocationRatio <<- FALSE - .self$.setParameterType("groups", C_PARAM_NOT_APPLICABLE) - .self$.setParameterType("directionUpper", C_PARAM_NOT_APPLICABLE) - .self$.setParameterType("optimumAllocationRatio", C_PARAM_NOT_APPLICABLE) + super$initialize(...) + self$.designCharacteristics <- designCharacteristics + self$lambda1 <- lambda1 + self$lambda2 <- lambda2 + self$lambda <- lambda + self$theta <- theta + self$thetaH0 <- thetaH0 + self$overdispersion <- overdispersion + self$fixedExposureTime <- fixedExposureTime + self$accrualTime <- accrualTime + self$accrualIntensity <- accrualIntensity + self$followUpTime <- followUpTime + self$allocationRatioPlanned <- allocationRatioPlanned + + self$groups <- 2L + self$optimumAllocationRatio <- FALSE + self$.setParameterType("groups", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("directionUpper", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("optimumAllocationRatio", C_PARAM_NOT_APPLICABLE) }, .toString = function(startWithUpperCase = FALSE) { s <- "count data" return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) - }, - clone = function(..., lambda1 = NA_real_, theta = NA_real_) { - if (all(is.na(lambda1))) { - lambda1Temp <- .self$.getParameterValueIfUserDefinedOrDefault("lambda1") - } else { - lambda1Temp <- lambda1 - if (any(is.na(lambda1))) { - lambda1Temp <- .self$lambda1 - } - } - if (all(is.na(theta))) { - thetaTemp <- .self$.getParameterValueIfUserDefinedOrDefault("theta") - } else { - thetaTemp <- theta - if (any(is.na(theta))) { - thetaTemp <- .self$theta - } - } - if (.objectType == "sampleSize") { - result <- getSampleSizeCounts( - design = .self$.design, - lambda1 = lambda1Temp, - lambda2 = .self$.getParameterValueIfUserDefinedOrDefault("lambda2"), - lambda = .self$.getParameterValueIfUserDefinedOrDefault("lambda"), - theta = thetaTemp, - thetaH0 = .self$.getParameterValueIfUserDefinedOrDefault("thetaH0"), - overdispersion = .self$.getParameterValueIfUserDefinedOrDefault("overdispersion"), - fixedExposureTime = .self$.getParameterValueIfUserDefinedOrDefault("fixedExposureTime"), - accrualTime = .self$.getParameterValueIfUserDefinedOrDefault("accrualTime"), - accrualIntensity = .self$.getParameterValueIfUserDefinedOrDefault("accrualIntensity"), - followUpTime = .self$.getParameterValueIfUserDefinedOrDefault("followUpTime"), - maxNumberOfSubjects = .self$.getParameterValueIfUserDefinedOrDefault("maxNumberOfSubjects"), - allocationRatioPlanned = .self$.getParameterValueIfUserDefinedOrDefault("allocationRatioPlanned") - ) - } else { - result <- getPowerCounts( - design = .self$.design, - directionUpper = .self$.getParameterValueIfUserDefinedOrDefault("directionUpper"), - maxNumberOfSubjects = .self$.getParameterValueIfUserDefinedOrDefault("maxNumberOfSubjects"), - lambda1 = lambda1Temp, - lambda2 = .self$.getParameterValueIfUserDefinedOrDefault("lambda2"), - lambda = .self$.getParameterValueIfUserDefinedOrDefault("lambda"), - theta = thetaTemp, - thetaH0 = .self$.getParameterValueIfUserDefinedOrDefault("thetaH0"), - overdispersion = .self$.getParameterValueIfUserDefinedOrDefault("overdispersion"), - fixedExposureTime = .self$.getParameterValueIfUserDefinedOrDefault("fixedExposureTime"), - accrualTime = .self$.getParameterValueIfUserDefinedOrDefault("accrualTime"), - accrualIntensity = .self$.getParameterValueIfUserDefinedOrDefault("accrualIntensity"), - followUpTime = .self$.getParameterValueIfUserDefinedOrDefault("followUpTime"), - allocationRatioPlanned = .self$.getParameterValueIfUserDefinedOrDefault("allocationRatioPlanned") - ) - } - result$.plotSettings <- .self$.plotSettings - return(result) } ) ) diff --git a/R/class_design_set.R b/R/class_design_set.R index 6db26f9b..81ab7fe4 100644 --- a/R/class_design_set.R +++ b/R/class_design_set.R @@ -22,7 +22,120 @@ #' @include f_core_utilities.R NULL +#' @title +#' Get Design Set +#' +#' @description +#' Creates a trial design set object and returns it. +#' +#' @param ... \code{designs} or \code{design} and one or more design parameters, e.g., \code{deltaWT = c(0.1, 0.3, 0.4)}. +#' \itemize{ +#' \item \code{design} The master design (optional, you need to specify an +#' additional parameter that shall be varied). +#' \item \code{designs} The designs to compare (optional, you need to specify the variable \code{variedParameters}). +#' } +#' +#' @details +#' Specify a master design and one or more design parameters or a list of designs. +#' +#' @return Returns a \code{\link{TrialDesignSet}} object. +#' The following generics (R generic functions) are available for this result object: +#' \itemize{ +#' \item \code{\link[=names.TrialDesignSet]{names}} to obtain the field names, +#' \item \code{\link[=length.TrialDesignSet]{length}} to obtain the number of design, +#' \item \code{\link[=print.FieldSet]{print()}} to print the object, +#' \item \code{\link[=summary.TrialDesignSet]{summary()}} to display a summary of the object, +#' \item \code{\link[=plot.TrialDesignSet]{plot()}} to plot the object, +#' \item \code{\link[=as.data.frame.TrialDesignSet]{as.data.frame()}} to coerce the object to a \code{\link[base]{data.frame}}, +#' \item \code{\link[=as.matrix.FieldSet]{as.matrix()}} to coerce the object to a \code{\link[base]{matrix}}. +#' } +#' @template how_to_get_help_for_generics +#' +#' @examples +#' # Example 1 +#' design <- getDesignGroupSequential( +#' alpha = 0.05, kMax = 6, +#' sided = 2, typeOfDesign = "WT", deltaWT = 0.1 +#' ) +#' designSet <- getDesignSet() +#' designSet$add(design = design, deltaWT = c(0.3, 0.4)) +#' \dontrun{ +#' if (require(ggplot2)) plot(designSet, type = 1) +#' } +#' +#' # Example 2 (shorter script) +#' design <- getDesignGroupSequential( +#' alpha = 0.05, kMax = 6, +#' sided = 2, typeOfDesign = "WT", deltaWT = 0.1 +#' ) +#' designSet <- getDesignSet(design = design, deltaWT = c(0.3, 0.4)) +#' \dontrun{ +#' if (require(ggplot2)) plot(designSet, type = 1) +#' } +#' +#' # Example 3 (use of designs instead of design) +#' d1 <- getDesignGroupSequential( +#' alpha = 0.05, kMax = 2, +#' sided = 1, beta = 0.2, typeOfDesign = "asHSD", +#' gammaA = 0.5, typeBetaSpending = "bsHSD", gammaB = 0.5 +#' ) +#' d2 <- getDesignGroupSequential( +#' alpha = 0.05, kMax = 4, +#' sided = 1, beta = 0.2, typeOfDesign = "asP", +#' typeBetaSpending = "bsP" +#' ) +#' designSet <- getDesignSet( +#' designs = c(d1, d2), +#' variedParameters = c("typeOfDesign", "kMax") +#' ) +#' \dontrun{ +#' if (require(ggplot2)) plot(designSet, type = 8, nMax = 20) +#' } +#' +#' @export +#' +getDesignSet <- function(...) { + return(TrialDesignSet$new(...)) +} + +#' +#' @title +#' Trial Design Set Summary +#' +#' @description +#' Displays a summary of \code{\link{ParameterSet}} object. +#' +#' @param object A \code{\link{ParameterSet}} object. +#' @inheritParams param_digits +#' @inheritParams param_three_dots +#' +#' @details +#' Summarizes the trial designs. +#' +#' @template details_summary +#' +#' @template return_object_summary +#' @template how_to_get_help_for_generics +#' +#' @export +#' +#' @keywords internal +#' +summary.TrialDesignSet <- function(object, ..., type = 1, digits = NA_integer_) { + .warnInCaseOfUnknownArguments(functionName = "summary.TrialDesignSet", ...) + .assertIsTrialDesignSet(object) + if (object$isEmpty()) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "cannot create summary because the design set is empty") + } + + summaries <- list() + for (design in object$designs) { + s <- .createSummary(design, digits = digits) + summaries <- c(summaries, s) + } + return(summaries) +} #' #' @name TrialDesignSet @@ -70,7 +183,7 @@ TrialDesignSet <- R6Class("TrialDesignSet", } if (length(self$designs) > 0) { masterDesign <- self$designs[[1]] - if (inherits(masterDesign, "ParameterSet") || inherits(masterDesign, "ParameterSet")) { + if (inherits(masterDesign, "ParameterSet")) { self$.plotSettings <- masterDesign$.plotSettings } } @@ -429,121 +542,6 @@ TrialDesignSet <- R6Class("TrialDesignSet", ) ) -#' @title -#' Get Design Set -#' -#' @description -#' Creates a trial design set object and returns it. -#' -#' @param ... \code{designs} or \code{design} and one or more design parameters, e.g., \code{deltaWT = c(0.1, 0.3, 0.4)}. -#' \itemize{ -#' \item \code{design} The master design (optional, you need to specify an -#' additional parameter that shall be varied). -#' \item \code{designs} The designs to compare (optional, you need to specify the variable \code{variedParameters}). -#' } -#' -#' @details -#' Specify a master design and one or more design parameters or a list of designs. -#' -#' @return Returns a \code{\link{TrialDesignSet}} object. -#' The following generics (R generic functions) are available for this result object: -#' \itemize{ -#' \item \code{\link[=names.TrialDesignSet]{names}} to obtain the field names, -#' \item \code{\link[=length.TrialDesignSet]{length}} to obtain the number of design, -#' \item \code{\link[=print.FieldSet]{print()}} to print the object, -#' \item \code{\link[=summary.TrialDesignSet]{summary()}} to display a summary of the object, -#' \item \code{\link[=plot.TrialDesignSet]{plot()}} to plot the object, -#' \item \code{\link[=as.data.frame.TrialDesignSet]{as.data.frame()}} to coerce the object to a \code{\link[base]{data.frame}}, -#' \item \code{\link[=as.matrix.FieldSet]{as.matrix()}} to coerce the object to a \code{\link[base]{matrix}}. -#' } -#' @template how_to_get_help_for_generics -#' -#' @examples -#' # Example 1 -#' design <- getDesignGroupSequential( -#' alpha = 0.05, kMax = 6, -#' sided = 2, typeOfDesign = "WT", deltaWT = 0.1 -#' ) -#' designSet <- getDesignSet() -#' designSet$add(design = design, deltaWT = c(0.3, 0.4)) -#' \dontrun{ -#' if (require(ggplot2)) plot(designSet, type = 1) -#' } -#' -#' # Example 2 (shorter script) -#' design <- getDesignGroupSequential( -#' alpha = 0.05, kMax = 6, -#' sided = 2, typeOfDesign = "WT", deltaWT = 0.1 -#' ) -#' designSet <- getDesignSet(design = design, deltaWT = c(0.3, 0.4)) -#' \dontrun{ -#' if (require(ggplot2)) plot(designSet, type = 1) -#' } -#' -#' # Example 3 (use of designs instead of design) -#' d1 <- getDesignGroupSequential( -#' alpha = 0.05, kMax = 2, -#' sided = 1, beta = 0.2, typeOfDesign = "asHSD", -#' gammaA = 0.5, typeBetaSpending = "bsHSD", gammaB = 0.5 -#' ) -#' d2 <- getDesignGroupSequential( -#' alpha = 0.05, kMax = 4, -#' sided = 1, beta = 0.2, typeOfDesign = "asP", -#' typeBetaSpending = "bsP" -#' ) -#' designSet <- getDesignSet( -#' designs = c(d1, d2), -#' variedParameters = c("typeOfDesign", "kMax") -#' ) -#' \dontrun{ -#' if (require(ggplot2)) plot(designSet, type = 8, nMax = 20) -#' } -#' -#' @export -#' -getDesignSet <- function(...) { - return(TrialDesignSet$new(...)) -} - -#' -#' @title -#' Trial Design Set Summary -#' -#' @description -#' Displays a summary of \code{\link{ParameterSet}} object. -#' -#' @param object A \code{\link{ParameterSet}} object. -#' @inheritParams param_digits -#' @inheritParams param_three_dots -#' -#' @details -#' Summarizes the trial designs. -#' -#' @template details_summary -#' -#' @template return_object_summary -#' @template how_to_get_help_for_generics -#' -#' @export -#' -#' @keywords internal -#' -summary.TrialDesignSet <- function(object, ..., type = 1, digits = NA_integer_) { - .warnInCaseOfUnknownArguments(functionName = "summary.TrialDesignSet", ...) - - .assertIsTrialDesignSet(object)#TODO - if (object$isEmpty()) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "cannot create summary because the design set is empty") - } - - summaries <- list() - for (design in object$designs) { - s <- .createSummary(design, digits = digits) - summaries <- c(summaries, s) - } - return(summaries) -} - #' #' @title #' Names of a Trial Design Set Object @@ -884,7 +882,7 @@ plot.TrialDesignSet <- function(x, y, ..., type = 1L, main = NA_character_, legendPosition = NA_integer_, showSource = FALSE, designSetName = NA_character_, plotSettings = NULL) { .assertGgplotIsInstalled() - if (!is.call(main) && !isS4(main)) { + if (!is.call(main) && !isS4(main) && !R6::is.R6(main)) { #TODO is.R6 added .assertIsSingleCharacter(main, "main", naAllowed = TRUE) } .assertIsSingleCharacter(xlab, "xlab", naAllowed = TRUE) @@ -902,7 +900,7 @@ plot.TrialDesignSet <- function(x, y, ..., type = 1L, main = NA_character_, .assertIsTrialDesign(designMaster) if (type == 1) { - main <- if (!is.call(main) && !isS4(main) && is.na(main)) "Boundaries" else main + main <- if (!is.call(main) && !isS4(main) && !R6::is.R6(main) && is.na(main)) "Boundaries" else main xParameterName <- "informationRates" yParameterNames <- "criticalValues" @@ -918,11 +916,11 @@ plot.TrialDesignSet <- function(x, y, ..., type = 1L, main = NA_character_, } else if (type == 2) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "designs with undefined endpoint do not support plot type 2") } else if (type == 3) { - main <- if (!is.call(main) && !isS4(main) && is.na(main)) "Stage Levels" else main + main <- if (!is.call(main) && !isS4(main) && !R6::is.R6(main) && is.na(main)) "Stage Levels" else main xParameterName <- "informationRates" yParameterNames <- "stageLevels" } else if (type == 4) { - main <- if (!is.call(main) && !isS4(main) && is.na(main)) "Error Spending" else main + main <- if (!is.call(main) && !isS4(main) && !R6::is.R6(main) && is.na(main)) "Error Spending" else main xParameterName <- "informationRates" yParameterNames <- c("alphaSpent") if (!.isTrialDesignFisher(designMaster) && @@ -932,36 +930,36 @@ plot.TrialDesignSet <- function(x, y, ..., type = 1L, main = NA_character_, } plotPointsEnabled <- ifelse(is.na(plotPointsEnabled), FALSE, plotPointsEnabled) } else if (type == 5) { - if (!is.call(main) && !isS4(main) && is.na(main)) { - main <- PlotSubTitleItems(title = "Power and Early Stopping") + if (!is.call(main) && !isS4(main) && !R6::is.R6(main) && is.na(main)) { + main <- PlotSubTitleItems$new(title = "Power and Early Stopping") main$add("N", nMax, "max") } xParameterName <- "theta" yParameterNames <- c("overallEarlyStop", "calculatedPower") } else if (type == 6) { - if (!is.call(main) && !isS4(main) && is.na(main)) { - main <- PlotSubTitleItems(title = "Average Sample Size and Power / Early Stop") + if (!is.call(main) && !isS4(main) && !R6::is.R6(main) && is.na(main)) { + main <- PlotSubTitleItems$new(title = "Average Sample Size and Power / Early Stop") main$add("N", nMax, "max") } xParameterName <- "theta" yParameterNames <- c("averageSampleNumber", "overallEarlyStop", "calculatedPower") } else if (type == 7) { - if (!is.call(main) && !isS4(main) && is.na(main)) { - main <- PlotSubTitleItems(title = "Power") + if (!is.call(main) && !isS4(main) && !R6::is.R6(main) && is.na(main)) { + main <- PlotSubTitleItems$new(title = "Power") main$add("N", nMax, "max") } xParameterName <- "theta" yParameterNames <- "calculatedPower" } else if (type == 8) { - if (!is.call(main) && !isS4(main) && is.na(main)) { - main <- PlotSubTitleItems(title = "Early Stopping") + if (!is.call(main) && !isS4(main) && !R6::is.R6(main) && is.na(main)) { + main <- PlotSubTitleItems$new(title = "Early Stopping") main$add("N", nMax, "max") } xParameterName <- "theta" yParameterNames <- "overallEarlyStop" } else if (type == 9) { - if (!is.call(main) && !isS4(main) && is.na(main)) { - main <- PlotSubTitleItems(title = "Average Sample Size") + if (!is.call(main) && !isS4(main) && !R6::is.R6(main) && is.na(main)) { + main <- PlotSubTitleItems$new(title = "Average Sample Size") main$add("N", nMax, "max") } xParameterName <- "theta" diff --git a/R/class_simulation_results.R b/R/class_simulation_results.R index 5e7017db..25e8c573 100644 --- a/R/class_simulation_results.R +++ b/R/class_simulation_results.R @@ -41,7 +41,7 @@ NULL #' names.SimulationResults <- function(x) { namesToShow <- c(".design", ".data", ".rawData") - if (inherits(x, "SimulationResultsSurvival") || inherits(x, "SimulationResultsSurvival")) { + if (inherits(x, "SimulationResultsSurvival")) { namesToShow <- c(namesToShow, ".piecewiseSurvivalTime", ".accrualTime") } namesToShow <- c(namesToShow, x$.getVisibleFieldNames()) @@ -106,7 +106,7 @@ SimulationResults <- R6Class("SimulationResults", self$.design <- design self$.showStatistics <- showStatistics - .plotSettings <<- PlotSettings() + self$.plotSettings <- PlotSettings$new() }, getPlotSettings = function() { return(self$.plotSettings) @@ -153,7 +153,7 @@ SimulationResults <- R6Class("SimulationResults", ) userDefinedParameters <- self$.getUserDefinedParameters() - if ((inherits(self, "SimulationResultsSurvival") || inherits(self, "SimulationResultsSurvival")) && + if (inherits(self, "SimulationResultsSurvival") && self$.piecewiseSurvivalTime$delayedResponseEnabled) { userDefinedParameters <- c( userDefinedParameters, @@ -183,19 +183,19 @@ SimulationResults <- R6Class("SimulationResults", (is.character(showStatistics) && showStatistics == "exclusive")) { self$.cat("Simulated data:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) params <- c() - if (inherits(self, "SimulationResultsMeans") || inherits(self, "SimulationResultsMeans")) { + if (inherits(self, "SimulationResultsMeans")) { params <- c( "effectMeasure", "numberOfSubjects", "testStatistic" ) - } else if (inherits(self, "SimulationResultsRates") || inherits(self, "SimulationResultsRates")) { + } else if (inherits(self, "SimulationResultsRates")) { params <- c( "effectMeasure", "numberOfSubjects", "testStatistic" ) - } else if (inherits(self, "SimulationResultsSurvival") || inherits(self, "SimulationResultsSurvival")) { + } else if (inherits(self, "SimulationResultsSurvival")) { params <- c( "effectMeasure", "analysisTime", @@ -207,8 +207,8 @@ SimulationResults <- R6Class("SimulationResults", "logRankStatistic", "hazardRatioEstimateLR" ) - } else if (inherits(self, "SimulationResultsMultiArmMeans") || inherits(self, "SimulationResultsMultiArmMeans") || - inherits(self, "SimulationResultsMultiArmRates") || inherits(self, "SimulationResultsMultiArmRates")) { + } else if (inherits(self, "SimulationResultsMultiArmMeans") || + inherits(self, "SimulationResultsMultiArmRates")) { params <- c( "effectMeasure", "subjectsActiveArm", @@ -218,8 +218,8 @@ SimulationResults <- R6Class("SimulationResults", "successStop", "futilityPerStage" ) - } else if (inherits(self, "SimulationResultsEnrichmentMeans") || inherits(self, "SimulationResultsEnrichmentMeans") || - inherits(self, "SimulationResultsEnrichmentRates") || inherits(self, "SimulationResultsEnrichmentRates")) { + } else if (inherits(self, "SimulationResultsEnrichmentMeans") || + inherits(self, "SimulationResultsEnrichmentRates")) { params <- c( "effectMeasure", "subjectsPopulation", @@ -229,8 +229,8 @@ SimulationResults <- R6Class("SimulationResults", "successStop", "futilityPerStage" ) - } else if (inherits(self, "SimulationResultsMultiArmSurvival") || inherits(self, "SimulationResultsMultiArmSurvival") || - inherits(self, "SimulationResultsEnrichmentSurvival") || inherits(self, "SimulationResultsEnrichmentSurvival")) { + } else if (inherits(self, "SimulationResultsMultiArmSurvival") || + inherits(self, "SimulationResultsEnrichmentSurvival")) { params <- c( "effectMeasure", "numberOfEvents", @@ -314,8 +314,8 @@ SimulationResults <- R6Class("SimulationResults", self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) } - twoGroupsEnabled <- !(inherits(self, "SimulationResultsMeans") || inherits(self, "SimulationResultsMeans")) - multiArmSurvivalEnabled <- inherits(self, "SimulationResultsMultiArmSurvival") || inherits(self, "SimulationResultsMultiArmSurvival") + twoGroupsEnabled <- !inherits(self, "SimulationResultsMeans") + multiArmSurvivalEnabled <- inherits(self, "SimulationResultsMultiArmSurvival") enrichmentEnabled <- grepl("SimulationResultsEnrichment", .getClassName(self)) if (!is.null(performanceScore)) { @@ -360,9 +360,9 @@ SimulationResults <- R6Class("SimulationResults", }, .getVariedParameterName = function(number = 1) { if (number == 2) { - if (!(inherits(self, "SimulationResultsMeans") || inherits(self, "SimulationResultsMeans")) && - !(inherits(self, "SimulationResultsRates") || inherits(self, "SimulationResultsRates")) && - !(inherits(self, "SimulationResultsSurvival") || inherits(self, "SimulationResultsSurvival")) && + if (!inherits(self, "SimulationResultsMeans") && + !inherits(self, "SimulationResultsRates") && + !inherits(self, "SimulationResultsSurvival") && grepl("MultiArm", .getClassName(self))) { return("armNumber") } @@ -370,16 +370,16 @@ SimulationResults <- R6Class("SimulationResults", } variedParameterName1 <- NA_character_ - if (inherits(self, "SimulationResultsMeans") || inherits(self, "SimulationResultsMeans")) { + if (inherits(self, "SimulationResultsMeans")) { variedParameterName1 <- "alternative" - } else if (inherits(self, "SimulationResultsRates") || inherits(self, "SimulationResultsRates") || inherits(self, "SimulationResultsSurvival") || inherits(self, "SimulationResultsSurvival")) { + } else if (inherits(self, "SimulationResultsRates") || inherits(self, "SimulationResultsSurvival")) { variedParameterName1 <- "pi1" } else if (grepl("MultiArm", .getClassName(self))) { - if (inherits(self, "SimulationResultsMultiArmMeans") || inherits(self, "SimulationResultsMultiArmMeans")) { + if (inherits(self, "SimulationResultsMultiArmMeans")) { variedParameterName1 <- "muMax" - } else if (inherits(self, "SimulationResultsMultiArmRates") || inherits(self, "SimulationResultsMultiArmRates")) { + } else if (inherits(self, "SimulationResultsMultiArmRates")) { variedParameterName1 <- "piMax" - } else if (inherits(self, "SimulationResultsMultiArmSurvival") || inherits(self, "SimulationResultsMultiArmSurvival")) { + } else if (inherits(self, "SimulationResultsMultiArmSurvival")) { variedParameterName1 <- "omegaMax" } } @@ -486,13 +486,13 @@ SimulationResults <- R6Class("SimulationResults", s <- paste(s, "enrichment") } - if (inherits(self, "SimulationResultsBaseMeans") || inherits(self, "SimulationResultsBaseMeans")) { + if (inherits(self, "SimulationResultsBaseMeans")) { s <- paste(s, "means") - } else if (inherits(self, "SimulationResultsBaseRates") || inherits(self, "SimulationResultsBaseRates")) { + } else if (inherits(self, "SimulationResultsBaseRates")) { s <- paste(s, "rates") - } else if (inherits(self, "SimulationResultsBaseSurvival") || inherits(self, "SimulationResultsBaseSurvival")) { + } else if (inherits(self, "SimulationResultsBaseSurvival")) { s <- paste(s, "survival data") - } else if (inherits(.self, "SimulationResultsBaseCountData")) { + } else if (inherits(self, "SimulationResultsBaseCountData")) { s <- paste(s, "count data") } else { s <- paste(s, "UNDEFINED") @@ -1026,7 +1026,7 @@ SimulationResultsBaseSurvival <- R6Class("SimulationResultsBaseSurvival", thetaH1 = NULL, calcEventsFunction = NULL, expectedNumberOfEvents = NULL, - conditionalPowerAchieved = matrix(), #TODO remove? + #conditionalPowerAchieved = matrix(), #TODO remove? initialize = function(design, ...) { super$initialize(design = design, ...) generatedParams <- c( @@ -1180,7 +1180,7 @@ SimulationResultsSurvival <- R6Class("SimulationResultsSurvival", "studyDuration", "allocationRatioPlanned" ) - if (inherits(.self, "SimulationResultsMultiArmSurvival")) { + if (inherits(self, "SimulationResultsMultiArmSurvival")) { generatedParams <- c(generatedParams, "cumulativeEventsPerStage", "singleEventsPerArmAndStage") } else { diff --git a/R/class_summary.R b/R/class_summary.R index 5142c9d7..e3dff977 100644 --- a/R/class_summary.R +++ b/R/class_summary.R @@ -150,7 +150,7 @@ knit_print.SummaryFactory <- function(x, ...) { #' @export #' print.SummaryFactory <- function(x, ..., - markdown = NA, + markdown = NA, sep = "\n-----\n\n") { if (is.na(markdown)) { markdown <- .isMarkdownEnabled() @@ -310,7 +310,7 @@ SummaryFactory <- R6Class("SummaryFactory", ) }, addSummaryItem = function(summaryItem) { - if (!(inherits(summaryItem, "SummaryItem") || inherits(summaryItem, "SummaryItem"))) { + if (!inherits(summaryItem, "SummaryItem")) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'summaryItem' must be an instance of class 'SummaryItem' (was '", .getClassName(summaryItem), "')" @@ -350,7 +350,7 @@ SummaryFactory <- R6Class("SummaryFactory", enforceFirstCase = FALSE, formatRepeatedPValues = FALSE, validateParameterType = TRUE) { if (!is.null(parameterName) && length(parameterName) == 1 && - (inherits(parameterSet, "ParameterSet") || inherits(parameterSet, "ParameterSet")) && + inherits(parameterSet, "ParameterSet") && parameterSet$.getParameterType(parameterName) == C_PARAM_NOT_APPLICABLE) { if (.getLogicalEnvironmentVariable("RPACT_DEVELOPMENT_MODE") && validateParameterType) { warning( @@ -410,7 +410,7 @@ SummaryFactory <- R6Class("SummaryFactory", parameterNames <- "" numberOfVariants <- 1 numberOfStages <- ifelse(is.matrix(values), ncol(values), length(values)) - if (inherits(parameterSet, "ParameterSet") || inherits(parameterSet, "ParameterSet")) { + if (inherits(parameterSet, "ParameterSet")) { parameterNames <- parameterSet$.getVisibleFieldNamesOrdered() numberOfVariants <- .getMultidimensionalNumberOfVariants(parameterSet, parameterNames) numberOfStages <- parameterSet$.getMultidimensionalNumberOfStages(parameterNames) @@ -420,7 +420,7 @@ SummaryFactory <- R6Class("SummaryFactory", if (is.null(stages) && !is.null(parameterSet[[".stageResults"]])) { stages <- parameterSet[[".stageResults"]][["stages"]] } - if (is.null(stages) && (inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResults"))) { + if (is.null(stages) && inherits(parameterSet, "ClosedCombinationTestResults")) { stages <- parameterSet[[".design"]][["stages"]] } if (!is.null(stages) && length(stages) > 0) { @@ -501,7 +501,7 @@ SummaryFactory <- R6Class("SummaryFactory", valuesToShow <- self$.getFormattedParameterValue(valuesToShow, valuesToShow2) self$addItem(parameterCaptionSingle, valuesToShow, legendEntry) } else { - if (!(inherits(parameterSet, "ParameterSet") || inherits(parameterSet, "ParameterSet"))) { + if (!inherits(parameterSet, "ParameterSet")) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "for varied values 'parameterSet' must be an instance of ", @@ -514,9 +514,9 @@ SummaryFactory <- R6Class("SummaryFactory", userDefinedEffectMatrix <- FALSE if (grepl("MultiArm|Enrichment", .getClassName(parameterSet)) || - (inherits(parameterSet, "AnalysisResultsConditionalDunnett") || inherits(parameterSet, "AnalysisResultsConditionalDunnett")) || - (inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResults")) || - (inherits(parameterSet, "ConditionalPowerResults") || inherits(parameterSet, "ConditionalPowerResults"))) { + inherits(parameterSet, "AnalysisResultsConditionalDunnett") || + inherits(parameterSet, "ClosedCombinationTestResults") || + inherits(parameterSet, "ConditionalPowerResults")) { if (grepl("SimulationResults(MultiArm|Enrichment)", .getClassName(parameterSet)) && parameterName %in% c( "rejectAtLeastOne", @@ -586,25 +586,25 @@ SummaryFactory <- R6Class("SummaryFactory", numberOfVariants <- length(variedParameterValues) legendEntry[["S[i]"]] <- "population i" legendEntry[["F"]] <- "full population" - } else if (!(inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResults")) || + } else if (!inherits(parameterSet, "ClosedCombinationTestResults") || parameterName %in% c("rejected", "separatePValues")) { - if ((inherits(parameterSet, "AnalysisResultsConditionalDunnett") || inherits(parameterSet, "AnalysisResultsConditionalDunnett")) && + if (inherits(parameterSet, "AnalysisResultsConditionalDunnett") && (!is.matrix(values) || ncol(values) > 1)) { transposed <- TRUE } - if ((inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResults")) && + if (inherits(parameterSet, "ClosedCombinationTestResults") && parameterSet$.getParameterType("adjustedStageWisePValues") != "g" && parameterName == "separatePValues") { transposed <- TRUE } - if ((inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResults")) && + if (inherits(parameterSet, "ClosedCombinationTestResults") && parameterName %in% c("rejected")) { transposed <- TRUE } - if ((inherits(parameterSet, "ConditionalPowerResults") || inherits(parameterSet, "ConditionalPowerResults")) && + if (inherits(parameterSet, "ConditionalPowerResults") && parameterName %in% c("conditionalPower", "values")) { transposed <- TRUE } @@ -622,7 +622,7 @@ SummaryFactory <- R6Class("SummaryFactory", } else { if (inherits(parameterSet, "Dataset")) { variedParameter <- "groups" - } else if (inherits(parameterSet, "PerformanceScore") || inherits(parameterSet, "PerformanceScore")) { + } else if (inherits(parameterSet, "PerformanceScore")) { variedParameter <- ".alternative" } else { variedParameter <- parameterSet$.getVariedParameter(parameterNames, numberOfVariants) @@ -688,9 +688,9 @@ SummaryFactory <- R6Class("SummaryFactory", } else if ( (grepl("MultiArm|Enrichment", .getClassName(parameterSet)) && !grepl("Simulation", .getClassName(parameterSet))) || - (inherits(parameterSet, "AnalysisResultsConditionalDunnett") || inherits(parameterSet, "AnalysisResultsConditionalDunnett")) || - (inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResults")) || - (inherits(parameterSet, "ConditionalPowerResults") || inherits(parameterSet, "ConditionalPowerResults"))) { + inherits(parameterSet, "AnalysisResultsConditionalDunnett") || + inherits(parameterSet, "ClosedCombinationTestResults") || + inherits(parameterSet, "ConditionalPowerResults")) { spacePrefix <- ifelse(parameterCaption %in% c("pi", "lambda", "median"), "", " ") self$addItem(paste0( parameterCaption, spacePrefix, @@ -721,7 +721,7 @@ SummaryFactory <- R6Class("SummaryFactory", .isEnrichmentAnalysisResults(parameterSet) || .isEnrichmentStageResults(parameterSet) || .isEnrichmentConditionalPowerResults(parameterSet) || - ((inherits(parameterSet, "ClosedCombinationTestResults") || inherits(parameterSet, "ClosedCombinationTestResults")) && + (inherits(parameterSet, "ClosedCombinationTestResults") && isTRUE(parameterSet$.enrichment)) ) }, @@ -922,10 +922,10 @@ SummaryFactory <- R6Class("SummaryFactory", designPlan <- NULL if (inherits(object, "TrialDesignCharacteristics")) { design <- object$.design - } else if (.isTrialDesignPlan(object) || inherits(object, "SimulationResults") || inherits(object, "SimulationResults")) { + } else if (.isTrialDesignPlan(object) || inherits(object, "SimulationResults")) { design <- object$.design designPlan <- object - } else if (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResults")) { + } else if (inherits(object, "AnalysisResults")) { return(.createSummaryTitleAnalysisResults(object$.design, object)) } else if (.isTrialDesign(object)) { design <- object @@ -992,7 +992,7 @@ SummaryFactory <- R6Class("SummaryFactory", title <- paste0(title, "Sequential analysis with a maximum of ", kMax, " looks") } if (!is.null(designPlan)) { - if (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResults")) { + if (inherits(designPlan, "SimulationResults")) { title <- "Simulation of a " } else if (designPlan$.isSampleSizeObject()) { title <- "Sample size calculation for a " @@ -1050,7 +1050,7 @@ SummaryFactory <- R6Class("SummaryFactory", countDataEnabled <- FALSE ratioEnabled <- FALSE populations <- NA_integer_ - if ((inherits(object, "AnalysisResults") || inherits(object, "AnalysisResults")) || (inherits(object, "StageResults") || inherits(object, "StageResults"))) { + if (inherits(object, "AnalysisResults") || inherits(object, "StageResults")) { groups <- object$.dataInput$getNumberOfGroups() meansEnabled <- grepl("Means", .getClassName(object$.dataInput)) ratesEnabled <- grepl("Rates", .getClassName(object$.dataInput)) @@ -1087,8 +1087,8 @@ SummaryFactory <- R6Class("SummaryFactory", } .createSummaryHypothesisText <- function(object, summaryFactory) { - if (!(inherits(object, "AnalysisResults") || inherits(object, "AnalysisResults")) && !(inherits(object, "TrialDesignPlan") || inherits(object, "TrialDesignPlan")) && - !(inherits(object, "SimulationResults") || inherits(object, "SimulationResults"))) { + if (!inherits(object, "AnalysisResults") && !inherits(object, "TrialDesignPlan") && + !inherits(object, "SimulationResults")) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'object' must be an instance of class 'AnalysisResults', 'TrialDesignPlan' ", @@ -1110,7 +1110,7 @@ SummaryFactory <- R6Class("SummaryFactory", comparisonH0 <- " = " comparisonH1 <- NA_character_ - if ((inherits(object, "AnalysisResults") || inherits(object, "AnalysisResults")) && !is.null(directionUpper)) { + if (inherits(object, "AnalysisResults") && !is.null(directionUpper)) { comparisonH1 <- ifelse(sided == 2, " != ", ifelse(directionUpper, " > ", " < ")) } @@ -1200,7 +1200,7 @@ SummaryFactory <- R6Class("SummaryFactory", return("") } - if (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResults")) { + if (inherits(object, "AnalysisResults")) { return("") } @@ -1246,11 +1246,11 @@ SummaryFactory <- R6Class("SummaryFactory", return(.createSummaryHeaderDesign(object$.design, NULL, summaryFactory)) } - if (.isTrialDesignPlan(object) || (inherits(object, "SimulationResults") || inherits(object, "SimulationResults"))) { + if (.isTrialDesignPlan(object) || inherits(object, "SimulationResults")) { return(.createSummaryHeaderDesign(object$.design, object, summaryFactory)) } - if (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResults")) { + if (inherits(object, "AnalysisResults")) { return(.createSummaryHeaderAnalysisResults(object$.design, object, summaryFactory, digits)) } @@ -1264,9 +1264,9 @@ SummaryFactory <- R6Class("SummaryFactory", .addAllocationRatioToHeader <- function(parameterSet, header, sep = ", ") { if (!.isTrialDesignPlanSurvival(parameterSet) && !grepl("Simulation", .getClassName(parameterSet))) { numberOfGroups <- 1 - if (inherits(parameterSet, "TrialDesignPlan") || inherits(parameterSet, "TrialDesignPlan")) { + if (inherits(parameterSet, "TrialDesignPlan")) { numberOfGroups <- parameterSet$groups - } else if (inherits(parameterSet, "AnalysisResults") || inherits(parameterSet, "AnalysisResults")) { + } else if (inherits(parameterSet, "AnalysisResults")) { numberOfGroups <- parameterSet$.dataInput$getNumberOfGroups() } if (numberOfGroups == 1) { @@ -1397,7 +1397,7 @@ SummaryFactory <- R6Class("SummaryFactory", } } - if ((inherits(stageResults, "StageResultsMeans") || inherits(stageResults, "StageResultsMeans")) && (dataInput$getNumberOfGroups() == 2)) { + if (inherits(stageResults, "StageResultsMeans") && (dataInput$getNumberOfGroups() == 2)) { if (stageResults$equalVariances) { header <- .concatenateSummaryText(header, "equal variances option") } else { @@ -1802,7 +1802,7 @@ SummaryFactory <- R6Class("SummaryFactory", ifelse(settings$populations == 1, "", "s") )) } - if (!is.null(designPlan) && (.isTrialDesignPlan(designPlan) || (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResults"))) && + if (!is.null(designPlan) && (.isTrialDesignPlan(designPlan) || inherits(designPlan, "SimulationResults")) && !settings$multiArmEnabled && !settings$enrichmentEnabled && !settings$survivalEnabled) { if (settings$ratesEnabled) { if (settings$groups == 1) { @@ -1871,7 +1871,7 @@ SummaryFactory <- R6Class("SummaryFactory", } header <- .addAdditionalArgumentsToHeader(header, designPlan, settings) } else if (settings$ratesEnabled && (.isTrialDesignInverseNormalOrGroupSequential(design) || - (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResults")))) { + inherits(designPlan, "SimulationResults"))) { if (settings$groups == 1) { if (!is.null(designPlan[["pi1"]]) && length(designPlan$pi1) == 1) { treatmentRateText <- paste0("H1: treatment rate pi = ", round(designPlan$pi1, 3)) @@ -1933,7 +1933,7 @@ SummaryFactory <- R6Class("SummaryFactory", header <- .addAdditionalArgumentsToHeader(header, designPlan, settings) } } else if (settings$survivalEnabled && (.isTrialDesignInverseNormalOrGroupSequential(design) || - (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResults")))) { + inherits(designPlan, "SimulationResults"))) { parameterNames <- designPlan$.getVisibleFieldNamesOrdered() numberOfVariants <- .getMultidimensionalNumberOfVariants(designPlan, parameterNames) @@ -1969,7 +1969,7 @@ SummaryFactory <- R6Class("SummaryFactory", } else if (!is.null(designPlan[["omegaMaxVector"]]) && length(designPlan$omegaMaxVector) == 1) { treatmentRateText <- paste0("H1: omega_max = ", round(designPlan$omegaMaxVector, 3)) } else if (!is.null(designPlan[["hazardRatio"]]) && (length(designPlan$hazardRatio) == 1) || - ((inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResults")) && !is.null(designPlan[[".piecewiseSurvivalTime"]]) && + (inherits(designPlan, "SimulationResults") && !is.null(designPlan[[".piecewiseSurvivalTime"]]) && designPlan$.piecewiseSurvivalTime$piecewiseSurvivalEnabled)) { treatmentRateText <- paste0( "H1: hazard ratio = ", @@ -2015,12 +2015,12 @@ SummaryFactory <- R6Class("SummaryFactory", header <- .addEnrichmentEffectListToHeader(header, designPlan) header <- .addAdditionalArgumentsToHeader(header, designPlan, settings) } - if (!(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResults")) && designPlan$.isSampleSizeObject()) { + if (!inherits(designPlan, "SimulationResults") && designPlan$.isSampleSizeObject()) { header <- .concatenateSummaryText(header, paste0("power ", round(100 * (1 - design$beta), 1), "%")) } - if (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResults")) { + if (inherits(designPlan, "SimulationResults")) { header <- .concatenateSummaryText(header, paste0("simulation runs = ", designPlan$maxNumberOfIterations)) header <- .concatenateSummaryText(header, paste0("seed = ", designPlan$seed)) } @@ -2371,19 +2371,19 @@ SummaryFactory <- R6Class("SummaryFactory", .createSummary <- function(object, digits = NA_integer_, output = c("all", "title", "overview", "body")) { output <- match.arg(output) - if (inherits(object, "TrialDesignCharacteristics") || inherits(object, "TrialDesignCharacteristics")) { + if (inherits(object, "TrialDesignCharacteristics")) { return(.createSummaryDesignPlan(object, digits = digits, output = output, showStageLevels = TRUE)) } - if (.isTrialDesign(object) || .isTrialDesignPlan(object) || inherits(object, "SimulationResults") || inherits(object, "SimulationResults")) { + if (.isTrialDesign(object) || .isTrialDesignPlan(object) || inherits(object, "SimulationResults")) { return(.createSummaryDesignPlan(object, digits = digits, output = output, showStageLevels = !.isTrialDesignPlan(object))) } - if (inherits(object, "AnalysisResults") || inherits(object, "AnalysisResults")) { + if (inherits(object, "AnalysisResults")) { return(.createSummaryAnalysisResults(object, digits = digits, output = output)) } - if (inherits(object, "PerformanceScore") || inherits(object, "PerformanceScore")) { + if (inherits(object, "PerformanceScore")) { return(.createSummaryPerformanceScore(object, digits = digits, output = output)) } @@ -2423,7 +2423,7 @@ SummaryFactory <- R6Class("SummaryFactory", #' .createSummaryAnalysisResults <- function(object, digits = NA_integer_, output = c("all", "title", "overview", "body")) { output <- match.arg(output) - if (!(inherits(object, "AnalysisResults") || inherits(object, "AnalysisResults"))) { + if (!inherits(object, "AnalysisResults")) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'object' must be a valid analysis result object (is class ", .getClassName(object), ")" @@ -2457,13 +2457,8 @@ SummaryFactory <- R6Class("SummaryFactory", conditionalPowerResults <- analysisResults$.conditionalPowerResults } } - - summaryFactory <- NULL - if(is.R6(object)) { - summaryFactory <- SummaryFactory$new(object = object, intervalFormat = intervalFormat, output = output) - } else { - summaryFactory <- SummaryFactory(object = object, intervalFormat = intervalFormat, output = output) - } + + summaryFactory <- SummaryFactory$new(object = object, intervalFormat = intervalFormat, output = output) .addDesignInformationToSummary(design, object, summaryFactory, output = output) @@ -2522,8 +2517,8 @@ SummaryFactory <- R6Class("SummaryFactory", parameterCaption <- ifelse(stageResults$isOneSampleDataset(), "Cumulative standard deviation", "Cumulative (pooled) standard deviation" ) - parameterName <- ifelse((inherits(stageResults, "StageResultsMultiArmMeans") || inherits(stageResults, "StageResultsMultiArmMeans")) && - !(inherits(stageResults, "StageResultsEnrichmentMeans") || inherits(stageResults, "StageResultsEnrichmentMeans")), + parameterName <- ifelse(inherits(stageResults, "StageResultsMultiArmMeans") && + !inherits(stageResults, "StageResultsEnrichmentMeans"), "overallPooledStDevs", "overallStDevs" ) summaryFactory$addParameter(stageResults, @@ -2828,10 +2823,10 @@ SummaryFactory <- R6Class("SummaryFactory", return(invisible(summaryFactory)) } - informationRatesCaption <- ifelse(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResults") || - (inherits(designPlan, "AnalysisResults") || inherits(designPlan, "AnalysisResults")), "Fixed weight", "Information") + informationRatesCaption <- ifelse(inherits(designPlan, "SimulationResults") || + inherits(designPlan, "AnalysisResults"), "Fixed weight", "Information") - if (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResults") || (inherits(designPlan, "AnalysisResults") || inherits(designPlan, "AnalysisResults"))) { + if (inherits(designPlan, "SimulationResults") || inherits(designPlan, "AnalysisResults")) { if (.isTrialDesignFisher(design)) { weights <- .getWeightsFisher(design) } else if (.isTrialDesignInverseNormal(design)) { @@ -2844,7 +2839,7 @@ SummaryFactory <- R6Class("SummaryFactory", summaryFactory$addItem( paste0( informationRatesCaption, - ifelse(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResults"), "", " rate") + ifelse(inherits(designPlan, "SimulationResults"), "", " rate") ), .getSummaryValuesInPercent(design$informationRates) ) @@ -2859,7 +2854,7 @@ SummaryFactory <- R6Class("SummaryFactory", .addDesignParameterToSummary <- function(design, designPlan, designCharacteristics, summaryFactory, digitsGeneral, digitsProbabilities) { - if (design$kMax > 1 && !(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResults")) && + if (design$kMax > 1 && !inherits(designPlan, "SimulationResults") && !.isTrialDesignConditionalDunnett(design)) { summaryFactory$addParameter(design, parameterName = "alphaSpent", @@ -2878,7 +2873,7 @@ SummaryFactory <- R6Class("SummaryFactory", if (!is.null(designPlan)) { if (!grepl("SimulationResults(MultiArm|Enrichment)", .getClassName(designPlan))) { outputSize <- getOption("rpact.summary.output.size", C_SUMMARY_OUTPUT_SIZE_DEFAULT) - if (outputSize == "large" && (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResults"))) { + if (outputSize == "large" && inherits(designPlan, "SimulationResults")) { summaryFactory$addParameter(designPlan, parameterName = "conditionalPowerAchieved", parameterCaption = "Conditional power (achieved)", @@ -2945,7 +2940,7 @@ SummaryFactory <- R6Class("SummaryFactory", parameterName = "alpha", parameterCaption = "Significance level", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) - } else if (!is.null(designPlan) && !(inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResults"))) { + } else if (!is.null(designPlan) && !inherits(designPlan, "SimulationResults")) { summaryFactory$addParameter(design, parameterName = "stageLevels", twoSided = design$sided == 2, @@ -2966,10 +2961,10 @@ SummaryFactory <- R6Class("SummaryFactory", performanceScore = NULL) { output <- match.arg(output) designPlan <- NULL - if (.isTrialDesignPlan(object) || (inherits(object, "SimulationResults") || inherits(object, "SimulationResults"))) { + if (.isTrialDesignPlan(object) || inherits(object, "SimulationResults")) { design <- object$.design designPlan <- object - } else if (inherits(object, "TrialDesignCharacteristics") || inherits(object, "TrialDesignCharacteristics")) { + } else if (inherits(object, "TrialDesignCharacteristics")) { design <- object$.design # designPlan <- object } else if (.isTrialDesign(object)) { @@ -2992,14 +2987,8 @@ SummaryFactory <- R6Class("SummaryFactory", intervalFormat <- getOption("rpact.summary.intervalFormat", "[%s; %s]") .assertIsValidSummaryIntervalFormat(intervalFormat) - - summaryFactory <- NULL - if(is.R6(object)) { - summaryFactory <- SummaryFactory$new(object = object, intervalFormat = intervalFormat, output = output) - } else { - summaryFactory <- SummaryFactory(object = object, intervalFormat = intervalFormat, output = output) - } - + + summaryFactory <- SummaryFactory$new(object = object, intervalFormat = intervalFormat, output = output) if (output %in% c("all", "title", "overview")) { .addDesignInformationToSummary(design, designPlan, summaryFactory, output = output) @@ -3096,7 +3085,7 @@ SummaryFactory <- R6Class("SummaryFactory", futilityPerStage = designPlan$futilityPerStage ) numberOfVariants <- 1 - if ((inherits(designPlan, "ParameterSet") || inherits(designPlan, "ParameterSet"))) { + if (inherits(designPlan, "ParameterSet")) { parameterNames <- designPlan$.getVisibleFieldNamesOrdered() numberOfVariants <- .getMultidimensionalNumberOfVariants(designPlan, parameterNames) } @@ -3314,7 +3303,7 @@ SummaryFactory <- R6Class("SummaryFactory", if (outputSize %in% c("medium", "large")) { - subjectsCaption <- ifelse(design$kMax > 1 && (inherits(designPlan, "SimulationResults") || inherits(designPlan, "SimulationResults")) && + subjectsCaption <- ifelse(design$kMax > 1 && inherits(designPlan, "SimulationResults") && !survivalEnabled, "Stagewise number of subjects", "Number of subjects") summaryFactory$addParameter(designPlan, parameterName = parameterNameSubjects, @@ -3614,6 +3603,7 @@ SummaryFactory <- R6Class("SummaryFactory", } if (!is.null(performanceScore)) { + print(performanceScore) summaryFactory$addParameter(performanceScore, parameterName = "performanceScore", parameterCaption = "Performance score", diff --git a/R/class_time.R b/R/class_time.R index 9c0f87d5..a2ec52b9 100644 --- a/R/class_time.R +++ b/R/class_time.R @@ -214,11 +214,11 @@ getPiecewiseSurvivalTime <- function(piecewiseSurvivalTime = NA_real_, ignore = c(".pi1Default", ".lambdaBased", ".silent"), exceptionEnabled = TRUE ) - if (inherits(piecewiseSurvivalTime, "TrialDesignPlanSurvival") || inherits(piecewiseSurvivalTime, "TrialDesignPlanSurvival")) { + if (inherits(piecewiseSurvivalTime, "TrialDesignPlanSurvival")) { piecewiseSurvivalTime <- piecewiseSurvivalTime$.piecewiseSurvivalTime } - if (inherits(piecewiseSurvivalTime, "PiecewiseSurvivalTime") || inherits(piecewiseSurvivalTime, "PiecewiseSurvivalTime")) { + if (inherits(piecewiseSurvivalTime, "PiecewiseSurvivalTime")) { lambdaBased <- .getOptionalArgument(".lambdaBased", ...) if (!is.null(lambdaBased) && isTRUE(lambdaBased) && !piecewiseSurvivalTime$.isLambdaBased()) { stop( @@ -307,19 +307,19 @@ getAccrualTime <- function(accrualTime = NA_real_, ignore = c("showWarnings") ) - if (inherits(accrualTime, "AccrualTime") || inherits(accrualTime, "AccrualTime") || - inherits(accrualTime, "TrialDesignPlanSurvival") || inherits(accrualTime, "TrialDesignPlanSurvival")) { + if (inherits(accrualTime, "AccrualTime") || + inherits(accrualTime, "TrialDesignPlanSurvival")) { if (!identical(accrualIntensity, C_ACCRUAL_INTENSITY_DEFAULT)) { .warnInCaseOfUnusedArgument(accrualIntensity, "accrualIntensity", NA_real_, "getAccrualTime") } .warnInCaseOfUnusedArgument(maxNumberOfSubjects, "maxNumberOfSubjects", NA_real_, "getAccrualTime") } - if (inherits(accrualTime, "AccrualTime") || inherits(accrualTime, "AccrualTime")) { + if (inherits(accrualTime, "AccrualTime")) { return(accrualTime) } - if (inherits(accrualTime, "TrialDesignPlanSurvival") || inherits(accrualTime, "TrialDesignPlanSurvival")) { + if (inherits(accrualTime, "TrialDesignPlanSurvival")) { return(accrualTime$.accrualTime) } @@ -1409,7 +1409,7 @@ AccrualTime <- R6Class("AccrualTime", self$.initAccrualIntensityAbsolute() self$.validateFormula() - self$.showWarningIfCaseIsNotAllowed() + self$.showWarningIfCaseIsNotAllowed()#TODO wrong naming upstream! }, .asDataFrame = function() { accrualIntensityTemp <- self$accrualIntensity @@ -1426,7 +1426,7 @@ AccrualTime <- R6Class("AccrualTime", rownames(data) <- as.character(1:nrow(data)) colnames(data) <- c( "Start time", - .getParameterCaption("accrualIntensity", .self) + .getParameterCaption("accrualIntensity", self) ) return(data) }, @@ -1892,7 +1892,7 @@ AccrualTime <- R6Class("AccrualTime", len <- length(self$accrualIntensity) accrualIntensityAbsolute <- self$maxNumberOfSubjects / sum((self$accrualTime[2:(len + 1)] - self$accrualTime[1:len]) * self$accrualIntensity) * self$accrualIntensity - + if (!isTRUE(all.equal(accrualIntensityAbsolute, self$accrualIntensity, tolerance = 1e-06)) && !isTRUE(all.equal(accrualIntensityAbsolute, 0, tolerance = 1e-06))) { self$.validateAccrualTimeAndIntensity() diff --git a/R/f_analysis_base.R b/R/f_analysis_base.R index bc89365a..985bee00 100644 --- a/R/f_analysis_base.R +++ b/R/f_analysis_base.R @@ -28,15 +28,15 @@ NULL stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, sQuote("dataInput"), " must be specified") } - if (missing(dataInput) && !missing(design) && (inherits(design, "Dataset") || inherits(design, "Dataset"))) { + if (missing(dataInput) && !missing(design) && inherits(design, "Dataset")) { dataInput <- design - if (!is.null(dataInput$.design) && (inherits(dataInput$.design, "TrialDesign") || inherits(dataInput$.design, "TrialDesign"))) { + if (!is.null(dataInput$.design) && inherits(dataInput$.design, "TrialDesign")) { design <- dataInput$.design } else { design <- .getDefaultDesign(..., type = "analysis") } } else if (!missing(dataInput) && missing(design)) { - if (!is.null(dataInput$.design) && (inherits(dataInput$.design, "TrialDesign") || inherits(dataInput$.design, "TrialDesign"))) { + if (!is.null(dataInput$.design) && inherits(dataInput$.design, "TrialDesign")) { design <- dataInput$.design } else { design <- .getDefaultDesign(..., type = "analysis") diff --git a/R/f_core_assertions.R b/R/f_core_assertions.R index 4e3cf1bf..7d59b08a 100644 --- a/R/f_core_assertions.R +++ b/R/f_core_assertions.R @@ -15,9 +15,9 @@ library("R6") ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7670 $ -## | Last changed: $Date: 2024-02-26 15:46:14 +0100 (Mo, 26 Feb 2024) $ -## | Last changed by: $Author: wassmer $ +## | File version: $Revision: 7712 $ +## | Last changed: $Date: 2024-03-12 08:24:58 +0100 (Di, 12 Mrz 2024) $ +## | Last changed by: $Author: pahlke $ ## | #' @include f_core_utilities.R @@ -39,7 +39,7 @@ NULL } .isParameterSet <- function(x) { - return((isS4(x) || R6::is.R6(x)) && (inherits(x, "ParameterSet") || inherits(x, "ParameterSet"))) + return(R6::is.R6(x) && inherits(x, "ParameterSet")) } .assertIsParameterSetClass <- function(x, objectName = "x") { @@ -61,23 +61,23 @@ NULL } .isTrialDesignSet <- function(x) { - return(.getClassName(x) == "TrialDesignSet" || .getClassName(x) == "TrialDesignSet") + return(.getClassName(x) == "TrialDesignSet") } .isTrialDesignGroupSequential <- function(design) { - return(.getClassName(design) == C_CLASS_NAME_TRIAL_DESIGN_GROUP_SEQUENTIAL || .getClassName(design) == "TrialDesignGroupSequential") + return(.getClassName(design) == C_CLASS_NAME_TRIAL_DESIGN_GROUP_SEQUENTIAL) } .isTrialDesignInverseNormal <- function(design) { - return(.getClassName(design) == C_CLASS_NAME_TRIAL_DESIGN_INVERSE_NORMAL || .getClassName(design) == "TrialDesignInverseNormal") + return(.getClassName(design) == C_CLASS_NAME_TRIAL_DESIGN_INVERSE_NORMAL) } .isTrialDesignFisher <- function(design) { - return(.getClassName(design) == C_CLASS_NAME_TRIAL_DESIGN_FISHER || .getClassName(design) == "TrialDesignFisher") + return(.getClassName(design) == C_CLASS_NAME_TRIAL_DESIGN_FISHER) } .isTrialDesignConditionalDunnett <- function(design) { - return(.getClassName(design) == C_CLASS_NAME_TRIAL_DESIGN_CONDITIONAL_DUNNETT || .getClassName(design) == "TrialDesignConditionalDunnett") + return(.getClassName(design) == C_CLASS_NAME_TRIAL_DESIGN_CONDITIONAL_DUNNETT) } .isTrialDesignInverseNormalOrGroupSequential <- function(design) { @@ -94,15 +94,15 @@ NULL } .isTrialDesignPlanMeans <- function(designPlan) { - return(.getClassName(designPlan) == "TrialDesignPlanMeans" || .getClassName(designPlan) == "TrialDesignPlanMeans") + return(.getClassName(designPlan) == "TrialDesignPlanMeans") } .isTrialDesignPlanRates <- function(designPlan) { - return(.getClassName(designPlan) == "TrialDesignPlanRates" || .getClassName(designPlan) == "TrialDesignPlanRates") + return(.getClassName(designPlan) == "TrialDesignPlanRates") } .isTrialDesignPlanSurvival <- function(designPlan) { - return(.getClassName(designPlan) == "TrialDesignPlanSurvival" || .getClassName(designPlan) == "TrialDesignPlanSurvival") + return(.getClassName(designPlan) == "TrialDesignPlanSurvival") } .isTrialDesignPlanCountData <- function(designPlan) { @@ -202,7 +202,7 @@ NULL } .isSimulationResults <- function(simulationResults) { - return(inherits(simulationResults, "SimulationResults") || inherits(simulationResults, "SimulationResults")) + return(inherits(simulationResults, "SimulationResults")) } .assertIsSimulationResults <- function(simulationResults) { @@ -215,23 +215,23 @@ NULL } .isStageResults <- function(stageResults) { - return(inherits(stageResults, "StageResults") || inherits(stageResults, "StageResults")) + return(inherits(stageResults, "StageResults")) } .isStageResultsMultiArmMeans <- function(stageResults) { - return(.getClassName(stageResults) == "StageResultsMultiArmMeans" || .getClassName(stageResults) == "StageResultsMultiArmMeans") + return(.getClassName(stageResults) == "StageResultsMultiArmMeans") } .isStageResultsMultiArmSurvival <- function(stageResults) { - return(.getClassName(stageResults) == "StageResultsMultiArmSurvival" || .getClassName(stageResults) == "StageResultsMultiArmSurvival") + return(.getClassName(stageResults) == "StageResultsMultiArmSurvival") } .isStageResultsEnrichmentMeans <- function(stageResults) { - return(.getClassName(stageResults) == "StageResultsEnrichmentMeans" || .getClassName(stageResults) == "StageResultsEnrichmentMeans") + return(.getClassName(stageResults) == "StageResultsEnrichmentMeans") } .isStageResultsEnrichmentSurvival <- function(stageResults) { - return(.getClassName(stageResults) == "StageResultsEnrichmentSurvival" || .getClassName(stageResults) == "StageResultsEnrichmentSurvival") + return(.getClassName(stageResults) == "StageResultsEnrichmentSurvival") } .assertIsStageResults <- function(stageResults) { @@ -452,15 +452,15 @@ NULL } .isDatasetMeans <- function(dataInput) { - return(inherits(dataInput, "DatasetMeans") || inherits(dataInput, "DatasetMeans")) + return(inherits(dataInput, "DatasetMeans")) } .isDatasetRates <- function(dataInput) { - return(inherits(dataInput, "DatasetRates") || inherits(dataInput, "DatasetRates")) + return(inherits(dataInput, "DatasetRates")) } .isDatasetSurvival <- function(dataInput) { - return(inherits(dataInput, "DatasetSurvival") || inherits(dataInput, "DatasetSurvival") || inherits(dataInput, "DatasetEnrichmentSurvival") || inherits(dataInput, "DatasetEnrichmentSurvival")) + return(inherits(dataInput, "DatasetSurvival") || inherits(dataInput, "DatasetEnrichmentSurvival")) } .assertIsNumericVector <- function(x, argumentName, ..., naAllowed = FALSE, noDefaultAvailable = FALSE, call. = TRUE) { @@ -561,7 +561,7 @@ NULL if ((!naAllowed && is.na(x)) || !is.logical(x)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' (", - ifelse(isS4(x), .getClassName(x), x), ") must be a single logical value", + ifelse(isS4(x) || R6::is.R6(x), .getClassName(x), x), ") must be a single logical value", call. = call. ) } @@ -588,7 +588,7 @@ NULL if ((!naAllowed && is.na(x)) || !is.numeric(x)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' (", - ifelse(isS4(x), .getClassName(x), x), ") must be a valid numeric value", + ifelse(isS4(x) || R6::is.R6(x), .getClassName(x), x), ") must be a valid numeric value", call. = call. ) } @@ -631,7 +631,7 @@ NULL (!validateType && !is.na(x) && !is.infinite(x) && as.integer(x) != x)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'", argumentName, "' (", ifelse(isS4(x), .getClassName(x), x), ") must be a ", prefix, "integer value", + "'", argumentName, "' (", ifelse(isS4(x) || R6::is.R6(x), .getClassName(x), x), ") must be a ", prefix, "integer value", call. = call. ) } @@ -639,7 +639,7 @@ NULL if (mustBePositive && !is.na(x) && !is.infinite(x) && x <= 0) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'", argumentName, "' (", ifelse(isS4(x), .getClassName(x), x), ") must be a ", prefix, "integer value", + "'", argumentName, "' (", ifelse(isS4(x) || R6::is.R6(x), .getClassName(x), x), ") must be a ", prefix, "integer value", call. = call. ) } @@ -781,17 +781,78 @@ NULL } } -.assertIsValidAlpha <- function(alpha) { - .assertIsSingleNumber(alpha, "alpha") +.showParameterOutOfValidatedBoundsMessage <- function( + parameterValue, + parameterName, ..., + lowerBound = NA_real_, + upperBound = NA_real_, + spendingFunctionName = NA_character_, + closedLowerBound = TRUE, + closedUpperBound = TRUE, + suffix = NA_character_) { - if (alpha < 1e-06 || alpha >= 0.5) { - stop( - C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, - "'alpha' (", alpha, ") is out of bounds [1e-06; 0.5)" - ) + .assertIsSingleNumber(lowerBound, "lowerBound", naAllowed = TRUE) + .assertIsSingleNumber(upperBound, "upperBound", naAllowed = TRUE) + if (is.na(lowerBound) && is.na(upperBound)) { + stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'lowerBound' or 'upperBound' must be defined") + } + + if (is.na(lowerBound)) { + lowerBound <- -Inf + } + + if (is.na(upperBound)) { + upperBound <- Inf + } + + if (closedLowerBound) { + bracketLowerBound <- "[" + conditionLowerBound <- parameterValue < lowerBound + } else { + bracketLowerBound <- "(" + conditionLowerBound <- parameterValue <= lowerBound + } + if (closedUpperBound) { + bracketUpperBound <- "]" + conditionUpperBound <- parameterValue > upperBound + } else { + bracketUpperBound <- ")" + conditionUpperBound <- parameterValue >= upperBound + } + + if (conditionLowerBound || conditionUpperBound) { + if (!is.null(spendingFunctionName) && !is.na(spendingFunctionName)) { + spendingFunctionName <- paste0("for ", spendingFunctionName, " function ") + } else { + spendingFunctionName <- "" + } + + if (is.na(suffix)) { + suffix <- "" + } else { + suffix <- paste0(" ", trimws(suffix)) + } + + type <- getOption("rpact.out.of.validated.bounds.message.type", "warning") + if (identical(type, "warning")) { + warning("The parameter ", sQuote(parameterName), " (", parameterValue, ") ", + spendingFunctionName, "is out of validated bounds ", + bracketLowerBound, lowerBound, "; ", upperBound, bracketUpperBound, suffix, call. = FALSE) + } + else if (identical(type, "message")) { + message("Note that parameter ", sQuote(parameterName), " (", parameterValue, ") ", + spendingFunctionName, "is out of validated bounds ", + bracketLowerBound, lowerBound, "; ", upperBound, bracketUpperBound, suffix) + } } } +.assertIsValidAlpha <- function(alpha) { + .assertIsSingleNumber(alpha, "alpha") + .assertIsInOpenInterval(alpha, "alpha", lower = 0, upper = NULL) + .showParameterOutOfValidatedBoundsMessage(alpha, "alpha", lowerBound = 1e-06, upperBound = 0.5, closedUpperBound = FALSE) +} + .assertIsValidKappa <- function(kappa) { .assertIsSingleNumber(kappa, "kappa") .assertIsInOpenInterval(kappa, "kappa", lower = 0, upper = NULL) @@ -863,14 +924,10 @@ NULL .assertIsValidBeta <- function(beta, alpha) { .assertIsSingleNumber(beta, "beta") .assertIsSingleNumber(alpha, "alpha") - - if (beta < 1e-04 || beta >= 1 - alpha) { - stop( - C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, - "'beta' (", beta, ") is out of bounds [1e-04; ", (1 - alpha), "); ", - "condition: 1e-05 <= alpha < 1 - beta <= 1 - 1e-04" - ) - } + .assertIsInOpenInterval(beta, "beta", lower = 0, upper = NULL) + .showParameterOutOfValidatedBoundsMessage(beta, "beta", lowerBound = 1e-04, + upperBound = 1 - alpha, closedUpperBound = FALSE, + suffix = "condition: 1e-06 <= alpha < 1 - beta <= 1 - 1e-04") } .assertIsValidAlphaAndBeta <- function(alpha, beta) { @@ -1347,11 +1404,11 @@ NULL for (i in 1:length(args)) { arg <- args[[i]] argName <- ifelse(is.null(argNames[i]) || argNames[i] == "", - ifelse(inherits(arg, "StageResults") || inherits(arg, "StageResults"), "stageResultsName", paste0("%param", i, "%")), + ifelse(inherits(arg, "StageResults"), "stageResultsName", paste0("%param", i, "%")), argNames[i] ) if (!(argName %in% ignore) && !grepl("^\\.", argName)) { - if (isS4(arg) || is.environment(arg)) { + if (isS4(arg) || is.environment(arg) || R6::is.R6(arg)) { arg <- .getClassName(arg) } if (is.function(arg)) { @@ -2157,24 +2214,24 @@ NULL } .isMultiArmDataset <- function(dataInput) { - return((inherits(dataInput, "Dataset") || inherits(dataInput, "Dataset")) && dataInput$getNumberOfGroups() > 2) + return(inherits(dataInput, "Dataset") && dataInput$getNumberOfGroups() > 2) } .isMultiArmStageResults <- function(stageResults) { - return((inherits(stageResults, "StageResults") || inherits(stageResults, "StageResults")) && grepl("MultiArm", .getClassName(stageResults))) + return(inherits(stageResults, "StageResults") && grepl("MultiArm", .getClassName(stageResults))) } .isEnrichmentStageResults <- function(stageResults) { - return((inherits(stageResults, "StageResults") || inherits(stageResults, "StageResults")) && grepl("Enrichment", .getClassName(stageResults))) + return(inherits(stageResults, "StageResults") && grepl("Enrichment", .getClassName(stageResults))) } .isEnrichmentConditionalPowerResults <- function(conditionalPowerResults) { - return((inherits(conditionalPowerResults, "ConditionalPowerResults") || inherits(conditionalPowerResults, "ConditionalPowerResults")) && + return(inherits(conditionalPowerResults, "ConditionalPowerResults") && grepl("Enrichment", .getClassName(conditionalPowerResults))) } .isMultiArmAnalysisResults <- function(analysisResults) { - return((inherits(analysisResults, "AnalysisResultsMultiArm") || inherits(analysisResults, "AnalysisResultsMultiArm"))) + return(inherits(analysisResults, "AnalysisResultsMultiArm")) } .isMultiHypothesesAnalysisResults <- function(x) { @@ -2182,23 +2239,23 @@ NULL } .isEnrichmentDataset <- function(dataInput) { - return((inherits(dataInput, "Dataset") || inherits(dataInput, "Dataset")) && dataInput$.enrichmentEnabled) + return(inherits(dataInput, "Dataset") && dataInput$.enrichmentEnabled) } .isEnrichmentAnalysisResults <- function(analysisResults) { - return(inherits(analysisResults, "AnalysisResultsEnrichment") || inherits(analysisResults, "AnalysisResultsEnrichment")) + return(inherits(analysisResults, "AnalysisResultsEnrichment")) } .isMultiArmSimulationResults <- function(simulationResults) { - return((inherits(simulationResults, "SimulationResults") || inherits(simulationResults, "SimulationResults")) && grepl("MultiArm", .getClassName(simulationResults))) + return(inherits(simulationResults, "SimulationResults") && grepl("MultiArm", .getClassName(simulationResults))) } .isEnrichmentSimulationResults <- function(simulationResults) { - return((inherits(simulationResults, "SimulationResults") || inherits(simulationResults, "SimulationResults")) && grepl("Enrichment", .getClassName(simulationResults))) + return(inherits(simulationResults, "SimulationResults") && grepl("Enrichment", .getClassName(simulationResults))) } .assertIsStageResultsMultiArm <- function(stageResults) { - if (!(inherits(stageResults, "StageResults") || inherits(stageResults, "StageResults"))) { + if (!inherits(stageResults, "StageResults")) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'stageResults' must be a multi-arm stage results object (is ", .getClassName(stageResults), ")" @@ -2214,14 +2271,14 @@ NULL } .assertIsStageResultsNonMultiHypotheses <- function(stageResults) { - if ((inherits(stageResults, "StageResults") || inherits(stageResults, "StageResults")) && .isMultiArmStageResults(stageResults)) { + if (inherits(stageResults, "StageResults") && .isMultiArmStageResults(stageResults)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'stageResults' must be a non-multi-arm object (is ", .getClassName(stageResults), ")" ) } - if ((inherits(stageResults, "StageResults") || inherits(stageResults, "StageResults")) && .isEnrichmentStageResults(stageResults)) { + if (inherits(stageResults, "StageResults") && .isEnrichmentStageResults(stageResults)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'stageResults' must be a non-enrichment object (is ", .getClassName(stageResults), ")" @@ -2229,9 +2286,6 @@ NULL } allowedClasses <- c( - "StageResultsMeans", - "StageResultsRates", - "StageResultsSurvival", "StageResultsMeans", "StageResultsRates", "StageResultsSurvival" @@ -2261,7 +2315,7 @@ NULL } .assertIsAnalysisResults <- function(analysisResults) { - if (!(inherits(analysisResults, "AnalysisResults") || inherits(analysisResults, "AnalysisResults"))) { + if (!inherits(analysisResults, "AnalysisResults")) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'analysisResults' must be a valid 'AnalysisResults' object ", " (is '", .getClassName(analysisResults), "')" diff --git a/R/f_core_plot.R b/R/f_core_plot.R index acdb1176..ffce1d72 100644 --- a/R/f_core_plot.R +++ b/R/f_core_plot.R @@ -36,7 +36,7 @@ NULL .assertIsSingleInteger(type, "type", validateType = FALSE) - if (inherits(obj, "TrialDesignPlan") || inherits(obj, "TrialDesignPlan")) { + if (inherits(obj, "TrialDesignPlan")) { if (type == 1) { if (.isTrialDesignPlanSurvival(obj)) { return(.addNumberToPlotCaption("Boundaries Z Scale", type, numberInCaptionEnabled)) @@ -76,11 +76,11 @@ NULL "Rejected Populations per Stage", "Rejected Populations" ), type, numberInCaptionEnabled)) } - } else if ((inherits(obj, "SimulationResults") || inherits(obj, "SimulationResults")) && type == 4) { + } else if (inherits(obj, "SimulationResults") && type == 4) { return(.addNumberToPlotCaption("Reject per Stage", type, numberInCaptionEnabled)) } - if (inherits(obj, "TrialDesignPlan") || inherits(obj, "TrialDesignPlan") || inherits(obj, "SimulationResults") || inherits(obj, "SimulationResults")) { + if (inherits(obj, "TrialDesignPlan") || inherits(obj, "SimulationResults")) { if (type == 5) { if (obj$.isSampleSizeObject()) { return(.addNumberToPlotCaption("Sample Size", type, numberInCaptionEnabled)) @@ -92,7 +92,7 @@ NULL } } else if (type == 6) { return(.addNumberToPlotCaption(ifelse(.isTrialDesignPlanSurvival(obj) || - inherits(obj, "SimulationResultsSurvival") || inherits(obj, "SimulationResultsSurvival"), + inherits(obj, "SimulationResultsSurvival"), "Number of Events", "Sample Size" ), type, numberInCaptionEnabled)) } else if (type == 7) { @@ -101,7 +101,7 @@ NULL return(.addNumberToPlotCaption("Overall Early Stopping", type, numberInCaptionEnabled)) } else if (type == 9) { if (.isTrialDesignPlanSurvival(obj) || - inherits(obj, "SimulationResultsSurvival") || inherits(obj, "SimulationResultsSurvival")) { + inherits(obj, "SimulationResultsSurvival")) { return(.addNumberToPlotCaption("Expected Number of Events", type, numberInCaptionEnabled)) } else { return(.addNumberToPlotCaption("Expected Sample Size", type, numberInCaptionEnabled)) @@ -117,7 +117,7 @@ NULL } else if (type == 14) { return(.addNumberToPlotCaption("Survival Function", type, numberInCaptionEnabled)) } - } else if (inherits(obj, "TrialDesign") || inherits(obj, "TrialDesignSet") || inherits(obj, "TrialDesign") || inherits(obj, "TrialDesignSet")) { + } else if (inherits(obj, "TrialDesign") || inherits(obj, "TrialDesignSet")) { if (type == 1) { return(.addNumberToPlotCaption("Boundaries", type, numberInCaptionEnabled)) } else if (type == 3) { @@ -138,7 +138,7 @@ NULL } else if (type == 9) { return(.addNumberToPlotCaption("Average Sample Size", type, numberInCaptionEnabled)) } - } else if (inherits(obj, "AnalysisResults") || inherits(obj, "AnalysisResults")) { + } else if (inherits(obj, "AnalysisResults")) { if (type == 1) { return(.addNumberToPlotCaption(C_PLOT_MAIN_CONDITIONAL_POWER_WITH_LIKELIHOOD, type, numberInCaptionEnabled)) } else if (type == 2) { @@ -399,7 +399,7 @@ getAvailablePlotTypes <- function(obj, output = c("numeric", "caption", "numcap" } types <- integer(0) - if (inherits(obj, "TrialDesignPlan") || inherits(obj, "TrialDesignPlan")) { + if (inherits(obj, "TrialDesignPlan")) { if (obj$.design$kMax > 1) { types <- c(types, 1) if (!.isTrialDesignPlanCountData(obj)) { @@ -431,7 +431,7 @@ getAvailablePlotTypes <- function(obj, output = c("numeric", "caption", "numcap" } } types <- .removeInvalidPlotTypes(obj, types, c(5:14)) - } else if (inherits(obj, "SimulationResults") || inherits(obj, "SimulationResults")) { + } else if (inherits(obj, "SimulationResults")) { if (grepl("Enrichment", .getClassName(obj)) && !.getSimulationEnrichmentEffectData( obj, validatePlotCapability = FALSE @@ -462,7 +462,7 @@ getAvailablePlotTypes <- function(obj, output = c("numeric", "caption", "numcap" if (!grepl("MultiArm", .getClassName(obj)) || obj$.design$kMax > 1) { types <- c(types, 9) } - if (inherits(obj, "SimulationResultsSurvival") || inherits(obj, "SimulationResultsSurvival")) { + if (inherits(obj, "SimulationResultsSurvival")) { types <- c(types, 10:14) } plotTypesToCheck <- c(4:14) @@ -470,9 +470,9 @@ getAvailablePlotTypes <- function(obj, output = c("numeric", "caption", "numcap" plotTypesToCheck <- c(1:14) } types <- .removeInvalidPlotTypes(obj, types, plotTypesToCheck) - } else if (inherits(obj, "TrialDesign") || inherits(obj, "TrialDesign") || inherits(obj, "TrialDesignSet") || inherits(obj, "TrialDesignSet")) { + } else if (inherits(obj, "TrialDesign") || inherits(obj, "TrialDesignSet")) { design <- obj - if (inherits(obj, "TrialDesignSet") || inherits(obj, "TrialDesignSet")) { + if (inherits(obj, "TrialDesignSet")) { design <- obj$getDesignMaster() } if (design$kMax > 1) { diff --git a/R/f_core_utilities.R b/R/f_core_utilities.R index f34c1e3b..b62be178 100644 --- a/R/f_core_utilities.R +++ b/R/f_core_utilities.R @@ -759,33 +759,32 @@ NULL } .setValueAndParameterType <- function(parameterSet, parameterName, value, defaultValue, - notApplicableIfNA = FALSE) { - .assertIsParameterSetClass(parameterSet, "parameterSet") - - if (is.null(parameterSet)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'parameterSet' must be not null") - } - - if (!ifelse(R6::is.R6(parameterSet), parameterName %in% names(parameterSet), parameterName %in% names(getClass(class(parameterSet))@fieldClasses))) { #names(.self$getRefClass()$fields()) - - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'", .getClassName(parameterSet), "' does not contain a field with name '", parameterName, "'" - ) - } - - parameterSet[[parameterName]] <- value - - if (notApplicableIfNA && all(is.na(value))) { - parameterSet$.setParameterType(parameterName, C_PARAM_NOT_APPLICABLE) - } else if (!is.null(value) && length(value) == length(defaultValue) && ( - (all(is.na(value)) && all(is.na(value) == is.na(defaultValue))) || - (!is.na(all(value == defaultValue)) && all(value == defaultValue)) - )) { - parameterSet$.setParameterType(parameterName, C_PARAM_DEFAULT_VALUE) - } else { - parameterSet$.setParameterType(parameterName, C_PARAM_USER_DEFINED) - } + notApplicableIfNA = FALSE) { + .assertIsParameterSetClass(parameterSet, "parameterSet") + + if (is.null(parameterSet)) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'parameterSet' must be not null") + } + + if (!ifelse(R6::is.R6(parameterSet), parameterName %in% names(parameterSet), parameterName %in% names(getClass(class(parameterSet))@fieldClasses))) { #TODO + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'", .getClassName(parameterSet), "' does not contain a field with name '", parameterName, "'" + ) + } + + parameterSet[[parameterName]] <- value + + if (notApplicableIfNA && all(is.na(value))) { + parameterSet$.setParameterType(parameterName, C_PARAM_NOT_APPLICABLE) + } else if (!is.null(value) && length(value) == length(defaultValue) && ( + (all(is.na(value)) && all(is.na(value) == is.na(defaultValue))) || + (!is.na(all(value == defaultValue)) && all(value == defaultValue)) + )) { + parameterSet$.setParameterType(parameterName, C_PARAM_DEFAULT_VALUE) + } else { + parameterSet$.setParameterType(parameterName, C_PARAM_USER_DEFINED) + } } .isDefaultVector <- function(x, default) { @@ -1044,7 +1043,7 @@ printCitation <- function(inclusiveR = TRUE, language = "en") { #' @export #' getParameterCaption <- function(obj, parameterName) { - if (is.null(obj) || length(obj) != 1 || !isS4(obj) || !inherits(obj, "FieldSet")) { + if (is.null(obj) || length(obj) != 1 || !isS4(obj) || !R6::is.R6(obj) || !inherits(obj, "FieldSet")) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'obj' (", .getClassName(obj), ") must be an rpact result object") } .assertIsSingleCharacter(parameterName, "parameterName", naAllowed = FALSE) @@ -1077,7 +1076,7 @@ getParameterCaption <- function(obj, parameterName) { #' @export #' getParameterName <- function(obj, parameterCaption) { - if (is.null(obj) || length(obj) != 1 || !isS4(obj) || !inherits(obj, "FieldSet")) { + if (is.null(obj) || length(obj) != 1 || !isS4(obj) || !R6::is.R6(obj) || !inherits(obj, "FieldSet")) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'obj' (", .getClassName(obj), ") must be an rpact result object") } .assertIsSingleCharacter(parameterCaption, "parameterCaption", naAllowed = FALSE) diff --git a/R/f_design_fisher_combination_test.R b/R/f_design_fisher_combination_test.R index 585791ff..c2281ec3 100644 --- a/R/f_design_fisher_combination_test.R +++ b/R/f_design_fisher_combination_test.R @@ -329,7 +329,6 @@ getDesignFisher <- function(..., } if (!all(is.na(design$stageLevels)) && any(na.omit(design$stageLevels[1:(design$kMax - 1)]) > design$alpha)) { - print(design$tolerance) stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'alpha' (", design$alpha, ") not correctly specified" diff --git a/R/f_design_general_utilities.R b/R/f_design_general_utilities.R index 00f09791..938d7250 100644 --- a/R/f_design_general_utilities.R +++ b/R/f_design_general_utilities.R @@ -1020,12 +1020,12 @@ getMedianByPi <- function(piValue, designParametersToShow <- c(designParametersToShow, ".design$stageLevels") } if (design$sided == 2 && !grepl("Analysis|Simulation", .getClassName(parameterSet)) && - (!(inherits(parameterSet, "TrialDesignPlan") || inherits(parameterSet, "TrialDesignPlan")) || parameterSet$.isSampleSizeObject())) { + (!inherits(parameterSet, "TrialDesignPlan") || parameterSet$.isSampleSizeObject())) { designParametersToShow <- c(designParametersToShow, ".design$twoSidedPower") } designParametersToShow <- c(designParametersToShow, ".design$alpha") if (!grepl("Analysis|Simulation", .getClassName(parameterSet)) && - (!(inherits(parameterSet, "TrialDesignPlan") || inherits(parameterSet, "TrialDesignPlan")) || parameterSet$.isSampleSizeObject())) { + (!inherits(parameterSet, "TrialDesignPlan") || parameterSet$.isSampleSizeObject())) { designParametersToShow <- c(designParametersToShow, ".design$beta") } @@ -1054,7 +1054,6 @@ getMedianByPi <- function(piValue, } .addDelayedInformationRates <- function(dataFrame) { - #print(dataFrame) if (all(c("informationRates", "delayedInformation", "kMax", "stages") %in% colnames(dataFrame))) { kMax <- max(dataFrame$kMax) if (kMax > 1) { diff --git a/R/f_design_group_sequential.R b/R/f_design_group_sequential.R index de32f213..acb880aa 100644 --- a/R/f_design_group_sequential.R +++ b/R/f_design_group_sequential.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7408 $ -## | Last changed: $Date: 2023-11-09 10:36:19 +0100 (Do, 09 Nov 2023) $ +## | File version: $Revision: 7703 $ +## | Last changed: $Date: 2024-03-07 13:38:48 +0100 (Do, 07 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -112,17 +112,16 @@ getGroupSequentialProbabilities <- function(decisionMatrix, informationRates) { if (design$typeOfDesign == C_TYPE_OF_DESIGN_WT) { .assertDesignParameterExists(design, "deltaWT", NA_real_) .assertIsSingleNumber(design$deltaWT, "deltaWT", naAllowed = FALSE) - .assertIsInClosedInterval(design$deltaWT, "deltaWT", lower = -0.5, upper = 1) + .showParameterOutOfValidatedBoundsMessage(design$deltaWT, "deltaWT", lowerBound = -0.5, upperBound = 1) } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_PT) { .assertDesignParameterExists(design, "deltaPT1", NA_real_) .assertIsSingleNumber(design$deltaPT1, "deltaPT1", naAllowed = FALSE) - .assertIsInClosedInterval(design$deltaPT1, "deltaPT1", lower = -0.5, upper = 1) + .showParameterOutOfValidatedBoundsMessage(design$deltaPT1, "deltaPT1", lowerBound = -0.5, upperBound = 1) .assertDesignParameterExists(design, "deltaPT0", NA_real_) .assertIsSingleNumber(design$deltaPT0, "deltaPT0", naAllowed = FALSE) - .assertIsInClosedInterval(design$deltaPT0, "deltaPT0", lower = -0.5, upper = 1) + .showParameterOutOfValidatedBoundsMessage(design$deltaPT0, "deltaPT0", lowerBound = -0.5, upperBound = 1) } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_WT_OPTIMUM) { .assertDesignParameterExists(design, "optimizationCriterion", C_OPTIMIZATION_CRITERION_DEFAULT) - if (!.isOptimizationCriterion(design$optimizationCriterion)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, @@ -132,27 +131,19 @@ getGroupSequentialProbabilities <- function(decisionMatrix, informationRates) { } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_HP) { .assertDesignParameterExists(design, "constantBoundsHP", C_CONST_BOUND_HP_DEFAULT) .assertIsSingleNumber(design$constantBoundsHP, "constantBoundsHP") - .assertIsInClosedInterval(design$constantBoundsHP, "constantBoundsHP", lower = 2, upper = NULL) + .showParameterOutOfValidatedBoundsMessage(design$constantBoundsHP, "constantBoundsHP", lowerBound = 2) } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_AS_KD) { .assertDesignParameterExists(design, "gammaA", NA_real_) .assertIsSingleNumber(design$gammaA, "gammaA", naAllowed = FALSE) - if (design$gammaA < 0.4 || design$gammaA > 8) { - stop( - C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, - "parameter 'gammaA' (", design$gammaA, ") for Kim & DeMets alpha ", - "spending function is out of bounds [0.4; 8]" - ) - } + .showParameterOutOfValidatedBoundsMessage(design$gammaA, "gammaA", + lowerBound = 0.4, upperBound = 8, + spendingFunctionName = "Kim & DeMets alpha spending") } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_AS_HSD) { .assertDesignParameterExists(design, "gammaA", NA_real_) .assertIsSingleNumber(design$gammaA, "gammaA", naAllowed = FALSE) - if (design$gammaA < -10 || design$gammaA > 5) { - stop( - C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, - "Parameter 'gammaA' (", design$gammaA, ") for Hwang, Shih & DeCani ", - "alpha spending function is out of bounds [-10; 5]" - ) - } + .showParameterOutOfValidatedBoundsMessage(design$gammaA, "gammaA", + lowerBound = -10, upperBound = 5, + spendingFunctionName = "Hwang, Shih & DeCani alpha spending") } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_AS_USER) { .validateUserAlphaSpending(design) design$.setParameterType("userAlphaSpending", C_PARAM_USER_DEFINED) @@ -189,25 +180,17 @@ getGroupSequentialProbabilities <- function(decisionMatrix, informationRates) { if (design$typeBetaSpending == C_TYPE_OF_DESIGN_BS_KD) { .assertDesignParameterExists(design, "gammaB", NA_real_) .assertIsSingleNumber(design$gammaB, "gammaB", naAllowed = FALSE) - if (design$gammaB < 0.4 || design$gammaB > 8) { - stop( - C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, - "parameter 'gammaB' (", design$gammaB, ") for Kim & DeMets beta ", - "spending function out of bounds [0.4; 8]" - ) - } + .showParameterOutOfValidatedBoundsMessage(design$gammaB, "gammaB", + lowerBound = 0.4, upperBound = 8, + spendingFunctionName = "Kim & DeMets beta spending", c(-0.4, 8)) } if (design$typeBetaSpending == C_TYPE_OF_DESIGN_BS_HSD) { .assertDesignParameterExists(design, "gammaB", NA_real_) .assertIsSingleNumber(design$gammaB, "gammaB", naAllowed = FALSE) - if (design$gammaB < -10 || design$gammaB > 5) { - stop( - C_EXCEPTION_TYPE_ARGUMENT_OUT_OF_BOUNDS, - "parameter 'gammaB' (", design$gammaB, ") for Hwang, Shih & DeCani ", - "beta spending out of bounds [-10; 5]" - ) - } + .showParameterOutOfValidatedBoundsMessage(design$gammaB, "gammaB", + lowerBound = -10, upperBound = 5, + spendingFunctionName = "Hwang, Shih & DeCani beta spending") } if (design$typeBetaSpending == C_TYPE_OF_DESIGN_BS_USER) { @@ -242,13 +225,14 @@ getGroupSequentialProbabilities <- function(decisionMatrix, informationRates) { } .validateBaseParameters <- function(design, twoSidedWarningForDefaultValues = TRUE) { - if (.isDefinedArgument(design$kMax)) { + if (.isDefinedArgument(design$kMax)) { .assertDesignParameterExists(design, "kMax", C_KMAX_DEFAULT) .assertIsValidKMax(design$kMax) if (.isDefinedArgument(design$informationRates)) { .assertAreValidInformationRates(design$informationRates, design$kMax) } + if (.isDefinedArgument(design$futilityBounds)) { .assertAreValidFutilityBounds(design$futilityBounds, design$kMax) } @@ -1346,8 +1330,7 @@ getDesignInverseNormal <- function(..., if (!is.na(design$informationRates)) { warning("Information rate", ifelse(length(design$informationRates) != 1, "s", ""), " ", .arrayToString(design$informationRates, vectorLookAndFeelEnabled = TRUE), - " will be ignored", - call. = FALSE + " will be ignored", call. = FALSE ) } design$informationRates <- 1 diff --git a/R/f_design_plan_count_data.R b/R/f_design_plan_count_data.R index 1073129f..09ccca9d 100644 --- a/R/f_design_plan_count_data.R +++ b/R/f_design_plan_count_data.R @@ -127,7 +127,7 @@ followUpTime, maxNumberOfSubjects, allocationRatioPlanned) { - designPlan <- TrialDesignPlanCountData(design = design, designCharacteristics = designCharacteristics) + designPlan <- TrialDesignPlanCountData$new(design = design, designCharacteristics = designCharacteristics) designPlan$.setObjectType(objectType) sampleSizeEnabled <- identical(objectType, "sampleSize") diff --git a/R/f_design_plan_means.R b/R/f_design_plan_means.R index 54ce1b94..22e688af 100644 --- a/R/f_design_plan_means.R +++ b/R/f_design_plan_means.R @@ -528,7 +528,7 @@ NULL } } - designPlan <- TrialDesignPlanMeans(design = design, meanRatio = meanRatio) + designPlan <- TrialDesignPlanMeans$new(design = design, meanRatio = meanRatio) designPlan$.setObjectType(objectType) designPlan$criticalValuesPValueScale <- matrix(design$stageLevels, ncol = 1) diff --git a/R/f_design_plan_plot.R b/R/f_design_plan_plot.R index 5a9dfbde..65045411 100644 --- a/R/f_design_plan_plot.R +++ b/R/f_design_plan_plot.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7645 $ -## | Last changed: $Date: 2024-02-16 16:12:34 +0100 (Fr, 16 Feb 2024) $ +## | File version: $Revision: 7701 $ +## | Last changed: $Date: 2024-03-07 11:44:08 +0100 (Do, 07 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -247,7 +247,7 @@ if (type == 1) { # Boundary plot if (survivalDesignPlanEnabled) { if (is.na(main)) { - main <- PlotSubTitleItems(title = "Boundaries Z Scale") + main <- PlotSubTitleItems$new(title = "Boundaries Z Scale") .addPlotSubTitleItems(designPlan, designMaster, main, type) if (!is.null(reducedParam)) { main$add(reducedParam$title, reducedParam$value, reducedParam$subscript) @@ -294,14 +294,14 @@ ) } else { if (is.na(main)) { - main <- PlotSubTitleItems(title = "Boundaries") + main <- PlotSubTitleItems$new(title = "Boundaries") .addPlotSubTitleItems(designPlan, designMaster, main, type) if (!is.null(reducedParam)) { main$add(reducedParam$title, reducedParam$value, reducedParam$subscript) } } - designSet <- TrialDesignSet(design = designMaster, singleDesign = TRUE) + designSet <- TrialDesignSet$new(design = designMaster, singleDesign = TRUE) designSet$.plotSettings <- designPlan$.plotSettings designPlanName <- paste0(designPlanName, "$.design") return(.plotTrialDesignSet( @@ -315,7 +315,7 @@ } } else if (type == 2) { # Effect Scale Boundary plot if (is.na(main)) { - main <- PlotSubTitleItems(title = "Boundaries Effect Scale") + main <- PlotSubTitleItems$new(title = "Boundaries Effect Scale") .addPlotSubTitleItems(designPlan, designMaster, main, type) if (!is.null(reducedParam)) { main$add(reducedParam$title, reducedParam$value, reducedParam$subscript) @@ -455,7 +455,7 @@ } } else if (type == 3) { # Stage Levels if (is.na(main)) { - main <- PlotSubTitleItems(title = "Boundaries p Values Scale") + main <- PlotSubTitleItems$new(title = "Boundaries p Values Scale") .addPlotSubTitleItems(designPlan, designMaster, main, type) if (!is.null(reducedParam)) { main$add(reducedParam$title, reducedParam$value, reducedParam$subscript) @@ -474,7 +474,7 @@ } else { xParameterName <- "informationRates" yParameterNames <- "stageLevels" - designPlan <- TrialDesignSet(design = designMaster, singleDesign = TRUE) + designPlan <- TrialDesignSet$new(design = designMaster, singleDesign = TRUE) xParameterNameSrc <- ".design$informationRates" yParameterNamesSrc <- ".design$stageLevels" } @@ -488,7 +488,7 @@ ) } else if (type == 4) { # Alpha Spending if (is.na(main)) { - main <- PlotSubTitleItems(title = "Error Spending") + main <- PlotSubTitleItems$new(title = "Error Spending") .addPlotSubTitleItems(designPlan, designMaster, main, type) if (!is.null(reducedParam)) { main$add(reducedParam$title, reducedParam$value, reducedParam$subscript) @@ -506,7 +506,7 @@ } else { xParameterName <- "informationRates" yParameterNames <- "alphaSpent" - designPlan <- TrialDesignSet(design = designMaster, singleDesign = TRUE) + designPlan <- TrialDesignSet$new(design = designMaster, singleDesign = TRUE) xParameterNameSrc <- ".design$informationRates" yParameterNamesSrc <- ".design$alphaSpent" } @@ -525,7 +525,7 @@ if (designPlan$.isSampleSizeObject()) { if (is.na(main)) { - main <- PlotSubTitleItems(title = "Sample Size") + main <- PlotSubTitleItems$new(title = "Sample Size") .addPlotSubTitleItems(designPlan, designMaster, main, type) } @@ -626,7 +626,7 @@ )) } else { if (is.na(main)) { - main <- PlotSubTitleItems(title = "Overall Power and Early Stopping") + main <- PlotSubTitleItems$new(title = "Overall Power and Early Stopping") .addPlotSubTitleItems(designPlan, designMaster, main, type) } if (survivalDesignPlanEnabled) { @@ -691,10 +691,10 @@ if (.isTrialDesignPlanCountData(designPlan) && (length(designPlan$expectedNumberOfSubjectsH1) == 0 || all(is.na(designPlan$expectedNumberOfSubjectsH1)))) { - main <- PlotSubTitleItems(title = "Power / Early Stop") + main <- PlotSubTitleItems$new(title = "Power / Early Stop") } else { titlePart <- ifelse(survivalDesignPlanEnabled, "Number of Events", "Sample Size") - main <- PlotSubTitleItems(title = paste0("Expected ", titlePart, " and Power / Early Stop")) + main <- PlotSubTitleItems$new(title = paste0("Expected ", titlePart, " and Power / Early Stop")) } .addPlotSubTitleItems(designPlan, designMaster, main, type) } @@ -735,7 +735,7 @@ .assertIsValidVariedParameterVectorForPlotting(designPlan, type) if (is.na(main)) { - main <- PlotSubTitleItems(title = "Overall Power") + main <- PlotSubTitleItems$new(title = "Overall Power") .addPlotSubTitleItems(designPlan, designMaster, main, type) } @@ -761,7 +761,7 @@ .assertIsValidVariedParameterVectorForPlotting(designPlan, type) if (is.na(main)) { - main <- PlotSubTitleItems(title = "Overall Early Stopping") + main <- PlotSubTitleItems$new(title = "Overall Early Stopping") .addPlotSubTitleItems(designPlan, designMaster, main, type) } @@ -788,9 +788,9 @@ if (is.na(main)) { if (survivalDesignPlanEnabled) { - main <- PlotSubTitleItems(title = "Expected Number of Events") + main <- PlotSubTitleItems$new(title = "Expected Number of Events") } else { - main <- PlotSubTitleItems(title = "Expected Sample Size") + main <- PlotSubTitleItems$new(title = "Expected Sample Size") } .addPlotSubTitleItems(designPlan, designMaster, main, type) } @@ -827,7 +827,7 @@ if (type == 10) { # Study Duration .assertIsValidVariedParameterVectorForPlotting(designPlan, type) if (is.na(main)) { - main <- PlotSubTitleItems(title = "Study Duration") + main <- PlotSubTitleItems$new(title = "Study Duration") .addPlotSubTitleItems(designPlan, designMaster, main, type) } xParameterName <- "hazardRatio" @@ -842,7 +842,7 @@ } else if (type == 11) { .assertIsValidVariedParameterVectorForPlotting(designPlan, type) if (is.na(main)) { - main <- PlotSubTitleItems(title = "Expected Number of Subjects") + main <- PlotSubTitleItems$new(title = "Expected Number of Subjects") .addPlotSubTitleItems(designPlan, designMaster, main, type) } xParameterName <- "hazardRatio" @@ -857,7 +857,7 @@ } else if (type == 12) { # Analysis Time .assertIsValidVariedParameterVectorForPlotting(designPlan, type) if (is.na(main)) { - main <- PlotSubTitleItems(title = "Analysis Time") + main <- PlotSubTitleItems$new(title = "Analysis Time") .addPlotSubTitleItems(designPlan, designMaster, main, type) } @@ -1009,9 +1009,9 @@ if (is.na(main)) { if (type == 13) { - main <- PlotSubTitleItems(title = "Cumulative Distribution Function") + main <- PlotSubTitleItems$new(title = "Cumulative Distribution Function") } else { - main <- PlotSubTitleItems(title = "Survival Function") + main <- PlotSubTitleItems$new(title = "Survival Function") } .addPlotSubTitleItems(designPlan, designMaster, main, type) if (!piecewiseSurvivalEnabled) { @@ -1034,7 +1034,7 @@ timeTo <- max(designPlan$piecewiseSurvivalTime) } if (is.na(timeTo) || !is.numeric(timeTo) || is.infinite(timeTo)) { - # warning("Unable to determine upper bound of time values", call. = FALSE) + # unable to determine upper bound of time values timeTo <- 0 } diff --git a/R/f_design_plan_rates.R b/R/f_design_plan_rates.R index ba0ce471..20c3db62 100644 --- a/R/f_design_plan_rates.R +++ b/R/f_design_plan_rates.R @@ -700,7 +700,7 @@ NULL } } - designPlan <- TrialDesignPlanRates(design = design) + designPlan <- TrialDesignPlanRates$new(design = design) designPlan$.setObjectType(objectType) designPlan$criticalValuesPValueScale <- matrix(design$stageLevels, ncol = 1) diff --git a/R/f_design_plan_survival.R b/R/f_design_plan_survival.R index 5ab21330..7fa7aecd 100644 --- a/R/f_design_plan_survival.R +++ b/R/f_design_plan_survival.R @@ -728,7 +728,7 @@ NULL .assertIsValidAllocationRatioPlannedSampleSize(allocationRatioPlanned, maxNumberOfSubjects) } - designPlan <- TrialDesignPlanSurvival( + designPlan <- TrialDesignPlanSurvival$new( design = design, typeOfComputation = typeOfComputation, thetaH0 = thetaH0, @@ -1755,7 +1755,7 @@ getEventProbabilities <- function(time, ..., stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "all rates (lambda2) must be > 0") } - eventProbabilities <- EventProbabilities( + eventProbabilities <- EventProbabilities$new( .piecewiseSurvivalTime = setting, .accrualTime = accrualSetup, time = time, @@ -1921,7 +1921,7 @@ getNumberOfSubjects <- function(time, ..., accrualIntensity = accrualIntensity, maxNumberOfSubjects = maxNumberOfSubjects ) - result <- NumberOfSubjects( + result <- NumberOfSubjects$new( .accrualTime = accrualSetup, time = time, accrualTime = accrualTime, diff --git a/R/f_object_r_code.R b/R/f_object_r_code.R index 23bef523..23f9ea11 100644 --- a/R/f_object_r_code.R +++ b/R/f_object_r_code.R @@ -59,7 +59,7 @@ NULL } } - if (is.function(x) || isS4(x)) { + if (is.function(x) || isS4(x) || R6::is.R6(x)) { return("NULL") } @@ -125,7 +125,7 @@ NULL } .getGeneratorFunctionName <- function(obj) { - if ("TrialDesignPlanMeans" == .getClassName(obj) || "TrialDesignPlanMeans" == .getClassName(obj)) { + if ("TrialDesignPlanMeans" == .getClassName(obj)) { if (obj$.isSampleSizeObject()) { return("getSampleSizeMeans") } @@ -133,7 +133,7 @@ NULL return("getPowerMeans") } - if ("TrialDesignPlanRates" == .getClassName(obj) || "TrialDesignPlanRates" == .getClassName(obj)) { + if ("TrialDesignPlanRates" == .getClassName(obj)) { if (obj$.isSampleSizeObject()) { return("getSampleSizeRates") } @@ -141,7 +141,7 @@ NULL return("getPowerRates") } - if ("TrialDesignPlanSurvival" == .getClassName(obj) || "TrialDesignPlanSurvival" == .getClassName(obj)) { + if ("TrialDesignPlanSurvival" == .getClassName(obj)) { if (obj$.isSampleSizeObject()) { return("getSampleSizeSurvival") } @@ -149,6 +149,10 @@ NULL return("getPowerSurvival") } + if ("TrialDesignPlanCountData" == .getClassName(obj)) { + if (obj$.isSampleSizeObject()) { + return("getSampleSizeCounts") + } return("getPowerCounts") } @@ -156,91 +160,92 @@ NULL if (inherits(obj, "TrialDesign")) { return(paste0("get", sub("^Trial", "", .getClassName(obj)))) } - - if (inherits(obj, "Dataset") || inherits(obj, "Dataset")) { + + if (inherits(obj, "Dataset")) { return("getDataset") + } - if (inherits(obj, "AnalysisResults") || inherits(obj, "AnalysisResults")) { + if (inherits(obj, "AnalysisResults")) { return("getAnalysisResults") } - if ("TrialDesignSet" == .getClassName(obj) || "TrialDesignSet" == .getClassName(obj)) { + if ("TrialDesignSet" == .getClassName(obj)) { return("getDesignSet") } - if ("TrialDesignCharacteristics" == .getClassName(obj) || "TrialDesignCharacteristics" == .getClassName(obj)) { + if ("TrialDesignCharacteristics" == .getClassName(obj)) { return("getDesignCharacteristics") } - if (inherits(obj, "SimulationResultsMeans") || inherits(obj, "SimulationResultsMeans")) { + if (inherits(obj, "SimulationResultsMeans")) { return("getSimulationMeans") } - if (inherits(obj, "SimulationResultsRates") || inherits(obj, "SimulationResultsRates")) { + if (inherits(obj, "SimulationResultsRates")) { return("getSimulationRates") } - if (inherits(obj, "SimulationResultsSurvival") || inherits(obj, "SimulationResultsSurvival")) { + if (inherits(obj, "SimulationResultsSurvival")) { return("getSimulationSurvival") } - if (inherits(obj, "SimulationResultsMultiArmMeans") || inherits(obj, "SimulationResultsMultiArmMeans")) { + if (inherits(obj, "SimulationResultsMultiArmMeans")) { return("getSimulationMultiArmMeans") } - if (inherits(obj, "SimulationResultsMultiArmRates") || inherits(obj, "SimulationResultsMultiArmRates")) { + if (inherits(obj, "SimulationResultsMultiArmRates")) { return("getSimulationMultiArmRates") } - if (inherits(obj, "SimulationResultsMultiArmSurvival") || inherits(obj, "SimulationResultsMultiArmSurvival")) { + if (inherits(obj, "SimulationResultsMultiArmSurvival")) { return("getSimulationMultiArmSurvival") } - if (inherits(obj, "SimulationResultsEnrichmentMeans") || inherits(obj, "SimulationResultsEnrichmentMeans")) { + if (inherits(obj, "SimulationResultsEnrichmentMeans")) { return("getSimulationEnrichmentMeans") } - if (inherits(obj, "SimulationResultsEnrichmentRates") || inherits(obj, "SimulationResultsEnrichmentRates")) { + if (inherits(obj, "SimulationResultsEnrichmentRates")) { return("getSimulationEnrichmentRates") } - if (inherits(obj, "SimulationResultsEnrichmentSurvival") || inherits(obj, "SimulationResultsEnrichmentSurvival")) { + if (inherits(obj, "SimulationResultsEnrichmentSurvival")) { return("getSimulationEnrichmentSurvival") } - if (inherits(obj, "PiecewiseSurvivalTime") || inherits(obj, "PiecewiseSurvivalTime")) { + if (inherits(obj, "PiecewiseSurvivalTime")) { return("getPiecewiseSurvivalTime") } - if (inherits(obj, "AccrualTime") || inherits(obj, "AccrualTime")) { + if (inherits(obj, "AccrualTime")) { return("getAccrualTime") } - if (inherits(obj, "StageResults") || inherits(obj, "StageResults")) { + if (inherits(obj, "StageResults")) { return("getStageResults") } - if (inherits(obj, "ConditionalPowerResults") || inherits(obj, "ConditionalPowerResults")) { + if (inherits(obj, "ConditionalPowerResults")) { return("getConditionalPower") } - if (inherits(obj, "PowerAndAverageSampleNumberResult") || inherits(obj, "PowerAndAverageSampleNumberResult")) { + if (inherits(obj, "PowerAndAverageSampleNumberResult")) { return("getPowerAndAverageSampleNumber") } - if (inherits(obj, "EventProbabilities") || inherits(obj, "EventProbabilities")) { + if (inherits(obj, "EventProbabilities")) { return("getEventProbabilities") } - if (inherits(obj, "NumberOfSubjects") || inherits(obj, "NumberOfSubjects")) { + if (inherits(obj, "NumberOfSubjects")) { return("getNumberOfSubjects") } - if (inherits(obj, "PerformanceScore") || inherits(obj, "PerformanceScore")) { + if (inherits(obj, "PerformanceScore")) { return("gePerformanceScore") } - if (inherits(obj, "SummaryFactory") || "SummaryFactory" == .getClassName(obj) || inherits(obj, "SummaryFactory") || "SummaryFactory" == .getClassName(obj)) { + if (inherits(obj, "SummaryFactory") || "SummaryFactory" == .getClassName(obj)) { return(.getGeneratorFunctionName(obj$object)) } @@ -395,7 +400,7 @@ getObjectRCode <- function(obj, ..., if (is.null(leadingArguments)) { leadingArguments <- character() } - if (!(inherits(obj, "ConditionalPowerResults") || inherits(obj, "ConditionalPowerResults")) && + if (!inherits(obj, "ConditionalPowerResults") && !is.null(obj[[".design"]]) && (is.null(leadingArguments) || !any(grepl("design", leadingArguments)))) { preconditionDesign <- getObjectRCode(obj$.design, @@ -415,7 +420,7 @@ getObjectRCode <- function(obj, ..., } } } - if (inherits(obj, "PerformanceScore") || inherits(obj, "PerformanceScore")) { + if (inherits(obj, "PerformanceScore")) { preconditionSimulationResults <- getObjectRCode(obj$.simulationResults, prefix = ifelse(pipeOperator == "none", "simulationResults <- ", ""), postfix = pipeOperatorPostfix, @@ -501,7 +506,7 @@ getObjectRCode <- function(obj, ..., } leadingArguments <- c(leadingArguments, "selectArmsFunction = selectArmsFunction") } - if ((inherits(obj, "ConditionalPowerResults") || inherits(obj, "ConditionalPowerResults")) && + if (inherits(obj, "ConditionalPowerResults") && !is.null(obj[[".stageResults"]]) && (is.null(leadingArguments) || !any(grepl("stageResults", leadingArguments)))) { precond <- getObjectRCode(obj$.stageResults, @@ -536,7 +541,7 @@ getObjectRCode <- function(obj, ..., precondition <- unique(precondition) - if (inherits(obj, "SummaryFactory") || inherits(obj, "SummaryFactory") || "SummaryFactory" == .getClassName(obj) || "SummaryFactory" == .getClassName(obj)) { + if (inherits(obj, "SummaryFactory") || "SummaryFactory" == .getClassName(obj)) { return(getObjectRCode(obj$object, prefix = ifelse(pipeOperator == "none", "summary(", ""), postfix = { @@ -558,33 +563,32 @@ getObjectRCode <- function(obj, ..., objNames <- objNames[objNames != "effectList"] - if (inherits(obj, "ParameterSet") || inherits(obj, "ParameterSet")) { + if (inherits(obj, "ParameterSet")) { if (includeDefaultParameters) { objNames <- obj$.getInputParameters() } else { objNames <- obj$.getUserDefinedParameters() } objNames <- objNames[objNames != "stages"] - } - if ((inherits(obj, "TrialDesign") || inherits(obj, "TrialDesign")) && !(inherits(obj, "TrialDesignConditionalDunnett") || inherits(obj, "TrialDesignConditionalDunnett")) && + if (inherits(obj, "TrialDesign") && !inherits(obj, "TrialDesignConditionalDunnett") && !("informationRates" %in% objNames) && !("kMax" %in% objNames) && obj$kMax != 3) { objNames <- c("kMax", objNames) } thetaH0 <- NA_real_ - if ((inherits(obj, "SimulationResultsSurvival") || inherits(obj, "SimulationResultsSurvival")) && + if (inherits(obj, "SimulationResultsSurvival") && obj$.getParameterType("thetaH1") == "g") { objNames <- c(objNames, "thetaH1") thetaH0 <- obj[["thetaH0"]] } - if (inherits(obj, "SimulationResultsSurvival") || inherits(obj, "SimulationResultsSurvival")) { + if (inherits(obj, "SimulationResultsSurvival")) { objNames <- objNames[objNames != "allocationRatioPlanned"] # allocation1 and allocation2 are used instead } - if ((inherits(obj, "AnalysisResults") || inherits(obj, "AnalysisResults")) && grepl("Fisher", .getClassName(obj))) { + if (inherits(obj, "AnalysisResults") && grepl("Fisher", .getClassName(obj))) { if (!is.null(obj[["seed"]]) && length(obj$seed) == 1 && !is.na(obj$seed)) { if (!("iterations" %in% objNames)) { objNames <- c(objNames, "iterations") @@ -632,7 +636,7 @@ getObjectRCode <- function(obj, ..., objNames <- c(objNames, defaultParams) } - if ((inherits(obj, "TrialDesign") || inherits(obj, "TrialDesign")) && "informationRates" %in% objNames && + if (inherits(obj, "TrialDesign") && "informationRates" %in% objNames && !("informationRates" %in% newArgumentValueNames)) { informationRates <- obj[["informationRates"]] if (!is.null(informationRates) && length(informationRates) > 0) { @@ -649,7 +653,7 @@ getObjectRCode <- function(obj, ..., } } - if (inherits(obj, "Dataset") || inherits(obj, "Dataset")) { + if (inherits(obj, "Dataset")) { lines <- .getDatasetArgumentsRCodeLines(obj, complete = FALSE, digits = NA_integer_) argumentsRCode <- paste0(lines, collapse = ", ") } else { @@ -664,7 +668,7 @@ getObjectRCode <- function(obj, ..., value <- obj[[name]] } - if (name == "accrualTime" && (inherits(obj, "AccrualTime") || inherits(obj, "AccrualTime")) && + if (name == "accrualTime" && inherits(obj, "AccrualTime") && !isTRUE(obj$endOfAccrualIsUserDefined) && isTRUE(length(obj$accrualIntensity) < length(value))) { value <- value[1:(length(value) - 1)] @@ -690,7 +694,7 @@ getObjectRCode <- function(obj, ..., optimumAllocationRatio <- obj[["optimumAllocationRatio"]] if (!is.null(optimumAllocationRatio) && isTRUE(optimumAllocationRatio)) { value <- 0 - } else if ((inherits(obj, "ParameterSet") || inherits(obj, "ParameterSet"))) { + } else if (inherits(obj, "ParameterSet")) { if (obj$.getParameterType("allocationRatioPlanned") == "g") { value <- 0 } @@ -734,7 +738,7 @@ getObjectRCode <- function(obj, ..., } } - if (inherits(obj, "TrialDesignPlanSurvival") || inherits(obj, "TrialDesignPlanSurvival")) { + if (inherits(obj, "TrialDesignPlanSurvival")) { if (!("accrualTime" %in% objNames) && obj$.getParameterType("accrualTime") == "g" && !all(is.na(obj$accrualTime))) { # case 2: follow-up time and absolute intensity given @@ -778,9 +782,9 @@ getObjectRCode <- function(obj, ..., .getArgumentValueRCode(obj$maxNumberOfSubjects[1], "maxNumberOfSubjects") )) } - } else if (inherits(obj, "AnalysisResults") || inherits(obj, "AnalysisResults")) { + } else if (inherits(obj, "AnalysisResults")) { arguments <- c(arguments, paste0("stage = ", obj$.stageResults$stage)) - } else if (inherits(obj, "StageResults") || inherits(obj, "StageResults")) { + } else if (inherits(obj, "StageResults")) { arguments <- c(arguments, paste0("stage = ", obj$stage)) } diff --git a/R/f_parameter_set_utilities.R b/R/f_parameter_set_utilities.R index 22fd0dfa..d4cc0280 100644 --- a/R/f_parameter_set_utilities.R +++ b/R/f_parameter_set_utilities.R @@ -91,7 +91,7 @@ NULL parameterName <- result$parameterName paramValue <- result$paramValue - if (isS4(paramValue)) { + if (isS4(paramValue) || R6::is.R6(paramValue)) { return(NULL) } diff --git a/R/f_simulation_calc_subjects_function.R b/R/f_simulation_calc_subjects_function.R index 0a652f65..c5a496d3 100644 --- a/R/f_simulation_calc_subjects_function.R +++ b/R/f_simulation_calc_subjects_function.R @@ -322,13 +322,13 @@ C_SIMULATION_CALC_SUBJECTS_FUNCTION_ARGUMENTS[[C_SIMULATION_CALC_SUBJECTS_FUNCTI .assertIsSingleLogical(cppEnabled, "cppEnabled") cppCodeBodyType <- NA_character_ - if (inherits(simulationResults, "SimulationResultsMeans") || inherits(simulationResults, "SimulationResultsMeans")) { + if (inherits(simulationResults, "SimulationResultsMeans")) { cppCodeBodyType <- C_SIMULATION_CALC_SUBJECTS_FUNCTION_BASE_MEANS } - if (inherits(simulationResults, "SimulationResultsRates") || inherits(simulationResults, "SimulationResultsRates")) { + if (inherits(simulationResults, "SimulationResultsRates")) { cppCodeBodyType <- C_SIMULATION_CALC_SUBJECTS_FUNCTION_BASE_RATES } - if (inherits(simulationResults, "SimulationResultsSurvival") || inherits(simulationResults, "SimulationResultsSurvival")) { + if (inherits(simulationResults, "SimulationResultsSurvival")) { cppCodeBodyType <- C_SIMULATION_CALC_SUBJECTS_FUNCTION_BASE_SURVIVAL } if (is.na(cppCodeBodyType)) { @@ -338,7 +338,7 @@ C_SIMULATION_CALC_SUBJECTS_FUNCTION_ARGUMENTS[[C_SIMULATION_CALC_SUBJECTS_FUNCTI ) } - functionFieldName <- ifelse(inherits(simulationResults, "SimulationResultsSurvival") || inherits(simulationResults, "SimulationResultsSurvival"), + functionFieldName <- ifelse(inherits(simulationResults, "SimulationResultsSurvival"), "calcEventsFunction", "calcSubjectsFunction" ) @@ -397,7 +397,7 @@ C_SIMULATION_CALC_SUBJECTS_FUNCTION_ARGUMENTS[[C_SIMULATION_CALC_SUBJECTS_FUNCTI if (.isCppCode(calcFunction)) { tryCatch( { - survivalEnabled <- inherits(simulationResults, "SimulationResultsSurvival") || inherits(simulationResults, "SimulationResultsSurvival") + survivalEnabled <- inherits(simulationResults, "SimulationResultsSurvival") expectedFunctionName <- ifelse(survivalEnabled, "calcEventsFunctionCppTemp", "calcSubjectsFunctionCppTemp" ) diff --git a/R/f_simulation_enrichment_rates.R b/R/f_simulation_enrichment_rates.R index 4b1a1408..351e7821 100644 --- a/R/f_simulation_enrichment_rates.R +++ b/R/f_simulation_enrichment_rates.R @@ -13,9 +13,9 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7383 $ -## | Last changed: $Date: 2023-11-02 15:18:21 +0100 (Do, 02 Nov 2023) $ -## | Last changed by: $Author: pahlke $ +## | File version: $Revision: 7679 $ +## | Last changed: $Date: 2024-03-04 15:00:35 +0100 (Mo, 04 Mrz 2024) $ +## | Last changed by: $Author: wassmer $ ## | #' @include f_simulation_enrichment.R diff --git a/R/f_simulation_performance_score.R b/R/f_simulation_performance_score.R index b865d4a9..6c461281 100644 --- a/R/f_simulation_performance_score.R +++ b/R/f_simulation_performance_score.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7644 $ -## | Last changed: $Date: 2024-02-16 10:36:28 +0100 (Fr, 16 Feb 2024) $ +## | File version: $Revision: 7688 $ +## | Last changed: $Date: 2024-03-05 14:56:47 +0100 (Tue, 05 Mar 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -24,7 +24,9 @@ #' #' @description #' Calculates the conditional performance score, its sub-scores and components according to -#' Herrmann et al. (2020) for a given simulation result from a two-stage design. +#' [Herrmann et al. (2020)](https://doi.org/10.1002/sim.8534) and +#' [Bokelmann et al. (2024)](https://doi.org/10.1186/s12874-024-02150-4) for a given +#' simulation result from a two-stage design with continuous or binary endpoint. #' Larger (sub-)score and component values refer to a better performance. #' #' @param simulationResult A simulation result. @@ -37,7 +39,8 @@ #' The term conditional refers to an evaluation perspective where the interim results #' suggest a trial continuation with a second stage. #' The score can take values between 0 and 1. More details on the performance score -#' can be found in Herrmann et al. (2020). +#' can be found in [Herrmann et al. (2020)](https://doi.org/10.1002/sim.8534) and +#' [Bokelmann et al. (2024)](https://doi.org/10.1186/s12874-024-02150-4). #' #' @template examples_get_performance_score #' @@ -50,10 +53,10 @@ getPerformanceScore <- function(simulationResult) { design <- simulationResult$.design - if (!(inherits(simulationResult, "SimulationResultsMeans") || inherits(simulationResult, "SimulationResultsMeans"))) { + if (!inherits(simulationResult, "SimulationResultsMeans") && !inherits(simulationResult, "SimulationResultsRates")) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "performance score so far implemented only for single comparisons with continuous endpoints" + "performance score so far implemented only for single comparisons with continuous and binary endpoints" ) } @@ -94,10 +97,10 @@ getPerformanceScore <- function(simulationResult) { referenceValue <- NA_real_ # simulated alternative values - if (methods::is(simulationResult, "SimulationResultsMeans") || methods::is(simulationResult, "SimulationResultsMeans")) { + if (methods::is(simulationResult, "SimulationResultsMeans")) { alternativeParamName <- "alternative" referenceValue <- 0 - } else if (methods::is(simulationResult, "SimulationResultsRates") || methods::is(simulationResult, "SimulationResultsRates")) { + } else if (methods::is(simulationResult, "SimulationResultsRates")) { alternativeParamName <- "pi1" referenceValue <- simulationResult$pi2 args$pi2 <- referenceValue @@ -116,9 +119,9 @@ getPerformanceScore <- function(simulationResult) { if (alternativeValue == referenceValue) { singleStageSampleSize <- plannedSubjects[2] - plannedSubjects[1] - } else if (methods::is(simulationResult, "SimulationResultsMeans") || methods::is(simulationResult, "SimulationResultsMeans")) { + } else if (methods::is(simulationResult, "SimulationResultsMeans")) { singleStageSampleSize <- do.call(getSampleSizeMeans, args)$numberOfSubjects - } else if (methods::is(simulationResult, "SimulationResultsRates") || methods::is(simulationResult, "SimulationResultsRates")) { + } else if (methods::is(simulationResult, "SimulationResultsRates")) { singleStageSampleSize <- do.call(getSampleSizeRates, args)$numberOfSubjects } diff --git a/R/f_simulation_plot.R b/R/f_simulation_plot.R index 18c753d7..090e609b 100644 --- a/R/f_simulation_plot.R +++ b/R/f_simulation_plot.R @@ -278,7 +278,7 @@ NULL if (type == 1) { # Multi-arm, Overall Success .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) if (is.na(main)) { - main <- PlotSubTitleItems(title = "Overall Success") + main <- PlotSubTitleItems$new(title = "Overall Success") .addPlotSubTitleItems(simulationResults, designMaster, main, type) } @@ -320,7 +320,7 @@ NULL } else if (type == 2) { # Multi-arm, Success per Stage .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) if (is.na(main)) { - main <- PlotSubTitleItems(title = "Success per Stage") + main <- PlotSubTitleItems$new(title = "Success per Stage") .addPlotSubTitleItems(simulationResults, designMaster, main, type) } @@ -385,7 +385,7 @@ NULL .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) if (is.na(main)) { - main <- PlotSubTitleItems(title = paste0("Selected ", armsCaption, " per Stage")) + main <- PlotSubTitleItems$new(title = paste0("Selected ", armsCaption, " per Stage")) .addPlotSubTitleItems(simulationResults, designMaster, main, type) } @@ -476,7 +476,7 @@ NULL } else if (type == 4) { # Multi-arm, Rejected Arms/Populations per Stage .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) if (is.na(main)) { - main <- PlotSubTitleItems(title = ifelse(!multiArmEnabled, + main <- PlotSubTitleItems$new(title = ifelse(!multiArmEnabled, "Reject per Stage", ifelse(designMaster$kMax > 1, paste0("Rejected ", armsCaption, " per Stage"), paste0("Rejected ", armsCaption) @@ -607,7 +607,7 @@ NULL .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) if (is.na(main)) { - main <- PlotSubTitleItems(title = ifelse(designMaster$kMax == 1, + main <- PlotSubTitleItems$new(title = ifelse(designMaster$kMax == 1, "Overall Power", "Overall Power and Early Stopping" )) .addPlotSubTitleItems(simulationResults, designMaster, main, type) @@ -694,7 +694,7 @@ NULL if (is.na(main)) { titlePart <- paste0("Expected ", ifelse(survivalEnabled, "Number of Events", "Number of Subjects")) - main <- PlotSubTitleItems(title = paste0( + main <- PlotSubTitleItems$new(title = paste0( titlePart, ifelse(designMaster$kMax == 1, "", paste0( " and Power", @@ -727,7 +727,7 @@ NULL } else if (type == 7) { .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) if (is.na(main)) { - main <- PlotSubTitleItems(title = "Overall Power") + main <- PlotSubTitleItems$new(title = "Overall Power") .addPlotSubTitleItems(simulationResults, designMaster, main, type) } @@ -753,7 +753,7 @@ NULL !all(na.omit(simulationResults$futilityStop) == 0) if (is.na(main)) { - main <- PlotSubTitleItems(title = paste0( + main <- PlotSubTitleItems$new(title = paste0( "Overall Early Stopping", ifelse(futilityStopEnabled, " and Futility Stopping", "") )) @@ -778,7 +778,7 @@ NULL .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) if (is.na(main)) { - main <- PlotSubTitleItems(title = ifelse(survivalEnabled, + main <- PlotSubTitleItems$new(title = ifelse(survivalEnabled, "Expected Number of Events", "Expected Number of Subjects" )) .addPlotSubTitleItems(simulationResults, designMaster, main, type) @@ -797,7 +797,7 @@ NULL } else if (type == 10) { # Study Duration .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) if (is.na(main)) { - main <- PlotSubTitleItems(title = "Study Duration") + main <- PlotSubTitleItems$new(title = "Study Duration") .addPlotSubTitleItems(simulationResults, designMaster, main, type) } xParameterName <- "hazardRatio" @@ -812,7 +812,7 @@ NULL } else if (type == 11) { .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) if (is.na(main)) { - main <- PlotSubTitleItems(title = "Expected Number of Subjects") + main <- PlotSubTitleItems$new(title = "Expected Number of Subjects") .addPlotSubTitleItems(simulationResults, designMaster, main, type) } xParameterName <- "hazardRatio" @@ -827,7 +827,7 @@ NULL } else if (type == 12) { # Analysis Time .assertIsValidVariedParameterVectorForSimulationResultsPlotting(simulationResults, type) if (is.na(main)) { - main <- PlotSubTitleItems(title = "Analysis Time") + main <- PlotSubTitleItems$new(title = "Analysis Time") .addPlotSubTitleItems(simulationResults, designMaster, main, type) } diff --git a/R/f_simulation_utilities.R b/R/f_simulation_utilities.R index 087f442d..cc80848e 100644 --- a/R/f_simulation_utilities.R +++ b/R/f_simulation_utilities.R @@ -95,7 +95,7 @@ NULL stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'data' must be a valid data.frame or a simulation result object") } - if (inherits(data, "SimulationResults") || inherits(data, "SimulationResults")) { + if (inherits(data, "SimulationResults")) { data <- data[[".data"]] } diff --git a/inst/doc/rpact_getting_started.html b/inst/doc/rpact_getting_started.html index c36333c5..28c35dce 100644 --- a/inst/doc/rpact_getting_started.html +++ b/inst/doc/rpact_getting_started.html @@ -12,7 +12,7 @@ - + Getting started with rpact @@ -239,7 +239,7 @@

Getting started with rpact

Friedrich Pahlke and Gernot Wassmer

-

2024-02-21

+

2024-03-07

diff --git a/man-roxygen/examples_get_performance_score.R b/man-roxygen/examples_get_performance_score.R index 2e9be6aa..fded3186 100644 --- a/man-roxygen/examples_get_performance_score.R +++ b/man-roxygen/examples_get_performance_score.R @@ -2,22 +2,22 @@ #' \dontrun{ #' # Example from Table 3 in "A new conditional performance score for #' # the evaluation of adaptive group sequential designs with samplesize -#' # recalculation from Herrmann et al 2023", p.2097 for +#' # recalculation from Herrmann et al 2023", p. 2097 for #' # Observed Conditional Power approach and Delta = 0.5 -#' +#' #' # Create two-stage Pocock design with binding futility boundary at 0 #' design <- getDesignGroupSequential( -#' kMax = 2, typeOfDesign = "P", +#' kMax = 2, typeOfDesign = "P", #' futilityBounds = 0, bindingFutility = TRUE) -#' -#' # Initialize sample sizes and effect; +#' +#' # Initialize sample sizes and effect; #' # Sample sizes are referring to overall stage-wise sample sizes #' n1 <- 100 #' n2 <- 100 #' nMax <- n1 + n2 #' alternative <- 0.5 -#' -#' # Perform Simulation; nMax*1.5 defines the maximum +#' +#' # Perform Simulation; nMax * 1.5 defines the maximum #' # sample size for the additional stage #' simulationResult <- getSimulationMeans( #' design = design, diff --git a/man-roxygen/examples_get_simulation_survival.R b/man-roxygen/examples_get_simulation_survival.R index c31c7a68..468755c6 100644 --- a/man-roxygen/examples_get_simulation_survival.R +++ b/man-roxygen/examples_get_simulation_survival.R @@ -245,15 +245,15 @@ #' theta <- max(1 + 1e-12, estimatedTheta) #' if (stage == 2) { #' requiredStageEvents <- -#' max(0, conditionalCriticalValue + qnorm(conditionalPower))^2 / log(theta)^2 -#' requiredStageEvents <- min( +#' max(0, conditionalCriticalValue + qnorm(conditionalPower))^2 * 4 / log(theta)^2 +#' requiredOverallStageEvents <- min( #' max(minNumberOfEventsPerStage[stage], requiredStageEvents), #' maxNumberOfEventsPerStage[stage] #' ) + eventsOverStages[stage - 1] #' } else { -#' requiredStageEvents <- 2 * eventsOverStages[stage - 1] - eventsOverStages[1] +#' requiredOverallStageEvents <- 2 * eventsOverStages[stage - 1] - eventsOverStages[1] #' } -#' return(requiredStageEvents) +#' return(requiredOverallStageEvents) #' } #' resultsWithSSR <- getSimulationSurvival( #' design = designIN, diff --git a/man/AnalysisResults.Rd b/man/AnalysisResults.Rd index d5e92f1d..d67d0197 100644 --- a/man/AnalysisResults.Rd +++ b/man/AnalysisResults.Rd @@ -1,29 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R, -% R/class_analysis_results_r6.R +% Please edit documentation in R/class_analysis_results.R \docType{class} \name{AnalysisResults} \alias{AnalysisResults} -\alias{AnalysisResultsR6} \title{Basic Class for Analysis Results} \description{ -A basic class for analysis results. - A basic class for analysis results. } \details{ -\code{AnalysisResults} is the basic class for -\itemize{ -\item \code{\link{AnalysisResultsFisher}}, -\item \code{\link{AnalysisResultsGroupSequential}}, -\item \code{\link{AnalysisResultsInverseNormal}}, -\item \code{\link{AnalysisResultsMultiArmFisher}}, -\item \code{\link{AnalysisResultsMultiArmInverseNormal}}, -\item \code{\link{AnalysisResultsConditionalDunnett}}, -\item \code{\link{AnalysisResultsEnrichmentFisher}}, -\item \code{\link{AnalysisResultsEnrichmentInverseNormal}}. -} - \code{AnalysisResults} is the basic class for \itemize{ \item \code{\link{AnalysisResultsFisher}}, diff --git a/man/AnalysisResultsConditionalDunnett.Rd b/man/AnalysisResultsConditionalDunnett.Rd index 0f88016c..c9242ba4 100644 --- a/man/AnalysisResultsConditionalDunnett.Rd +++ b/man/AnalysisResultsConditionalDunnett.Rd @@ -1,20 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R, -% R/class_analysis_results_r6.R +% Please edit documentation in R/class_analysis_results.R \docType{class} \name{AnalysisResultsConditionalDunnett} \alias{AnalysisResultsConditionalDunnett} -\alias{AnalysisResultsConditionalDunnettR6} \title{Analysis Results Multi-Arm Conditional Dunnett} \description{ -Class for multi-arm analysis results based on a conditional Dunnett test design. - Class for multi-arm analysis results based on a conditional Dunnett test design. } \details{ -This object cannot be created directly; use \code{\link{getAnalysisResults}} -with suitable arguments to create the multi-arm analysis results of a conditional Dunnett test design. - This object cannot be created directly; use \code{\link{getAnalysisResults}} with suitable arguments to create the multi-arm analysis results of a conditional Dunnett test design. } @@ -55,42 +48,6 @@ with suitable arguments to create the multi-arm analysis results of a conditiona \item{\code{repeatedPValues}}{The p-values that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} -\item{\code{piControl}}{The assumed probability in the control arm for simulation and under which the sample size recalculation is performed. Is a numeric vector of length 1 containing a value between 0 and 1.} - -\item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} - -\item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} - -\item{\code{thetaH0}}{The difference or assumed effect under H0. Is a numeric vector of length 1.} - -\item{\code{pi1}}{The assumed probability or probabilities in the active treatment group in two-group designs, or the alternative probability for a one-group design.} - -\item{\code{pi2}}{The assumed probability in the reference group for two-group designs. Is a numeric vector of length 1 containing a value between 0 and 1.} - -\item{\code{nPlanned}}{The sample size planned for each of the subsequent stages. Is a numeric vector of length \code{kMax} containing whole numbers.} - -\item{\code{allocationRatioPlanned}}{The planned allocation ratio (\code{n1 / n2}) for the groups. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. Is a positive numeric vector of length 1.} - -\item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} - -\item{\code{assumedStDevs}}{Assumed standard deviations to calculate conditional power in multi-arm trials or enrichment designs. Is a numeric vector.} - -\item{\code{piTreatments}}{The assumed rates in the treatment groups for multi-arm and enrichment designs, i.e., designs with multiple subsets.} - -\item{\code{intersectionTest}}{The multiple test used for intersection hypotheses in closed systems of hypotheses. Is a character vector of length 1.} - -\item{\code{varianceOption}}{Defines the way to calculate the variance in multiple (i.e., >2) treatment arms or population enrichment designs when testing means. Available options for multiple arms: \code{"overallPooled", "pairwisePooled", "notPooled"}. Available options for enrichment designs: \code{"pooled", "pooledFromFull", "notPooled"}.} - -\item{\code{conditionalRejectionProbabilities}}{The probabilities of rejecting the null hypothesis at each stage, given the stage has been reached. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{conditionalPower}}{The conditional power at each stage of the trial. Is a numeric vector of length 1 containing a value between 0 and 1.} - -\item{\code{repeatedConfidenceIntervalLowerBounds}}{The lower bound of the confidence intervals that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax}.} - -\item{\code{repeatedConfidenceIntervalUpperBounds}}{The upper bound of the confidence interval that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax}.} - -\item{\code{repeatedPValues}}{The p-values that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - \item{\code{piControl}}{The assumed probability in the control arm for simulation and under which the sample size recalculation is performed. Is a numeric vector of length 1 containing a value between 0 and 1.} }} diff --git a/man/AnalysisResultsEnrichment.Rd b/man/AnalysisResultsEnrichment.Rd index 1ac3bc50..feb1922c 100644 --- a/man/AnalysisResultsEnrichment.Rd +++ b/man/AnalysisResultsEnrichment.Rd @@ -1,23 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R, -% R/class_analysis_results_r6.R +% Please edit documentation in R/class_analysis_results.R \docType{class} \name{AnalysisResultsEnrichment} \alias{AnalysisResultsEnrichment} -\alias{AnalysisResultsEnrichmentR6} \title{Basic Class for Analysis Results Enrichment} \description{ -A basic class for enrichment analysis results. - A basic class for enrichment analysis results. } \details{ -\code{AnalysisResultsEnrichment} is the basic class for -\itemize{ -\item \code{\link{AnalysisResultsEnrichmentFisher}} and -\item \code{\link{AnalysisResultsEnrichmentInverseNormal}}. -} - \code{AnalysisResultsEnrichment} is the basic class for \itemize{ \item \code{\link{AnalysisResultsEnrichmentFisher}} and diff --git a/man/AnalysisResultsEnrichmentFisher.Rd b/man/AnalysisResultsEnrichmentFisher.Rd index 13726cf1..a912cb06 100644 --- a/man/AnalysisResultsEnrichmentFisher.Rd +++ b/man/AnalysisResultsEnrichmentFisher.Rd @@ -1,20 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R, -% R/class_analysis_results_r6.R +% Please edit documentation in R/class_analysis_results.R \docType{class} \name{AnalysisResultsEnrichmentFisher} \alias{AnalysisResultsEnrichmentFisher} -\alias{AnalysisResultsEnrichmentFisherR6} \title{Analysis Results Enrichment Fisher} \description{ -Class for enrichment analysis results based on a Fisher combination test design. - Class for enrichment analysis results based on a Fisher combination test design. } \details{ -This object cannot be created directly; use \code{\link{getAnalysisResults}} -with suitable arguments to create the multi-arm analysis results of a Fisher combination test design. - This object cannot be created directly; use \code{\link{getAnalysisResults}} with suitable arguments to create the multi-arm analysis results of a Fisher combination test design. } @@ -59,46 +52,6 @@ with suitable arguments to create the multi-arm analysis results of a Fisher com \item{\code{seed}}{The seed used for random number generation. Is a numeric vector of length 1.} -\item{\code{stratifiedAnalysis}}{For enrichment designs, typically a stratified analysis should be chosen. When testing means and rates, a non-stratified analysis can be performed on overall data. For survival data, only a stratified analysis is possible. Is a logical vector of length 1.} - -\item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} - -\item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} - -\item{\code{thetaH0}}{The difference or assumed effect under H0. Is a numeric vector of length 1.} - -\item{\code{pi1}}{The assumed probability or probabilities in the active treatment group in two-group designs, or the alternative probability for a one-group design.} - -\item{\code{pi2}}{The assumed probability in the reference group for two-group designs. Is a numeric vector of length 1 containing a value between 0 and 1.} - -\item{\code{nPlanned}}{The sample size planned for each of the subsequent stages. Is a numeric vector of length \code{kMax} containing whole numbers.} - -\item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} - -\item{\code{assumedStDevs}}{Assumed standard deviations to calculate conditional power in multi-arm trials or enrichment designs. Is a numeric vector.} - -\item{\code{piTreatments}}{The assumed rates in the treatment groups for multi-arm and enrichment designs, i.e., designs with multiple subsets.} - -\item{\code{intersectionTest}}{The multiple test used for intersection hypotheses in closed systems of hypotheses. Is a character vector of length 1.} - -\item{\code{varianceOption}}{Defines the way to calculate the variance in multiple (i.e., >2) treatment arms or population enrichment designs when testing means. Available options for multiple arms: \code{"overallPooled", "pairwisePooled", "notPooled"}. Available options for enrichment designs: \code{"pooled", "pooledFromFull", "notPooled"}.} - -\item{\code{conditionalRejectionProbabilities}}{The probabilities of rejecting the null hypothesis at each stage, given the stage has been reached. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{repeatedConfidenceIntervalLowerBounds}}{The lower bound of the confidence intervals that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax}.} - -\item{\code{repeatedConfidenceIntervalUpperBounds}}{The upper bound of the confidence interval that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax}.} - -\item{\code{repeatedPValues}}{The p-values that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{piControls}}{The assumed rates in the control group for enrichment designs, i.e., designs with multiple subsets.} - -\item{\code{conditionalPowerSimulated}}{The simulated conditional power, under the assumption of observed or assumed effect sizes.} - -\item{\code{iterations}}{The number of iterations used for simulations. Is a numeric vector of length 1 containing a whole number.} - -\item{\code{seed}}{The seed used for random number generation. Is a numeric vector of length 1.} - \item{\code{stratifiedAnalysis}}{For enrichment designs, typically a stratified analysis should be chosen. When testing means and rates, a non-stratified analysis can be performed on overall data. For survival data, only a stratified analysis is possible. Is a logical vector of length 1.} }} diff --git a/man/AnalysisResultsEnrichmentInverseNormal.Rd b/man/AnalysisResultsEnrichmentInverseNormal.Rd index 7a2e1915..db7d53c7 100644 --- a/man/AnalysisResultsEnrichmentInverseNormal.Rd +++ b/man/AnalysisResultsEnrichmentInverseNormal.Rd @@ -1,20 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R, -% R/class_analysis_results_r6.R +% Please edit documentation in R/class_analysis_results.R \docType{class} \name{AnalysisResultsEnrichmentInverseNormal} \alias{AnalysisResultsEnrichmentInverseNormal} -\alias{AnalysisResultsEnrichmentInverseNormalR6} \title{Analysis Results Enrichment Inverse Normal} \description{ -Class for enrichment analysis results based on a inverse normal design. - Class for enrichment analysis results based on a inverse normal design. } \details{ -This object cannot be created directly; use \code{\link{getAnalysisResults}} -with suitable arguments to create the enrichment analysis results of an inverse normal design. - This object cannot be created directly; use \code{\link{getAnalysisResults}} with suitable arguments to create the enrichment analysis results of an inverse normal design. } @@ -57,44 +50,6 @@ with suitable arguments to create the enrichment analysis results of an inverse \item{\code{piControls}}{The assumed rates in the control group for enrichment designs, i.e., designs with multiple subsets.} -\item{\code{stratifiedAnalysis}}{For enrichment designs, typically a stratified analysis should be chosen. When testing means and rates, a non-stratified analysis can be performed on overall data. For survival data, only a stratified analysis is possible. Is a logical vector of length 1.} - -\item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} - -\item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} - -\item{\code{thetaH0}}{The difference or assumed effect under H0. Is a numeric vector of length 1.} - -\item{\code{pi1}}{The assumed probability or probabilities in the active treatment group in two-group designs, or the alternative probability for a one-group design.} - -\item{\code{pi2}}{The assumed probability in the reference group for two-group designs. Is a numeric vector of length 1 containing a value between 0 and 1.} - -\item{\code{nPlanned}}{The sample size planned for each of the subsequent stages. Is a numeric vector of length \code{kMax} containing whole numbers.} - -\item{\code{allocationRatioPlanned}}{The planned allocation ratio (\code{n1 / n2}) for the groups. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. Is a positive numeric vector of length 1.} - -\item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} - -\item{\code{assumedStDevs}}{Assumed standard deviations to calculate conditional power in multi-arm trials or enrichment designs. Is a numeric vector.} - -\item{\code{piTreatments}}{The assumed rates in the treatment groups for multi-arm and enrichment designs, i.e., designs with multiple subsets.} - -\item{\code{intersectionTest}}{The multiple test used for intersection hypotheses in closed systems of hypotheses. Is a character vector of length 1.} - -\item{\code{varianceOption}}{Defines the way to calculate the variance in multiple (i.e., >2) treatment arms or population enrichment designs when testing means. Available options for multiple arms: \code{"overallPooled", "pairwisePooled", "notPooled"}. Available options for enrichment designs: \code{"pooled", "pooledFromFull", "notPooled"}.} - -\item{\code{conditionalRejectionProbabilities}}{The probabilities of rejecting the null hypothesis at each stage, given the stage has been reached. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{conditionalPower}}{The conditional power at each stage of the trial. Is a numeric vector of length 1 containing a value between 0 and 1.} - -\item{\code{repeatedConfidenceIntervalLowerBounds}}{The lower bound of the confidence intervals that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax}.} - -\item{\code{repeatedConfidenceIntervalUpperBounds}}{The upper bound of the confidence interval that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax}.} - -\item{\code{repeatedPValues}}{The p-values that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{piControls}}{The assumed rates in the control group for enrichment designs, i.e., designs with multiple subsets.} - \item{\code{stratifiedAnalysis}}{For enrichment designs, typically a stratified analysis should be chosen. When testing means and rates, a non-stratified analysis can be performed on overall data. For survival data, only a stratified analysis is possible. Is a logical vector of length 1.} }} diff --git a/man/AnalysisResultsFisher.Rd b/man/AnalysisResultsFisher.Rd index c42907e8..892419af 100644 --- a/man/AnalysisResultsFisher.Rd +++ b/man/AnalysisResultsFisher.Rd @@ -1,20 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R, -% R/class_analysis_results_r6.R +% Please edit documentation in R/class_analysis_results.R \docType{class} \name{AnalysisResultsFisher} \alias{AnalysisResultsFisher} -\alias{AnalysisResultsFisherR6} \title{Analysis Results Fisher} \description{ -Class for analysis results based on a Fisher combination test design. - Class for analysis results based on a Fisher combination test design. } \details{ -This object cannot be created directly; use \code{\link{getAnalysisResults}} -with suitable arguments to create the analysis results of a Fisher combination test design. - This object cannot be created directly; use \code{\link{getAnalysisResults}} with suitable arguments to create the analysis results of a Fisher combination test design. } @@ -67,54 +60,6 @@ with suitable arguments to create the analysis results of a Fisher combination t \item{\code{iterations}}{The number of iterations used for simulations. Is a numeric vector of length 1 containing a whole number.} -\item{\code{seed}}{The seed used for random number generation. Is a numeric vector of length 1.} - -\item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} - -\item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} - -\item{\code{thetaH0}}{The difference or assumed effect under H0. Is a numeric vector of length 1.} - -\item{\code{pi1}}{The assumed probability or probabilities in the active treatment group in two-group designs, or the alternative probability for a one-group design.} - -\item{\code{pi2}}{The assumed probability in the reference group for two-group designs. Is a numeric vector of length 1 containing a value between 0 and 1.} - -\item{\code{nPlanned}}{The sample size planned for each of the subsequent stages. Is a numeric vector of length \code{kMax} containing whole numbers.} - -\item{\code{allocationRatioPlanned}}{The planned allocation ratio (\code{n1 / n2}) for the groups. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. Is a positive numeric vector of length 1.} - -\item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} - -\item{\code{assumedStDev}}{The assumed standard deviation(s) for means analysis. Is a numeric vector.} - -\item{\code{equalVariances}}{Describes if the variances in two treatment groups are assumed to be the same. Is a logical vector of length 1.} - -\item{\code{testActions}}{The test decisions at each stage of the trial. Is a character vector of length \code{kMax}.} - -\item{\code{conditionalRejectionProbabilities}}{The probabilities of rejecting the null hypothesis at each stage, given the stage has been reached. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{conditionalPower}}{The conditional power at each stage of the trial. Is a numeric vector of length 1 containing a value between 0 and 1.} - -\item{\code{repeatedConfidenceIntervalLowerBounds}}{The lower bound of the confidence intervals that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax}.} - -\item{\code{repeatedConfidenceIntervalUpperBounds}}{The upper bound of the confidence interval that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax}.} - -\item{\code{repeatedPValues}}{The p-values that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{finalStage}}{The stage at which the trial ends, either with acceptance or rejection of the null hypothesis. Is a numeric vector of length 1.} - -\item{\code{finalPValues}}{The final p-value that is based on the stage-wise ordering. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{finalConfidenceIntervalLowerBounds}}{The lower bound of the confidence interval that is based on the stage-wise ordering. Is a numeric vector of length \code{kMax}.} - -\item{\code{finalConfidenceIntervalUpperBounds}}{The upper bound of the confidence interval that is based on the stage-wise ordering. Is a numeric vector of length \code{kMax}.} - -\item{\code{medianUnbiasedEstimates}}{The calculated median unbiased estimates that are based on the stage-wise ordering. Is a numeric vector of length \code{kMax}.} - -\item{\code{conditionalPowerSimulated}}{The simulated conditional power, under the assumption of observed or assumed effect sizes.} - -\item{\code{iterations}}{The number of iterations used for simulations. Is a numeric vector of length 1 containing a whole number.} - \item{\code{seed}}{The seed used for random number generation. Is a numeric vector of length 1.} }} diff --git a/man/AnalysisResultsGroupSequential.Rd b/man/AnalysisResultsGroupSequential.Rd index 7cf7127d..069cf571 100644 --- a/man/AnalysisResultsGroupSequential.Rd +++ b/man/AnalysisResultsGroupSequential.Rd @@ -1,20 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R, -% R/class_analysis_results_r6.R +% Please edit documentation in R/class_analysis_results.R \docType{class} \name{AnalysisResultsGroupSequential} \alias{AnalysisResultsGroupSequential} -\alias{AnalysisResultsGroupSequentialR6} \title{Analysis Results Group Sequential} \description{ -Class for analysis results results based on a group sequential design. - Class for analysis results results based on a group sequential design. } \details{ -This object cannot be created directly; use \code{\link{getAnalysisResults}} -with suitable arguments to create the analysis results of a group sequential design. - This object cannot be created directly; use \code{\link{getAnalysisResults}} with suitable arguments to create the analysis results of a group sequential design. } @@ -65,52 +58,6 @@ with suitable arguments to create the analysis results of a group sequential des \item{\code{maxInformation}}{The maximum information. Is a numeric vector of length 1 containing a whole number.} -\item{\code{informationEpsilon}}{The absolute information epsilon, which defines the maximum distance from the observed information to the maximum information that causes the final analysis. Updates at the final analysis if the observed information at the final analysis is smaller ("under-running") than the planned maximum information. Is either a positive integer value specifying the absolute information epsilon or a floating point number >0 and <1 to define a relative information epsilon.} - -\item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} - -\item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} - -\item{\code{thetaH0}}{The difference or assumed effect under H0. Is a numeric vector of length 1.} - -\item{\code{pi1}}{The assumed probability or probabilities in the active treatment group in two-group designs, or the alternative probability for a one-group design.} - -\item{\code{pi2}}{The assumed probability in the reference group for two-group designs. Is a numeric vector of length 1 containing a value between 0 and 1.} - -\item{\code{nPlanned}}{The sample size planned for each of the subsequent stages. Is a numeric vector of length \code{kMax} containing whole numbers.} - -\item{\code{allocationRatioPlanned}}{The planned allocation ratio (\code{n1 / n2}) for the groups. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. Is a positive numeric vector of length 1.} - -\item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} - -\item{\code{assumedStDev}}{The assumed standard deviation(s) for means analysis. Is a numeric vector.} - -\item{\code{equalVariances}}{Describes if the variances in two treatment groups are assumed to be the same. Is a logical vector of length 1.} - -\item{\code{testActions}}{The test decisions at each stage of the trial. Is a character vector of length \code{kMax}.} - -\item{\code{conditionalRejectionProbabilities}}{The probabilities of rejecting the null hypothesis at each stage, given the stage has been reached. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{conditionalPower}}{The conditional power at each stage of the trial. Is a numeric vector of length 1 containing a value between 0 and 1.} - -\item{\code{repeatedConfidenceIntervalLowerBounds}}{The lower bound of the confidence intervals that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax}.} - -\item{\code{repeatedConfidenceIntervalUpperBounds}}{The upper bound of the confidence interval that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax}.} - -\item{\code{repeatedPValues}}{The p-values that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{finalStage}}{The stage at which the trial ends, either with acceptance or rejection of the null hypothesis. Is a numeric vector of length 1.} - -\item{\code{finalPValues}}{The final p-value that is based on the stage-wise ordering. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{finalConfidenceIntervalLowerBounds}}{The lower bound of the confidence interval that is based on the stage-wise ordering. Is a numeric vector of length \code{kMax}.} - -\item{\code{finalConfidenceIntervalUpperBounds}}{The upper bound of the confidence interval that is based on the stage-wise ordering. Is a numeric vector of length \code{kMax}.} - -\item{\code{medianUnbiasedEstimates}}{The calculated median unbiased estimates that are based on the stage-wise ordering. Is a numeric vector of length \code{kMax}.} - -\item{\code{maxInformation}}{The maximum information. Is a numeric vector of length 1 containing a whole number.} - \item{\code{informationEpsilon}}{The absolute information epsilon, which defines the maximum distance from the observed information to the maximum information that causes the final analysis. Updates at the final analysis if the observed information at the final analysis is smaller ("under-running") than the planned maximum information. Is either a positive integer value specifying the absolute information epsilon or a floating point number >0 and <1 to define a relative information epsilon.} }} diff --git a/man/AnalysisResultsInverseNormal.Rd b/man/AnalysisResultsInverseNormal.Rd index 21f95b26..bbf9333a 100644 --- a/man/AnalysisResultsInverseNormal.Rd +++ b/man/AnalysisResultsInverseNormal.Rd @@ -1,20 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R, -% R/class_analysis_results_r6.R +% Please edit documentation in R/class_analysis_results.R \docType{class} \name{AnalysisResultsInverseNormal} \alias{AnalysisResultsInverseNormal} -\alias{AnalysisResultsInverseNormalR6} \title{Analysis Results Inverse Normal} \description{ -Class for analysis results results based on an inverse normal design. - Class for analysis results results based on an inverse normal design. } \details{ -This object cannot be created directly; use \code{\link{getAnalysisResults}} -with suitable arguments to create the analysis results of a inverse normal design. - This object cannot be created directly; use \code{\link{getAnalysisResults}} with suitable arguments to create the analysis results of a inverse normal design. } @@ -61,48 +54,6 @@ with suitable arguments to create the analysis results of a inverse normal desig \item{\code{finalConfidenceIntervalUpperBounds}}{The upper bound of the confidence interval that is based on the stage-wise ordering. Is a numeric vector of length \code{kMax}.} -\item{\code{medianUnbiasedEstimates}}{The calculated median unbiased estimates that are based on the stage-wise ordering. Is a numeric vector of length \code{kMax}.} - -\item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} - -\item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} - -\item{\code{thetaH0}}{The difference or assumed effect under H0. Is a numeric vector of length 1.} - -\item{\code{pi1}}{The assumed probability or probabilities in the active treatment group in two-group designs, or the alternative probability for a one-group design.} - -\item{\code{pi2}}{The assumed probability in the reference group for two-group designs. Is a numeric vector of length 1 containing a value between 0 and 1.} - -\item{\code{nPlanned}}{The sample size planned for each of the subsequent stages. Is a numeric vector of length \code{kMax} containing whole numbers.} - -\item{\code{allocationRatioPlanned}}{The planned allocation ratio (\code{n1 / n2}) for the groups. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. Is a positive numeric vector of length 1.} - -\item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} - -\item{\code{assumedStDev}}{The assumed standard deviation(s) for means analysis. Is a numeric vector.} - -\item{\code{equalVariances}}{Describes if the variances in two treatment groups are assumed to be the same. Is a logical vector of length 1.} - -\item{\code{testActions}}{The test decisions at each stage of the trial. Is a character vector of length \code{kMax}.} - -\item{\code{conditionalRejectionProbabilities}}{The probabilities of rejecting the null hypothesis at each stage, given the stage has been reached. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{conditionalPower}}{The conditional power at each stage of the trial. Is a numeric vector of length 1 containing a value between 0 and 1.} - -\item{\code{repeatedConfidenceIntervalLowerBounds}}{The lower bound of the confidence intervals that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax}.} - -\item{\code{repeatedConfidenceIntervalUpperBounds}}{The upper bound of the confidence interval that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax}.} - -\item{\code{repeatedPValues}}{The p-values that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{finalStage}}{The stage at which the trial ends, either with acceptance or rejection of the null hypothesis. Is a numeric vector of length 1.} - -\item{\code{finalPValues}}{The final p-value that is based on the stage-wise ordering. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{finalConfidenceIntervalLowerBounds}}{The lower bound of the confidence interval that is based on the stage-wise ordering. Is a numeric vector of length \code{kMax}.} - -\item{\code{finalConfidenceIntervalUpperBounds}}{The upper bound of the confidence interval that is based on the stage-wise ordering. Is a numeric vector of length \code{kMax}.} - \item{\code{medianUnbiasedEstimates}}{The calculated median unbiased estimates that are based on the stage-wise ordering. Is a numeric vector of length \code{kMax}.} }} diff --git a/man/AnalysisResultsMultiArm.Rd b/man/AnalysisResultsMultiArm.Rd index b5aaecf7..7719af7f 100644 --- a/man/AnalysisResultsMultiArm.Rd +++ b/man/AnalysisResultsMultiArm.Rd @@ -1,24 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R, -% R/class_analysis_results_r6.R +% Please edit documentation in R/class_analysis_results.R \docType{class} \name{AnalysisResultsMultiArm} \alias{AnalysisResultsMultiArm} -\alias{AnalysisResultsMultiArmR6} \title{Basic Class for Analysis Results Multi-Arm} \description{ -A basic class for multi-arm analysis results. - A basic class for multi-arm analysis results. } \details{ -\code{AnalysisResultsMultiArm} is the basic class for -\itemize{ -\item \code{\link{AnalysisResultsMultiArmFisher}}, -\item \code{\link{AnalysisResultsMultiArmInverseNormal}}, and -\item \code{\link{AnalysisResultsConditionalDunnett}}. -} - \code{AnalysisResultsMultiArm} is the basic class for \itemize{ \item \code{\link{AnalysisResultsMultiArmFisher}}, diff --git a/man/AnalysisResultsMultiArmInverseNormal.Rd b/man/AnalysisResultsMultiArmInverseNormal.Rd index 76b18187..84be8996 100644 --- a/man/AnalysisResultsMultiArmInverseNormal.Rd +++ b/man/AnalysisResultsMultiArmInverseNormal.Rd @@ -1,20 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R, -% R/class_analysis_results_r6.R +% Please edit documentation in R/class_analysis_results.R \docType{class} \name{AnalysisResultsMultiArmInverseNormal} \alias{AnalysisResultsMultiArmInverseNormal} -\alias{AnalysisResultsMultiArmInverseNormalR6} \title{Analysis Results Multi-Arm Inverse Normal} \description{ -Class for multi-arm analysis results based on a inverse normal design. - Class for multi-arm analysis results based on a inverse normal design. } \details{ -This object cannot be created directly; use \code{\link{getAnalysisResults}} -with suitable arguments to create the multi-arm analysis results of an inverse normal design. - This object cannot be created directly; use \code{\link{getAnalysisResults}} with suitable arguments to create the multi-arm analysis results of an inverse normal design. } @@ -55,42 +48,6 @@ with suitable arguments to create the multi-arm analysis results of an inverse n \item{\code{repeatedPValues}}{The p-values that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} -\item{\code{piControl}}{The assumed probability in the control arm for simulation and under which the sample size recalculation is performed. Is a numeric vector of length 1 containing a value between 0 and 1.} - -\item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} - -\item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} - -\item{\code{thetaH0}}{The difference or assumed effect under H0. Is a numeric vector of length 1.} - -\item{\code{pi1}}{The assumed probability or probabilities in the active treatment group in two-group designs, or the alternative probability for a one-group design.} - -\item{\code{pi2}}{The assumed probability in the reference group for two-group designs. Is a numeric vector of length 1 containing a value between 0 and 1.} - -\item{\code{nPlanned}}{The sample size planned for each of the subsequent stages. Is a numeric vector of length \code{kMax} containing whole numbers.} - -\item{\code{allocationRatioPlanned}}{The planned allocation ratio (\code{n1 / n2}) for the groups. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. Is a positive numeric vector of length 1.} - -\item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} - -\item{\code{assumedStDevs}}{Assumed standard deviations to calculate conditional power in multi-arm trials or enrichment designs. Is a numeric vector.} - -\item{\code{piTreatments}}{The assumed rates in the treatment groups for multi-arm and enrichment designs, i.e., designs with multiple subsets.} - -\item{\code{intersectionTest}}{The multiple test used for intersection hypotheses in closed systems of hypotheses. Is a character vector of length 1.} - -\item{\code{varianceOption}}{Defines the way to calculate the variance in multiple (i.e., >2) treatment arms or population enrichment designs when testing means. Available options for multiple arms: \code{"overallPooled", "pairwisePooled", "notPooled"}. Available options for enrichment designs: \code{"pooled", "pooledFromFull", "notPooled"}.} - -\item{\code{conditionalRejectionProbabilities}}{The probabilities of rejecting the null hypothesis at each stage, given the stage has been reached. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{conditionalPower}}{The conditional power at each stage of the trial. Is a numeric vector of length 1 containing a value between 0 and 1.} - -\item{\code{repeatedConfidenceIntervalLowerBounds}}{The lower bound of the confidence intervals that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax}.} - -\item{\code{repeatedConfidenceIntervalUpperBounds}}{The upper bound of the confidence interval that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax}.} - -\item{\code{repeatedPValues}}{The p-values that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - \item{\code{piControl}}{The assumed probability in the control arm for simulation and under which the sample size recalculation is performed. Is a numeric vector of length 1 containing a value between 0 and 1.} }} diff --git a/man/AnalysisResultsMultiHypotheses.Rd b/man/AnalysisResultsMultiHypotheses.Rd index b93259e7..e521a933 100644 --- a/man/AnalysisResultsMultiHypotheses.Rd +++ b/man/AnalysisResultsMultiHypotheses.Rd @@ -1,23 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R, -% R/class_analysis_results_r6.R +% Please edit documentation in R/class_analysis_results.R \docType{class} \name{AnalysisResultsMultiHypotheses} \alias{AnalysisResultsMultiHypotheses} -\alias{AnalysisResultsMultiHypothesesR6} \title{Basic Class for Analysis Results Multi-Hypotheses} \description{ -A basic class for multi-hypotheses analysis results. - A basic class for multi-hypotheses analysis results. } \details{ -\code{AnalysisResultsMultiHypotheses} is the basic class for -\itemize{ -\item \code{\link{AnalysisResultsMultiArm}} and -\item \code{\link{AnalysisResultsEnrichment}}. -} - \code{AnalysisResultsMultiHypotheses} is the basic class for \itemize{ \item \code{\link{AnalysisResultsMultiArm}} and diff --git a/man/ClosedCombinationTestResults.Rd b/man/ClosedCombinationTestResults.Rd index 3b49d190..3e457354 100644 --- a/man/ClosedCombinationTestResults.Rd +++ b/man/ClosedCombinationTestResults.Rd @@ -1,20 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R, -% R/class_analysis_results_r6.R +% Please edit documentation in R/class_analysis_results.R \docType{class} \name{ClosedCombinationTestResults} \alias{ClosedCombinationTestResults} -\alias{ClosedCombinationTestResultsR6} \title{Analysis Results Closed Combination Test} \description{ -Class for multi-arm analysis results based on a closed combination test. - Class for multi-arm analysis results based on a closed combination test. } \details{ -This object cannot be created directly; use \code{\link{getAnalysisResults}} -with suitable arguments to create the multi-arm analysis results of a closed combination test design. - This object cannot be created directly; use \code{\link{getAnalysisResults}} with suitable arguments to create the multi-arm analysis results of a closed combination test design. } @@ -37,24 +30,6 @@ with suitable arguments to create the multi-arm analysis results of a closed com \item{\code{rejected}}{Indicates whether a hypothesis is rejected or not.} -\item{\code{rejectedIntersections}}{The simulated number of rejected arms in the closed testing procedure.. Is a logical matrix.} - -\item{\code{intersectionTest}}{The multiple test used for intersection hypotheses in closed systems of hypotheses. Is a character vector of length 1.} - -\item{\code{indices}}{Indicates which stages are available for analysis.} - -\item{\code{adjustedStageWisePValues}}{The multiplicity adjusted p-values from the separate stages. Is a numeric matrix.} - -\item{\code{overallAdjustedTestStatistics}}{The overall adjusted test statistics.} - -\item{\code{separatePValues}}{The p-values from the separate stages. Is a numeric matrix.} - -\item{\code{conditionalErrorRate}}{The calculated conditional error rate.} - -\item{\code{secondStagePValues}}{For conditional Dunnett test, the conditional or unconditional p-value calculated for the second stage.} - -\item{\code{rejected}}{Indicates whether a hypothesis is rejected or not.} - \item{\code{rejectedIntersections}}{The simulated number of rejected arms in the closed testing procedure.. Is a logical matrix.} }} diff --git a/man/ConditionalPowerResults.Rd b/man/ConditionalPowerResults.Rd index 7c846921..3a920396 100644 --- a/man/ConditionalPowerResults.Rd +++ b/man/ConditionalPowerResults.Rd @@ -1,20 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R, -% R/class_analysis_results_r6.R +% Please edit documentation in R/class_analysis_results.R \docType{class} \name{ConditionalPowerResults} \alias{ConditionalPowerResults} -\alias{ConditionalPowerResultsR6} \title{Conditional Power Results} \description{ -Class for conditional power calculations - Class for conditional power calculations } \details{ -This object cannot be created directly; use \code{\link[=getConditionalPower]{getConditionalPower()}} -with suitable arguments to create the results of a group sequential or a combination test design. - This object cannot be created directly; use \code{\link[=getConditionalPower]{getConditionalPower()}} with suitable arguments to create the results of a group sequential or a combination test design. } @@ -35,22 +28,6 @@ with suitable arguments to create the results of a group sequential or a combina \item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} -\item{\code{assumedStDev}}{The assumed standard deviation(s) for means analysis. Is a numeric vector.} - -\item{\code{nPlanned}}{The sample size planned for each of the subsequent stages. Is a numeric vector of length \code{kMax} containing whole numbers.} - -\item{\code{allocationRatioPlanned}}{The planned allocation ratio (\code{n1 / n2}) for the groups. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. Is a positive numeric vector of length 1.} - -\item{\code{iterations}}{The number of iterations used for simulations. Is a numeric vector of length 1 containing a whole number.} - -\item{\code{seed}}{The seed used for random number generation. Is a numeric vector of length 1.} - -\item{\code{simulated}}{Describes if the power for Fisher's combination test has been simulated. Only applicable when using Fisher designs. Is a logical vector of length 1.} - -\item{\code{conditionalPower}}{The conditional power at each stage of the trial. Is a numeric vector of length 1 containing a value between 0 and 1.} - -\item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} - \item{\code{assumedStDev}}{The assumed standard deviation(s) for means analysis. Is a numeric vector.} }} diff --git a/man/ConditionalPowerResultsEnrichmentMeans.Rd b/man/ConditionalPowerResultsEnrichmentMeans.Rd index fc15c00f..6f6b3c0e 100644 --- a/man/ConditionalPowerResultsEnrichmentMeans.Rd +++ b/man/ConditionalPowerResultsEnrichmentMeans.Rd @@ -1,20 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R, -% R/class_analysis_results_r6.R +% Please edit documentation in R/class_analysis_results.R \docType{class} \name{ConditionalPowerResultsEnrichmentMeans} \alias{ConditionalPowerResultsEnrichmentMeans} -\alias{ConditionalPowerResultsEnrichmentMeansR6} \title{Conditional Power Results Enrichment Means} \description{ -Class for conditional power calculations of enrichment means data - Class for conditional power calculations of enrichment means data } \details{ -This object cannot be created directly; use \code{\link{getConditionalPower}} -with suitable arguments to create the results of a group sequential or a combination test design. - This object cannot be created directly; use \code{\link{getConditionalPower}} with suitable arguments to create the results of a group sequential or a combination test design. } @@ -35,22 +28,6 @@ with suitable arguments to create the results of a group sequential or a combina \item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} -\item{\code{assumedStDevs}}{Assumed standard deviations to calculate conditional power in multi-arm trials or enrichment designs. Is a numeric vector.} - -\item{\code{nPlanned}}{The sample size planned for each of the subsequent stages. Is a numeric vector of length \code{kMax} containing whole numbers.} - -\item{\code{allocationRatioPlanned}}{The planned allocation ratio (\code{n1 / n2}) for the groups. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. Is a positive numeric vector of length 1.} - -\item{\code{iterations}}{The number of iterations used for simulations. Is a numeric vector of length 1 containing a whole number.} - -\item{\code{seed}}{The seed used for random number generation. Is a numeric vector of length 1.} - -\item{\code{simulated}}{Describes if the power for Fisher's combination test has been simulated. Only applicable when using Fisher designs. Is a logical vector of length 1.} - -\item{\code{conditionalPower}}{The conditional power at each stage of the trial. Is a numeric vector of length 1 containing a value between 0 and 1.} - -\item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} - \item{\code{assumedStDevs}}{Assumed standard deviations to calculate conditional power in multi-arm trials or enrichment designs. Is a numeric vector.} }} diff --git a/man/ConditionalPowerResultsEnrichmentRates.Rd b/man/ConditionalPowerResultsEnrichmentRates.Rd index 0203ef5d..08d88514 100644 --- a/man/ConditionalPowerResultsEnrichmentRates.Rd +++ b/man/ConditionalPowerResultsEnrichmentRates.Rd @@ -1,20 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R, -% R/class_analysis_results_r6.R +% Please edit documentation in R/class_analysis_results.R \docType{class} \name{ConditionalPowerResultsEnrichmentRates} \alias{ConditionalPowerResultsEnrichmentRates} -\alias{ConditionalPowerResultsEnrichmentRatesR6} \title{Conditional Power Results Enrichment Rates} \description{ -Class for conditional power calculations of enrichment rates data - Class for conditional power calculations of enrichment rates data } \details{ -This object cannot be created directly; use \code{\link{getConditionalPower}} -with suitable arguments to create the results of a group sequential or a combination test design. - This object cannot be created directly; use \code{\link{getConditionalPower}} with suitable arguments to create the results of a group sequential or a combination test design. } @@ -35,22 +28,6 @@ with suitable arguments to create the results of a group sequential or a combina \item{\code{piTreatments}}{The assumed rates in the treatment groups for multi-arm and enrichment designs, i.e., designs with multiple subsets.} -\item{\code{piControls}}{The assumed rates in the control group for enrichment designs, i.e., designs with multiple subsets.} - -\item{\code{nPlanned}}{The sample size planned for each of the subsequent stages. Is a numeric vector of length \code{kMax} containing whole numbers.} - -\item{\code{allocationRatioPlanned}}{The planned allocation ratio (\code{n1 / n2}) for the groups. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. Is a positive numeric vector of length 1.} - -\item{\code{iterations}}{The number of iterations used for simulations. Is a numeric vector of length 1 containing a whole number.} - -\item{\code{seed}}{The seed used for random number generation. Is a numeric vector of length 1.} - -\item{\code{simulated}}{Describes if the power for Fisher's combination test has been simulated. Only applicable when using Fisher designs. Is a logical vector of length 1.} - -\item{\code{conditionalPower}}{The conditional power at each stage of the trial. Is a numeric vector of length 1 containing a value between 0 and 1.} - -\item{\code{piTreatments}}{The assumed rates in the treatment groups for multi-arm and enrichment designs, i.e., designs with multiple subsets.} - \item{\code{piControls}}{The assumed rates in the control group for enrichment designs, i.e., designs with multiple subsets.} }} diff --git a/man/ConditionalPowerResultsMeans.Rd b/man/ConditionalPowerResultsMeans.Rd index 6d580098..2b0dcb98 100644 --- a/man/ConditionalPowerResultsMeans.Rd +++ b/man/ConditionalPowerResultsMeans.Rd @@ -1,20 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R, -% R/class_analysis_results_r6.R +% Please edit documentation in R/class_analysis_results.R \docType{class} \name{ConditionalPowerResultsMeans} \alias{ConditionalPowerResultsMeans} -\alias{ConditionalPowerResultsMeansR6} \title{Conditional Power Results Means} \description{ -Class for conditional power calculations of means data - Class for conditional power calculations of means data } \details{ -This object cannot be created directly; use \code{\link{getConditionalPower}} -with suitable arguments to create the results of a group sequential or a combination test design. - This object cannot be created directly; use \code{\link{getConditionalPower}} with suitable arguments to create the results of a group sequential or a combination test design. } @@ -35,22 +28,6 @@ with suitable arguments to create the results of a group sequential or a combina \item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} -\item{\code{assumedStDev}}{The assumed standard deviation(s) for means analysis. Is a numeric vector.} - -\item{\code{nPlanned}}{The sample size planned for each of the subsequent stages. Is a numeric vector of length \code{kMax} containing whole numbers.} - -\item{\code{allocationRatioPlanned}}{The planned allocation ratio (\code{n1 / n2}) for the groups. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. Is a positive numeric vector of length 1.} - -\item{\code{iterations}}{The number of iterations used for simulations. Is a numeric vector of length 1 containing a whole number.} - -\item{\code{seed}}{The seed used for random number generation. Is a numeric vector of length 1.} - -\item{\code{simulated}}{Describes if the power for Fisher's combination test has been simulated. Only applicable when using Fisher designs. Is a logical vector of length 1.} - -\item{\code{conditionalPower}}{The conditional power at each stage of the trial. Is a numeric vector of length 1 containing a value between 0 and 1.} - -\item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} - \item{\code{assumedStDev}}{The assumed standard deviation(s) for means analysis. Is a numeric vector.} }} diff --git a/man/ConditionalPowerResultsRates.Rd b/man/ConditionalPowerResultsRates.Rd index d259a9c3..0cf596a3 100644 --- a/man/ConditionalPowerResultsRates.Rd +++ b/man/ConditionalPowerResultsRates.Rd @@ -1,20 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R, -% R/class_analysis_results_r6.R +% Please edit documentation in R/class_analysis_results.R \docType{class} \name{ConditionalPowerResultsRates} \alias{ConditionalPowerResultsRates} -\alias{ConditionalPowerResultsRatesR6} \title{Conditional Power Results Rates} \description{ -Class for conditional power calculations of rates data - Class for conditional power calculations of rates data } \details{ -This object cannot be created directly; use \code{\link{getConditionalPower}} -with suitable arguments to create the results of a group sequential or a combination test design. - This object cannot be created directly; use \code{\link{getConditionalPower}} with suitable arguments to create the results of a group sequential or a combination test design. } @@ -35,22 +28,6 @@ with suitable arguments to create the results of a group sequential or a combina \item{\code{pi1}}{The assumed probability or probabilities in the active treatment group in two-group designs, or the alternative probability for a one-group design.} -\item{\code{pi2}}{The assumed probability in the reference group for two-group designs. Is a numeric vector of length 1 containing a value between 0 and 1.} - -\item{\code{nPlanned}}{The sample size planned for each of the subsequent stages. Is a numeric vector of length \code{kMax} containing whole numbers.} - -\item{\code{allocationRatioPlanned}}{The planned allocation ratio (\code{n1 / n2}) for the groups. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. Is a positive numeric vector of length 1.} - -\item{\code{iterations}}{The number of iterations used for simulations. Is a numeric vector of length 1 containing a whole number.} - -\item{\code{seed}}{The seed used for random number generation. Is a numeric vector of length 1.} - -\item{\code{simulated}}{Describes if the power for Fisher's combination test has been simulated. Only applicable when using Fisher designs. Is a logical vector of length 1.} - -\item{\code{conditionalPower}}{The conditional power at each stage of the trial. Is a numeric vector of length 1 containing a value between 0 and 1.} - -\item{\code{pi1}}{The assumed probability or probabilities in the active treatment group in two-group designs, or the alternative probability for a one-group design.} - \item{\code{pi2}}{The assumed probability in the reference group for two-group designs. Is a numeric vector of length 1 containing a value between 0 and 1.} }} diff --git a/man/ConditionalPowerResultsSurvival.Rd b/man/ConditionalPowerResultsSurvival.Rd index ed7f4036..cbedeb4c 100644 --- a/man/ConditionalPowerResultsSurvival.Rd +++ b/man/ConditionalPowerResultsSurvival.Rd @@ -1,20 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results.R, -% R/class_analysis_results_r6.R +% Please edit documentation in R/class_analysis_results.R \docType{class} \name{ConditionalPowerResultsSurvival} \alias{ConditionalPowerResultsSurvival} -\alias{ConditionalPowerResultsSurvivalR6} \title{Conditional Power Results Survival} \description{ -Class for conditional power calculations of survival data - Class for conditional power calculations of survival data } \details{ -This object cannot be created directly; use \code{\link{getConditionalPower}} -with suitable arguments to create the results of a group sequential or a combination test design. - This object cannot be created directly; use \code{\link{getConditionalPower}} with suitable arguments to create the results of a group sequential or a combination test design. } @@ -33,20 +26,6 @@ with suitable arguments to create the results of a group sequential or a combina \item{\code{conditionalPower}}{The conditional power at each stage of the trial. Is a numeric vector of length 1 containing a value between 0 and 1.} -\item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} - -\item{\code{nPlanned}}{The sample size planned for each of the subsequent stages. Is a numeric vector of length \code{kMax} containing whole numbers.} - -\item{\code{allocationRatioPlanned}}{The planned allocation ratio (\code{n1 / n2}) for the groups. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. Is a positive numeric vector of length 1.} - -\item{\code{iterations}}{The number of iterations used for simulations. Is a numeric vector of length 1 containing a whole number.} - -\item{\code{seed}}{The seed used for random number generation. Is a numeric vector of length 1.} - -\item{\code{simulated}}{Describes if the power for Fisher's combination test has been simulated. Only applicable when using Fisher designs. Is a logical vector of length 1.} - -\item{\code{conditionalPower}}{The conditional power at each stage of the trial. Is a numeric vector of length 1 containing a value between 0 and 1.} - \item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} }} diff --git a/man/StageResults.Rd b/man/StageResults.Rd index 367a5e28..c24c3345 100644 --- a/man/StageResults.Rd +++ b/man/StageResults.Rd @@ -1,30 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_stage_results.R, -% R/class_analysis_stage_results_r6.R +% Please edit documentation in R/class_analysis_stage_results.R \docType{class} \name{StageResults} \alias{StageResults} -\alias{StageResultsR6} \title{Basic Stage Results} \description{ -Basic class for stage results. - Basic class for stage results. } \details{ -\code{StageResults} is the basic class for -\itemize{ -\item \code{\link{StageResultsMeans}}, -\item \code{\link{StageResultsRates}}, -\item \code{\link{StageResultsSurvival}}, -\item \code{\link{StageResultsMultiArmMeans}}, -\item \code{\link{StageResultsMultiArmRates}}, -\item \code{\link{StageResultsMultiArmSurvival}}, -\item \code{\link{StageResultsEnrichmentMeans}}, -\item \code{\link{StageResultsEnrichmentRates}}, and -\item \code{\link{StageResultsEnrichmentSurvival}}. -} - \code{StageResults} is the basic class for \itemize{ \item \code{\link{StageResultsMeans}}, @@ -57,24 +40,6 @@ Basic class for stage results. \item{\code{weightsFisher}}{The weights for Fisher's combination test. Is a numeric vector of length \code{kMax}.} -\item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} - -\item{\code{stages}}{The stage numbers of the trial. Is a numeric vector of length \code{kMax} containing whole numbers.} - -\item{\code{testStatistics}}{The stage-wise test statistics. Is a numeric vector of length \code{kMax}.} - -\item{\code{pValues}}{The stage-wise p-values. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{combInverseNormal}}{The test statistics over stages for the inverse normal test. Is a numeric vector of length \code{kMax}.} - -\item{\code{combFisher}}{The test statistics over stages for Fisher's combination test. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{effectSizes}}{The stage-wise effect sizes. Is a numeric vector of length \code{kMax}.} - -\item{\code{testActions}}{The test decisions at each stage of the trial. Is a character vector of length \code{kMax}.} - -\item{\code{weightsFisher}}{The weights for Fisher's combination test. Is a numeric vector of length \code{kMax}.} - \item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} }} diff --git a/man/StageResultsEnrichmentMeans.Rd b/man/StageResultsEnrichmentMeans.Rd index bf507069..ef96ffa3 100644 --- a/man/StageResultsEnrichmentMeans.Rd +++ b/man/StageResultsEnrichmentMeans.Rd @@ -1,20 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_stage_results.R, -% R/class_analysis_stage_results_r6.R +% Please edit documentation in R/class_analysis_stage_results.R \docType{class} \name{StageResultsEnrichmentMeans} \alias{StageResultsEnrichmentMeans} -\alias{StageResultsEnrichmentMeansR6} \title{Stage Results Enrichment Means} \description{ -Class for stage results of enrichment means data - Class for stage results of enrichment means data } \details{ -This object cannot be created directly; use \code{getStageResults} -with suitable arguments to create the stage results of a dataset of enrichment means. - This object cannot be created directly; use \code{getStageResults} with suitable arguments to create the stage results of a dataset of enrichment means. } @@ -61,48 +54,6 @@ with suitable arguments to create the stage results of a dataset of enrichment m \item{\code{weightsFisher}}{The weights for Fisher's combination test. Is a numeric vector of length \code{kMax}.} -\item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} - -\item{\code{stages}}{The stage numbers of the trial. Is a numeric vector of length \code{kMax} containing whole numbers.} - -\item{\code{thetaH0}}{The difference or assumed effect under H0. Is a numeric vector of length 1.} - -\item{\code{direction}}{Specifies the direction of the alternative, is either "upper" or "lower". Only applicable for one-sided testing.} - -\item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} - -\item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} - -\item{\code{varianceOption}}{Defines the way to calculate the variance in multiple (i.e., >2) treatment arms or population enrichment designs when testing means. Available options for multiple arms: \code{"overallPooled", "pairwisePooled", "notPooled"}. Available options for enrichment designs: \code{"pooled", "pooledFromFull", "notPooled"}.} - -\item{\code{intersectionTest}}{The multiple test used for intersection hypotheses in closed systems of hypotheses. Is a character vector of length 1.} - -\item{\code{testStatistics}}{The stage-wise test statistics. Is a numeric vector of length \code{kMax}.} - -\item{\code{overallTestStatistics}}{The overall, i.e., cumulated test statistics. Is a numeric vector of length \code{kMax}.} - -\item{\code{pValues}}{The stage-wise p-values. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{overallPValues}}{The overall, i.e., cumulated p-values. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{overallStDevs}}{The overall, i.e., cumulative standard deviations. Is a numeric vector of length number of stages times number of groups.} - -\item{\code{overallPooledStDevs}}{The overall pooled standard deviations. Is a numeric matrix.} - -\item{\code{separatePValues}}{The p-values from the separate stages. Is a numeric matrix.} - -\item{\code{effectSizes}}{The stage-wise effect sizes. Is a numeric vector of length \code{kMax}.} - -\item{\code{singleStepAdjustedPValues}}{The adjusted p-value for testing multiple hypotheses per stage of the trial.} - -\item{\code{stratifiedAnalysis}}{For enrichment designs, typically a stratified analysis should be chosen. When testing means and rates, a non-stratified analysis can be performed on overall data. For survival data, only a stratified analysis is possible. Is a logical vector of length 1.} - -\item{\code{combInverseNormal}}{The test statistics over stages for the inverse normal test. Is a numeric vector of length \code{kMax}.} - -\item{\code{combFisher}}{The test statistics over stages for Fisher's combination test. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{weightsFisher}}{The weights for Fisher's combination test. Is a numeric vector of length \code{kMax}.} - \item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} }} diff --git a/man/StageResultsEnrichmentRates.Rd b/man/StageResultsEnrichmentRates.Rd index 1d418e86..e15d30ef 100644 --- a/man/StageResultsEnrichmentRates.Rd +++ b/man/StageResultsEnrichmentRates.Rd @@ -1,20 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_stage_results.R, -% R/class_analysis_stage_results_r6.R +% Please edit documentation in R/class_analysis_stage_results.R \docType{class} \name{StageResultsEnrichmentRates} \alias{StageResultsEnrichmentRates} -\alias{StageResultsEnrichmentRatesR6} \title{Stage Results Enrichment Rates} \description{ -Class for stage results of enrichment rates data. - Class for stage results of enrichment rates data. } \details{ -This object cannot be created directly; use \code{getStageResults} -with suitable arguments to create the stage results of a dataset of enrichment rates. - This object cannot be created directly; use \code{getStageResults} with suitable arguments to create the stage results of a dataset of enrichment rates. } @@ -37,24 +30,6 @@ with suitable arguments to create the stage results of a dataset of enrichment r \item{\code{weightsFisher}}{The weights for Fisher's combination test. Is a numeric vector of length \code{kMax}.} -\item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} - -\item{\code{stages}}{The stage numbers of the trial. Is a numeric vector of length \code{kMax} containing whole numbers.} - -\item{\code{testStatistics}}{The stage-wise test statistics. Is a numeric vector of length \code{kMax}.} - -\item{\code{pValues}}{The stage-wise p-values. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{combInverseNormal}}{The test statistics over stages for the inverse normal test. Is a numeric vector of length \code{kMax}.} - -\item{\code{combFisher}}{The test statistics over stages for Fisher's combination test. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{effectSizes}}{The stage-wise effect sizes. Is a numeric vector of length \code{kMax}.} - -\item{\code{testActions}}{The test decisions at each stage of the trial. Is a character vector of length \code{kMax}.} - -\item{\code{weightsFisher}}{The weights for Fisher's combination test. Is a numeric vector of length \code{kMax}.} - \item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} }} diff --git a/man/StageResultsEnrichmentSurvival.Rd b/man/StageResultsEnrichmentSurvival.Rd index cabe6289..091fa8be 100644 --- a/man/StageResultsEnrichmentSurvival.Rd +++ b/man/StageResultsEnrichmentSurvival.Rd @@ -1,20 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_stage_results.R, -% R/class_analysis_stage_results_r6.R +% Please edit documentation in R/class_analysis_stage_results.R \docType{class} \name{StageResultsEnrichmentSurvival} \alias{StageResultsEnrichmentSurvival} -\alias{StageResultsEnrichmentSurvivalR6} \title{Stage Results Enrichment Survival} \description{ -Class for stage results of enrichment survival data. - Class for stage results of enrichment survival data. } \details{ -This object cannot be created directly; use \code{getStageResults} -with suitable arguments to create the stage results of a dataset of enrichment survival. - This object cannot be created directly; use \code{getStageResults} with suitable arguments to create the stage results of a dataset of enrichment survival. } @@ -37,24 +30,6 @@ with suitable arguments to create the stage results of a dataset of enrichment s \item{\code{weightsFisher}}{The weights for Fisher's combination test. Is a numeric vector of length \code{kMax}.} -\item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} - -\item{\code{stages}}{The stage numbers of the trial. Is a numeric vector of length \code{kMax} containing whole numbers.} - -\item{\code{testStatistics}}{The stage-wise test statistics. Is a numeric vector of length \code{kMax}.} - -\item{\code{pValues}}{The stage-wise p-values. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{combInverseNormal}}{The test statistics over stages for the inverse normal test. Is a numeric vector of length \code{kMax}.} - -\item{\code{combFisher}}{The test statistics over stages for Fisher's combination test. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{effectSizes}}{The stage-wise effect sizes. Is a numeric vector of length \code{kMax}.} - -\item{\code{testActions}}{The test decisions at each stage of the trial. Is a character vector of length \code{kMax}.} - -\item{\code{weightsFisher}}{The weights for Fisher's combination test. Is a numeric vector of length \code{kMax}.} - \item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} }} diff --git a/man/StageResultsMeans.Rd b/man/StageResultsMeans.Rd index 15e0f5f7..c6f7bcec 100644 --- a/man/StageResultsMeans.Rd +++ b/man/StageResultsMeans.Rd @@ -1,20 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_stage_results.R, -% R/class_analysis_stage_results_r6.R +% Please edit documentation in R/class_analysis_stage_results.R \docType{class} \name{StageResultsMeans} \alias{StageResultsMeans} -\alias{StageResultsMeansR6} \title{Stage Results of Means} \description{ -Class for stage results of means. - Class for stage results of means. } \details{ -This object cannot be created directly; use \code{getStageResults} -with suitable arguments to create the stage results of a dataset of means. - This object cannot be created directly; use \code{getStageResults} with suitable arguments to create the stage results of a dataset of means. } @@ -49,36 +42,6 @@ with suitable arguments to create the stage results of a dataset of means. \item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} -\item{\code{...}}{Names of \code{dataInput}.} - -\item{\code{stages}}{The stage numbers of the trial. Is a numeric vector of length \code{kMax} containing whole numbers.} - -\item{\code{testStatistics}}{The stage-wise test statistics. Is a numeric vector of length \code{kMax}.} - -\item{\code{overallTestStatistics}}{The overall, i.e., cumulated test statistics. Is a numeric vector of length \code{kMax}.} - -\item{\code{pValues}}{The stage-wise p-values. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{overallPValues}}{The overall, i.e., cumulated p-values. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{effectSizes}}{The stage-wise effect sizes. Is a numeric vector of length \code{kMax}.} - -\item{\code{testActions}}{The test decisions at each stage of the trial. Is a character vector of length \code{kMax}.} - -\item{\code{direction}}{Specifies the direction of the alternative, is either "upper" or "lower". Only applicable for one-sided testing.} - -\item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} - -\item{\code{equalVariances}}{Describes if the variances in two treatment groups are assumed to be the same. Is a logical vector of length 1.} - -\item{\code{combFisher}}{The test statistics over stages for Fisher's combination test. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{weightsFisher}}{The weights for Fisher's combination test. Is a numeric vector of length \code{kMax}.} - -\item{\code{combInverseNormal}}{The test statistics over stages for the inverse normal test. Is a numeric vector of length \code{kMax}.} - -\item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} - \item{\code{...}}{Names of \code{dataInput}.} }} diff --git a/man/StageResultsMultiArmMeans.Rd b/man/StageResultsMultiArmMeans.Rd index 46708325..bb86eedd 100644 --- a/man/StageResultsMultiArmMeans.Rd +++ b/man/StageResultsMultiArmMeans.Rd @@ -1,20 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_stage_results.R, -% R/class_analysis_stage_results_r6.R +% Please edit documentation in R/class_analysis_stage_results.R \docType{class} \name{StageResultsMultiArmMeans} \alias{StageResultsMultiArmMeans} -\alias{StageResultsMultiArmMeansR6} \title{Stage Results Multi Arm Means} \description{ -Class for stage results of multi arm means data - Class for stage results of multi arm means data } \details{ -This object cannot be created directly; use \code{getStageResults} -with suitable arguments to create the stage results of a dataset of multi arm means. - This object cannot be created directly; use \code{getStageResults} with suitable arguments to create the stage results of a dataset of multi arm means. } @@ -65,52 +58,6 @@ with suitable arguments to create the stage results of a dataset of multi arm me \item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} -\item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} - -\item{\code{stages}}{The stage numbers of the trial. Is a numeric vector of length \code{kMax} containing whole numbers.} - -\item{\code{testStatistics}}{The stage-wise test statistics. Is a numeric vector of length \code{kMax}.} - -\item{\code{pValues}}{The stage-wise p-values. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{combInverseNormal}}{The test statistics over stages for the inverse normal test. Is a numeric vector of length \code{kMax}.} - -\item{\code{combFisher}}{The test statistics over stages for Fisher's combination test. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{effectSizes}}{The stage-wise effect sizes. Is a numeric vector of length \code{kMax}.} - -\item{\code{testActions}}{The test decisions at each stage of the trial. Is a character vector of length \code{kMax}.} - -\item{\code{weightsFisher}}{The weights for Fisher's combination test. Is a numeric vector of length \code{kMax}.} - -\item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} - -\item{\code{combInverseNormal}}{The test statistics over stages for the inverse normal test. Is a numeric vector of length \code{kMax}.} - -\item{\code{combFisher}}{The test statistics over stages for Fisher's combination test. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{overallTestStatistics}}{The overall, i.e., cumulated test statistics. Is a numeric vector of length \code{kMax}.} - -\item{\code{overallStDevs}}{The overall, i.e., cumulative standard deviations. Is a numeric vector of length number of stages times number of groups.} - -\item{\code{overallPooledStDevs}}{The overall pooled standard deviations. Is a numeric matrix.} - -\item{\code{overallPValues}}{The overall, i.e., cumulated p-values. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{testStatistics}}{The stage-wise test statistics. Is a numeric vector of length \code{kMax}.} - -\item{\code{separatePValues}}{The p-values from the separate stages. Is a numeric matrix.} - -\item{\code{effectSizes}}{The stage-wise effect sizes. Is a numeric vector of length \code{kMax}.} - -\item{\code{singleStepAdjustedPValues}}{The adjusted p-value for testing multiple hypotheses per stage of the trial.} - -\item{\code{intersectionTest}}{The multiple test used for intersection hypotheses in closed systems of hypotheses. Is a character vector of length 1.} - -\item{\code{varianceOption}}{Defines the way to calculate the variance in multiple (i.e., >2) treatment arms or population enrichment designs when testing means. Available options for multiple arms: \code{"overallPooled", "pairwisePooled", "notPooled"}. Available options for enrichment designs: \code{"pooled", "pooledFromFull", "notPooled"}.} - -\item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} - \item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} }} diff --git a/man/StageResultsMultiArmRates.Rd b/man/StageResultsMultiArmRates.Rd index 6f6e6a77..ed93dd91 100644 --- a/man/StageResultsMultiArmRates.Rd +++ b/man/StageResultsMultiArmRates.Rd @@ -1,20 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_stage_results.R, -% R/class_analysis_stage_results_r6.R +% Please edit documentation in R/class_analysis_stage_results.R \docType{class} \name{StageResultsMultiArmRates} \alias{StageResultsMultiArmRates} -\alias{StageResultsMultiArmRatesR6} \title{Stage Results Multi Arm Rates} \description{ -Class for stage results of multi arm rates data - Class for stage results of multi arm rates data } \details{ -This object cannot be created directly; use \code{getStageResults} -with suitable arguments to create the stage results of a dataset of multi arm rates. - This object cannot be created directly; use \code{getStageResults} with suitable arguments to create the stage results of a dataset of multi arm rates. } @@ -59,46 +52,6 @@ with suitable arguments to create the stage results of a dataset of multi arm ra \item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} -\item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} - -\item{\code{stages}}{The stage numbers of the trial. Is a numeric vector of length \code{kMax} containing whole numbers.} - -\item{\code{testStatistics}}{The stage-wise test statistics. Is a numeric vector of length \code{kMax}.} - -\item{\code{pValues}}{The stage-wise p-values. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{combInverseNormal}}{The test statistics over stages for the inverse normal test. Is a numeric vector of length \code{kMax}.} - -\item{\code{combFisher}}{The test statistics over stages for Fisher's combination test. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{effectSizes}}{The stage-wise effect sizes. Is a numeric vector of length \code{kMax}.} - -\item{\code{testActions}}{The test decisions at each stage of the trial. Is a character vector of length \code{kMax}.} - -\item{\code{weightsFisher}}{The weights for Fisher's combination test. Is a numeric vector of length \code{kMax}.} - -\item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} - -\item{\code{combInverseNormal}}{The test statistics over stages for the inverse normal test. Is a numeric vector of length \code{kMax}.} - -\item{\code{combFisher}}{The test statistics over stages for Fisher's combination test. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{overallTestStatistics}}{The overall, i.e., cumulated test statistics. Is a numeric vector of length \code{kMax}.} - -\item{\code{overallPValues}}{The overall, i.e., cumulated p-values. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{testStatistics}}{The stage-wise test statistics. Is a numeric vector of length \code{kMax}.} - -\item{\code{separatePValues}}{The p-values from the separate stages. Is a numeric matrix.} - -\item{\code{effectSizes}}{The stage-wise effect sizes. Is a numeric vector of length \code{kMax}.} - -\item{\code{singleStepAdjustedPValues}}{The adjusted p-value for testing multiple hypotheses per stage of the trial.} - -\item{\code{intersectionTest}}{The multiple test used for intersection hypotheses in closed systems of hypotheses. Is a character vector of length 1.} - -\item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} - \item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} }} diff --git a/man/StageResultsMultiArmSurvival.Rd b/man/StageResultsMultiArmSurvival.Rd index 04fb8640..446c4dab 100644 --- a/man/StageResultsMultiArmSurvival.Rd +++ b/man/StageResultsMultiArmSurvival.Rd @@ -1,20 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_stage_results.R, -% R/class_analysis_stage_results_r6.R +% Please edit documentation in R/class_analysis_stage_results.R \docType{class} \name{StageResultsMultiArmSurvival} \alias{StageResultsMultiArmSurvival} -\alias{StageResultsMultiArmSurvivalR6} \title{Stage Results Multi Arm Survival} \description{ -Class for stage results of multi arm survival data - Class for stage results of multi arm survival data } \details{ -This object cannot be created directly; use \code{getStageResults} -with suitable arguments to create the stage results of a dataset of multi arm survival. - This object cannot be created directly; use \code{getStageResults} with suitable arguments to create the stage results of a dataset of multi arm survival. } @@ -57,44 +50,6 @@ with suitable arguments to create the stage results of a dataset of multi arm su \item{\code{intersectionTest}}{The multiple test used for intersection hypotheses in closed systems of hypotheses. Is a character vector of length 1.} -\item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} - -\item{\code{stages}}{The stage numbers of the trial. Is a numeric vector of length \code{kMax} containing whole numbers.} - -\item{\code{testStatistics}}{The stage-wise test statistics. Is a numeric vector of length \code{kMax}.} - -\item{\code{pValues}}{The stage-wise p-values. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{combInverseNormal}}{The test statistics over stages for the inverse normal test. Is a numeric vector of length \code{kMax}.} - -\item{\code{combFisher}}{The test statistics over stages for Fisher's combination test. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{effectSizes}}{The stage-wise effect sizes. Is a numeric vector of length \code{kMax}.} - -\item{\code{testActions}}{The test decisions at each stage of the trial. Is a character vector of length \code{kMax}.} - -\item{\code{weightsFisher}}{The weights for Fisher's combination test. Is a numeric vector of length \code{kMax}.} - -\item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} - -\item{\code{combInverseNormal}}{The test statistics over stages for the inverse normal test. Is a numeric vector of length \code{kMax}.} - -\item{\code{combFisher}}{The test statistics over stages for Fisher's combination test. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{overallTestStatistics}}{The overall, i.e., cumulated test statistics. Is a numeric vector of length \code{kMax}.} - -\item{\code{overallPValues}}{The overall, i.e., cumulated p-values. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{testStatistics}}{The stage-wise test statistics. Is a numeric vector of length \code{kMax}.} - -\item{\code{separatePValues}}{The p-values from the separate stages. Is a numeric matrix.} - -\item{\code{effectSizes}}{The stage-wise effect sizes. Is a numeric vector of length \code{kMax}.} - -\item{\code{singleStepAdjustedPValues}}{The adjusted p-value for testing multiple hypotheses per stage of the trial.} - -\item{\code{intersectionTest}}{The multiple test used for intersection hypotheses in closed systems of hypotheses. Is a character vector of length 1.} - \item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} }} diff --git a/man/StageResultsRates.Rd b/man/StageResultsRates.Rd index 6ce48420..f327a9dc 100644 --- a/man/StageResultsRates.Rd +++ b/man/StageResultsRates.Rd @@ -1,20 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_stage_results.R, -% R/class_analysis_stage_results_r6.R +% Please edit documentation in R/class_analysis_stage_results.R \docType{class} \name{StageResultsRates} \alias{StageResultsRates} -\alias{StageResultsRatesR6} \title{Stage Results of Rates} \description{ -Class for stage results of rates. - Class for stage results of rates. } \details{ -This object cannot be created directly; use \code{getStageResults} -with suitable arguments to create the stage results of a dataset of rates. - This object cannot be created directly; use \code{getStageResults} with suitable arguments to create the stage results of a dataset of rates. } @@ -49,36 +42,6 @@ with suitable arguments to create the stage results of a dataset of rates. \item{\code{combFisher}}{The test statistics over stages for Fisher's combination test. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} -\item{\code{...}}{Names of \code{dataInput}.} - -\item{\code{stages}}{The stage numbers of the trial. Is a numeric vector of length \code{kMax} containing whole numbers.} - -\item{\code{testStatistics}}{The stage-wise test statistics. Is a numeric vector of length \code{kMax}.} - -\item{\code{overallTestStatistics}}{The overall, i.e., cumulated test statistics. Is a numeric vector of length \code{kMax}.} - -\item{\code{pValues}}{The stage-wise p-values. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{overallPValues}}{The overall, i.e., cumulated p-values. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{effectSizes}}{The stage-wise effect sizes. Is a numeric vector of length \code{kMax}.} - -\item{\code{direction}}{Specifies the direction of the alternative, is either "upper" or "lower". Only applicable for one-sided testing.} - -\item{\code{testActions}}{The test decisions at each stage of the trial. Is a character vector of length \code{kMax}.} - -\item{\code{thetaH0}}{The difference or assumed effect under H0. Is a numeric vector of length 1.} - -\item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} - -\item{\code{weightsFisher}}{The weights for Fisher's combination test. Is a numeric vector of length \code{kMax}.} - -\item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} - -\item{\code{combInverseNormal}}{The test statistics over stages for the inverse normal test. Is a numeric vector of length \code{kMax}.} - -\item{\code{combFisher}}{The test statistics over stages for Fisher's combination test. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - \item{\code{...}}{Names of \code{dataInput}.} }} diff --git a/man/StageResultsSurvival.Rd b/man/StageResultsSurvival.Rd index f6c2713a..7c5b29ab 100644 --- a/man/StageResultsSurvival.Rd +++ b/man/StageResultsSurvival.Rd @@ -1,20 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_stage_results.R, -% R/class_analysis_stage_results_r6.R +% Please edit documentation in R/class_analysis_stage_results.R \docType{class} \name{StageResultsSurvival} \alias{StageResultsSurvival} -\alias{StageResultsSurvivalR6} \title{Stage Results of Survival Data} \description{ -Class for stage results survival data. - Class for stage results survival data. } \details{ -This object cannot be created directly; use \code{getStageResults} -with suitable arguments to create the stage results of a dataset of survival data. - This object cannot be created directly; use \code{getStageResults} with suitable arguments to create the stage results of a dataset of survival data. } @@ -55,42 +48,6 @@ with suitable arguments to create the stage results of a dataset of survival dat \item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} -\item{\code{...}}{Names of \code{dataInput}.} - -\item{\code{stages}}{The stage numbers of the trial. Is a numeric vector of length \code{kMax} containing whole numbers.} - -\item{\code{testStatistics}}{The stage-wise test statistics. Is a numeric vector of length \code{kMax}.} - -\item{\code{overallTestStatistics}}{The overall, i.e., cumulated test statistics. Is a numeric vector of length \code{kMax}.} - -\item{\code{separatePValues}}{The p-values from the separate stages. Is a numeric matrix.} - -\item{\code{singleStepAdjustedPValues}}{The adjusted p-value for testing multiple hypotheses per stage of the trial.} - -\item{\code{overallPValues}}{The overall, i.e., cumulated p-values. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{direction}}{Specifies the direction of the alternative, is either "upper" or "lower". Only applicable for one-sided testing.} - -\item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} - -\item{\code{intersectionTest}}{The multiple test used for intersection hypotheses in closed systems of hypotheses. Is a character vector of length 1.} - -\item{\code{combInverseNormal}}{The test statistics over stages for the inverse normal test. Is a numeric vector of length \code{kMax}.} - -\item{\code{combFisher}}{The test statistics over stages for Fisher's combination test. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{effectSizes}}{The stage-wise effect sizes. Is a numeric vector of length \code{kMax}.} - -\item{\code{testActions}}{The test decisions at each stage of the trial. Is a character vector of length \code{kMax}.} - -\item{\code{thetaH0}}{The difference or assumed effect under H0. Is a numeric vector of length 1.} - -\item{\code{weightsFisher}}{The weights for Fisher's combination test. Is a numeric vector of length \code{kMax}.} - -\item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} - -\item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} - \item{\code{...}}{Names of \code{dataInput}.} }} diff --git a/man/getPerformanceScore.Rd b/man/getPerformanceScore.Rd index e653a90c..17a0f829 100644 --- a/man/getPerformanceScore.Rd +++ b/man/getPerformanceScore.Rd @@ -11,7 +11,9 @@ getPerformanceScore(simulationResult) } \description{ Calculates the conditional performance score, its sub-scores and components according to -Herrmann et al. (2020) for a given simulation result from a two-stage design. +\href{https://doi.org/10.1002/sim.8534}{Herrmann et al. (2020)} and +\href{https://doi.org/10.1186/s12874-024-02150-4}{Bokelmann et al. (2024)} for a given +simulation result from a two-stage design with continuous or binary endpoint. Larger (sub-)score and component values refer to a better performance. } \details{ @@ -22,13 +24,14 @@ and variation component (variationSampleSize, variationConditionalPower). The term conditional refers to an evaluation perspective where the interim results suggest a trial continuation with a second stage. The score can take values between 0 and 1. More details on the performance score -can be found in Herrmann et al. (2020). +can be found in \href{https://doi.org/10.1002/sim.8534}{Herrmann et al. (2020)} and +\href{https://doi.org/10.1186/s12874-024-02150-4}{Bokelmann et al. (2024)}. } \examples{ \dontrun{ # Example from Table 3 in "A new conditional performance score for # the evaluation of adaptive group sequential designs with samplesize -# recalculation from Herrmann et al 2023", p.2097 for +# recalculation from Herrmann et al 2023", p. 2097 for # Observed Conditional Power approach and Delta = 0.5 # Create two-stage Pocock design with binding futility boundary at 0 @@ -43,7 +46,7 @@ n2 <- 100 nMax <- n1 + n2 alternative <- 0.5 -# Perform Simulation; nMax*1.5 defines the maximum +# Perform Simulation; nMax * 1.5 defines the maximum # sample size for the additional stage simulationResult <- getSimulationMeans( design = design, diff --git a/man/getRawData.Rd b/man/getRawData.Rd index 030e4cf6..53e8e38a 100644 --- a/man/getRawData.Rd +++ b/man/getRawData.Rd @@ -35,7 +35,7 @@ The data frame contains the following columns: \item \code{treatmentGroup}: The treatment group number (1 or 2). \item \code{survivalTime}: The survival time of the subject. \item \code{dropoutTime}: The dropout time of the subject (may be \code{NA}). -\item \code{observationTime}: The specific observation time. +\item \code{lastObservationTime}: The specific observation time. \item \code{timeUnderObservation}: The time under observation is defined as follows: \if{html}{\out{
}}\preformatted{if (event == TRUE) \{ @@ -43,7 +43,7 @@ The data frame contains the following columns: \} else if (dropoutEvent == TRUE) \{ timeUnderObservation <- dropoutTime \} else \{ - timeUnderObservation <- observationTime - accrualTime + timeUnderObservation <- lastObservationTime - accrualTime \} }\if{html}{\out{
}} diff --git a/man/getSimulationSurvival.Rd b/man/getSimulationSurvival.Rd index a38dca10..02d39c30 100644 --- a/man/getSimulationSurvival.Rd +++ b/man/getSimulationSurvival.Rd @@ -586,15 +586,15 @@ myCalcEventsFunction <- function(..., theta <- max(1 + 1e-12, estimatedTheta) if (stage == 2) { requiredStageEvents <- - max(0, conditionalCriticalValue + qnorm(conditionalPower))^2 / log(theta)^2 - requiredStageEvents <- min( + max(0, conditionalCriticalValue + qnorm(conditionalPower))^2 * 4 / log(theta)^2 + requiredOverallStageEvents <- min( max(minNumberOfEventsPerStage[stage], requiredStageEvents), maxNumberOfEventsPerStage[stage] ) + eventsOverStages[stage - 1] } else { - requiredStageEvents <- 2 * eventsOverStages[stage - 1] - eventsOverStages[1] + requiredOverallStageEvents <- 2 * eventsOverStages[stage - 1] - eventsOverStages[1] } - return(requiredStageEvents) + return(requiredOverallStageEvents) } resultsWithSSR <- getSimulationSurvival( design = designIN, diff --git a/man/kable.Rd b/man/kable.Rd index 768182ea..99efbe60 100644 --- a/man/kable.Rd +++ b/man/kable.Rd @@ -1,12 +1,9 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_core_parameter_set.R, -% R/class_core_parameter_set_r6.R +% Please edit documentation in R/class_core_parameter_set.R \name{kable} \alias{kable} \title{Create tables in Markdown} \usage{ -kable(x, ...) - kable(x, ...) } \arguments{ @@ -15,12 +12,8 @@ kable(x, ...) \item{...}{Other arguments (see \code{\link[knitr]{kable}}).} } \description{ -The \code{kable()} function returns a single table for a single object that inherits from class \code{\link{ParameterSet}}. - The \code{kable()} function returns a single table for a single object that inherits from class \code{\link{ParameterSet}}. } \details{ -Generic to represent a parameter set in Markdown. - Generic to represent a parameter set in Markdown. } diff --git a/man/t-FieldSet-method.Rd b/man/t-FieldSet-method.Rd index b0a971fa..98654749 100644 --- a/man/t-FieldSet-method.Rd +++ b/man/t-FieldSet-method.Rd @@ -1,25 +1,18 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_core_parameter_set.R, -% R/class_core_parameter_set_r6.R +% Please edit documentation in R/class_core_parameter_set.R \name{t,FieldSet-method} \alias{t,FieldSet-method} \title{Field Set Transpose} \usage{ -\S4method{t}{FieldSet}(x) - \S4method{t}{FieldSet}(x) } \arguments{ \item{x}{A \code{FieldSet}.} } \description{ -Given a \code{FieldSet} \code{x}, t returns the transpose of \code{x}. - Given a \code{FieldSet} \code{x}, t returns the transpose of \code{x}. } \details{ -Implementation of the base R generic function \code{\link[base]{t}} - Implementation of the base R generic function \code{\link[base]{t}} } \keyword{internal} diff --git a/src/f_simulation_base_means.cpp b/src/f_simulation_base_means.cpp index c8973976..c6225dc8 100644 --- a/src/f_simulation_base_means.cpp +++ b/src/f_simulation_base_means.cpp @@ -14,8 +14,8 @@ * * Contact us for information about our services: info@rpact.com * - * File version: $Revision: 7408 $ - * Last changed: $Date: 2023-11-09 10:36:19 +0100 (Do, 09 Nov 2023) $ + * File version: $Revision: 7701 $ + * Last changed: $Date: 2024-03-07 11:44:08 +0100 (Do, 07 Mrz 2024) $ * Last changed by: $Author: pahlke $ * */ @@ -278,7 +278,7 @@ List getSimulationStepMeans( thetaStandardized = thetaStandardized * sqrt(allocationRatio) / (1.0 + allocationRatio); } else { thetaStandardized = thetaStandardized * sqrt(allocationRatio) / - sqrt((1.0 + allocationRatio) * (1.0 + thetaH0 * allocationRatio)); + sqrt((1.0 + allocationRatio) * (1.0 + pow(thetaH0, 2) * allocationRatio)); } } simulatedConditionalPower = getOneMinusPNorm(conditionalCriticalValue - @@ -297,10 +297,10 @@ List getSimulationStepMeans( double allocationRatio = allocationRatioPlanned[k - 1]; if (!meanRatio) { nz = (alternative - thetaH0) / stDev * sqrt(allocationRatio * stageSubjects) / - (1 + allocationRatio); + (1.0 + allocationRatio); } else { nz = (alternative - thetaH0) / stDev * sqrt(allocationRatio * stageSubjects) / - sqrt((1 + allocationRatio) * (1 + pow(thetaH0,2) * allocationRatio)); + sqrt((1.0 + allocationRatio) * (1.0 + pow(thetaH0, 2) * allocationRatio)); } if (normalApproximation) { testResult = (2.0 * directionUpper - 1.0) * R::rnorm(nz, 1.0); diff --git a/src/f_simulation_base_survival.cpp b/src/f_simulation_base_survival.cpp index 009de7d5..bcc05b76 100644 --- a/src/f_simulation_base_survival.cpp +++ b/src/f_simulation_base_survival.cpp @@ -14,9 +14,9 @@ * * Contact us for information about our services: info@rpact.com * - * File version: $Revision: 7450 $ - * Last changed: $Date: 2023-11-27 15:01:59 +0100 (Mon, 27 Nov 2023) $ - * Last changed by: $Author: pahlke $ + * File version: $Revision: 7679 $ + * Last changed: $Date: 2024-03-04 15:00:35 +0100 (Mo, 04 Mrz 2024) $ + * Last changed by: $Author: wassmer $ * */ @@ -277,7 +277,7 @@ double getEstimatedTheta( double allocationRatioPlanned) { if (!R_IsNA(thetaH1)) { - return directionUpper ? thetaH1 : 1 / thetaH1; + return directionUpper ? thetaH1 * thetaH0 : 1 / thetaH1 * thetaH0; } return exp((double) logRankOverStages[stage - 2] * diff --git a/tests/testthat/test-class_core_plot_settings.R b/tests/testthat/test-class_core_plot_settings.R index 4021660e..6779b2ef 100644 --- a/tests/testthat/test-class_core_plot_settings.R +++ b/tests/testthat/test-class_core_plot_settings.R @@ -23,11 +23,11 @@ test_plan_section("Testing the Class 'PlotSettings'") test_that("Test plot settings", { - expect_type(getPlotSettings(), "environment") - expect_error(PlotSubTitleItem$new()) expect_type(PlotSubTitleItems$new(), "environment") + expect_type(getPlotSettings(), "environment") + expect_type(PlotSettings$new(), "environment") }) diff --git a/tests/testthat/test-class_design_plan.R b/tests/testthat/test-class_design_plan.R index 915606ed..1e61b196 100644 --- a/tests/testthat/test-class_design_plan.R +++ b/tests/testthat/test-class_design_plan.R @@ -50,7 +50,7 @@ test_that("Sample size means result object clone function", { test_that("Sample size means result object utility functions", { sampleSizeResult <- getSampleSizeMeans(groups = 1, thetaH0 = 0.1, stDev = 2) - expect_true(isS4(sampleSizeResult$getPlotSettings())) + expect_true(R6::is.R6(sampleSizeResult$getPlotSettings())) expect_true(any(grepl("Technical developer summary", utils::capture.output(sampleSizeResult$show(showType = 2))))) expect_true(any(grepl("Legend", utils::capture.output(sampleSizeResult$show(showType = 3))))) }) @@ -87,7 +87,7 @@ test_that("Power means result object clone function", { test_that("Power means result object utility functions", { powerResult <- getPowerMeans(groups = 1, thetaH0 = -0.5, stDev = 2, alternative = -1.2, maxNumberOfSubjects = 50) - expect_true(isS4(powerResult$getPlotSettings())) + expect_true(R6::is.R6(powerResult$getPlotSettings())) expect_true(any(grepl("Technical developer summary", utils::capture.output(powerResult$show(showType = 2))))) expect_true(any(grepl("Legend", utils::capture.output(powerResult$show(showType = 3))))) }) @@ -115,7 +115,7 @@ test_that("Sample size rates result object clone function", { test_that("Sample size rates result object utility functions", { sampleSizeResult <- getSampleSizeRates(groups = 1, thetaH0 = 0.5, pi1 = 0.8, normalApproximation = FALSE) - expect_true(isS4(sampleSizeResult$getPlotSettings())) + expect_true(R6::is.R6(sampleSizeResult$getPlotSettings())) expect_true(any(grepl("Technical developer summary", utils::capture.output(sampleSizeResult$show(showType = 2))))) expect_true(any(grepl("Legend", utils::capture.output(sampleSizeResult$show(showType = 3))))) }) @@ -151,7 +151,7 @@ test_that("Power rates result object clone function", { test_that("Power rates result object utility functions", { powerResult <- getPowerRates(groups = 1, thetaH0 = 0.4, pi1 = c(0.2, 0.3, 0.4), directionUpper = FALSE, maxNumberOfSubjects = 40) - expect_true(isS4(powerResult$getPlotSettings())) + expect_true(R6::is.R6(powerResult$getPlotSettings())) expect_true(any(grepl("Technical developer summary", utils::capture.output(powerResult$show(showType = 2))))) expect_true(any(grepl("Legend", utils::capture.output(powerResult$show(showType = 3))))) }) @@ -195,7 +195,7 @@ test_that("Sample size survival result object clone function", { test_that("Sample size survival result object utility functions", { sampleSizeResult <- getSampleSizeSurvival(alpha = 0.01) - expect_true(isS4(sampleSizeResult$getPlotSettings())) + expect_true(R6::is.R6(sampleSizeResult$getPlotSettings())) expect_true(any(grepl("Technical developer summary", utils::capture.output(sampleSizeResult$show(showType = 2))))) expect_true(any(grepl("Legend", utils::capture.output(sampleSizeResult$show(showType = 3))))) }) @@ -249,7 +249,7 @@ test_that("Power survival result object clone function", { test_that("Power survival result object utility functions", { powerResult <- getPowerSurvival(maxNumberOfEvents = 40, maxNumberOfSubjects = 200) - expect_true(isS4(powerResult$getPlotSettings())) + expect_true(R6::is.R6(powerResult$getPlotSettings())) expect_true(any(grepl("Technical developer summary", utils::capture.output(powerResult$show(showType = 2))))) expect_true(any(grepl("Legend", utils::capture.output(powerResult$show(showType = 3))))) }) @@ -296,7 +296,7 @@ test_that("Sample size counts result object utility functions", { alpha = 0.01, beta = 0.05, lambda = 0.234, theta = 0.7, overdispersion = 0.71, accrualTime = 7, fixedExposureTime = 1 ) - expect_true(isS4(sampleSizeResult$getPlotSettings())) + expect_true(R6::is.R6(sampleSizeResult$getPlotSettings())) expect_true(any(grepl("Technical developer summary", utils::capture.output(sampleSizeResult$show(showType = 2))))) expect_true(any(grepl("Sample size calculation for a count data endpoint", utils::capture.output(sampleSizeResult$show(showType = 3))))) }) @@ -338,7 +338,7 @@ test_that("Power counts result object utility functions", { maxNumberOfSubjects = 400, directionUpper = FALSE, overdispersion = 1, fixedExposureTime = 1, lambda1 = seq(1.05, 1.55, 0.1), lambda2 = 1.4 ) - expect_true(isS4(powerResult$getPlotSettings())) + expect_true(R6::is.R6(powerResult$getPlotSettings())) expect_true(any(grepl("Technical developer summary", utils::capture.output(powerResult$show(showType = 2))))) expect_true(any(grepl("Power calculation for a count data endpoint", utils::capture.output(powerResult$show(showType = 3))))) }) diff --git a/tests/testthat/test-class_design_set.R b/tests/testthat/test-class_design_set.R index a76ea62a..0b8ee17f 100644 --- a/tests/testthat/test-class_design_set.R +++ b/tests/testthat/test-class_design_set.R @@ -98,5 +98,5 @@ test_that("Testing 'TrialDesignSet' functions, warnings, and errors", { expect_error(getDesignSet()$add(x = 1)) expect_error(getDesignSet()$assertHaveEqualSidedValues(), NA) expect_error(getDesignSet(designs = c(getDesignGroupSequential(sided = 1), getDesignGroupSequential(sided = 2)))$assertHaveEqualSidedValues()) - expect_true(isS4(designSet$getPlotSettings())) + expect_true(R6::is.R6(designSet$getPlotSettings())) }) diff --git a/tests/testthat/test-class_summary.R b/tests/testthat/test-class_summary.R index 73912fc9..a914e871 100644 --- a/tests/testthat/test-class_summary.R +++ b/tests/testthat/test-class_summary.R @@ -1,584 +1,585 @@ -## | -## | *Unit tests* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | RPACT package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File name: test-class_summary.R -## | Creation date: 08 November 2023, 08:49:48 -## | File version: $Revision$ -## | Last changed: $Date$ -## | Last changed by: $Author$ -## | - -test_plan_section("Testing Class 'SummaryFactory'") - - -test_that("Testing 'summary.ParameterSet': no errors occur", { - .skipTestIfDisabled() - - # @refFS[Function]{fs:outputOfGenericFunctions} - invisible(capture.output(expect_error(summary(getDesignGroupSequential( - beta = 0.05, typeOfDesign = "asKD", gammaA = 1, typeBetaSpending = "bsOF" - )), NA))) - invisible(capture.output(expect_error(summary(getDesignGroupSequential(kMax = 1)), NA))) - invisible(capture.output(expect_error(summary(getDesignGroupSequential(kMax = 4, sided = 2)), NA))) - invisible(capture.output(expect_error(summary(getDesignGroupSequential(kMax = 4, sided = 2), digits = 0), NA))) - invisible(capture.output(expect_error(summary(getDesignGroupSequential(kMax = 1, sided = 2)), NA))) - invisible(capture.output(expect_error(summary(getDesignGroupSequential(futilityBounds = c(-6, 0))), NA))) - invisible(capture.output(expect_error(summary(getDesignGroupSequential(futilityBounds = c(-6, 0)), digits = 5), NA))) - - invisible(capture.output(expect_error(summary(getDataset( - n = c(13, 25), - means = c(242, 222), - stDevs = c(244, 221) - )), NA))) - - invisible(capture.output(expect_error(summary(getDataset( - n = c(13), - means = c(242), - stDevs = c(244) - )), NA))) - - invisible(capture.output(expect_error(summary(getDataset( - n1 = c(13, 25), - n2 = c(15, NA), - n3 = c(14, 27), - n4 = c(12, 29), - means1 = c(242, 222), - means2 = c(188, NA), - means3 = c(267, 277), - means4 = c(92, 122), - stDevs1 = c(244, 221), - stDevs2 = c(212, NA), - stDevs3 = c(256, 232), - stDevs4 = c(215, 227) - )), NA))) - - invisible(capture.output(expect_error(summary(getDataset( - n1 = c(11, 13, 12, 13), - n2 = c(8, 10, 9, 11), - n3 = c(7, 10, 8, 9), - events1 = c(10, 10, 12, 12), - events2 = c(3, 5, 5, 6), - events3 = c(2, 4, 3, 5) - )), NA))) - - invisible(capture.output(expect_error(summary(getDataset( - events1 = c(25, 32), - events2 = c(18, NA), - events3 = c(22, 36), - logRanks1 = c(2.2, 1.8), - logRanks2 = c(1.99, NA), - logRanks3 = c(2.32, 2.11) - )), NA))) - - invisible(capture.output(expect_error(summary(getDesignInverseNormal(kMax = 1)), NA))) - invisible(capture.output(expect_error(summary(getDesignInverseNormal(futilityBounds = c(0, 1))), NA))) - invisible(capture.output(expect_error(summary(getDesignInverseNormal(kMax = 1)), NA))) - invisible(capture.output(expect_error(summary(getDesignInverseNormal(kMax = 4, sided = 2)), NA))) - invisible(capture.output(expect_error(summary(getDesignInverseNormal(kMax = 4, sided = 2), digits = 0), NA))) - invisible(capture.output(expect_error(summary(getDesignInverseNormal(kMax = 1, sided = 2)), NA))) - - invisible(capture.output(expect_error(summary(getDesignFisher()), NA))) - invisible(capture.output(expect_error(summary(getDesignFisher(alpha0Vec = c(0.1, 0.2))), NA))) - invisible(capture.output(expect_error(summary(getDesignFisher(kMax = 1)), NA))) - invisible(capture.output(expect_error(summary(getDesignFisher(kMax = 4), digits = 5), NA))) - invisible(capture.output(expect_error(summary(getDesignFisher(kMax = 4), digits = 0), NA))) - invisible(capture.output(expect_error(summary(getDesignFisher(kMax = 1)), NA))) - - ## test design plans - means - - invisible(capture.output(expect_error(summary(getSampleSizeMeans(sided = 2, alternative = -0.5)), NA))) - invisible(capture.output(expect_warning(summary(getSampleSizeMeans(sided = 2), alternative = -0.5)))) # warning expected - invisible(capture.output(expect_error(summary(getPowerMeans( - sided = 1, alternative = c(-0.5, -0.3), - maxNumberOfSubjects = 100, directionUpper = FALSE - )), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeMeans( - thetaH0 = 0, - alternative = 0.5, sided = 1, stDev = 2.5 - )), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeMeans( - thetaH0 = 0, - alternative = 0.5, sided = 1, stDev = 1, groups = 1 - )), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeMeans( - thetaH0 = 0, - sided = 2, stDev = 1, groups = 1 - )), NA))) - - invisible(capture.output(expect_error(summary(getSampleSizeMeans( - thetaH0 = 0, - alternative = 1.2, sided = 2, stDev = 5 - )), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeMeans( - thetaH0 = 0, - alternative = 1.2, sided = 2, stDev = 5, allocationRatioPlanned = 0 - )), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeMeans( - thetaH0 = 0, - alternative = 1.2, sided = 2, stDev = 5, groups = 1 - )), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeMeans( - getDesignGroupSequential(futilityBounds = c(1, 2)) - )), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeMeans( - getDesignGroupSequential(futilityBounds = c(1, 2)) - ), digits = 0), NA))) - invisible(capture.output(expect_error(summary(getPowerMeans( - getDesignGroupSequential(futilityBounds = c(1, 2)), - maxNumberOfSubjects = 100, alternative = 1 - )), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeMeans( - getDesignGroupSequential(kMax = 4, sided = 2) - )), NA))) - invisible(capture.output(expect_error(summary(getPowerMeans( - getDesignGroupSequential(kMax = 4, sided = 2), - maxNumberOfSubjects = 100 - )), NA))) - invisible(capture.output(expect_error(summary(getPowerMeans( - getDesignGroupSequential(kMax = 1, sided = 2), - maxNumberOfSubjects = 100 - )), NA))) - - invisible(capture.output(expect_error(summary(getSampleSizeMeans( - getDesignGroupSequential(futilityBounds = c(1, 2)) - )), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeMeans( - getDesignGroupSequential(futilityBounds = c(1, 2)) - ), digits = 4), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeMeans( - getDesignGroupSequential(futilityBounds = c(1, 2)) - ), digits = 3), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeMeans( - getDesignGroupSequential(futilityBounds = c(1, 2)) - ), digits = 2), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeMeans( - getDesignGroupSequential(futilityBounds = c(1, 2)) - ), digits = -1), NA))) - - ## test design plans - rates - - invisible(capture.output(expect_error(summary(getSampleSizeRates(pi2 = 0.3)), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeRates(groups = 1, thetaH0 = 0.3)), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeRates(groups = 1, thetaH0 = 0.45)), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeRates( - groups = 2, thetaH0 = 0.45, allocationRatioPlanned = 0 - )), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeRates( - getDesignGroupSequential(futilityBounds = c(1, 2)) - )), NA))) - invisible(capture.output(expect_error(summary(getPowerRates( - getDesignGroupSequential(futilityBounds = c(1, 2)), - maxNumberOfSubjects = 100 - )), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeRates( - getDesignGroupSequential(kMax = 4, sided = 2) - )), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeRates( - getDesignGroupSequential(kMax = 4, sided = 2), - groups = 1, thetaH0 = 0.3 - )), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeRates( - getDesignGroupSequential(kMax = 1, sided = 2), - groups = 1, thetaH0 = 0.2, pi1 = c(0.4, 0.5) - )), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeRates( - getDesignGroupSequential(kMax = 1, sided = 2), - groups = 1, thetaH0 = 0.2, pi1 = 0.4 - )), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeRates( - getDesignGroupSequential(kMax = 1, sided = 2), - groups = 2, thetaH0 = 0, pi1 = 0.25 - )), NA))) - invisible(capture.output(expect_error(summary(getPowerRates( - getDesignGroupSequential(kMax = 4, sided = 2), - maxNumberOfSubjects = 100 - )), NA))) - - ## test design plans - survival - - invisible(capture.output(expect_error(summary(getSampleSizeSurvival()), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeSurvival(lambda2 = 0.3, hazardRatio = 1.2)), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeSurvival(lambda2 = 0.3, hazardRatio = c(1.2, 2))), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeSurvival(pi2 = 0.3, hazardRatio = 1.2)), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeSurvival(pi1 = 0.1, pi2 = 0.3)), NA))) - - invisible(capture.output(expect_error(summary(getSampleSizeSurvival(lambda2 = 0.03, lambda1 = c(0.040))), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeSurvival(piecewiseSurvivalTime = list( - "0 - <6" = 0.025, - "6 - <9" = 0.04, - "9 - <15" = 0.015, - "15 - <21" = 0.01, - ">=21" = 0.007 - ), hazardRatio = 1.2)), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeSurvival( - getDesignGroupSequential(futilityBounds = c(1, 2)) - )), NA))) - invisible(capture.output(expect_error(summary(getPowerSurvival( - getDesignGroupSequential(futilityBounds = c(1, 2)), - maxNumberOfSubjects = 100, maxNumberOfEvents = 60 - )), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeSurvival( - getDesignGroupSequential(kMax = 4, sided = 2) - )), NA))) - invisible(capture.output(expect_error(summary(getPowerSurvival( - getDesignGroupSequential(kMax = 4, sided = 2), - maxNumberOfSubjects = 100, maxNumberOfEvents = 60 - )), NA))) - - invisible(capture.output(expect_error(summary(getSampleSizeSurvival(sided = 2, lambda2 = log(2) / 6, lambda1 = log(2) / 8)), NA))) - - invisible(capture.output(expect_error(summary(getPowerSurvival(sided = 2, maxNumberOfSubjects = 200, maxNumberOfEvents = 40, lambda2 = log(2) / 6, lambda1 = log(2) / 8)), NA))) - - invisible(capture.output(expect_error(summary(getSampleSizeSurvival( - getDesignGroupSequential(sided = 2), - lambda2 = log(2) / 6, hazardRatio = c(0.55), - accrualTime = c(0, 10), accrualIntensity = 20 - )), NA))) - - invisible(capture.output(expect_error(summary(getPowerSurvival( - getDesignGroupSequential(kMax = 2), - maxNumberOfEvents = 200, maxNumberOfSubjects = 400, - lambda2 = log(2) / 60, lambda1 = log(2) / 50, - dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, - accrualTime = 0, accrualIntensity = 30 - )), NA))) - - invisible(capture.output(expect_error(summary(getPowerSurvival( - getDesignGroupSequential(kMax = 3), - maxNumberOfEvents = 200, maxNumberOfSubjects = 400, - lambda2 = log(2) / 60, lambda1 = c(log(2) / 50, log(2) / 60), - dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, - accrualTime = 0, accrualIntensity = 30 - )), NA))) - - invisible(capture.output(expect_error(summary(getPowerSurvival( - getDesignGroupSequential(kMax = 3), - maxNumberOfEvents = 200, maxNumberOfSubjects = 400, - lambda2 = log(2) / 60, hazardRatio = c(0.7, 0.8), directionUpper = FALSE, - dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, - accrualTime = 0, accrualIntensity = 30 - )), NA))) - - design1 <- getDesignGroupSequential( - sided = 2, alpha = 0.05, beta = 0.2, - informationRates = c(0.6, 1), - typeOfDesign = "asOF", twoSidedPower = FALSE - ) - - invisible(capture.output(expect_error(summary(getSampleSizeSurvival( - design1, - lambda2 = log(2) / 60, hazardRatio = 0.74, - dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, - accrualTime = 0, accrualIntensity = 30, - followUpTime = 12 - )), NA))) - - invisible(capture.output(expect_error(summary(getSampleSizeSurvival( - design1, - lambda2 = log(2) / 60, lambda1 = log(2) / 50, - dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, - accrualTime = 0, accrualIntensity = 30, - followUpTime = 12 - )), NA))) - - invisible(capture.output(expect_error(summary(getSampleSizeSurvival( - getDesignGroupSequential(kMax = 4, sided = 2) - )), NA))) - - ## simulations - - design2 <- getDesignInverseNormal( - alpha = 0.05, kMax = 4, futilityBounds = c(0, 0, 0), - sided = 1, typeOfDesign = "WT", deltaWT = 0.1 - ) - - invisible(capture.output(expect_error(summary(getSimulationSurvival(design2, - lambda2 = log(2) / 60, lambda1 = c(log(2) / 80), - maxNumberOfSubjects = 1000, plannedEvents = c(50, 100, 150, 200), seed = 12345, directionUpper = FALSE - )), NA))) - - invisible(capture.output(expect_error(summary(getSimulationSurvival(design2, - lambda2 = log(2) / 60, hazardRatio = c(1.2, 1.4), - maxNumberOfSubjects = 1000, plannedEvents = c(50, 100, 150, 200), seed = 12345 - )), NA))) - - design3 <- getDesignGroupSequential(typeOfDesign = "P", futilityBounds = c(1, 1)) - - invisible(capture.output(expect_error(summary(getSampleSizeMeans(design3)), NA))) - - invisible(capture.output(expect_error(summary(getSimulationMeans(design3, stDev = 4, plannedSubjects = (1:3) * 200, alternative = c(1, 2))), NA))) - - invisible(capture.output(expect_error(summary(getSimulationRates(design3, - plannedSubjects = (1:3) * 200, pi1 = c(0.3, 0.4), maxNumberOfIterations = 1000, - minNumberOfSubjectsPerStage = c(NA, 40, 40), maxNumberOfSubjectsPerStage = c(NA, 40, 400), conditionalPower = 0.8 - )), NA))) - - invisible(capture.output(expect_error(summary(getSimulationMeans( - getDesignGroupSequential(kMax = 1), - stDev = 4, plannedSubjects = 200, alternative = c(1) - )), NA))) - -}) - -test_that("Testing 'summary.ParameterSet': output will be produced", { - - .skipTestIfDisabled() - - # @refFS[Function]{fs:outputOfGenericFunctions} - expect_output(summary(getDesignGroupSequential(beta = 0.05, typeOfDesign = "asKD", gammaA = 1, typeBetaSpending = "bsOF"))$show()) - expect_output(summary(getDesignGroupSequential(kMax = 1))$show()) - expect_output(summary(getDesignGroupSequential(kMax = 4, sided = 2))$show()) - expect_output(summary(getDesignGroupSequential(kMax = 4, sided = 2), digits = 0)$show()) - expect_output(summary(getDesignGroupSequential(kMax = 1, sided = 2))$show()) - expect_output(summary(getDesignGroupSequential(futilityBounds = c(-6, 0)))$show()) - expect_output(summary(getDesignGroupSequential(futilityBounds = c(-6, 0)), digits = 5)$show()) - - expect_output(summary(getDataset( - n = c(13, 25), - means = c(242, 222), - stDevs = c(244, 221) - ))$show()) - - expect_output(summary(getDataset( - n = c(13), - means = c(242), - stDevs = c(244) - ))$show()) - - expect_output(summary(getDataset( - n1 = c(13, 25), - n2 = c(15, NA), - n3 = c(14, 27), - n4 = c(12, 29), - means1 = c(242, 222), - means2 = c(188, NA), - means3 = c(267, 277), - means4 = c(92, 122), - stDevs1 = c(244, 221), - stDevs2 = c(212, NA), - stDevs3 = c(256, 232), - stDevs4 = c(215, 227) - ))$show()) - - expect_output(summary(getDataset( - n1 = c(11, 13, 12, 13), - n2 = c(8, 10, 9, 11), - n3 = c(7, 10, 8, 9), - events1 = c(10, 10, 12, 12), - events2 = c(3, 5, 5, 6), - events3 = c(2, 4, 3, 5) - ))$show()) - - expect_output(summary(getDataset( - events1 = c(25, 32), - events2 = c(18, NA), - events3 = c(22, 36), - logRanks1 = c(2.2, 1.8), - logRanks2 = c(1.99, NA), - logRanks3 = c(2.32, 2.11) - ))$show()) - - expect_output(summary(getDesignInverseNormal(kMax = 1))$show()) - expect_output(summary(getDesignInverseNormal(futilityBounds = c(0, 1)))$show()) - expect_output(summary(getDesignInverseNormal(kMax = 1))$show()) - expect_output(summary(getDesignInverseNormal(kMax = 4, sided = 2))$show()) - expect_output(summary(getDesignInverseNormal(kMax = 4, sided = 2), digits = 0)$show()) - expect_output(summary(getDesignInverseNormal(kMax = 1, sided = 2))$show()) - - expect_output(summary(getDesignFisher())$show()) - expect_output(summary(getDesignFisher(alpha0Vec = c(0.1, 0.2)))$show()) - expect_output(summary(getDesignFisher(kMax = 1))$show()) - expect_output(summary(getDesignFisher(kMax = 4), digits = 5)$show()) - expect_output(summary(getDesignFisher(kMax = 4), digits = 0)$show()) - expect_output(summary(getDesignFisher(kMax = 1))$show()) - - ## test design plans - means - - expect_output(summary(getSampleSizeMeans(sided = 2, alternative = -0.5))$show()) - expect_output(summary(getPowerMeans(sided = 1, alternative = c(-0.5, -0.3), maxNumberOfSubjects = 100, directionUpper = FALSE))$show()) - expect_output(summary(getSampleSizeMeans(thetaH0 = 0, alternative = 0.5, sided = 1, stDev = 2.5))$show()) - expect_output(summary(getSampleSizeMeans(thetaH0 = 0, alternative = 0.5, sided = 1, stDev = 1, groups = 1))$show()) - expect_output(summary(getSampleSizeMeans(thetaH0 = 0, sided = 2, stDev = 1, groups = 1))$show()) - - expect_output(summary(getSampleSizeMeans(thetaH0 = 0, alternative = 1.2, sided = 2, stDev = 5))$show()) - expect_output(summary(getSampleSizeMeans(thetaH0 = 0, alternative = 1.2, sided = 2, stDev = 5, allocationRatioPlanned = 0))$show()) - expect_output(summary(getSampleSizeMeans(thetaH0 = 0, alternative = 1.2, sided = 2, stDev = 5, groups = 1))$show()) - expect_output(summary(getSampleSizeMeans( - getDesignGroupSequential(futilityBounds = c(1, 2)) - ))$show()) - expect_output(summary(getSampleSizeMeans( - getDesignGroupSequential(futilityBounds = c(1, 2)) - ), digits = 0)$show()) - expect_output(summary(getPowerMeans( - getDesignGroupSequential(futilityBounds = c(1, 2)), - maxNumberOfSubjects = 100, alternative = 1 - ))$show()) - expect_output(summary(getSampleSizeMeans( - getDesignGroupSequential(kMax = 4, sided = 2) - ))$show()) - expect_output(summary(getPowerMeans( - getDesignGroupSequential(kMax = 4, sided = 2), - maxNumberOfSubjects = 100 - ))$show()) - expect_output(summary(getPowerMeans( - getDesignGroupSequential(kMax = 1, sided = 2), - maxNumberOfSubjects = 100 - ))$show()) - - expect_output(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2))))$show()) - expect_output(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2))), digits = 4)$show()) - expect_output(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2))), digits = 3)$show()) - expect_output(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2))), digits = 2)$show()) - expect_output(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2))), digits = -1)$show()) - - ## test design plans - rates - - expect_output(summary(getSampleSizeRates(pi2 = 0.3))$show()) - expect_output(summary(getSampleSizeRates(groups = 1, thetaH0 = 0.3))$show()) - expect_output(summary(getSampleSizeRates(groups = 1, thetaH0 = 0.45))$show()) - expect_output(summary(getSampleSizeRates(groups = 2, thetaH0 = 0.45, allocationRatioPlanned = 0))$show()) - expect_output(summary(getSampleSizeRates(getDesignGroupSequential(futilityBounds = c(1, 2))))$show()) - expect_output(summary(getPowerRates(getDesignGroupSequential(futilityBounds = c(1, 2)), maxNumberOfSubjects = 100))$show()) - expect_output(summary(getSampleSizeRates(getDesignGroupSequential(kMax = 4, sided = 2)))$show()) - expect_output(summary(getSampleSizeRates(getDesignGroupSequential(kMax = 4, sided = 2), groups = 1, thetaH0 = 0.3))$show()) - expect_output(summary(getSampleSizeRates(getDesignGroupSequential(kMax = 1, sided = 2), - groups = 1, thetaH0 = 0.2, pi1 = c(0.4, 0.5) - ))$show()) - expect_output(summary(getSampleSizeRates(getDesignGroupSequential( - kMax = 1, sided = 2 - ), groups = 1, thetaH0 = 0.2, pi1 = 0.4))$show()) - expect_output(summary(getSampleSizeRates(getDesignGroupSequential( - kMax = 1, sided = 2 - ), groups = 2, thetaH0 = 0, pi1 = 0.25))$show()) - expect_output(summary(getPowerRates(getDesignGroupSequential(kMax = 4, sided = 2), maxNumberOfSubjects = 100))$show()) - - ## test design plans - survival - - expect_output(summary(getSampleSizeSurvival())$show()) - expect_output(summary(getSampleSizeSurvival(lambda2 = 0.3, hazardRatio = 1.2))$show()) - expect_output(summary(getSampleSizeSurvival(lambda2 = 0.3, hazardRatio = c(1.2, 2)))$show()) - expect_output(summary(getSampleSizeSurvival(pi2 = 0.3, hazardRatio = 1.2))$show()) - expect_output(summary(getSampleSizeSurvival(pi1 = 0.1, pi2 = 0.3))$show()) - - expect_output(summary(getSampleSizeSurvival(lambda2 = 0.03, lambda1 = c(0.040)))$show()) - expect_output(summary(getSampleSizeSurvival(piecewiseSurvivalTime = list( - "0 - <6" = 0.025, - "6 - <9" = 0.04, - "9 - <15" = 0.015, - "15 - <21" = 0.01, - ">=21" = 0.007 - ), hazardRatio = 1.2))$show()) - expect_output(summary(getSampleSizeSurvival(getDesignGroupSequential(futilityBounds = c(1, 2))))$show()) - expect_output(summary(getPowerSurvival(getDesignGroupSequential(futilityBounds = c(1, 2)), - maxNumberOfSubjects = 100, maxNumberOfEvents = 60 - ))$show()) - expect_output(summary(getSampleSizeSurvival(getDesignGroupSequential(kMax = 4, sided = 2)))$show()) - expect_output(summary(getPowerSurvival(getDesignGroupSequential(kMax = 4, sided = 2), - maxNumberOfSubjects = 100, maxNumberOfEvents = 60 - ))$show()) - - expect_output(summary(getSampleSizeSurvival(sided = 2, lambda2 = log(2) / 6, lambda1 = log(2) / 8))$show()) - - expect_output(summary(getPowerSurvival( - sided = 2, maxNumberOfSubjects = 200, - maxNumberOfEvents = 40, lambda2 = log(2) / 6, lambda1 = log(2) / 8 - ))$show()) - - expect_warning(expect_output(summary(getSampleSizeSurvival(getDesignGroupSequential(sided = 2), - lambda2 = log(2) / 6, hazardRatio = c(0.55), - accrualTime = c(0, 10), accrualIntensity = 60 - ))$show()), - "Accrual duration longer than maximal study duration (time to maximal number of events); followUpTime = -2.959", - fixed = TRUE - ) - - expect_output(summary(getPowerSurvival(getDesignGroupSequential(kMax = 2), - maxNumberOfEvents = 150, maxNumberOfSubjects = 400, - lambda2 = log(2) / 60, lambda1 = log(2) / 50, - dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, - accrualTime = 0, accrualIntensity = 30 - ))$show()) - - expect_output(summary(getPowerSurvival(getDesignGroupSequential(kMax = 3), - maxNumberOfEvents = 200, maxNumberOfSubjects = 400, - lambda2 = log(2) / 60, lambda1 = c(log(2) / 50, log(2) / 60), - dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, - accrualTime = 0, accrualIntensity = 30 - ))$show()) - - expect_output(summary(getPowerSurvival(getDesignGroupSequential(kMax = 3), - maxNumberOfEvents = 200, maxNumberOfSubjects = 400, - lambda2 = log(2) / 60, hazardRatio = c(0.7, 0.8), directionUpper = FALSE, - dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, - accrualTime = 0, accrualIntensity = 30 - ))$show()) - - design1 <- getDesignGroupSequential( - sided = 2, alpha = 0.05, beta = 0.2, - informationRates = c(0.6, 1), - typeOfDesign = "asOF", twoSidedPower = FALSE - ) - - expect_output(summary(getSampleSizeSurvival( - design1, - lambda2 = log(2) / 60, hazardRatio = 0.74, - dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, - accrualTime = 0, accrualIntensity = 30, - followUpTime = 12 - ))$show()) - - expect_output(summary(getSampleSizeSurvival( - design1, - lambda2 = log(2) / 60, lambda1 = log(2) / 50, - dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, - accrualTime = 0, accrualIntensity = 30, - followUpTime = 12 - ))$show()) - - expect_output(summary(getSampleSizeSurvival(getDesignGroupSequential(kMax = 4, sided = 2)))$show()) - - ## simulations - - design2 <- getDesignInverseNormal( - alpha = 0.05, kMax = 4, futilityBounds = c(0, 0, 0), - sided = 1, typeOfDesign = "WT", deltaWT = 0.1 - ) - - expect_output(summary(getSimulationSurvival(design2, - lambda2 = log(2) / 60, lambda1 = c(log(2) / 80), - maxNumberOfSubjects = 1000, plannedEvents = c(50, 100, 150, 200), seed = 12345, directionUpper = FALSE - ))$show()) - - expect_output(summary(getSimulationSurvival(design2, - lambda2 = log(2) / 60, hazardRatio = c(1.2, 1.4), - maxNumberOfSubjects = 1000, plannedEvents = c(50, 100, 150, 200), seed = 12345 - ))$show()) - - design3 <- getDesignGroupSequential(typeOfDesign = "P", futilityBounds = c(1, 1)) - - expect_output(summary(getSampleSizeMeans(design3))$show()) - - expect_output(summary(getSimulationMeans(design3, stDev = 4, plannedSubjects = (1:3) * 200, alternative = c(1, 2)))$show()) - - expect_output(summary(getSimulationRates(design3, - plannedSubjects = (1:3) * 200, pi1 = c(0.3, 0.4), maxNumberOfIterations = 1000, - minNumberOfSubjectsPerStage = c(NA, 40, 40), maxNumberOfSubjectsPerStage = c(NA, 40, 400), conditionalPower = 0.8 - ))$show()) - - expect_output(summary(getSimulationMeans(getDesignGroupSequential(kMax = 1), - stDev = 4, plannedSubjects = 200, alternative = 1 - ))$show()) -}) - +## | +## | *Unit tests* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | RPACT package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File name: test-class_summary.R +## | Creation date: 08 November 2023, 08:49:48 +## | File version: $Revision$ +## | Last changed: $Date$ +## | Last changed by: $Author$ +## | + +test_plan_section("Testing Class 'SummaryFactory'") + + +test_that("Testing 'summary.ParameterSet': no errors occur", { + .skipTestIfDisabled() + + # @refFS[Function]{fs:outputOfGenericFunctions} + invisible(capture.output(expect_error(summary(getDesignGroupSequential( + beta = 0.05, typeOfDesign = "asKD", gammaA = 1, typeBetaSpending = "bsOF" + )), NA))) + invisible(capture.output(expect_error(summary(getDesignGroupSequential(kMax = 1)), NA))) + invisible(capture.output(expect_error(summary(getDesignGroupSequential(kMax = 4, sided = 2)), NA))) + invisible(capture.output(expect_error(summary(getDesignGroupSequential(kMax = 4, sided = 2), digits = 0), NA))) + invisible(capture.output(expect_error(summary(getDesignGroupSequential(kMax = 1, sided = 2)), NA))) + invisible(capture.output(expect_error(summary(getDesignGroupSequential(futilityBounds = c(-6, 0))), NA))) + invisible(capture.output(expect_error(summary(getDesignGroupSequential(futilityBounds = c(-6, 0)), digits = 5), NA))) + + invisible(capture.output(expect_error(summary(getDataset( + n = c(13, 25), + means = c(242, 222), + stDevs = c(244, 221) + )), NA))) + + invisible(capture.output(expect_error(summary(getDataset( + n = c(13), + means = c(242), + stDevs = c(244) + )), NA))) + + invisible(capture.output(expect_error(summary(getDataset( + n1 = c(13, 25), + n2 = c(15, NA), + n3 = c(14, 27), + n4 = c(12, 29), + means1 = c(242, 222), + means2 = c(188, NA), + means3 = c(267, 277), + means4 = c(92, 122), + stDevs1 = c(244, 221), + stDevs2 = c(212, NA), + stDevs3 = c(256, 232), + stDevs4 = c(215, 227) + )), NA))) + + invisible(capture.output(expect_error(summary(getDataset( + n1 = c(11, 13, 12, 13), + n2 = c(8, 10, 9, 11), + n3 = c(7, 10, 8, 9), + events1 = c(10, 10, 12, 12), + events2 = c(3, 5, 5, 6), + events3 = c(2, 4, 3, 5) + )), NA))) + + invisible(capture.output(expect_error(summary(getDataset( + events1 = c(25, 32), + events2 = c(18, NA), + events3 = c(22, 36), + logRanks1 = c(2.2, 1.8), + logRanks2 = c(1.99, NA), + logRanks3 = c(2.32, 2.11) + )), NA))) + + invisible(capture.output(expect_error(summary(getDesignInverseNormal(kMax = 1)), NA))) + invisible(capture.output(expect_error(summary(getDesignInverseNormal(futilityBounds = c(0, 1))), NA))) + invisible(capture.output(expect_error(summary(getDesignInverseNormal(kMax = 1)), NA))) + invisible(capture.output(expect_error(summary(getDesignInverseNormal(kMax = 4, sided = 2)), NA))) + invisible(capture.output(expect_error(summary(getDesignInverseNormal(kMax = 4, sided = 2), digits = 0), NA))) + invisible(capture.output(expect_error(summary(getDesignInverseNormal(kMax = 1, sided = 2)), NA))) + + invisible(capture.output(expect_error(summary(getDesignFisher()), NA))) + invisible(capture.output(expect_error(summary(getDesignFisher(alpha0Vec = c(0.1, 0.2))), NA))) + invisible(capture.output(expect_error(summary(getDesignFisher(kMax = 1)), NA))) + invisible(capture.output(expect_error(summary(getDesignFisher(kMax = 4), digits = 5), NA))) + invisible(capture.output(expect_error(summary(getDesignFisher(kMax = 4), digits = 0), NA))) + invisible(capture.output(expect_error(summary(getDesignFisher(kMax = 1)), NA))) + + ## test design plans - means + + invisible(capture.output(expect_error(summary(getSampleSizeMeans(sided = 2, alternative = -0.5)), NA))) + invisible(capture.output(expect_warning(summary(getSampleSizeMeans(sided = 2), alternative = -0.5)))) # warning expected + invisible(capture.output(expect_error(summary(getPowerMeans( + sided = 1, alternative = c(-0.5, -0.3), + maxNumberOfSubjects = 100, directionUpper = FALSE + )), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeMeans( + thetaH0 = 0, + alternative = 0.5, sided = 1, stDev = 2.5 + )), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeMeans( + thetaH0 = 0, + alternative = 0.5, sided = 1, stDev = 1, groups = 1 + )), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeMeans( + thetaH0 = 0, + sided = 2, stDev = 1, groups = 1 + )), NA))) + + invisible(capture.output(expect_error(summary(getSampleSizeMeans( + thetaH0 = 0, + alternative = 1.2, sided = 2, stDev = 5 + )), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeMeans( + thetaH0 = 0, + alternative = 1.2, sided = 2, stDev = 5, allocationRatioPlanned = 0 + )), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeMeans( + thetaH0 = 0, + alternative = 1.2, sided = 2, stDev = 5, groups = 1 + )), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeMeans( + getDesignGroupSequential(futilityBounds = c(1, 2)) + )), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeMeans( + getDesignGroupSequential(futilityBounds = c(1, 2)) + ), digits = 0), NA))) + invisible(capture.output(expect_error(summary(getPowerMeans( + getDesignGroupSequential(futilityBounds = c(1, 2)), + maxNumberOfSubjects = 100, alternative = 1 + )), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeMeans( + getDesignGroupSequential(kMax = 4, sided = 2) + )), NA))) + invisible(capture.output(expect_error(summary(getPowerMeans( + getDesignGroupSequential(kMax = 4, sided = 2), + maxNumberOfSubjects = 100 + )), NA))) + invisible(capture.output(expect_error(summary(getPowerMeans( + getDesignGroupSequential(kMax = 1, sided = 2), + maxNumberOfSubjects = 100 + )), NA))) + + invisible(capture.output(expect_error(summary(getSampleSizeMeans( + getDesignGroupSequential(futilityBounds = c(1, 2)) + )), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeMeans( + getDesignGroupSequential(futilityBounds = c(1, 2)) + ), digits = 4), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeMeans( + getDesignGroupSequential(futilityBounds = c(1, 2)) + ), digits = 3), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeMeans( + getDesignGroupSequential(futilityBounds = c(1, 2)) + ), digits = 2), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeMeans( + getDesignGroupSequential(futilityBounds = c(1, 2)) + ), digits = -1), NA))) + + ## test design plans - rates + + invisible(capture.output(expect_error(summary(getSampleSizeRates(pi2 = 0.3)), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeRates(groups = 1, thetaH0 = 0.3)), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeRates(groups = 1, thetaH0 = 0.45)), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeRates( + groups = 2, thetaH0 = 0.45, allocationRatioPlanned = 0 + )), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeRates( + getDesignGroupSequential(futilityBounds = c(1, 2)) + )), NA))) + invisible(capture.output(expect_error(summary(getPowerRates( + getDesignGroupSequential(futilityBounds = c(1, 2)), + maxNumberOfSubjects = 100 + )), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeRates( + getDesignGroupSequential(kMax = 4, sided = 2) + )), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeRates( + getDesignGroupSequential(kMax = 4, sided = 2), + groups = 1, thetaH0 = 0.3 + )), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeRates( + getDesignGroupSequential(kMax = 1, sided = 2), + groups = 1, thetaH0 = 0.2, pi1 = c(0.4, 0.5) + )), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeRates( + getDesignGroupSequential(kMax = 1, sided = 2), + groups = 1, thetaH0 = 0.2, pi1 = 0.4 + )), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeRates( + getDesignGroupSequential(kMax = 1, sided = 2), + groups = 2, thetaH0 = 0, pi1 = 0.25 + )), NA))) + invisible(capture.output(expect_error(summary(getPowerRates( + getDesignGroupSequential(kMax = 4, sided = 2), + maxNumberOfSubjects = 100 + )), NA))) + + ## test design plans - survival + + invisible(capture.output(expect_error(summary(getSampleSizeSurvival()), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeSurvival(lambda2 = 0.3, hazardRatio = 1.2)), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeSurvival(lambda2 = 0.3, hazardRatio = c(1.2, 2))), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeSurvival(pi2 = 0.3, hazardRatio = 1.2)), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeSurvival(pi1 = 0.1, pi2 = 0.3)), NA))) + + invisible(capture.output(expect_error(summary(getSampleSizeSurvival(lambda2 = 0.03, lambda1 = c(0.040))), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeSurvival(piecewiseSurvivalTime = list( + "0 - <6" = 0.025, + "6 - <9" = 0.04, + "9 - <15" = 0.015, + "15 - <21" = 0.01, + ">=21" = 0.007 + ), hazardRatio = 1.2)), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeSurvival( + getDesignGroupSequential(futilityBounds = c(1, 2)) + )), NA))) + invisible(capture.output(expect_error(summary(getPowerSurvival( + getDesignGroupSequential(futilityBounds = c(1, 2)), + maxNumberOfSubjects = 100, maxNumberOfEvents = 60 + )), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeSurvival( + getDesignGroupSequential(kMax = 4, sided = 2) + )), NA))) + invisible(capture.output(expect_error(summary(getPowerSurvival( + getDesignGroupSequential(kMax = 4, sided = 2), + maxNumberOfSubjects = 100, maxNumberOfEvents = 60 + )), NA))) + + invisible(capture.output(expect_error(summary(getSampleSizeSurvival(sided = 2, lambda2 = log(2) / 6, lambda1 = log(2) / 8)), NA))) + + invisible(capture.output(expect_error(summary(getPowerSurvival(sided = 2, maxNumberOfSubjects = 200, maxNumberOfEvents = 40, lambda2 = log(2) / 6, lambda1 = log(2) / 8)), NA))) + + invisible(capture.output(expect_error(summary(getSampleSizeSurvival( + getDesignGroupSequential(sided = 2), + lambda2 = log(2) / 6, hazardRatio = c(0.55), + accrualTime = c(0, 10), accrualIntensity = 20 + )), NA))) + + invisible(capture.output(expect_error(summary(getPowerSurvival( + getDesignGroupSequential(kMax = 2), + maxNumberOfEvents = 200, maxNumberOfSubjects = 400, + lambda2 = log(2) / 60, lambda1 = log(2) / 50, + dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, + accrualTime = 0, accrualIntensity = 30 + )), NA))) + + invisible(capture.output(expect_error(summary(getPowerSurvival( + getDesignGroupSequential(kMax = 3), + maxNumberOfEvents = 200, maxNumberOfSubjects = 400, + lambda2 = log(2) / 60, lambda1 = c(log(2) / 50, log(2) / 60), + dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, + accrualTime = 0, accrualIntensity = 30 + )), NA))) + + invisible(capture.output(expect_error(summary(getPowerSurvival( + getDesignGroupSequential(kMax = 3), + maxNumberOfEvents = 200, maxNumberOfSubjects = 400, + lambda2 = log(2) / 60, hazardRatio = c(0.7, 0.8), directionUpper = FALSE, + dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, + accrualTime = 0, accrualIntensity = 30 + )), NA))) + + design1 <- getDesignGroupSequential( + sided = 2, alpha = 0.05, beta = 0.2, + informationRates = c(0.6, 1), + typeOfDesign = "asOF", twoSidedPower = FALSE + ) + + invisible(capture.output(expect_error(summary(getSampleSizeSurvival( + design1, + lambda2 = log(2) / 60, hazardRatio = 0.74, + dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, + accrualTime = 0, accrualIntensity = 30, + followUpTime = 12 + )), NA))) + + invisible(capture.output(expect_error(summary(getSampleSizeSurvival( + design1, + lambda2 = log(2) / 60, lambda1 = log(2) / 50, + dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, + accrualTime = 0, accrualIntensity = 30, + followUpTime = 12 + )), NA))) + + invisible(capture.output(expect_error(summary(getSampleSizeSurvival( + getDesignGroupSequential(kMax = 4, sided = 2) + )), NA))) + + ## simulations + + design2 <- getDesignInverseNormal( + alpha = 0.05, kMax = 4, futilityBounds = c(0, 0, 0), + sided = 1, typeOfDesign = "WT", deltaWT = 0.1 + ) + + invisible(capture.output(expect_error(summary(getSimulationSurvival(design2, + lambda2 = log(2) / 60, lambda1 = c(log(2) / 80), + maxNumberOfSubjects = 1000, plannedEvents = c(50, 100, 150, 200), seed = 12345, directionUpper = FALSE + )), NA))) + + invisible(capture.output(expect_error(summary(getSimulationSurvival(design2, + lambda2 = log(2) / 60, hazardRatio = c(1.2, 1.4), + maxNumberOfSubjects = 1000, plannedEvents = c(50, 100, 150, 200), seed = 12345 + )), NA))) + + design3 <- getDesignGroupSequential(typeOfDesign = "P", futilityBounds = c(1, 1)) + + invisible(capture.output(expect_error(summary(getSampleSizeMeans(design3)), NA))) + + invisible(capture.output(expect_error(summary(getSimulationMeans(design3, stDev = 4, plannedSubjects = (1:3) * 200, alternative = c(1, 2))), NA))) + + invisible(capture.output(expect_error(summary(getSimulationRates(design3, + plannedSubjects = (1:3) * 200, pi1 = c(0.3, 0.4), maxNumberOfIterations = 1000, + minNumberOfSubjectsPerStage = c(NA, 40, 40), maxNumberOfSubjectsPerStage = c(NA, 40, 400), conditionalPower = 0.8 + )), NA))) + + invisible(capture.output(expect_error(summary(getSimulationMeans( + getDesignGroupSequential(kMax = 1), + stDev = 4, plannedSubjects = 200, alternative = c(1) + )), NA))) + +}) + +test_that("Testing 'summary.ParameterSet': output will be produced", { + + .skipTestIfDisabled() + + # @refFS[Function]{fs:outputOfGenericFunctions} + expect_output(summary(getDesignGroupSequential(beta = 0.05, typeOfDesign = "asKD", gammaA = 1, typeBetaSpending = "bsOF"))$show()) + expect_output(summary(getDesignGroupSequential(kMax = 1))$show()) + expect_output(summary(getDesignGroupSequential(kMax = 4, sided = 2))$show()) + expect_output(summary(getDesignGroupSequential(kMax = 4, sided = 2), digits = 0)$show()) + expect_output(summary(getDesignGroupSequential(kMax = 1, sided = 2))$show()) + expect_output(summary(getDesignGroupSequential(futilityBounds = c(-6, 0)))$show()) + expect_output(summary(getDesignGroupSequential(futilityBounds = c(-6, 0)), digits = 5)$show()) + + expect_output(summary(getDataset( + n = c(13, 25), + means = c(242, 222), + stDevs = c(244, 221) + ))$show()) + + expect_output(summary(getDataset( + n = c(13), + means = c(242), + stDevs = c(244) + ))$show()) + + expect_output(summary(getDataset( + n1 = c(13, 25), + n2 = c(15, NA), + n3 = c(14, 27), + n4 = c(12, 29), + means1 = c(242, 222), + means2 = c(188, NA), + means3 = c(267, 277), + means4 = c(92, 122), + stDevs1 = c(244, 221), + stDevs2 = c(212, NA), + stDevs3 = c(256, 232), + stDevs4 = c(215, 227) + ))$show()) + + expect_output(summary(getDataset( + n1 = c(11, 13, 12, 13), + n2 = c(8, 10, 9, 11), + n3 = c(7, 10, 8, 9), + events1 = c(10, 10, 12, 12), + events2 = c(3, 5, 5, 6), + events3 = c(2, 4, 3, 5) + ))$show()) + + expect_output(summary(getDataset( + events1 = c(25, 32), + events2 = c(18, NA), + events3 = c(22, 36), + logRanks1 = c(2.2, 1.8), + logRanks2 = c(1.99, NA), + logRanks3 = c(2.32, 2.11) + ))$show()) + + expect_output(summary(getDesignInverseNormal(kMax = 1))$show()) + expect_output(summary(getDesignInverseNormal(futilityBounds = c(0, 1)))$show()) + expect_output(summary(getDesignInverseNormal(kMax = 1))$show()) + expect_output(summary(getDesignInverseNormal(kMax = 4, sided = 2))$show()) + expect_output(summary(getDesignInverseNormal(kMax = 4, sided = 2), digits = 0)$show()) + expect_output(summary(getDesignInverseNormal(kMax = 1, sided = 2))$show()) + + expect_output(summary(getDesignFisher())$show()) + expect_output(summary(getDesignFisher(alpha0Vec = c(0.1, 0.2)))$show()) + expect_output(summary(getDesignFisher(kMax = 1))$show()) + expect_output(summary(getDesignFisher(kMax = 4), digits = 5)$show()) + expect_output(summary(getDesignFisher(kMax = 4), digits = 0)$show()) + expect_output(summary(getDesignFisher(kMax = 1))$show()) + + ## test design plans - means + + expect_output(summary(getSampleSizeMeans(sided = 2, alternative = -0.5))$show()) + expect_output(summary(getPowerMeans(sided = 1, alternative = c(-0.5, -0.3), maxNumberOfSubjects = 100, directionUpper = FALSE))$show()) + expect_output(summary(getSampleSizeMeans(thetaH0 = 0, alternative = 0.5, sided = 1, stDev = 2.5))$show()) + expect_output(summary(getSampleSizeMeans(thetaH0 = 0, alternative = 0.5, sided = 1, stDev = 1, groups = 1))$show()) + expect_output(summary(getSampleSizeMeans(thetaH0 = 0, sided = 2, stDev = 1, groups = 1))$show()) + + expect_output(summary(getSampleSizeMeans(thetaH0 = 0, alternative = 1.2, sided = 2, stDev = 5))$show()) + expect_output(summary(getSampleSizeMeans(thetaH0 = 0, alternative = 1.2, sided = 2, stDev = 5, allocationRatioPlanned = 0))$show()) + expect_output(summary(getSampleSizeMeans(thetaH0 = 0, alternative = 1.2, sided = 2, stDev = 5, groups = 1))$show()) + expect_output(summary(getSampleSizeMeans( + getDesignGroupSequential(futilityBounds = c(1, 2)) + ))$show()) + expect_output(summary(getSampleSizeMeans( + getDesignGroupSequential(futilityBounds = c(1, 2)) + ), digits = 0)$show()) + expect_output(summary(getPowerMeans( + getDesignGroupSequential(futilityBounds = c(1, 2)), + maxNumberOfSubjects = 100, alternative = 1 + ))$show()) + expect_output(summary(getSampleSizeMeans( + getDesignGroupSequential(kMax = 4, sided = 2) + ))$show()) + expect_output(summary(getPowerMeans( + getDesignGroupSequential(kMax = 4, sided = 2), + maxNumberOfSubjects = 100 + ))$show()) + expect_output(summary(getPowerMeans( + getDesignGroupSequential(kMax = 1, sided = 2), + maxNumberOfSubjects = 100 + ))$show()) + + expect_output(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2))))$show()) + expect_output(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2))), digits = 4)$show()) + expect_output(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2))), digits = 3)$show()) + expect_output(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2))), digits = 2)$show()) + expect_output(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2))), digits = -1)$show()) + + ## test design plans - rates + + expect_output(summary(getSampleSizeRates(pi2 = 0.3))$show()) + expect_output(summary(getSampleSizeRates(groups = 1, thetaH0 = 0.3))$show()) + expect_output(summary(getSampleSizeRates(groups = 1, thetaH0 = 0.45))$show()) + expect_output(summary(getSampleSizeRates(groups = 2, thetaH0 = 0.45, allocationRatioPlanned = 0))$show()) + expect_output(summary(getSampleSizeRates(getDesignGroupSequential(futilityBounds = c(1, 2))))$show()) + expect_output(summary(getPowerRates(getDesignGroupSequential(futilityBounds = c(1, 2)), maxNumberOfSubjects = 100))$show()) + expect_output(summary(getSampleSizeRates(getDesignGroupSequential(kMax = 4, sided = 2)))$show()) + expect_output(summary(getSampleSizeRates(getDesignGroupSequential(kMax = 4, sided = 2), groups = 1, thetaH0 = 0.3))$show()) + expect_output(summary(getSampleSizeRates(getDesignGroupSequential(kMax = 1, sided = 2), + groups = 1, thetaH0 = 0.2, pi1 = c(0.4, 0.5) + ))$show()) + expect_output(summary(getSampleSizeRates(getDesignGroupSequential( + kMax = 1, sided = 2 + ), groups = 1, thetaH0 = 0.2, pi1 = 0.4))$show()) + expect_output(summary(getSampleSizeRates(getDesignGroupSequential( + kMax = 1, sided = 2 + ), groups = 2, thetaH0 = 0, pi1 = 0.25))$show()) + expect_output(summary(getPowerRates(getDesignGroupSequential(kMax = 4, sided = 2), maxNumberOfSubjects = 100))$show()) + + ## test design plans - survival + + expect_output(summary(getSampleSizeSurvival())$show()) + expect_output(summary(getSampleSizeSurvival(lambda2 = 0.3, hazardRatio = 1.2))$show()) + expect_output(summary(getSampleSizeSurvival(lambda2 = 0.3, hazardRatio = c(1.2, 2)))$show()) + expect_output(summary(getSampleSizeSurvival(pi2 = 0.3, hazardRatio = 1.2))$show()) + expect_output(summary(getSampleSizeSurvival(pi1 = 0.1, pi2 = 0.3))$show()) + + expect_output(summary(getSampleSizeSurvival(lambda2 = 0.03, lambda1 = c(0.040)))$show()) + expect_output(summary(getSampleSizeSurvival(piecewiseSurvivalTime = list( + "0 - <6" = 0.025, + "6 - <9" = 0.04, + "9 - <15" = 0.015, + "15 - <21" = 0.01, + ">=21" = 0.007 + ), hazardRatio = 1.2))$show()) + expect_output(summary(getSampleSizeSurvival(getDesignGroupSequential(futilityBounds = c(1, 2))))$show()) + expect_output(summary(getPowerSurvival(getDesignGroupSequential(futilityBounds = c(1, 2)), + maxNumberOfSubjects = 100, maxNumberOfEvents = 60 + ))$show()) + expect_output(summary(getSampleSizeSurvival(getDesignGroupSequential(kMax = 4, sided = 2)))$show()) + expect_output(summary(getPowerSurvival(getDesignGroupSequential(kMax = 4, sided = 2), + maxNumberOfSubjects = 100, maxNumberOfEvents = 60 + ))$show()) + + expect_output(summary(getSampleSizeSurvival(sided = 2, lambda2 = log(2) / 6, lambda1 = log(2) / 8))$show()) + + expect_output(summary(getPowerSurvival( + sided = 2, maxNumberOfSubjects = 200, + maxNumberOfEvents = 40, lambda2 = log(2) / 6, lambda1 = log(2) / 8 + ))$show()) + + expect_warning(expect_output(summary(getSampleSizeSurvival(getDesignGroupSequential(sided = 2), + lambda2 = log(2) / 6, hazardRatio = c(0.55), + accrualTime = c(0, 10), accrualIntensity = 60 + ))$show()), + "Accrual duration longer than maximal study duration (time to maximal number of events); followUpTime = -2.959", + fixed = TRUE + ) + + expect_output(summary(getPowerSurvival(getDesignGroupSequential(kMax = 2), + maxNumberOfEvents = 150, maxNumberOfSubjects = 400, + lambda2 = log(2) / 60, lambda1 = log(2) / 50, + dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, + accrualTime = 0, accrualIntensity = 30 + ))$show()) + + expect_output(summary(getPowerSurvival(getDesignGroupSequential(kMax = 3), + maxNumberOfEvents = 200, maxNumberOfSubjects = 400, + lambda2 = log(2) / 60, lambda1 = c(log(2) / 50, log(2) / 60), + dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, + accrualTime = 0, accrualIntensity = 30 + ))$show()) + + expect_output(summary(getPowerSurvival(getDesignGroupSequential(kMax = 3), + maxNumberOfEvents = 200, maxNumberOfSubjects = 400, + lambda2 = log(2) / 60, hazardRatio = c(0.7, 0.8), directionUpper = FALSE, + dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, + accrualTime = 0, accrualIntensity = 30 + ))$show()) + + design1 <- getDesignGroupSequential( + sided = 2, alpha = 0.05, beta = 0.2, + informationRates = c(0.6, 1), + typeOfDesign = "asOF", twoSidedPower = FALSE + ) + + expect_output(summary(getSampleSizeSurvival( + design1, + lambda2 = log(2) / 60, hazardRatio = 0.74, + dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, + accrualTime = 0, accrualIntensity = 30, + followUpTime = 12 + ))$show()) + + expect_output(summary(getSampleSizeSurvival( + design1, + lambda2 = log(2) / 60, lambda1 = log(2) / 50, + dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, + accrualTime = 0, accrualIntensity = 30, + followUpTime = 12 + ))$show()) + + expect_output(summary(getSampleSizeSurvival(getDesignGroupSequential(kMax = 4, sided = 2)))$show()) + + ## simulations + + design2 <- getDesignInverseNormal( + alpha = 0.05, kMax = 4, futilityBounds = c(0, 0, 0), + sided = 1, typeOfDesign = "WT", deltaWT = 0.1 + ) + + expect_output(summary(getSimulationSurvival(design2, + lambda2 = log(2) / 60, lambda1 = c(log(2) / 80), + maxNumberOfSubjects = 1000, plannedEvents = c(50, 100, 150, 200), seed = 12345, directionUpper = FALSE + ))$show()) + + expect_output(summary(getSimulationSurvival(design2, + lambda2 = log(2) / 60, hazardRatio = c(1.2, 1.4), + maxNumberOfSubjects = 1000, plannedEvents = c(50, 100, 150, 200), seed = 12345 + ))$show()) + + design3 <- getDesignGroupSequential(typeOfDesign = "P", futilityBounds = c(1, 1)) + + expect_output(summary(getSampleSizeMeans(design3))$show()) + + expect_output(summary(getSimulationMeans(design3, stDev = 4, plannedSubjects = (1:3) * 200, alternative = c(1, 2)))$show()) + + expect_output(summary(getSimulationRates(design3, + plannedSubjects = (1:3) * 200, pi1 = c(0.3, 0.4), maxNumberOfIterations = 1000, + minNumberOfSubjectsPerStage = c(NA, 40, 40), maxNumberOfSubjectsPerStage = c(NA, 40, 400), conditionalPower = 0.8 + ))$show()) + + expect_output(summary(getSimulationMeans(getDesignGroupSequential(kMax = 1), + stDev = 4, plannedSubjects = 200, alternative = 1 + ))$show()) + +}) + diff --git a/tests/testthat/test-class_time.R b/tests/testthat/test-class_time.R index 8f2c8810..772eae8d 100644 --- a/tests/testthat/test-class_time.R +++ b/tests/testthat/test-class_time.R @@ -1,2734 +1,2735 @@ -## | -## | *Unit tests* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | RPACT package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File name: test-class_time.R -## | Creation date: 08 November 2023, 08:49:49 -## | File version: $Revision: 7665 $ -## | Last changed: $Date: 2024-02-23 17:33:46 +0100 (Fr, 23 Feb 2024) $ -## | Last changed by: $Author: pahlke $ -## | - -test_plan_section("Testing Class 'PiecewiseSurvivalTime'") - - -test_that("Testing 'getPiecewiseSurvivalTime': isPiecewiseSurvivalEnabled()", { - # @refFS[Tab.]{fs:tab:output:getPiecewiseSurvivalTime} - expect_false(getPiecewiseSurvivalTime()$isPiecewiseSurvivalEnabled()) - expect_false(getPiecewiseSurvivalTime(piecewiseSurvivalTime = NA)$isPiecewiseSurvivalEnabled()) - -}) - -test_that("Testing 'getPiecewiseSurvivalTime': simple vector based definition", { - - # @refFS[Tab.]{fs:tab:output:getPiecewiseSurvivalTime} - pwSurvivalTime1 <- getPiecewiseSurvivalTime(lambda2 = 0.5, hazardRatio = 0.8) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime1' with expected results - expect_equal(pwSurvivalTime1$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime1$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$lambda1, 0.4, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$lambda2, 0.5, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime1$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime1$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$median1, 1.732868, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$median2, 1.3862944, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime1$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime1$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime1$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime1$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime1$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime1), NA))) - expect_output(print(pwSurvivalTime1)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime1), NA))) - expect_output(summary(pwSurvivalTime1)$show()) - pwSurvivalTime1CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime1, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime1CodeBased$piecewiseSurvivalTime, pwSurvivalTime1$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$lambda1, pwSurvivalTime1$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$lambda2, pwSurvivalTime1$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$hazardRatio, pwSurvivalTime1$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$pi1, pwSurvivalTime1$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$pi2, pwSurvivalTime1$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$median1, pwSurvivalTime1$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$median2, pwSurvivalTime1$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$eventTime, pwSurvivalTime1$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$kappa, pwSurvivalTime1$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime1$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$delayedResponseAllowed, pwSurvivalTime1$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$delayedResponseEnabled, pwSurvivalTime1$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime1), "character") - df <- as.data.frame(pwSurvivalTime1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime2 <- getPiecewiseSurvivalTime(lambda2 = 0.5, lambda1 = 0.4) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime2' with expected results - expect_equal(pwSurvivalTime2$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime2$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$lambda1, 0.4, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$lambda2, 0.5, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime2$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime2$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$median1, 1.732868, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$median2, 1.3862944, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime2$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime2$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime2), NA))) - expect_output(print(pwSurvivalTime2)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime2), NA))) - expect_output(summary(pwSurvivalTime2)$show()) - pwSurvivalTime2CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime2, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalTime, pwSurvivalTime2$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$lambda1, pwSurvivalTime2$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$lambda2, pwSurvivalTime2$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$hazardRatio, pwSurvivalTime2$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$pi1, pwSurvivalTime2$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$pi2, pwSurvivalTime2$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$median1, pwSurvivalTime2$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$median2, pwSurvivalTime2$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$eventTime, pwSurvivalTime2$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$kappa, pwSurvivalTime2$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime2$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$delayedResponseAllowed, pwSurvivalTime2$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$delayedResponseEnabled, pwSurvivalTime2$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime2), "character") - df <- as.data.frame(pwSurvivalTime2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - .skipTestIfDisabled() - - pwSurvivalTime2 <- getPiecewiseSurvivalTime(pi2 = 0.5, hazardRatio = 0.8) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime2' with expected results - expect_equal(pwSurvivalTime2$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime2$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$lambda1, 0.046209812, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$lambda2, 0.057762265, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$pi1, 0.42565082, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$pi2, 0.5, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$median1, 15, label = paste0("c(", paste0(pwSurvivalTime2$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$median2, 12, label = paste0("c(", paste0(pwSurvivalTime2$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$eventTime, 12, label = paste0("c(", paste0(pwSurvivalTime2$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime2$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime2), NA))) - expect_output(print(pwSurvivalTime2)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime2), NA))) - expect_output(summary(pwSurvivalTime2)$show()) - pwSurvivalTime2CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime2, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalTime, pwSurvivalTime2$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$lambda1, pwSurvivalTime2$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$lambda2, pwSurvivalTime2$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$hazardRatio, pwSurvivalTime2$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$pi1, pwSurvivalTime2$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$pi2, pwSurvivalTime2$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$median1, pwSurvivalTime2$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$median2, pwSurvivalTime2$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$eventTime, pwSurvivalTime2$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$kappa, pwSurvivalTime2$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime2$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$delayedResponseAllowed, pwSurvivalTime2$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$delayedResponseEnabled, pwSurvivalTime2$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime2), "character") - df <- as.data.frame(pwSurvivalTime2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime2 <- getPiecewiseSurvivalTime(pi2 = 0.5, pi1 = 0.4) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime2' with expected results - expect_equal(pwSurvivalTime2$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime2$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$lambda1, 0.042568802, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$lambda2, 0.057762265, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$hazardRatio, 0.73696559, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$pi1, 0.4, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$pi2, 0.5, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$median1, 16.282985, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$median2, 12, label = paste0("c(", paste0(pwSurvivalTime2$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$eventTime, 12, label = paste0("c(", paste0(pwSurvivalTime2$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime2$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime2), NA))) - expect_output(print(pwSurvivalTime2)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime2), NA))) - expect_output(summary(pwSurvivalTime2)$show()) - pwSurvivalTime2CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime2, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalTime, pwSurvivalTime2$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$lambda1, pwSurvivalTime2$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$lambda2, pwSurvivalTime2$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$hazardRatio, pwSurvivalTime2$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$pi1, pwSurvivalTime2$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$pi2, pwSurvivalTime2$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$median1, pwSurvivalTime2$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$median2, pwSurvivalTime2$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$eventTime, pwSurvivalTime2$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$kappa, pwSurvivalTime2$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime2$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$delayedResponseAllowed, pwSurvivalTime2$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$delayedResponseEnabled, pwSurvivalTime2$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime2), "character") - df <- as.data.frame(pwSurvivalTime2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime3 <- getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), lambda2 = 0.4) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime3' with expected results - expect_equal(pwSurvivalTime3$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime3$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$lambda1, c(0.24, 0.32), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$lambda2, 0.4, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$hazardRatio, c(0.6, 0.8), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime3$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime3$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$median1, c(2.8881133, 2.1660849), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$median2, 1.732868, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime3$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime3$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime3$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime3$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime3$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime3), NA))) - expect_output(print(pwSurvivalTime3)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime3), NA))) - expect_output(summary(pwSurvivalTime3)$show()) - pwSurvivalTime3CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime3, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime3CodeBased$piecewiseSurvivalTime, pwSurvivalTime3$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$lambda1, pwSurvivalTime3$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$lambda2, pwSurvivalTime3$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$hazardRatio, pwSurvivalTime3$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$pi1, pwSurvivalTime3$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$pi2, pwSurvivalTime3$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$median1, pwSurvivalTime3$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$median2, pwSurvivalTime3$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$eventTime, pwSurvivalTime3$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$kappa, pwSurvivalTime3$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime3$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$delayedResponseAllowed, pwSurvivalTime3$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$delayedResponseEnabled, pwSurvivalTime3$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime3), "character") - df <- as.data.frame(pwSurvivalTime3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime8 <- getPiecewiseSurvivalTime(pi2 = 0.4, pi1 = 0.3) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime8' with expected results - expect_equal(pwSurvivalTime8$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime8$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime8$lambda1, 0.029722912, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime8$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime8$lambda2, 0.042568802, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime8$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime8$hazardRatio, 0.69823229, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime8$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime8$pi1, 0.3, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime8$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime8$pi2, 0.4, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime8$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime8$median1, 23.320299, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime8$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime8$median2, 16.282985, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime8$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime8$eventTime, 12, label = paste0("c(", paste0(pwSurvivalTime8$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime8$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime8$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime8$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime8$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime8$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime8$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime8$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime8$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime8), NA))) - expect_output(print(pwSurvivalTime8)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime8), NA))) - expect_output(summary(pwSurvivalTime8)$show()) - pwSurvivalTime8CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime8, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime8CodeBased$piecewiseSurvivalTime, pwSurvivalTime8$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime8CodeBased$lambda1, pwSurvivalTime8$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime8CodeBased$lambda2, pwSurvivalTime8$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime8CodeBased$hazardRatio, pwSurvivalTime8$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime8CodeBased$pi1, pwSurvivalTime8$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime8CodeBased$pi2, pwSurvivalTime8$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime8CodeBased$median1, pwSurvivalTime8$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime8CodeBased$median2, pwSurvivalTime8$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime8CodeBased$eventTime, pwSurvivalTime8$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime8CodeBased$kappa, pwSurvivalTime8$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime8CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime8$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime8CodeBased$delayedResponseAllowed, pwSurvivalTime8$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime8CodeBased$delayedResponseEnabled, pwSurvivalTime8$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime8), "character") - df <- as.data.frame(pwSurvivalTime8) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime8) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime9 <- getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), pi2 = 0.3) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime9' with expected results - expect_equal(pwSurvivalTime9$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime9$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime9$lambda1, c(0.017833747, 0.02377833), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime9$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime9$lambda2, 0.029722912, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime9$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime9$hazardRatio, c(0.6, 0.8), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime9$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime9$pi1, c(0.19265562, 0.24824135), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime9$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime9$pi2, 0.3, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime9$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime9$median1, c(38.867164, 29.150373), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime9$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime9$median2, 23.320299, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime9$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime9$eventTime, 12, label = paste0("c(", paste0(pwSurvivalTime9$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime9$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime9$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime9$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime9$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime9$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime9$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime9$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime9$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime9), NA))) - expect_output(print(pwSurvivalTime9)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime9), NA))) - expect_output(summary(pwSurvivalTime9)$show()) - pwSurvivalTime9CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime9, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime9CodeBased$piecewiseSurvivalTime, pwSurvivalTime9$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime9CodeBased$lambda1, pwSurvivalTime9$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime9CodeBased$lambda2, pwSurvivalTime9$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime9CodeBased$hazardRatio, pwSurvivalTime9$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime9CodeBased$pi1, pwSurvivalTime9$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime9CodeBased$pi2, pwSurvivalTime9$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime9CodeBased$median1, pwSurvivalTime9$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime9CodeBased$median2, pwSurvivalTime9$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime9CodeBased$eventTime, pwSurvivalTime9$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime9CodeBased$kappa, pwSurvivalTime9$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime9CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime9$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime9CodeBased$delayedResponseAllowed, pwSurvivalTime9$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime9CodeBased$delayedResponseEnabled, pwSurvivalTime9$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime9), "character") - df <- as.data.frame(pwSurvivalTime9) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime9) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime10 <- getPiecewiseSurvivalTime(median2 = 1.386294, hazardRatio = 0.8) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime10' with expected results - expect_equal(pwSurvivalTime10$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime10$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$lambda1, 0.4000001, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$lambda2, 0.50000013, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime10$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime10$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$median1, 1.7328675, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$median2, 1.386294, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime10$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime10$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime10$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime10$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime10$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime10), NA))) - expect_output(print(pwSurvivalTime10)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime10), NA))) - expect_output(summary(pwSurvivalTime10)$show()) - pwSurvivalTime10CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime10, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime10CodeBased$piecewiseSurvivalTime, pwSurvivalTime10$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$lambda1, pwSurvivalTime10$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$lambda2, pwSurvivalTime10$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$hazardRatio, pwSurvivalTime10$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$pi1, pwSurvivalTime10$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$pi2, pwSurvivalTime10$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$median1, pwSurvivalTime10$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$median2, pwSurvivalTime10$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$eventTime, pwSurvivalTime10$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$kappa, pwSurvivalTime10$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime10$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$delayedResponseAllowed, pwSurvivalTime10$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$delayedResponseEnabled, pwSurvivalTime10$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime10), "character") - df <- as.data.frame(pwSurvivalTime10) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime10) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime11 <- getPiecewiseSurvivalTime(median2 = 1.386294, lambda1 = 0.4) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime11' with expected results - expect_equal(pwSurvivalTime11$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime11$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$lambda1, 0.4, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$lambda2, 0.50000013, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$hazardRatio, 0.79999979, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime11$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime11$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$median1, 1.732868, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$median2, 1.386294, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime11$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime11$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime11$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime11$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime11$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime11), NA))) - expect_output(print(pwSurvivalTime11)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime11), NA))) - expect_output(summary(pwSurvivalTime11)$show()) - pwSurvivalTime11CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime11, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime11CodeBased$piecewiseSurvivalTime, pwSurvivalTime11$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$lambda1, pwSurvivalTime11$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$lambda2, pwSurvivalTime11$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$hazardRatio, pwSurvivalTime11$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$pi1, pwSurvivalTime11$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$pi2, pwSurvivalTime11$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$median1, pwSurvivalTime11$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$median2, pwSurvivalTime11$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$eventTime, pwSurvivalTime11$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$kappa, pwSurvivalTime11$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime11$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$delayedResponseAllowed, pwSurvivalTime11$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$delayedResponseEnabled, pwSurvivalTime11$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime11), "character") - df <- as.data.frame(pwSurvivalTime11) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime11) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime12 <- getPiecewiseSurvivalTime(median2 = 5, median1 = 6) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime12' with expected results - expect_equal(pwSurvivalTime12$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$lambda1, 0.11552453, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime12$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$lambda2, 0.13862944, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime12$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$hazardRatio, 0.83333333, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime12$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$median1, 6, label = paste0("c(", paste0(pwSurvivalTime12$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$median2, 5, label = paste0("c(", paste0(pwSurvivalTime12$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime12$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime12$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime12$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime12$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime12), NA))) - expect_output(print(pwSurvivalTime12)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime12), NA))) - expect_output(summary(pwSurvivalTime12)$show()) - pwSurvivalTime12CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime12, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime12CodeBased$piecewiseSurvivalTime, pwSurvivalTime12$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$lambda1, pwSurvivalTime12$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$lambda2, pwSurvivalTime12$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$hazardRatio, pwSurvivalTime12$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$pi1, pwSurvivalTime12$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$pi2, pwSurvivalTime12$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$median1, pwSurvivalTime12$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$median2, pwSurvivalTime12$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$eventTime, pwSurvivalTime12$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$kappa, pwSurvivalTime12$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime12$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$delayedResponseAllowed, pwSurvivalTime12$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$delayedResponseEnabled, pwSurvivalTime12$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime12), "character") - df <- as.data.frame(pwSurvivalTime12) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime12) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime13 <- getPiecewiseSurvivalTime(median2 = 1.386294, lambda1 = c(0.3, 0.4)) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime13' with expected results - expect_equal(pwSurvivalTime13$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime13$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$lambda1, c(0.3, 0.4), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime13$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$lambda2, 0.50000013, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime13$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$hazardRatio, c(0.59999984, 0.79999979), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime13$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime13$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime13$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$median1, c(2.3104906, 1.732868), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime13$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$median2, 1.386294, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime13$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime13$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime13$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime13$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime13$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime13$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime13), NA))) - expect_output(print(pwSurvivalTime13)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime13), NA))) - expect_output(summary(pwSurvivalTime13)$show()) - pwSurvivalTime13CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime13, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime13CodeBased$piecewiseSurvivalTime, pwSurvivalTime13$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$lambda1, pwSurvivalTime13$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$lambda2, pwSurvivalTime13$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$hazardRatio, pwSurvivalTime13$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$pi1, pwSurvivalTime13$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$pi2, pwSurvivalTime13$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$median1, pwSurvivalTime13$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$median2, pwSurvivalTime13$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$eventTime, pwSurvivalTime13$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$kappa, pwSurvivalTime13$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime13$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$delayedResponseAllowed, pwSurvivalTime13$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$delayedResponseEnabled, pwSurvivalTime13$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime13), "character") - df <- as.data.frame(pwSurvivalTime13) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime13) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime14 <- getPiecewiseSurvivalTime(median2 = 5, median1 = c(6:8)) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime14' with expected results - expect_equal(pwSurvivalTime14$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime14$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime14$lambda1, c(0.11552453, 0.099021026, 0.086643398), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime14$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime14$lambda2, 0.13862944, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime14$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime14$hazardRatio, c(0.83333333, 0.71428571, 0.625), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime14$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime14$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime14$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime14$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime14$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime14$median1, c(6, 7, 8), label = paste0("c(", paste0(pwSurvivalTime14$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime14$median2, 5, label = paste0("c(", paste0(pwSurvivalTime14$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime14$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime14$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime14$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime14$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime14$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime14$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime14$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime14$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime14$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime14$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime14), NA))) - expect_output(print(pwSurvivalTime14)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime14), NA))) - expect_output(summary(pwSurvivalTime14)$show()) - pwSurvivalTime14CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime14, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime14CodeBased$piecewiseSurvivalTime, pwSurvivalTime14$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime14CodeBased$lambda1, pwSurvivalTime14$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime14CodeBased$lambda2, pwSurvivalTime14$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime14CodeBased$hazardRatio, pwSurvivalTime14$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime14CodeBased$pi1, pwSurvivalTime14$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime14CodeBased$pi2, pwSurvivalTime14$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime14CodeBased$median1, pwSurvivalTime14$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime14CodeBased$median2, pwSurvivalTime14$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime14CodeBased$eventTime, pwSurvivalTime14$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime14CodeBased$kappa, pwSurvivalTime14$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime14CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime14$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime14CodeBased$delayedResponseAllowed, pwSurvivalTime14$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime14CodeBased$delayedResponseEnabled, pwSurvivalTime14$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime14), "character") - df <- as.data.frame(pwSurvivalTime14) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime14) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime15 <- getPiecewiseSurvivalTime(median2 = 2, hazardRatio = 0.8) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime15' with expected results - expect_equal(pwSurvivalTime15$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime15$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime15$lambda1, 0.27725887, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime15$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime15$lambda2, 0.34657359, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime15$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime15$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime15$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime15$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime15$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime15$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime15$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime15$median1, 2.5, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime15$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime15$median2, 2, label = paste0("c(", paste0(pwSurvivalTime15$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime15$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime15$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime15$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime15$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime15$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime15$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime15$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime15$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime15$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime15$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime15), NA))) - expect_output(print(pwSurvivalTime15)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime15), NA))) - expect_output(summary(pwSurvivalTime15)$show()) - pwSurvivalTime15CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime15, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime15CodeBased$piecewiseSurvivalTime, pwSurvivalTime15$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime15CodeBased$lambda1, pwSurvivalTime15$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime15CodeBased$lambda2, pwSurvivalTime15$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime15CodeBased$hazardRatio, pwSurvivalTime15$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime15CodeBased$pi1, pwSurvivalTime15$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime15CodeBased$pi2, pwSurvivalTime15$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime15CodeBased$median1, pwSurvivalTime15$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime15CodeBased$median2, pwSurvivalTime15$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime15CodeBased$eventTime, pwSurvivalTime15$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime15CodeBased$kappa, pwSurvivalTime15$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime15CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime15$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime15CodeBased$delayedResponseAllowed, pwSurvivalTime15$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime15CodeBased$delayedResponseEnabled, pwSurvivalTime15$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime15), "character") - df <- as.data.frame(pwSurvivalTime15) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime15) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime16 <- getPiecewiseSurvivalTime(median1 = c(2, 2), hazardRatio = c(1.4, 1.4)) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime16' with expected results - expect_equal(pwSurvivalTime16$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime16$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime16$lambda1, c(0.34657359, 0.34657359), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime16$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime16$lambda2, c(0.24755256, 0.24755256), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime16$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime16$hazardRatio, c(1.4, 1.4), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime16$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime16$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime16$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime16$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime16$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime16$median1, c(2, 2), label = paste0("c(", paste0(pwSurvivalTime16$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime16$median2, c(2.8, 2.8), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime16$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime16$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime16$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime16$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime16$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime16$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime16$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime16$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime16$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime16$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime16$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime16), NA))) - expect_output(print(pwSurvivalTime16)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime16), NA))) - expect_output(summary(pwSurvivalTime16)$show()) - pwSurvivalTime16CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime16, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime16CodeBased$piecewiseSurvivalTime, pwSurvivalTime16$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime16CodeBased$lambda1, pwSurvivalTime16$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime16CodeBased$lambda2, pwSurvivalTime16$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime16CodeBased$hazardRatio, pwSurvivalTime16$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime16CodeBased$pi1, pwSurvivalTime16$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime16CodeBased$pi2, pwSurvivalTime16$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime16CodeBased$median1, pwSurvivalTime16$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime16CodeBased$median2, pwSurvivalTime16$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime16CodeBased$eventTime, pwSurvivalTime16$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime16CodeBased$kappa, pwSurvivalTime16$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime16CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime16$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime16CodeBased$delayedResponseAllowed, pwSurvivalTime16$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime16CodeBased$delayedResponseEnabled, pwSurvivalTime16$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime16), "character") - df <- as.data.frame(pwSurvivalTime16) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime16) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime17 <- getPiecewiseSurvivalTime(median1 = c(2, 3), median2 = 4) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime17' with expected results - expect_equal(pwSurvivalTime17$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime17$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime17$lambda1, c(0.34657359, 0.23104906), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime17$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime17$lambda2, 0.1732868, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime17$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime17$hazardRatio, c(2, 1.3333333), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime17$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime17$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime17$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime17$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime17$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime17$median1, c(2, 3), label = paste0("c(", paste0(pwSurvivalTime17$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime17$median2, 4, label = paste0("c(", paste0(pwSurvivalTime17$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime17$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime17$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime17$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime17$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime17$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime17$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime17$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime17$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime17$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime17$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime17), NA))) - expect_output(print(pwSurvivalTime17)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime17), NA))) - expect_output(summary(pwSurvivalTime17)$show()) - pwSurvivalTime17CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime17, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime17CodeBased$piecewiseSurvivalTime, pwSurvivalTime17$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime17CodeBased$lambda1, pwSurvivalTime17$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime17CodeBased$lambda2, pwSurvivalTime17$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime17CodeBased$hazardRatio, pwSurvivalTime17$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime17CodeBased$pi1, pwSurvivalTime17$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime17CodeBased$pi2, pwSurvivalTime17$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime17CodeBased$median1, pwSurvivalTime17$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime17CodeBased$median2, pwSurvivalTime17$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime17CodeBased$eventTime, pwSurvivalTime17$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime17CodeBased$kappa, pwSurvivalTime17$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime17CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime17$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime17CodeBased$delayedResponseAllowed, pwSurvivalTime17$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime17CodeBased$delayedResponseEnabled, pwSurvivalTime17$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime17), "character") - df <- as.data.frame(pwSurvivalTime17) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime17) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime18 <- getPiecewiseSurvivalTime(median1 = c(2, 3), lambda2 = 0.4) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime18' with expected results - expect_equal(pwSurvivalTime18$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime18$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime18$lambda1, c(0.34657359, 0.23104906), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime18$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime18$lambda2, 0.4, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime18$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime18$hazardRatio, c(0.86643398, 0.57762265), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime18$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime18$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime18$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime18$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime18$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime18$median1, c(2, 3), label = paste0("c(", paste0(pwSurvivalTime18$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime18$median2, 1.732868, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime18$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime18$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime18$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime18$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime18$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime18$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime18$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime18$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime18$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime18$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime18$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime18), NA))) - expect_output(print(pwSurvivalTime18)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime18), NA))) - expect_output(summary(pwSurvivalTime18)$show()) - pwSurvivalTime18CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime18, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime18CodeBased$piecewiseSurvivalTime, pwSurvivalTime18$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime18CodeBased$lambda1, pwSurvivalTime18$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime18CodeBased$lambda2, pwSurvivalTime18$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime18CodeBased$hazardRatio, pwSurvivalTime18$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime18CodeBased$pi1, pwSurvivalTime18$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime18CodeBased$pi2, pwSurvivalTime18$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime18CodeBased$median1, pwSurvivalTime18$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime18CodeBased$median2, pwSurvivalTime18$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime18CodeBased$eventTime, pwSurvivalTime18$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime18CodeBased$kappa, pwSurvivalTime18$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime18CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime18$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime18CodeBased$delayedResponseAllowed, pwSurvivalTime18$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime18CodeBased$delayedResponseEnabled, pwSurvivalTime18$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime18), "character") - df <- as.data.frame(pwSurvivalTime18) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime18) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime19 <- getPiecewiseSurvivalTime(pi1 = 0.45) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime19' with expected results - expect_equal(pwSurvivalTime19$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime19$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime19$lambda1, 0.04981975, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime19$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime19$lambda2, 0.018595296, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime19$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime19$hazardRatio, 2.6791588, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime19$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime19$pi1, 0.45, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime19$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime19$pi2, 0.2, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime19$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime19$median1, 13.9131, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime19$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime19$median2, 37.275405, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime19$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime19$eventTime, 12, label = paste0("c(", paste0(pwSurvivalTime19$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime19$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime19$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime19$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime19$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime19$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime19$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime19$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime19$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime19), NA))) - expect_output(print(pwSurvivalTime19)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime19), NA))) - expect_output(summary(pwSurvivalTime19)$show()) - pwSurvivalTime19CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime19, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime19CodeBased$piecewiseSurvivalTime, pwSurvivalTime19$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime19CodeBased$lambda1, pwSurvivalTime19$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime19CodeBased$lambda2, pwSurvivalTime19$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime19CodeBased$hazardRatio, pwSurvivalTime19$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime19CodeBased$pi1, pwSurvivalTime19$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime19CodeBased$pi2, pwSurvivalTime19$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime19CodeBased$median1, pwSurvivalTime19$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime19CodeBased$median2, pwSurvivalTime19$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime19CodeBased$eventTime, pwSurvivalTime19$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime19CodeBased$kappa, pwSurvivalTime19$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime19CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime19$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime19CodeBased$delayedResponseAllowed, pwSurvivalTime19$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime19CodeBased$delayedResponseEnabled, pwSurvivalTime19$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime19), "character") - df <- as.data.frame(pwSurvivalTime19) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime19) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime20 <- getPiecewiseSurvivalTime(median1 = c(2, 4), hazardRatio = c(1.4, 0.7)) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime20' with expected results - expect_equal(pwSurvivalTime20$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime20$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime20$lambda1, c(0.34657359, 0.1732868), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime20$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime20$lambda2, c(0.24755256, 0.24755256), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime20$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime20$hazardRatio, c(1.4, 0.7), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime20$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime20$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime20$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime20$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime20$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime20$median1, c(2, 4), label = paste0("c(", paste0(pwSurvivalTime20$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime20$median2, c(2.8, 2.8), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime20$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime20$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime20$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime20$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime20$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime20$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime20$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime20$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime20$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime20$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime20$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime20), NA))) - expect_output(print(pwSurvivalTime20)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime20), NA))) - expect_output(summary(pwSurvivalTime20)$show()) - pwSurvivalTime20CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime20, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime20CodeBased$piecewiseSurvivalTime, pwSurvivalTime20$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime20CodeBased$lambda1, pwSurvivalTime20$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime20CodeBased$lambda2, pwSurvivalTime20$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime20CodeBased$hazardRatio, pwSurvivalTime20$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime20CodeBased$pi1, pwSurvivalTime20$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime20CodeBased$pi2, pwSurvivalTime20$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime20CodeBased$median1, pwSurvivalTime20$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime20CodeBased$median2, pwSurvivalTime20$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime20CodeBased$eventTime, pwSurvivalTime20$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime20CodeBased$kappa, pwSurvivalTime20$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime20CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime20$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime20CodeBased$delayedResponseAllowed, pwSurvivalTime20$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime20CodeBased$delayedResponseEnabled, pwSurvivalTime20$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime20), "character") - df <- as.data.frame(pwSurvivalTime20) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime20) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime21 <- getPiecewiseSurvivalTime(median1 = 3, hazardRatio = 0.8) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime21' with expected results - expect_equal(pwSurvivalTime21$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime21$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime21$lambda1, 0.23104906, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime21$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime21$lambda2, 0.28881133, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime21$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime21$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime21$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime21$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime21$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime21$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime21$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime21$median1, 3, label = paste0("c(", paste0(pwSurvivalTime21$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime21$median2, 2.4, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime21$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime21$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime21$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime21$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime21$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime21$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime21$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime21$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime21$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime21$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime21$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime21), NA))) - expect_output(print(pwSurvivalTime21)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime21), NA))) - expect_output(summary(pwSurvivalTime21)$show()) - pwSurvivalTime21CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime21, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime21CodeBased$piecewiseSurvivalTime, pwSurvivalTime21$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime21CodeBased$lambda1, pwSurvivalTime21$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime21CodeBased$lambda2, pwSurvivalTime21$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime21CodeBased$hazardRatio, pwSurvivalTime21$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime21CodeBased$pi1, pwSurvivalTime21$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime21CodeBased$pi2, pwSurvivalTime21$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime21CodeBased$median1, pwSurvivalTime21$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime21CodeBased$median2, pwSurvivalTime21$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime21CodeBased$eventTime, pwSurvivalTime21$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime21CodeBased$kappa, pwSurvivalTime21$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime21CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime21$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime21CodeBased$delayedResponseAllowed, pwSurvivalTime21$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime21CodeBased$delayedResponseEnabled, pwSurvivalTime21$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime21), "character") - df <- as.data.frame(pwSurvivalTime21) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime21) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - expect_error(getPiecewiseSurvivalTime(median2 = 1.386294, lambda2 = 0.4, hazardRatio = 0.8)) - expect_error(getPiecewiseSurvivalTime(median2 = c(1.5, 1.7), lambda1 = c(0.3, 0.4))) - expect_error(getPiecewiseSurvivalTime(median1 = c(2, 4), hazardRatio = c(1, 0.7))) - expect_error(getPiecewiseSurvivalTime(median1 = c(2, 4), hazardRatio = 0.7)) - -}) - -test_that("Testing 'getPiecewiseSurvivalTime': vector based definition", { - - # @refFS[Tab.]{fs:tab:output:getPiecewiseSurvivalTime} - pwSurvivalTime1 <- getPiecewiseSurvivalTime( - piecewiseSurvivalTime = c(0, 6, 9), - lambda2 = c(0.025, 0.04, 0.015), hazardRatio = 0.8 - ) - expect_equal(pwSurvivalTime1$hazardRatio, 0.8) - expect_equal(pwSurvivalTime1$lambda1, c(0.025, 0.04, 0.015) * 0.8) - expect_false(pwSurvivalTime1$isDelayedResponseEnabled()) - - .skipTestIfDisabled() - - pwSurvivalTime2 <- getPiecewiseSurvivalTime( - piecewiseSurvivalTime = c(0, 5, 10), - lambda2 = c(0.1, 0.2, 0.8), hazardRatio = 0.8 - ) - expect_true(pwSurvivalTime2$isPiecewiseSurvivalEnabled()) - expect_false(pwSurvivalTime2$isDelayedResponseEnabled()) - expect_equal(pwSurvivalTime2$hazardRatio, 0.8) - expect_equal(pwSurvivalTime2$piecewiseSurvivalTime, c(0, 5, 10)) - expect_equal(pwSurvivalTime2$lambda2, c(0.1, 0.2, 0.8)) - - pwSurvivalTime3 <- getPiecewiseSurvivalTime(c(0, 6), lambda2 = c(0.01, 0.03), hazardRatio = 0.8) - expect_true(pwSurvivalTime3$isPiecewiseSurvivalEnabled()) - expect_false(pwSurvivalTime3$isDelayedResponseEnabled()) - expect_equal(pwSurvivalTime3$hazardRatio, 0.8) - expect_equal(pwSurvivalTime3$piecewiseSurvivalTime, c(0, 6)) - expect_equal(pwSurvivalTime3$lambda2, c(0.01, 0.03)) - - pwSurvivalTime4 <- getPiecewiseSurvivalTime(0, lambda2 = 0.01, hazardRatio = 0.8) - expect_true(pwSurvivalTime4$isPiecewiseSurvivalEnabled()) - expect_false(pwSurvivalTime4$isDelayedResponseEnabled()) - expect_equal(pwSurvivalTime4$hazardRatio, 0.8) - expect_equal(pwSurvivalTime4$piecewiseSurvivalTime, 0) - expect_equal(pwSurvivalTime4$lambda2, 0.01) - expect_equal(pwSurvivalTime4$lambda1, 0.01 * 0.8) - - pwSurvivalTime5 <- getPiecewiseSurvivalTime(NA_real_, lambda2 = 0.01, hazardRatio = 0.8) - expect_true(pwSurvivalTime5$isPiecewiseSurvivalEnabled()) - expect_false(pwSurvivalTime5$isDelayedResponseEnabled()) - expect_equal(pwSurvivalTime5$hazardRatio, 0.8) - expect_equal(pwSurvivalTime5$piecewiseSurvivalTime, 0) - expect_equal(pwSurvivalTime5$lambda2, 0.01) - expect_equal(pwSurvivalTime5$lambda1, 0.01 * 0.8) - - pwSurvivalTime6 <- getPiecewiseSurvivalTime(0, lambda2 = 0.01, lambda1 = 0.008) - expect_true(pwSurvivalTime6$isPiecewiseSurvivalEnabled()) - expect_false(pwSurvivalTime6$isDelayedResponseEnabled()) - expect_equal(pwSurvivalTime6$hazardRatio, 0.8) - expect_equal(pwSurvivalTime6$piecewiseSurvivalTime, 0) - expect_equal(pwSurvivalTime6$lambda2, 0.01) - expect_equal(pwSurvivalTime6$lambda1, 0.008) - - pwSurvivalTime7 <- getPiecewiseSurvivalTime(NA_real_, lambda2 = 0.01, lambda1 = 0.008) - expect_true(pwSurvivalTime7$isPiecewiseSurvivalEnabled()) - expect_false(pwSurvivalTime7$isDelayedResponseEnabled()) - expect_equal(pwSurvivalTime7$hazardRatio, 0.8) - expect_equal(pwSurvivalTime7$piecewiseSurvivalTime, 0) - expect_equal(pwSurvivalTime7$lambda2, 0.01) - expect_equal(pwSurvivalTime7$lambda1, 0.008) - - # case 2.2 - pwSurvivalTime9 <- getPiecewiseSurvivalTime( - piecewiseSurvivalTime = c(0, 6, 9), - lambda2 = c(0.025, 0.04, 0.015), - lambda1 = c(0.025, 0.04, 0.015) * 0.8 - ) - expect_true(pwSurvivalTime9$isPiecewiseSurvivalEnabled()) - expect_false(pwSurvivalTime9$isDelayedResponseEnabled()) - expect_equal(pwSurvivalTime9$hazardRatio, 0.8) - - pwSurvivalTime10 <- getPiecewiseSurvivalTime(lambda2 = 0.025, hazardRatio = 0.8) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime10' with expected results - expect_equal(pwSurvivalTime10$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime10$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$lambda1, 0.02, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$lambda2, 0.025, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime10$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime10$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$median1, 34.657359, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$median2, 27.725887, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime10$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime10$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime10$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime10$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime10$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime10), NA))) - expect_output(print(pwSurvivalTime10)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime10), NA))) - expect_output(summary(pwSurvivalTime10)$show()) - pwSurvivalTime10CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime10, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime10CodeBased$piecewiseSurvivalTime, pwSurvivalTime10$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$lambda1, pwSurvivalTime10$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$lambda2, pwSurvivalTime10$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$hazardRatio, pwSurvivalTime10$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$pi1, pwSurvivalTime10$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$pi2, pwSurvivalTime10$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$median1, pwSurvivalTime10$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$median2, pwSurvivalTime10$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$eventTime, pwSurvivalTime10$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$kappa, pwSurvivalTime10$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime10$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$delayedResponseAllowed, pwSurvivalTime10$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$delayedResponseEnabled, pwSurvivalTime10$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime10), "character") - df <- as.data.frame(pwSurvivalTime10) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime10) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime11 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = 0, lambda2 = 0.025, hazardRatio = 0.8) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime11' with expected results - expect_equal(pwSurvivalTime11$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime11$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$lambda1, 0.02, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$lambda2, 0.025, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime11$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime11$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$median1, 34.657359, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$median2, 27.725887, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime11$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime11$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime11$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime11$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime11$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime11), NA))) - expect_output(print(pwSurvivalTime11)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime11), NA))) - expect_output(summary(pwSurvivalTime11)$show()) - pwSurvivalTime11CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime11, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime11CodeBased$piecewiseSurvivalTime, pwSurvivalTime11$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$lambda1, pwSurvivalTime11$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$lambda2, pwSurvivalTime11$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$hazardRatio, pwSurvivalTime11$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$pi1, pwSurvivalTime11$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$pi2, pwSurvivalTime11$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$median1, pwSurvivalTime11$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$median2, pwSurvivalTime11$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$eventTime, pwSurvivalTime11$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$kappa, pwSurvivalTime11$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime11$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$delayedResponseAllowed, pwSurvivalTime11$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$delayedResponseEnabled, pwSurvivalTime11$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime11), "character") - df <- as.data.frame(pwSurvivalTime11) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime11) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime12 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 6), lambda2 = c(0.025, 0.01), hazardRatio = c(0.8, 0.9)) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime12' with expected results - expect_equal(pwSurvivalTime12$piecewiseSurvivalTime, c(0, 6), label = paste0("c(", paste0(pwSurvivalTime12$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$lambda1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$lambda2, c(0.025, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime12$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$hazardRatio, c(0.8, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime12$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$median1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$median2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime12$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$piecewiseSurvivalEnabled, TRUE, label = paste0("c(", paste0(pwSurvivalTime12$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime12$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime12$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime12), NA))) - expect_output(print(pwSurvivalTime12)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime12), NA))) - expect_output(summary(pwSurvivalTime12)$show()) - pwSurvivalTime12CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime12, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime12CodeBased$piecewiseSurvivalTime, pwSurvivalTime12$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$lambda1, pwSurvivalTime12$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$lambda2, pwSurvivalTime12$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$hazardRatio, pwSurvivalTime12$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$pi1, pwSurvivalTime12$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$pi2, pwSurvivalTime12$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$median1, pwSurvivalTime12$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$median2, pwSurvivalTime12$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$eventTime, pwSurvivalTime12$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$kappa, pwSurvivalTime12$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime12$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$delayedResponseAllowed, pwSurvivalTime12$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$delayedResponseEnabled, pwSurvivalTime12$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime12), "character") - df <- as.data.frame(pwSurvivalTime12) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime12) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime13 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 6), lambda2 = c(0.025, 0.01), hazardRatio = c(0.8, 0.9), delayedResponseAllowed = TRUE) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime13' with expected results - expect_equal(pwSurvivalTime13$piecewiseSurvivalTime, c(0, 6), label = paste0("c(", paste0(pwSurvivalTime13$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$lambda1, c(0.02, 0.009), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime13$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$lambda2, c(0.025, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime13$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$hazardRatio, c(0.8, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime13$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime13$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime13$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$median1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime13$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$median2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime13$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime13$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime13$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$piecewiseSurvivalEnabled, TRUE, label = paste0("c(", paste0(pwSurvivalTime13$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$delayedResponseAllowed, TRUE, label = paste0("c(", paste0(pwSurvivalTime13$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$delayedResponseEnabled, TRUE, label = paste0("c(", paste0(pwSurvivalTime13$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime13), NA))) - expect_output(print(pwSurvivalTime13)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime13), NA))) - expect_output(summary(pwSurvivalTime13)$show()) - pwSurvivalTime13CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime13, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime13CodeBased$piecewiseSurvivalTime, pwSurvivalTime13$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$lambda1, pwSurvivalTime13$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$lambda2, pwSurvivalTime13$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$hazardRatio, pwSurvivalTime13$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$pi1, pwSurvivalTime13$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$pi2, pwSurvivalTime13$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$median1, pwSurvivalTime13$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$median2, pwSurvivalTime13$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$eventTime, pwSurvivalTime13$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$kappa, pwSurvivalTime13$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime13$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$delayedResponseAllowed, pwSurvivalTime13$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$delayedResponseEnabled, pwSurvivalTime13$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime13), "character") - df <- as.data.frame(pwSurvivalTime13) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime13) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # case 2.2: error expected - expect_error(getPiecewiseSurvivalTime( - piecewiseSurvivalTime = c(0, 6, 9), - lambda2 = c(0.025, 0.04, 0.015), - lambda1 = c(0.03, 0.04, 0.025) - ), - paste0( - "Illegal argument: 'hazardRatio' can only be calculated if ", - "'unique(lambda1 / lambda2)' result in a single value; ", - "current result = c(1.2, 1, 1.667) (e.g., delayed response is not allowed)" - ), - fixed = TRUE - ) - - # case 3 - expect_false(getPiecewiseSurvivalTime(delayedResponseAllowed = TRUE)$isPiecewiseSurvivalEnabled()) - expect_false(getPiecewiseSurvivalTime( - piecewiseSurvivalTime = NA, - delayedResponseAllowed = TRUE - )$isPiecewiseSurvivalEnabled()) - - # case 3.1 - pwSurvivalTimeSim1 <- getPiecewiseSurvivalTime( - piecewiseSurvivalTime = c(0, 6, 9), - lambda2 = c(0.025, 0.04, 0.015), hazardRatio = 0.8, - delayedResponseAllowed = TRUE - ) - expect_equal(pwSurvivalTimeSim1$hazardRatio, 0.8) - expect_equal(pwSurvivalTimeSim1$lambda1, c(0.025, 0.04, 0.015) * 0.8) - expect_false(pwSurvivalTimeSim1$isDelayedResponseEnabled()) - - # case 3.2 - pwSurvivalTimeSim2 <- getPiecewiseSurvivalTime( - piecewiseSurvivalTime = c(0, 6, 9), - lambda2 = c(0.025, 0.04, 0.015), - lambda1 = c(0.03, 0.04, 0.025), delayedResponseAllowed = TRUE - ) - expect_true(pwSurvivalTimeSim2$isPiecewiseSurvivalEnabled()) - expect_true(pwSurvivalTimeSim2$isDelayedResponseEnabled()) - expect_equal(pwSurvivalTimeSim2$hazardRatio, c(1.2, 1, 5 / 3)) - - pwsTime1 <- getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), lambda2 = 0.4) - expect_equal(pwsTime1$.isLambdaBased(minNumberOfLambdas = 1), TRUE) - -}) - -test_that("Testing 'getPiecewiseSurvivalTime': check error and warnings", { - - # @refFS[Tab.]{fs:tab:output:getPiecewiseSurvivalTime} - expect_error(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), lambda2 = 0.4, pi2 = 0.4), - "Conflicting arguments: it is not allowed to specify 'pi2' (0.4) and 'lambda2' (0.4) concurrently", - fixed = TRUE - ) - - expect_error(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), lambda2 = 0.4, pi2 = 0.4, pi1 = 0.3), - "Conflicting arguments: it is not allowed to specify 'pi1' (0.3) and 'lambda2' (0.4) concurrently", - fixed = TRUE - ) - - expect_error(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), lambda2 = 0.4, pi2 = 0.4, pi1 = 0.3), - "Conflicting arguments: it is not allowed to specify 'pi1' (0.3) and 'lambda2' (0.4) concurrently", - fixed = TRUE - ) - - expect_error(getPiecewiseSurvivalTime(lambda2 = 0.4, lambda1 = 0.3, pi2 = 0.4, pi1 = 0.3), - "Conflicting arguments: it is not allowed to specify 'pi1' (0.3) and 'lambda1' (0.3) concurrently", - fixed = TRUE - ) - - expect_error(getPiecewiseSurvivalTime(lambda2 = 0.4, lambda1 = 0.3, pi2 = 0.4, pi1 = 0.3), - "Conflicting arguments: it is not allowed to specify 'pi1' (0.3) and 'lambda1' (0.3) concurrently", - fixed = TRUE - ) - - expect_equal(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), pi2 = 0.4)$.isPiBased(), TRUE) - - expect_warning(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), pi2 = 0.4, pi1 = 0.3), - "'hazardRatio' (0.6, 0.8) will be ignored because it will be calculated", - fixed = TRUE - ) - - expect_warning(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), pi1 = 0.3), - "'hazardRatio' (0.6, 0.8) will be ignored because it will be calculated", - fixed = TRUE - ) - - expect_error(getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 6), lambda2 = 0.025, hazardRatio = 0.8, delayedResponseAllowed = TRUE), - "Illegal argument: length of 'piecewiseSurvivalTime' (2) and length of 'lambda2' (1) must be equal", - fixed = TRUE - ) - - expect_error(getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 6, 12), lambda2 = 0.025, hazardRatio = 0.8, delayedResponseAllowed = TRUE), - "Illegal argument: length of 'piecewiseSurvivalTime' (3) and length of 'lambda2' (1) must be equal", - fixed = TRUE - ) - - expect_error(getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 6), lambda2 = 0.025, hazardRatio = 0.8), - "Illegal argument: length of 'piecewiseSurvivalTime' (2) and length of 'lambda2' (1) must be equal", - fixed = TRUE - ) - -}) - -test_that("Testing 'getPiecewiseSurvivalTime': list-wise definition", { - - # @refFS[Tab.]{fs:tab:output:getPiecewiseSurvivalTime} - pwSurvivalTime8 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = list( - "<6" = 0.025, - "6 - <9" = 0.04, - "9 - <15" = 0.015, - "15 - <21" = 0.01, - ">=21" = 0.007 - ), hazardRatio = 0.6) - expect_true(pwSurvivalTime8$isPiecewiseSurvivalEnabled()) - expect_false(pwSurvivalTime8$isDelayedResponseEnabled()) - expect_equal(pwSurvivalTime8$hazardRatio, 0.6) - expect_equal(pwSurvivalTime8$piecewiseSurvivalTime, c(0, 6, 9, 15, 21)) - expect_equal(pwSurvivalTime8$lambda2, c(0.025, 0.040, 0.015, 0.010, 0.007)) - expect_equal(pwSurvivalTime8$lambda1, c(0.0150, 0.0240, 0.0090, 0.0060, 0.0042)) - - .skipTestIfDisabled() - - result1 <- getPiecewiseSurvivalTime(list( - "<5" = 0.1, - "5 - <10" = 0.2, - ">=10" = 0.8 - ), hazardRatio = 0.8) - expect_equal(result1$piecewiseSurvivalTime, c(0, 5, 10)) - expect_equal(result1$lambda2, c(0.1, 0.2, 0.8)) - - result2 <- getPiecewiseSurvivalTime(list( - "0 - <5" = 0.1, - "5 - <10" = 0.2, - "10 - Inf" = 0.8 - ), hazardRatio = 0.8) - expect_equal(result2$piecewiseSurvivalTime, c(0, 5, 10)) - expect_equal(result2$lambda2, c(0.1, 0.2, 0.8)) - - pwSurvivalTime2 <- getPiecewiseSurvivalTime( - piecewiseSurvivalTime = c(0, 5, 10), - lambda2 = c(0.1, 0.2, 0.8), hazardRatio = 0.8 - ) - expect_equal(pwSurvivalTime2$piecewiseSurvivalTime, c(0, 5, 10)) - expect_equal(pwSurvivalTime2$lambda2, c(0.1, 0.2, 0.8)) - - pwSurvivalTime3 <- getPiecewiseSurvivalTime(c(0, 6), lambda2 = c(0.01, 0.03), hazardRatio = 0.8) - expect_equal(pwSurvivalTime3$piecewiseSurvivalTime, c(0, 6)) - expect_equal(pwSurvivalTime3$lambda2, c(0.01, 0.03)) - - pwSurvivalTime4 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = list("0 - ?" = 0.025), - hazardRatio = 0.8, delayedResponseAllowed = TRUE) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime4' with expected results - expect_equal(pwSurvivalTime4$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime4$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime4$lambda1, 0.02, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime4$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime4$lambda2, 0.025, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime4$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime4$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime4$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime4$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime4$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime4$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime4$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime4$median1, 34.657359, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime4$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime4$median2, 27.725887, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime4$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime4$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime4$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime4$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime4$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime4$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime4$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime4$delayedResponseAllowed, TRUE, label = paste0("c(", paste0(pwSurvivalTime4$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime4$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime4$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime4), NA))) - expect_output(print(pwSurvivalTime4)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime4), NA))) - expect_output(summary(pwSurvivalTime4)$show()) - pwSurvivalTime4CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime4, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime4CodeBased$piecewiseSurvivalTime, pwSurvivalTime4$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime4CodeBased$lambda1, pwSurvivalTime4$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime4CodeBased$lambda2, pwSurvivalTime4$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime4CodeBased$hazardRatio, pwSurvivalTime4$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime4CodeBased$pi1, pwSurvivalTime4$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime4CodeBased$pi2, pwSurvivalTime4$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime4CodeBased$median1, pwSurvivalTime4$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime4CodeBased$median2, pwSurvivalTime4$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime4CodeBased$eventTime, pwSurvivalTime4$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime4CodeBased$kappa, pwSurvivalTime4$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime4CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime4$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime4CodeBased$delayedResponseAllowed, pwSurvivalTime4$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime4CodeBased$delayedResponseEnabled, pwSurvivalTime4$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime4), "character") - df <- as.data.frame(pwSurvivalTime4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime5 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = list("x" = 0.025), - hazardRatio = 0.8, delayedResponseAllowed = TRUE) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime5' with expected results - expect_equal(pwSurvivalTime5$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime5$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime5$lambda1, 0.02, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime5$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime5$lambda2, 0.025, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime5$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime5$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime5$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime5$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime5$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime5$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime5$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime5$median1, 34.657359, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime5$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime5$median2, 27.725887, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime5$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime5$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime5$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime5$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime5$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime5$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime5$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime5$delayedResponseAllowed, TRUE, label = paste0("c(", paste0(pwSurvivalTime5$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime5$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime5$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime5), NA))) - expect_output(print(pwSurvivalTime5)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime5), NA))) - expect_output(summary(pwSurvivalTime5)$show()) - pwSurvivalTime5CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime5, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime5CodeBased$piecewiseSurvivalTime, pwSurvivalTime5$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime5CodeBased$lambda1, pwSurvivalTime5$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime5CodeBased$lambda2, pwSurvivalTime5$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime5CodeBased$hazardRatio, pwSurvivalTime5$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime5CodeBased$pi1, pwSurvivalTime5$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime5CodeBased$pi2, pwSurvivalTime5$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime5CodeBased$median1, pwSurvivalTime5$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime5CodeBased$median2, pwSurvivalTime5$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime5CodeBased$eventTime, pwSurvivalTime5$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime5CodeBased$kappa, pwSurvivalTime5$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime5CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime5$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime5CodeBased$delayedResponseAllowed, pwSurvivalTime5$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime5CodeBased$delayedResponseEnabled, pwSurvivalTime5$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime5), "character") - df <- as.data.frame(pwSurvivalTime5) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime5) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime6 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = list("0 - 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime6) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime7 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = list("x" = 0.025), - hazardRatio = 0.8, delayedResponseAllowed = FALSE) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime7' with expected results - expect_equal(pwSurvivalTime7$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime7$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime7$lambda1, 0.02, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime7$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime7$lambda2, 0.025, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime7$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime7$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime7$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime7$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime7$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime7$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime7$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime7$median1, 34.657359, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime7$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime7$median2, 27.725887, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime7$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime7$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime7$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime7$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime7$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime7$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime7$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime7$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime7$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime7$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime7$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime7), NA))) - expect_output(print(pwSurvivalTime7)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime7), NA))) - expect_output(summary(pwSurvivalTime7)$show()) - pwSurvivalTime7CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime7, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime7CodeBased$piecewiseSurvivalTime, pwSurvivalTime7$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime7CodeBased$lambda1, pwSurvivalTime7$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime7CodeBased$lambda2, pwSurvivalTime7$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime7CodeBased$hazardRatio, pwSurvivalTime7$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime7CodeBased$pi1, pwSurvivalTime7$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime7CodeBased$pi2, pwSurvivalTime7$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime7CodeBased$median1, pwSurvivalTime7$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime7CodeBased$median2, pwSurvivalTime7$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime7CodeBased$eventTime, pwSurvivalTime7$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime7CodeBased$kappa, pwSurvivalTime7$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime7CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime7$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime7CodeBased$delayedResponseAllowed, pwSurvivalTime7$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime7CodeBased$delayedResponseEnabled, pwSurvivalTime7$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime7), "character") - df <- as.data.frame(pwSurvivalTime7) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime7) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime8 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = list("0 - 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime8) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - expect_warning(getPiecewiseSurvivalTime(piecewiseSurvivalTime = list("<6" = 0.025), hazardRatio = 0.8), - "Defined time period \"0 - <6\" will be ignored because 'piecewiseSurvivalTime' list has only 1 entry", - fixed = TRUE - ) - -}) - -test_plan_section("Testing Class 'AccrualTime'") - - -test_that("Testing 'getAccrualTime': isAccrualTimeEnabled()", { - expect_true(getAccrualTime()$isAccrualTimeEnabled()) - expect_true(getAccrualTime(maxNumberOfSubjects = 100)$isAccrualTimeEnabled()) - -}) - -test_that("Testing 'getAccrualTime': vector based definition", { - - accrualTime1 <- getAccrualTime( - accrualTime = c(0, 6, 9, 15), - accrualIntensity = c(15, 21, 27), maxNumberOfSubjects = 315 - ) - expect_equal(accrualTime1$accrualTime, c(0, 6, 9, 15)) - expect_equal(accrualTime1$accrualIntensity, c(15, 21, 27)) - expect_equal(accrualTime1$remainingTime, NA_real_) - - accrualTime2 <- getAccrualTime( - accrualTime = c(0, 6, 9), - accrualIntensity = c(15, 21, 27), maxNumberOfSubjects = 1000 - ) - expect_equal(accrualTime2$accrualTime, c(0, 6, 9, 40.37037)) - expect_equal(accrualTime2$accrualIntensity, c(15, 21, 27)) - expect_equal(accrualTime2$remainingTime, 31.37037) - - .skipTestIfDisabled() - - accrualTime3 <- getAccrualTime( - accrualTime = c(0, 12, 13, 14, 15, 16), - accrualIntensity = c(15, 21, 27, 33, 39, 45), maxNumberOfSubjects = 1405 - ) - expect_equal(accrualTime3$accrualTime, c(0, 12, 13, 14, 15, 16, 40.55555556)) - expect_equal(accrualTime3$accrualIntensity, c(15, 21, 27, 33, 39, 45)) - expect_equal(accrualTime3$remainingTime, 24.55555556) - - accrualTime4 <- getAccrualTime( - accrualTime = c(0, 24), - accrualIntensity = c(30), maxNumberOfSubjects = 720 - ) - - ## Comparison of the results of AccrualTime object 'accrualTime4' with expected results - expect_equal(accrualTime4$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime4$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime4$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime4$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime4$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime4$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime4$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime4$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime4$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime4$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime4$accrualTime, c(0, 24), label = paste0("c(", paste0(accrualTime4$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime4$accrualIntensity, 30, label = paste0("c(", paste0(accrualTime4$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime4$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime4$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime4$maxNumberOfSubjects, 720, label = paste0("c(", paste0(accrualTime4$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime4$remainingTime, NA_real_, label = paste0("c(", paste0(accrualTime4$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime4$piecewiseAccrualEnabled, FALSE, label = paste0("c(", paste0(accrualTime4$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime4), NA))) - expect_output(print(accrualTime4)$show()) - invisible(capture.output(expect_error(summary(accrualTime4), NA))) - expect_output(summary(accrualTime4)$show()) - accrualTime4CodeBased <- eval(parse(text = getObjectRCode(accrualTime4, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime4CodeBased$endOfAccrualIsUserDefined, accrualTime4$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$followUpTimeMustBeUserDefined, accrualTime4$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime4$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime4$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$absoluteAccrualIntensityEnabled, accrualTime4$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$accrualTime, accrualTime4$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$accrualIntensity, accrualTime4$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$accrualIntensityRelative, accrualTime4$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$maxNumberOfSubjects, accrualTime4$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$remainingTime, accrualTime4$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$piecewiseAccrualEnabled, accrualTime4$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime4), "character") - df <- as.data.frame(accrualTime4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime5 <- getAccrualTime( - accrualTime = c(0, 24, 30), - accrualIntensity = c(30, 45) - ) - - ## Comparison of the results of AccrualTime object 'accrualTime5' with expected results - expect_equal(accrualTime5$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime5$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime5$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime5$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime5$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime5$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime5$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime5$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime5$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime5$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime5$accrualTime, c(0, 24, 30), label = paste0("c(", paste0(accrualTime5$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime5$accrualIntensity, c(30, 45), label = paste0("c(", paste0(accrualTime5$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime5$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime5$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime5$maxNumberOfSubjects, 990, label = paste0("c(", paste0(accrualTime5$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime5$remainingTime, 6, label = paste0("c(", paste0(accrualTime5$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime5$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime5$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime5), NA))) - expect_output(print(accrualTime5)$show()) - invisible(capture.output(expect_error(summary(accrualTime5), NA))) - expect_output(summary(accrualTime5)$show()) - accrualTime5CodeBased <- eval(parse(text = getObjectRCode(accrualTime5, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime5CodeBased$endOfAccrualIsUserDefined, accrualTime5$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$followUpTimeMustBeUserDefined, accrualTime5$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime5$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime5$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$absoluteAccrualIntensityEnabled, accrualTime5$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$accrualTime, accrualTime5$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$accrualIntensity, accrualTime5$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$accrualIntensityRelative, accrualTime5$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$maxNumberOfSubjects, accrualTime5$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$remainingTime, accrualTime5$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$piecewiseAccrualEnabled, accrualTime5$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime5), "character") - df <- as.data.frame(accrualTime5) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime5) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime6 <- getAccrualTime( - accrualTime = c(0, 24, 30), - accrualIntensity = c(20, 25, 45), maxNumberOfSubjects = 720 - ) - - ## Comparison of the results of AccrualTime object 'accrualTime6' with expected results - expect_equal(accrualTime6$endOfAccrualIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime6$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime6$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime6$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime6$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime6$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime6$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime6$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime6$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime6$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime6$accrualTime, c(0, 24, 30, 32), label = paste0("c(", paste0(accrualTime6$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime6$accrualIntensity, c(20, 25, 45), label = paste0("c(", paste0(accrualTime6$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime6$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime6$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime6$maxNumberOfSubjects, 720, label = paste0("c(", paste0(accrualTime6$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime6$remainingTime, 2, label = paste0("c(", paste0(accrualTime6$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime6$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime6$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime6), NA))) - expect_output(print(accrualTime6)$show()) - invisible(capture.output(expect_error(summary(accrualTime6), NA))) - expect_output(summary(accrualTime6)$show()) - accrualTime6CodeBased <- eval(parse(text = getObjectRCode(accrualTime6, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime6CodeBased$endOfAccrualIsUserDefined, accrualTime6$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$followUpTimeMustBeUserDefined, accrualTime6$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime6$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime6$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$absoluteAccrualIntensityEnabled, accrualTime6$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$accrualTime, accrualTime6$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$accrualIntensity, accrualTime6$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$accrualIntensityRelative, accrualTime6$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$maxNumberOfSubjects, accrualTime6$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$remainingTime, accrualTime6$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$piecewiseAccrualEnabled, accrualTime6$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime6), "character") - df <- as.data.frame(accrualTime6) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime6) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime8 <- getAccrualTime(accrualTime = 0, accrualIntensity = 15, maxNumberOfSubjects = 1000) - - ## Comparison of the results of AccrualTime object 'accrualTime8' with expected results - expect_equal(accrualTime8$endOfAccrualIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime8$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime8$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime8$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime8$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime8$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime8$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime8$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime8$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime8$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime8$accrualTime, c(0, 66.666667), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime8$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime8$accrualIntensity, 15, label = paste0("c(", paste0(accrualTime8$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime8$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime8$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime8$maxNumberOfSubjects, 1000, label = paste0("c(", paste0(accrualTime8$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime8$remainingTime, 66.666667, tolerance = 1e-07, label = paste0("c(", paste0(accrualTime8$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime8$piecewiseAccrualEnabled, FALSE, label = paste0("c(", paste0(accrualTime8$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime8), NA))) - expect_output(print(accrualTime8)$show()) - invisible(capture.output(expect_error(summary(accrualTime8), NA))) - expect_output(summary(accrualTime8)$show()) - accrualTime8CodeBased <- eval(parse(text = getObjectRCode(accrualTime8, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime8CodeBased$endOfAccrualIsUserDefined, accrualTime8$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$followUpTimeMustBeUserDefined, accrualTime8$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime8$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime8$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$absoluteAccrualIntensityEnabled, accrualTime8$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$accrualTime, accrualTime8$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$accrualIntensity, accrualTime8$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$accrualIntensityRelative, accrualTime8$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$maxNumberOfSubjects, accrualTime8$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$remainingTime, accrualTime8$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$piecewiseAccrualEnabled, accrualTime8$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime8), "character") - df <- as.data.frame(accrualTime8) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime8) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime9 <- getAccrualTime(accrualTime = c(0, 5), accrualIntensity = 15) - - ## Comparison of the results of AccrualTime object 'accrualTime9' with expected results - expect_equal(accrualTime9$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime9$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime9$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime9$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime9$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime9$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime9$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime9$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime9$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime9$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime9$accrualTime, c(0, 5), label = paste0("c(", paste0(accrualTime9$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime9$accrualIntensity, 15, label = paste0("c(", paste0(accrualTime9$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime9$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime9$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime9$maxNumberOfSubjects, 75, label = paste0("c(", paste0(accrualTime9$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime9$remainingTime, 5, label = paste0("c(", paste0(accrualTime9$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime9$piecewiseAccrualEnabled, FALSE, label = paste0("c(", paste0(accrualTime9$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime9), NA))) - expect_output(print(accrualTime9)$show()) - invisible(capture.output(expect_error(summary(accrualTime9), NA))) - expect_output(summary(accrualTime9)$show()) - accrualTime9CodeBased <- eval(parse(text = getObjectRCode(accrualTime9, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime9CodeBased$endOfAccrualIsUserDefined, accrualTime9$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$followUpTimeMustBeUserDefined, accrualTime9$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime9$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime9$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$absoluteAccrualIntensityEnabled, accrualTime9$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$accrualTime, accrualTime9$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$accrualIntensity, accrualTime9$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$accrualIntensityRelative, accrualTime9$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$maxNumberOfSubjects, accrualTime9$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$remainingTime, accrualTime9$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$piecewiseAccrualEnabled, accrualTime9$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime9), "character") - df <- as.data.frame(accrualTime9) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime9) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime10 <- getAccrualTime(accrualTime = 0, accrualIntensity = 15, maxNumberOfSubjects = 10) - - ## Comparison of the results of AccrualTime object 'accrualTime10' with expected results - expect_equal(accrualTime10$endOfAccrualIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime10$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime10$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime10$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime10$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime10$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime10$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime10$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime10$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime10$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime10$accrualTime, c(0, 0.66666667), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime10$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime10$accrualIntensity, 15, label = paste0("c(", paste0(accrualTime10$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime10$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime10$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime10$maxNumberOfSubjects, 10, label = paste0("c(", paste0(accrualTime10$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime10$remainingTime, 0.66666667, tolerance = 1e-07, label = paste0("c(", paste0(accrualTime10$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime10$piecewiseAccrualEnabled, FALSE, label = paste0("c(", paste0(accrualTime10$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime10), NA))) - expect_output(print(accrualTime10)$show()) - invisible(capture.output(expect_error(summary(accrualTime10), NA))) - expect_output(summary(accrualTime10)$show()) - accrualTime10CodeBased <- eval(parse(text = getObjectRCode(accrualTime10, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime10CodeBased$endOfAccrualIsUserDefined, accrualTime10$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$followUpTimeMustBeUserDefined, accrualTime10$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime10$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime10$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$absoluteAccrualIntensityEnabled, accrualTime10$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$accrualTime, accrualTime10$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$accrualIntensity, accrualTime10$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$accrualIntensityRelative, accrualTime10$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$maxNumberOfSubjects, accrualTime10$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$remainingTime, accrualTime10$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$piecewiseAccrualEnabled, accrualTime10$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime10), "character") - df <- as.data.frame(accrualTime10) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime10) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime11 <- getAccrualTime(accrualTime = c(0, 5), accrualIntensity = 15, maxNumberOfSubjects = 75) - - ## Comparison of the results of AccrualTime object 'accrualTime11' with expected results - expect_equal(accrualTime11$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime11$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime11$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime11$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime11$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime11$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime11$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime11$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime11$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime11$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime11$accrualTime, c(0, 5), label = paste0("c(", paste0(accrualTime11$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime11$accrualIntensity, 15, label = paste0("c(", paste0(accrualTime11$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime11$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime11$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime11$maxNumberOfSubjects, 75, label = paste0("c(", paste0(accrualTime11$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime11$remainingTime, NA_real_, label = paste0("c(", paste0(accrualTime11$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime11$piecewiseAccrualEnabled, FALSE, label = paste0("c(", paste0(accrualTime11$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime11), NA))) - expect_output(print(accrualTime11)$show()) - invisible(capture.output(expect_error(summary(accrualTime11), NA))) - expect_output(summary(accrualTime11)$show()) - accrualTime11CodeBased <- eval(parse(text = getObjectRCode(accrualTime11, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime11CodeBased$endOfAccrualIsUserDefined, accrualTime11$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime11CodeBased$followUpTimeMustBeUserDefined, accrualTime11$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime11CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime11$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime11CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime11$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime11CodeBased$absoluteAccrualIntensityEnabled, accrualTime11$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime11CodeBased$accrualTime, accrualTime11$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime11CodeBased$accrualIntensity, accrualTime11$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime11CodeBased$accrualIntensityRelative, accrualTime11$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime11CodeBased$maxNumberOfSubjects, accrualTime11$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime11CodeBased$remainingTime, accrualTime11$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime11CodeBased$piecewiseAccrualEnabled, accrualTime11$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime11), "character") - df <- as.data.frame(accrualTime11) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime11) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime12 <- getAccrualTime(accrualTime = c(0, 6, 15, 25), accrualIntensity = c(22, 0, 33)) - - ## Comparison of the results of AccrualTime object 'accrualTime12' with expected results - expect_equal(accrualTime12$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime12$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime12$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime12$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime12$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime12$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime12$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime12$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime12$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime12$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime12$accrualTime, c(0, 6, 15, 25), label = paste0("c(", paste0(accrualTime12$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime12$accrualIntensity, c(22, 0, 33), label = paste0("c(", paste0(accrualTime12$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime12$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime12$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime12$maxNumberOfSubjects, 462, label = paste0("c(", paste0(accrualTime12$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime12$remainingTime, 10, label = paste0("c(", paste0(accrualTime12$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime12$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime12$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime12), NA))) - expect_output(print(accrualTime12)$show()) - invisible(capture.output(expect_error(summary(accrualTime12), NA))) - expect_output(summary(accrualTime12)$show()) - accrualTime12CodeBased <- eval(parse(text = getObjectRCode(accrualTime12, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime12CodeBased$endOfAccrualIsUserDefined, accrualTime12$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$followUpTimeMustBeUserDefined, accrualTime12$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime12$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime12$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$absoluteAccrualIntensityEnabled, accrualTime12$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$accrualTime, accrualTime12$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$accrualIntensity, accrualTime12$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$accrualIntensityRelative, accrualTime12$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$maxNumberOfSubjects, accrualTime12$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$remainingTime, accrualTime12$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$piecewiseAccrualEnabled, accrualTime12$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime12), "character") - df <- as.data.frame(accrualTime12) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime12) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime13 <- getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(22, 33), maxNumberOfSubjects = 1000) - - ## Comparison of the results of AccrualTime object 'accrualTime13' with expected results - expect_equal(accrualTime13$endOfAccrualIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime13$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime13$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime13$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime13$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime13$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime13$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime13$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime13$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime13$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime13$accrualTime, c(0, 6, 32.30303), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime13$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime13$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime13$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime13$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime13$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime13$maxNumberOfSubjects, 1000, label = paste0("c(", paste0(accrualTime13$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime13$remainingTime, 26.30303, tolerance = 1e-07, label = paste0("c(", paste0(accrualTime13$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime13$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime13$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime13), NA))) - expect_output(print(accrualTime13)$show()) - invisible(capture.output(expect_error(summary(accrualTime13), NA))) - expect_output(summary(accrualTime13)$show()) - accrualTime13CodeBased <- eval(parse(text = getObjectRCode(accrualTime13, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime13CodeBased$endOfAccrualIsUserDefined, accrualTime13$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$followUpTimeMustBeUserDefined, accrualTime13$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime13$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime13$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$absoluteAccrualIntensityEnabled, accrualTime13$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$accrualTime, accrualTime13$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$accrualIntensity, accrualTime13$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$accrualIntensityRelative, accrualTime13$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$maxNumberOfSubjects, accrualTime13$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$remainingTime, accrualTime13$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$piecewiseAccrualEnabled, accrualTime13$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime13), "character") - df <- as.data.frame(accrualTime13) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime13) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("Testing 'getAccrualTime': test absolute and relative definition", { - - # @refFS[Tab.]{fs:tab:output:getAccrualTime} - accrualTime1 <- getAccrualTime( - accrualTime = c(0, 6, 30), - accrualIntensity = c(22, 33), maxNumberOfSubjects = 924 - ) - - ## Comparison of the results of AccrualTime object 'accrualTime1' with expected results - expect_equal(accrualTime1$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime1$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime1$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime1$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime1$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime1$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime1$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime1$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime1$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime1$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime1$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime1$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime1$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime1$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime1$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime1$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime1$maxNumberOfSubjects, 924, label = paste0("c(", paste0(accrualTime1$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime1$remainingTime, NA_real_, label = paste0("c(", paste0(accrualTime1$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime1$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime1$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime1), NA))) - expect_output(print(accrualTime1)$show()) - invisible(capture.output(expect_error(summary(accrualTime1), NA))) - expect_output(summary(accrualTime1)$show()) - accrualTime1CodeBased <- eval(parse(text = getObjectRCode(accrualTime1, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime1CodeBased$endOfAccrualIsUserDefined, accrualTime1$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime1CodeBased$followUpTimeMustBeUserDefined, accrualTime1$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime1CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime1$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime1CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime1$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime1CodeBased$absoluteAccrualIntensityEnabled, accrualTime1$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime1CodeBased$accrualTime, accrualTime1$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime1CodeBased$accrualIntensity, accrualTime1$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime1CodeBased$accrualIntensityRelative, accrualTime1$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime1CodeBased$maxNumberOfSubjects, accrualTime1$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime1CodeBased$remainingTime, accrualTime1$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime1CodeBased$piecewiseAccrualEnabled, accrualTime1$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime1), "character") - df <- as.data.frame(accrualTime1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime2 <- getAccrualTime(list( - "0 - <6" = 22, - "6 - <=30" = 33 - ), - maxNumberOfSubjects = 924 - ) - - ## Comparison of the results of AccrualTime object 'accrualTime2' with expected results - expect_equal(accrualTime2$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime2$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime2$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime2$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime2$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime2$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime2$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime2$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime2$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime2$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime2$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime2$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime2$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime2$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime2$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime2$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime2$maxNumberOfSubjects, 924, label = paste0("c(", paste0(accrualTime2$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime2$remainingTime, NA_real_, label = paste0("c(", paste0(accrualTime2$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime2$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime2$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime2), NA))) - expect_output(print(accrualTime2)$show()) - invisible(capture.output(expect_error(summary(accrualTime2), NA))) - expect_output(summary(accrualTime2)$show()) - accrualTime2CodeBased <- eval(parse(text = getObjectRCode(accrualTime2, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime2CodeBased$endOfAccrualIsUserDefined, accrualTime2$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime2CodeBased$followUpTimeMustBeUserDefined, accrualTime2$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime2CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime2$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime2CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime2$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime2CodeBased$absoluteAccrualIntensityEnabled, accrualTime2$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime2CodeBased$accrualTime, accrualTime2$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime2CodeBased$accrualIntensity, accrualTime2$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime2CodeBased$accrualIntensityRelative, accrualTime2$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime2CodeBased$maxNumberOfSubjects, accrualTime2$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime2CodeBased$remainingTime, accrualTime2$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime2CodeBased$piecewiseAccrualEnabled, accrualTime2$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime2), "character") - df <- as.data.frame(accrualTime2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - .skipTestIfDisabled() - - accrualTime3 <- getAccrualTime( - accrualTime = c(0, 6, 30), - accrualIntensity = c(0.22, 0.33), maxNumberOfSubjects = 1000 - ) - - ## Comparison of the results of AccrualTime object 'accrualTime3' with expected results - expect_equal(accrualTime3$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime3$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime3$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime3$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime3$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime3$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime3$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime3$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime3$absoluteAccrualIntensityEnabled, FALSE, label = paste0("c(", paste0(accrualTime3$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime3$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime3$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime3$accrualIntensity, c(23.809524, 35.714286), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime3$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime3$accrualIntensityRelative, c(0.22, 0.33), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime3$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime3$maxNumberOfSubjects, 1000, label = paste0("c(", paste0(accrualTime3$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime3$remainingTime, 24, label = paste0("c(", paste0(accrualTime3$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime3$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime3$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime3), NA))) - expect_output(print(accrualTime3)$show()) - invisible(capture.output(expect_error(summary(accrualTime3), NA))) - expect_output(summary(accrualTime3)$show()) - accrualTime3CodeBased <- eval(parse(text = getObjectRCode(accrualTime3, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime3CodeBased$endOfAccrualIsUserDefined, accrualTime3$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime3CodeBased$followUpTimeMustBeUserDefined, accrualTime3$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime3CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime3$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime3CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime3$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime3CodeBased$absoluteAccrualIntensityEnabled, accrualTime3$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime3CodeBased$accrualTime, accrualTime3$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime3CodeBased$accrualIntensity, accrualTime3$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime3CodeBased$accrualIntensityRelative, accrualTime3$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime3CodeBased$maxNumberOfSubjects, accrualTime3$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime3CodeBased$remainingTime, accrualTime3$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime3CodeBased$piecewiseAccrualEnabled, accrualTime3$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime3), "character") - df <- as.data.frame(accrualTime3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime4 <- getAccrualTime(list( - "0 - <6" = 0.22, - "6 - <=30" = 0.33 - ), - maxNumberOfSubjects = 1000 - ) - - ## Comparison of the results of AccrualTime object 'accrualTime4' with expected results - expect_equal(accrualTime4$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime4$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime4$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime4$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime4$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime4$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime4$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime4$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime4$absoluteAccrualIntensityEnabled, FALSE, label = paste0("c(", paste0(accrualTime4$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime4$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime4$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime4$accrualIntensity, c(23.809524, 35.714286), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime4$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime4$accrualIntensityRelative, c(0.22, 0.33), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime4$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime4$maxNumberOfSubjects, 1000, label = paste0("c(", paste0(accrualTime4$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime4$remainingTime, 24, label = paste0("c(", paste0(accrualTime4$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime4$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime4$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime4), NA))) - expect_output(print(accrualTime4)$show()) - invisible(capture.output(expect_error(summary(accrualTime4), NA))) - expect_output(summary(accrualTime4)$show()) - accrualTime4CodeBased <- eval(parse(text = getObjectRCode(accrualTime4, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime4CodeBased$endOfAccrualIsUserDefined, accrualTime4$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$followUpTimeMustBeUserDefined, accrualTime4$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime4$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime4$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$absoluteAccrualIntensityEnabled, accrualTime4$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$accrualTime, accrualTime4$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$accrualIntensity, accrualTime4$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$accrualIntensityRelative, accrualTime4$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$maxNumberOfSubjects, accrualTime4$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$remainingTime, accrualTime4$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$piecewiseAccrualEnabled, accrualTime4$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime4), "character") - df <- as.data.frame(accrualTime4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime5 <- getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(22, 33)) - - ## Comparison of the results of AccrualTime object 'accrualTime5' with expected results - expect_equal(accrualTime5$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime5$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime5$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime5$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime5$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime5$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime5$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime5$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime5$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime5$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime5$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime5$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime5$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime5$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime5$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime5$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime5$maxNumberOfSubjects, 924, label = paste0("c(", paste0(accrualTime5$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime5$remainingTime, 24, label = paste0("c(", paste0(accrualTime5$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime5$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime5$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime5), NA))) - expect_output(print(accrualTime5)$show()) - invisible(capture.output(expect_error(summary(accrualTime5), NA))) - expect_output(summary(accrualTime5)$show()) - accrualTime5CodeBased <- eval(parse(text = getObjectRCode(accrualTime5, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime5CodeBased$endOfAccrualIsUserDefined, accrualTime5$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$followUpTimeMustBeUserDefined, accrualTime5$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime5$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime5$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$absoluteAccrualIntensityEnabled, accrualTime5$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$accrualTime, accrualTime5$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$accrualIntensity, accrualTime5$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$accrualIntensityRelative, accrualTime5$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$maxNumberOfSubjects, accrualTime5$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$remainingTime, accrualTime5$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$piecewiseAccrualEnabled, accrualTime5$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime5), "character") - df <- as.data.frame(accrualTime5) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime5) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime6 <- getAccrualTime(list( - "0 - <6" = 22, - "6 - <=30" = 33 - )) - - ## Comparison of the results of AccrualTime object 'accrualTime6' with expected results - expect_equal(accrualTime6$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime6$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime6$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime6$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime6$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime6$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime6$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime6$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime6$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime6$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime6$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime6$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime6$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime6$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime6$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime6$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime6$maxNumberOfSubjects, 924, label = paste0("c(", paste0(accrualTime6$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime6$remainingTime, 24, label = paste0("c(", paste0(accrualTime6$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime6$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime6$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime6), NA))) - expect_output(print(accrualTime6)$show()) - invisible(capture.output(expect_error(summary(accrualTime6), NA))) - expect_output(summary(accrualTime6)$show()) - accrualTime6CodeBased <- eval(parse(text = getObjectRCode(accrualTime6, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime6CodeBased$endOfAccrualIsUserDefined, accrualTime6$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$followUpTimeMustBeUserDefined, accrualTime6$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime6$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime6$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$absoluteAccrualIntensityEnabled, accrualTime6$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$accrualTime, accrualTime6$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$accrualIntensity, accrualTime6$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$accrualIntensityRelative, accrualTime6$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$maxNumberOfSubjects, accrualTime6$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$remainingTime, accrualTime6$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$piecewiseAccrualEnabled, accrualTime6$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime6), "character") - df <- as.data.frame(accrualTime6) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime6) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime7 <- getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(0.22, 0.33)) - - ## Comparison of the results of AccrualTime object 'accrualTime7' with expected results - expect_equal(accrualTime7$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime7$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime7$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime7$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime7$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime7$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime7$maxNumberOfSubjectsCanBeCalculatedDirectly, FALSE, label = paste0("c(", paste0(accrualTime7$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime7$absoluteAccrualIntensityEnabled, FALSE, label = paste0("c(", paste0(accrualTime7$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime7$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime7$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime7$accrualIntensity, c(0.22, 0.33), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime7$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime7$accrualIntensityRelative, c(0.22, 0.33), label = paste0("c(", paste0(accrualTime7$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime7$maxNumberOfSubjects, NA_real_, label = paste0("c(", paste0(accrualTime7$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime7$remainingTime, NA_real_, label = paste0("c(", paste0(accrualTime7$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime7$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime7$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime7), NA))) - expect_output(print(accrualTime7)$show()) - invisible(capture.output(expect_error(summary(accrualTime7), NA))) - expect_output(summary(accrualTime7)$show()) - accrualTime7CodeBased <- eval(parse(text = getObjectRCode(accrualTime7, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime7CodeBased$endOfAccrualIsUserDefined, accrualTime7$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime7CodeBased$followUpTimeMustBeUserDefined, accrualTime7$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime7CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime7$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime7CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime7$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime7CodeBased$absoluteAccrualIntensityEnabled, accrualTime7$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime7CodeBased$accrualTime, accrualTime7$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime7CodeBased$accrualIntensity, accrualTime7$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime7CodeBased$accrualIntensityRelative, accrualTime7$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime7CodeBased$maxNumberOfSubjects, accrualTime7$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime7CodeBased$remainingTime, accrualTime7$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime7CodeBased$piecewiseAccrualEnabled, accrualTime7$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime7), "character") - df <- as.data.frame(accrualTime7) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime7) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime8 <- getAccrualTime(list( - "0 - <6" = 0.22, - "6 - <=30" = 0.33 - )) - - ## Comparison of the results of AccrualTime object 'accrualTime8' with expected results - expect_equal(accrualTime8$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime8$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime8$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime8$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime8$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime8$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime8$maxNumberOfSubjectsCanBeCalculatedDirectly, FALSE, label = paste0("c(", paste0(accrualTime8$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime8$absoluteAccrualIntensityEnabled, FALSE, label = paste0("c(", paste0(accrualTime8$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime8$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime8$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime8$accrualIntensity, c(0.22, 0.33), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime8$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime8$accrualIntensityRelative, c(0.22, 0.33), label = paste0("c(", paste0(accrualTime8$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime8$maxNumberOfSubjects, NA_real_, label = paste0("c(", paste0(accrualTime8$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime8$remainingTime, NA_real_, label = paste0("c(", paste0(accrualTime8$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime8$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime8$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime8), NA))) - expect_output(print(accrualTime8)$show()) - invisible(capture.output(expect_error(summary(accrualTime8), NA))) - expect_output(summary(accrualTime8)$show()) - accrualTime8CodeBased <- eval(parse(text = getObjectRCode(accrualTime8, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime8CodeBased$endOfAccrualIsUserDefined, accrualTime8$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$followUpTimeMustBeUserDefined, accrualTime8$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime8$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime8$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$absoluteAccrualIntensityEnabled, accrualTime8$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$accrualTime, accrualTime8$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$accrualIntensity, accrualTime8$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$accrualIntensityRelative, accrualTime8$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$maxNumberOfSubjects, accrualTime8$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$remainingTime, accrualTime8$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$piecewiseAccrualEnabled, accrualTime8$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime8), "character") - df <- as.data.frame(accrualTime8) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime8) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime9 <- getAccrualTime( - accrualTime = c(0, 6), - accrualIntensity = c(22, 33), maxNumberOfSubjects = 1000 - ) - - ## Comparison of the results of AccrualTime object 'accrualTime9' with expected results - expect_equal(accrualTime9$endOfAccrualIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime9$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime9$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime9$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime9$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime9$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime9$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime9$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime9$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime9$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime9$accrualTime, c(0, 6, 32.30303), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime9$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime9$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime9$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime9$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime9$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime9$maxNumberOfSubjects, 1000, label = paste0("c(", paste0(accrualTime9$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime9$remainingTime, 26.30303, tolerance = 1e-07, label = paste0("c(", paste0(accrualTime9$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime9$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime9$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime9), NA))) - expect_output(print(accrualTime9)$show()) - invisible(capture.output(expect_error(summary(accrualTime9), NA))) - expect_output(summary(accrualTime9)$show()) - accrualTime9CodeBased <- eval(parse(text = getObjectRCode(accrualTime9, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime9CodeBased$endOfAccrualIsUserDefined, accrualTime9$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$followUpTimeMustBeUserDefined, accrualTime9$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime9$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime9$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$absoluteAccrualIntensityEnabled, accrualTime9$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$accrualTime, accrualTime9$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$accrualIntensity, accrualTime9$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$accrualIntensityRelative, accrualTime9$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$maxNumberOfSubjects, accrualTime9$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$remainingTime, accrualTime9$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$piecewiseAccrualEnabled, accrualTime9$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime9), "character") - df <- as.data.frame(accrualTime9) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime9) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime10 <- getAccrualTime(list( - "0 - <6" = 22, - "6" = 33 - ), - maxNumberOfSubjects = 1000 - ) - - ## Comparison of the results of AccrualTime object 'accrualTime10' with expected results - expect_equal(accrualTime10$endOfAccrualIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime10$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime10$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime10$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime10$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime10$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime10$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime10$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime10$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime10$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime10$accrualTime, c(0, 6, 32.30303), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime10$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime10$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime10$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime10$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime10$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime10$maxNumberOfSubjects, 1000, label = paste0("c(", paste0(accrualTime10$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime10$remainingTime, 26.30303, tolerance = 1e-07, label = paste0("c(", paste0(accrualTime10$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime10$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime10$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime10), NA))) - expect_output(print(accrualTime10)$show()) - invisible(capture.output(expect_error(summary(accrualTime10), NA))) - expect_output(summary(accrualTime10)$show()) - accrualTime10CodeBased <- eval(parse(text = getObjectRCode(accrualTime10, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime10CodeBased$endOfAccrualIsUserDefined, accrualTime10$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$followUpTimeMustBeUserDefined, accrualTime10$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime10$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime10$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$absoluteAccrualIntensityEnabled, accrualTime10$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$accrualTime, accrualTime10$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$accrualIntensity, accrualTime10$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$accrualIntensityRelative, accrualTime10$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$maxNumberOfSubjects, accrualTime10$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$remainingTime, accrualTime10$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$piecewiseAccrualEnabled, accrualTime10$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime10), "character") - df <- as.data.frame(accrualTime10) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime10) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime12 <- getAccrualTime(list( - "0 - <6" = 0.22, - "6 - <=30" = 0.33 - ), - maxNumberOfSubjects = 1000 - ) - - ## Comparison of the results of AccrualTime object 'accrualTime12' with expected results - expect_equal(accrualTime12$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime12$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime12$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime12$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime12$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime12$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime12$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime12$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime12$absoluteAccrualIntensityEnabled, FALSE, label = paste0("c(", paste0(accrualTime12$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime12$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime12$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime12$accrualIntensity, c(23.809524, 35.714286), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime12$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime12$accrualIntensityRelative, c(0.22, 0.33), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime12$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime12$maxNumberOfSubjects, 1000, label = paste0("c(", paste0(accrualTime12$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime12$remainingTime, 24, label = paste0("c(", paste0(accrualTime12$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime12$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime12$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime12), NA))) - expect_output(print(accrualTime12)$show()) - invisible(capture.output(expect_error(summary(accrualTime12), NA))) - expect_output(summary(accrualTime12)$show()) - accrualTime12CodeBased <- eval(parse(text = getObjectRCode(accrualTime12, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime12CodeBased$endOfAccrualIsUserDefined, accrualTime12$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$followUpTimeMustBeUserDefined, accrualTime12$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime12$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime12$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$absoluteAccrualIntensityEnabled, accrualTime12$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$accrualTime, accrualTime12$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$accrualIntensity, accrualTime12$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$accrualIntensityRelative, accrualTime12$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$maxNumberOfSubjects, accrualTime12$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$remainingTime, accrualTime12$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$piecewiseAccrualEnabled, accrualTime12$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime12), "character") - df <- as.data.frame(accrualTime12) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime12) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime13 <- getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(22, 33)) - - ## Comparison of the results of AccrualTime object 'accrualTime13' with expected results - expect_equal(accrualTime13$endOfAccrualIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime13$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime13$followUpTimeMustBeUserDefined, TRUE, label = paste0("c(", paste0(accrualTime13$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime13$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime13$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime13$maxNumberOfSubjectsCanBeCalculatedDirectly, FALSE, label = paste0("c(", paste0(accrualTime13$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime13$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime13$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime13$accrualTime, c(0, 6), label = paste0("c(", paste0(accrualTime13$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime13$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime13$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime13$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime13$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime13$maxNumberOfSubjects, NA_real_, label = paste0("c(", paste0(accrualTime13$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime13$remainingTime, NA_real_, label = paste0("c(", paste0(accrualTime13$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime13$piecewiseAccrualEnabled, FALSE, label = paste0("c(", paste0(accrualTime13$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime13), NA))) - expect_output(print(accrualTime13)$show()) - invisible(capture.output(expect_error(summary(accrualTime13), NA))) - expect_output(summary(accrualTime13)$show()) - accrualTime13CodeBased <- eval(parse(text = getObjectRCode(accrualTime13, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime13CodeBased$endOfAccrualIsUserDefined, accrualTime13$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$followUpTimeMustBeUserDefined, accrualTime13$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime13$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime13$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$absoluteAccrualIntensityEnabled, accrualTime13$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$accrualTime, accrualTime13$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$accrualIntensity, accrualTime13$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$accrualIntensityRelative, accrualTime13$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$maxNumberOfSubjects, accrualTime13$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$remainingTime, accrualTime13$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$piecewiseAccrualEnabled, accrualTime13$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime13), "character") - df <- as.data.frame(accrualTime13) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime13) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime14 <- getAccrualTime(list( - "0 - <6" = 22, - "6 - <=30" = 33 - )) - - ## Comparison of the results of AccrualTime object 'accrualTime14' with expected results - expect_equal(accrualTime14$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime14$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime14$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime14$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime14$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime14$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime14$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime14$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime14$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime14$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime14$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime14$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime14$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime14$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime14$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime14$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime14$maxNumberOfSubjects, 924, label = paste0("c(", paste0(accrualTime14$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime14$remainingTime, 24, label = paste0("c(", paste0(accrualTime14$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime14$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime14$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime14), NA))) - expect_output(print(accrualTime14)$show()) - invisible(capture.output(expect_error(summary(accrualTime14), NA))) - expect_output(summary(accrualTime14)$show()) - accrualTime14CodeBased <- eval(parse(text = getObjectRCode(accrualTime14, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime14CodeBased$endOfAccrualIsUserDefined, accrualTime14$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime14CodeBased$followUpTimeMustBeUserDefined, accrualTime14$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime14CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime14$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime14CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime14$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime14CodeBased$absoluteAccrualIntensityEnabled, accrualTime14$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime14CodeBased$accrualTime, accrualTime14$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime14CodeBased$accrualIntensity, accrualTime14$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime14CodeBased$accrualIntensityRelative, accrualTime14$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime14CodeBased$maxNumberOfSubjects, accrualTime14$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime14CodeBased$remainingTime, accrualTime14$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime14CodeBased$piecewiseAccrualEnabled, accrualTime14$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime14), "character") - df <- as.data.frame(accrualTime14) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime14) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("Testing 'getAccrualTime': check expected warnings and errors", { - - # @refFS[Tab.]{fs:tab:output:getAccrualTime} - expect_warning(getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(0.22, 0.33)), - paste0("The specified accrual time and intensity cannot be supplemented ", - "automatically with the missing information; therefore further calculations are not possible"), - fixed = TRUE - ) - - expect_warning(getAccrualTime(accrualTime = c(0, 24), accrualIntensity = c(30, 45), maxNumberOfSubjects = 720), - "Last accrual intensity value (45) ignored", - fixed = TRUE - ) - - .skipTestIfDisabled() - - suppressWarnings(expect_warning(getAccrualTime(accrualTime = c(0, 24, 30), - accrualIntensity = c(30, 45, 55), maxNumberOfSubjects = 720), - "Last 2 accrual intensity values (45, 55) ignored", - fixed = TRUE - )) - - suppressWarnings(expect_warning(getAccrualTime(accrualTime = c(0, 24, 30, 40), - accrualIntensity = c(30, 45, 55, 66), maxNumberOfSubjects = 720), - "Last 2 accrual time values (30, 40) ignored", - fixed = TRUE - )) - - suppressWarnings(expect_warning(getAccrualTime(accrualTime = c(0, 24, 30, 40), - accrualIntensity = c(30, 45, 55, 66), maxNumberOfSubjects = 720), - "Last 3 accrual intensity values (45, 55, 66) ignored", - fixed = TRUE - )) - - expect_warning(getAccrualTime(accrualTime = c(0, 6, 15, 25), accrualIntensity = c(0, 22, 33)), - "It makes no sense to start 'accrualIntensity' (0, 22, 33) with 0", - fixed = TRUE - ) - - expect_error(getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(0)), - "Illegal argument: at least one 'accrualIntensity' value must be > 0", - fixed = TRUE - ) - - expect_error(getAccrualTime( - accrualTime = c(0, 6, 30), accrualIntensity = c(22, 33), - maxNumberOfSubjects = 1000 - ), - paste0( - "Conflicting arguments: 'maxNumberOfSubjects' (1000) disagrees with the defined ", - "accrual time (0, 6, 30) and intensity: 6 * 22 + 24 * 33 = 924" - ), - fixed = TRUE - ) - -}) - -test_that("Testing 'getAccrualTime': list-wise definition", { - - accrualTime1 <- list( - "0 - <12" = 15, - "12 - <13" = 21, - "13 - <14" = 27, - "14 - <15" = 33, - "15 - <16" = 39, - ">=16" = 45 - ) - - # @refFS[Tab.]{fs:tab:output:getAccrualTime} - accrualTime4 <- getAccrualTime(accrualTime = accrualTime1, maxNumberOfSubjects = 1405) - expect_equal(accrualTime4$accrualTime, c(0, 12, 13, 14, 15, 16, 40.55555556)) - expect_equal(accrualTime4$accrualIntensity, c(15, 21, 27, 33, 39, 45)) - expect_equal(accrualTime4$remainingTime, 24.55555556) - - .skipTestIfDisabled() - - accrualTime2 <- list( - "0 - <12" = 15, - "12 - <13" = 21, - "13 - <14" = 27, - "14 - <15" = 33, - "15 - <16" = 39, - "16 - ?" = 45 - ) - accrualTime5 <- getAccrualTime(accrualTime = accrualTime2, maxNumberOfSubjects = 1405) - expect_equal(accrualTime5$accrualTime, c(0, 12, 13, 14, 15, 16, 40.55555556)) - expect_equal(accrualTime5$accrualIntensity, c(15, 21, 27, 33, 39, 45)) - expect_equal(accrualTime5$remainingTime, 24.55555556) - - accrualTime3 <- list( - "0 - <11" = 20, - "11 - <16" = 40, - ">=16" = 60 - ) - accrualTime6 <- getAccrualTime(accrualTime = accrualTime3, maxNumberOfSubjects = 800) - expect_equal(accrualTime6$accrualTime, c(0, 11, 16, 22.3333333)) - expect_equal(accrualTime6$accrualIntensity, c(20, 40, 60)) - expect_equal(accrualTime6$remainingTime, 6.33333333) - - accrualTime7 <- list( - "0 - <11" = 20, - "11 - <16" = 40, - "16 - ?" = 60 - ) - accrualTime8 <- getAccrualTime(accrualTime = accrualTime7, maxNumberOfSubjects = 800) - expect_equal(accrualTime8$accrualTime, c(0, 11, 16, 22.3333333)) - expect_equal(accrualTime8$accrualIntensity, c(20, 40, 60)) - expect_equal(accrualTime8$remainingTime, 6.33333333) - -}) - -test_that("Testing 'getPiecewiseSurvivalTime': mixed arguments", { - - # @refFS[Tab.]{fs:tab:output:getPiecewiseSurvivalTime} - pwSurvivalTime1 <- getPiecewiseSurvivalTime(median1 = 37, hazardRatio = 0.8) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime1' with expected results - expect_equal(pwSurvivalTime1$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime1$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$lambda1, 0.018733708, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$lambda2, 0.023417134, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime1$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime1$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$median1, 37, label = paste0("c(", paste0(pwSurvivalTime1$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$median2, 29.6, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime1$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime1$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime1$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime1$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime1$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime1), NA))) - expect_output(print(pwSurvivalTime1)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime1), NA))) - expect_output(summary(pwSurvivalTime1)$show()) - pwSurvivalTime1CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime1, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime1CodeBased$piecewiseSurvivalTime, pwSurvivalTime1$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$lambda1, pwSurvivalTime1$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$lambda2, pwSurvivalTime1$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$hazardRatio, pwSurvivalTime1$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$pi1, pwSurvivalTime1$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$pi2, pwSurvivalTime1$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$median1, pwSurvivalTime1$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$median2, pwSurvivalTime1$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$eventTime, pwSurvivalTime1$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$kappa, pwSurvivalTime1$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime1$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$delayedResponseAllowed, pwSurvivalTime1$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$delayedResponseEnabled, pwSurvivalTime1$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime1), "character") - df <- as.data.frame(pwSurvivalTime1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime2 <- getPiecewiseSurvivalTime(lambda1 = 0.01873371, median2 = 29.6) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime2' with expected results - expect_equal(pwSurvivalTime2$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime2$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$lambda1, 0.01873371, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$lambda2, 0.023417134, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$hazardRatio, 0.8000001, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime2$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime2$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$median1, 36.999995, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$median2, 29.6, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime2$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime2$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime2), NA))) - expect_output(print(pwSurvivalTime2)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime2), NA))) - expect_output(summary(pwSurvivalTime2)$show()) - pwSurvivalTime2CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime2, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalTime, pwSurvivalTime2$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$lambda1, pwSurvivalTime2$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$lambda2, pwSurvivalTime2$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$hazardRatio, pwSurvivalTime2$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$pi1, pwSurvivalTime2$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$pi2, pwSurvivalTime2$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$median1, pwSurvivalTime2$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$median2, pwSurvivalTime2$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$eventTime, pwSurvivalTime2$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$kappa, pwSurvivalTime2$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime2$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$delayedResponseAllowed, pwSurvivalTime2$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$delayedResponseEnabled, pwSurvivalTime2$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime2), "character") - df <- as.data.frame(pwSurvivalTime2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime3 <- getPiecewiseSurvivalTime(median1 = 37, lambda2 = 0.02341713) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime3' with expected results - expect_equal(pwSurvivalTime3$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime3$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$lambda1, 0.018733708, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$lambda2, 0.02341713, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$hazardRatio, 0.80000015, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime3$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime3$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$median1, 37, label = paste0("c(", paste0(pwSurvivalTime3$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$median2, 29.600006, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime3$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime3$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime3$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime3$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime3$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime3), NA))) - expect_output(print(pwSurvivalTime3)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime3), NA))) - expect_output(summary(pwSurvivalTime3)$show()) - pwSurvivalTime3CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime3, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime3CodeBased$piecewiseSurvivalTime, pwSurvivalTime3$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$lambda1, pwSurvivalTime3$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$lambda2, pwSurvivalTime3$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$hazardRatio, pwSurvivalTime3$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$pi1, pwSurvivalTime3$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$pi2, pwSurvivalTime3$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$median1, pwSurvivalTime3$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$median2, pwSurvivalTime3$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$eventTime, pwSurvivalTime3$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$kappa, pwSurvivalTime3$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime3$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$delayedResponseAllowed, pwSurvivalTime3$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$delayedResponseEnabled, pwSurvivalTime3$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime3), "character") - df <- as.data.frame(pwSurvivalTime3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - expect_warning(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), pi1 = 0.3), - "'hazardRatio' (0.6, 0.8) will be ignored because it will be calculated", - fixed = TRUE - ) -}) - +## | +## | *Unit tests* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | RPACT package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File name: test-class_time.R +## | Creation date: 08 November 2023, 08:49:49 +## | File version: $Revision: 7665 $ +## | Last changed: $Date: 2024-02-23 17:33:46 +0100 (Fr, 23 Feb 2024) $ +## | Last changed by: $Author: pahlke $ +## | + +test_plan_section("Testing Class 'PiecewiseSurvivalTime'") + + +test_that("Testing 'getPiecewiseSurvivalTime': isPiecewiseSurvivalEnabled()", { + # @refFS[Tab.]{fs:tab:output:getPiecewiseSurvivalTime} + expect_false(getPiecewiseSurvivalTime()$isPiecewiseSurvivalEnabled()) + expect_false(getPiecewiseSurvivalTime(piecewiseSurvivalTime = NA)$isPiecewiseSurvivalEnabled()) + +}) + +test_that("Testing 'getPiecewiseSurvivalTime': simple vector based definition", { + + # @refFS[Tab.]{fs:tab:output:getPiecewiseSurvivalTime} + pwSurvivalTime1 <- getPiecewiseSurvivalTime(lambda2 = 0.5, hazardRatio = 0.8) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime1' with expected results + expect_equal(pwSurvivalTime1$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime1$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$lambda1, 0.4, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$lambda2, 0.5, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime1$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime1$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$median1, 1.732868, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$median2, 1.3862944, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime1$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime1$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime1$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime1$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime1$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime1), NA))) + expect_output(print(pwSurvivalTime1)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime1), NA))) + expect_output(summary(pwSurvivalTime1)$show()) + pwSurvivalTime1CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime1, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime1CodeBased$piecewiseSurvivalTime, pwSurvivalTime1$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$lambda1, pwSurvivalTime1$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$lambda2, pwSurvivalTime1$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$hazardRatio, pwSurvivalTime1$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$pi1, pwSurvivalTime1$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$pi2, pwSurvivalTime1$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$median1, pwSurvivalTime1$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$median2, pwSurvivalTime1$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$eventTime, pwSurvivalTime1$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$kappa, pwSurvivalTime1$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime1$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$delayedResponseAllowed, pwSurvivalTime1$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$delayedResponseEnabled, pwSurvivalTime1$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime1), "character") + df <- as.data.frame(pwSurvivalTime1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime2 <- getPiecewiseSurvivalTime(lambda2 = 0.5, lambda1 = 0.4) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime2' with expected results + expect_equal(pwSurvivalTime2$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime2$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$lambda1, 0.4, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$lambda2, 0.5, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime2$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime2$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$median1, 1.732868, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$median2, 1.3862944, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime2$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime2$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime2), NA))) + expect_output(print(pwSurvivalTime2)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime2), NA))) + expect_output(summary(pwSurvivalTime2)$show()) + pwSurvivalTime2CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime2, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalTime, pwSurvivalTime2$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$lambda1, pwSurvivalTime2$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$lambda2, pwSurvivalTime2$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$hazardRatio, pwSurvivalTime2$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$pi1, pwSurvivalTime2$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$pi2, pwSurvivalTime2$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$median1, pwSurvivalTime2$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$median2, pwSurvivalTime2$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$eventTime, pwSurvivalTime2$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$kappa, pwSurvivalTime2$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime2$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$delayedResponseAllowed, pwSurvivalTime2$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$delayedResponseEnabled, pwSurvivalTime2$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime2), "character") + df <- as.data.frame(pwSurvivalTime2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + .skipTestIfDisabled() + + pwSurvivalTime2 <- getPiecewiseSurvivalTime(pi2 = 0.5, hazardRatio = 0.8) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime2' with expected results + expect_equal(pwSurvivalTime2$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime2$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$lambda1, 0.046209812, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$lambda2, 0.057762265, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$pi1, 0.42565082, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$pi2, 0.5, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$median1, 15, label = paste0("c(", paste0(pwSurvivalTime2$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$median2, 12, label = paste0("c(", paste0(pwSurvivalTime2$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$eventTime, 12, label = paste0("c(", paste0(pwSurvivalTime2$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime2$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime2), NA))) + expect_output(print(pwSurvivalTime2)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime2), NA))) + expect_output(summary(pwSurvivalTime2)$show()) + pwSurvivalTime2CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime2, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalTime, pwSurvivalTime2$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$lambda1, pwSurvivalTime2$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$lambda2, pwSurvivalTime2$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$hazardRatio, pwSurvivalTime2$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$pi1, pwSurvivalTime2$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$pi2, pwSurvivalTime2$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$median1, pwSurvivalTime2$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$median2, pwSurvivalTime2$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$eventTime, pwSurvivalTime2$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$kappa, pwSurvivalTime2$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime2$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$delayedResponseAllowed, pwSurvivalTime2$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$delayedResponseEnabled, pwSurvivalTime2$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime2), "character") + df <- as.data.frame(pwSurvivalTime2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime2 <- getPiecewiseSurvivalTime(pi2 = 0.5, pi1 = 0.4) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime2' with expected results + expect_equal(pwSurvivalTime2$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime2$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$lambda1, 0.042568802, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$lambda2, 0.057762265, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$hazardRatio, 0.73696559, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$pi1, 0.4, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$pi2, 0.5, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$median1, 16.282985, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$median2, 12, label = paste0("c(", paste0(pwSurvivalTime2$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$eventTime, 12, label = paste0("c(", paste0(pwSurvivalTime2$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime2$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime2), NA))) + expect_output(print(pwSurvivalTime2)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime2), NA))) + expect_output(summary(pwSurvivalTime2)$show()) + pwSurvivalTime2CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime2, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalTime, pwSurvivalTime2$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$lambda1, pwSurvivalTime2$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$lambda2, pwSurvivalTime2$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$hazardRatio, pwSurvivalTime2$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$pi1, pwSurvivalTime2$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$pi2, pwSurvivalTime2$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$median1, pwSurvivalTime2$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$median2, pwSurvivalTime2$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$eventTime, pwSurvivalTime2$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$kappa, pwSurvivalTime2$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime2$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$delayedResponseAllowed, pwSurvivalTime2$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$delayedResponseEnabled, pwSurvivalTime2$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime2), "character") + df <- as.data.frame(pwSurvivalTime2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime3 <- getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), lambda2 = 0.4) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime3' with expected results + expect_equal(pwSurvivalTime3$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime3$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$lambda1, c(0.24, 0.32), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$lambda2, 0.4, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$hazardRatio, c(0.6, 0.8), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime3$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime3$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$median1, c(2.8881133, 2.1660849), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$median2, 1.732868, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime3$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime3$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime3$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime3$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime3$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime3), NA))) + expect_output(print(pwSurvivalTime3)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime3), NA))) + expect_output(summary(pwSurvivalTime3)$show()) + pwSurvivalTime3CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime3, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime3CodeBased$piecewiseSurvivalTime, pwSurvivalTime3$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$lambda1, pwSurvivalTime3$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$lambda2, pwSurvivalTime3$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$hazardRatio, pwSurvivalTime3$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$pi1, pwSurvivalTime3$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$pi2, pwSurvivalTime3$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$median1, pwSurvivalTime3$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$median2, pwSurvivalTime3$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$eventTime, pwSurvivalTime3$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$kappa, pwSurvivalTime3$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime3$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$delayedResponseAllowed, pwSurvivalTime3$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$delayedResponseEnabled, pwSurvivalTime3$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime3), "character") + df <- as.data.frame(pwSurvivalTime3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime8 <- getPiecewiseSurvivalTime(pi2 = 0.4, pi1 = 0.3) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime8' with expected results + expect_equal(pwSurvivalTime8$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime8$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime8$lambda1, 0.029722912, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime8$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime8$lambda2, 0.042568802, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime8$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime8$hazardRatio, 0.69823229, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime8$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime8$pi1, 0.3, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime8$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime8$pi2, 0.4, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime8$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime8$median1, 23.320299, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime8$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime8$median2, 16.282985, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime8$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime8$eventTime, 12, label = paste0("c(", paste0(pwSurvivalTime8$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime8$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime8$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime8$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime8$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime8$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime8$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime8$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime8$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime8), NA))) + expect_output(print(pwSurvivalTime8)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime8), NA))) + expect_output(summary(pwSurvivalTime8)$show()) + pwSurvivalTime8CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime8, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime8CodeBased$piecewiseSurvivalTime, pwSurvivalTime8$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime8CodeBased$lambda1, pwSurvivalTime8$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime8CodeBased$lambda2, pwSurvivalTime8$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime8CodeBased$hazardRatio, pwSurvivalTime8$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime8CodeBased$pi1, pwSurvivalTime8$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime8CodeBased$pi2, pwSurvivalTime8$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime8CodeBased$median1, pwSurvivalTime8$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime8CodeBased$median2, pwSurvivalTime8$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime8CodeBased$eventTime, pwSurvivalTime8$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime8CodeBased$kappa, pwSurvivalTime8$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime8CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime8$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime8CodeBased$delayedResponseAllowed, pwSurvivalTime8$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime8CodeBased$delayedResponseEnabled, pwSurvivalTime8$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime8), "character") + df <- as.data.frame(pwSurvivalTime8) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime8) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime9 <- getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), pi2 = 0.3) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime9' with expected results + expect_equal(pwSurvivalTime9$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime9$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime9$lambda1, c(0.017833747, 0.02377833), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime9$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime9$lambda2, 0.029722912, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime9$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime9$hazardRatio, c(0.6, 0.8), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime9$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime9$pi1, c(0.19265562, 0.24824135), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime9$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime9$pi2, 0.3, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime9$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime9$median1, c(38.867164, 29.150373), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime9$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime9$median2, 23.320299, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime9$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime9$eventTime, 12, label = paste0("c(", paste0(pwSurvivalTime9$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime9$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime9$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime9$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime9$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime9$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime9$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime9$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime9$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime9), NA))) + expect_output(print(pwSurvivalTime9)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime9), NA))) + expect_output(summary(pwSurvivalTime9)$show()) + pwSurvivalTime9CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime9, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime9CodeBased$piecewiseSurvivalTime, pwSurvivalTime9$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime9CodeBased$lambda1, pwSurvivalTime9$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime9CodeBased$lambda2, pwSurvivalTime9$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime9CodeBased$hazardRatio, pwSurvivalTime9$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime9CodeBased$pi1, pwSurvivalTime9$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime9CodeBased$pi2, pwSurvivalTime9$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime9CodeBased$median1, pwSurvivalTime9$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime9CodeBased$median2, pwSurvivalTime9$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime9CodeBased$eventTime, pwSurvivalTime9$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime9CodeBased$kappa, pwSurvivalTime9$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime9CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime9$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime9CodeBased$delayedResponseAllowed, pwSurvivalTime9$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime9CodeBased$delayedResponseEnabled, pwSurvivalTime9$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime9), "character") + df <- as.data.frame(pwSurvivalTime9) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime9) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime10 <- getPiecewiseSurvivalTime(median2 = 1.386294, hazardRatio = 0.8) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime10' with expected results + expect_equal(pwSurvivalTime10$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime10$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$lambda1, 0.4000001, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$lambda2, 0.50000013, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime10$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime10$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$median1, 1.7328675, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$median2, 1.386294, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime10$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime10$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime10$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime10$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime10$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime10), NA))) + expect_output(print(pwSurvivalTime10)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime10), NA))) + expect_output(summary(pwSurvivalTime10)$show()) + pwSurvivalTime10CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime10, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime10CodeBased$piecewiseSurvivalTime, pwSurvivalTime10$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$lambda1, pwSurvivalTime10$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$lambda2, pwSurvivalTime10$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$hazardRatio, pwSurvivalTime10$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$pi1, pwSurvivalTime10$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$pi2, pwSurvivalTime10$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$median1, pwSurvivalTime10$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$median2, pwSurvivalTime10$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$eventTime, pwSurvivalTime10$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$kappa, pwSurvivalTime10$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime10$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$delayedResponseAllowed, pwSurvivalTime10$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$delayedResponseEnabled, pwSurvivalTime10$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime10), "character") + df <- as.data.frame(pwSurvivalTime10) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime10) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime11 <- getPiecewiseSurvivalTime(median2 = 1.386294, lambda1 = 0.4) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime11' with expected results + expect_equal(pwSurvivalTime11$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime11$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$lambda1, 0.4, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$lambda2, 0.50000013, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$hazardRatio, 0.79999979, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime11$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime11$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$median1, 1.732868, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$median2, 1.386294, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime11$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime11$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime11$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime11$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime11$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime11), NA))) + expect_output(print(pwSurvivalTime11)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime11), NA))) + expect_output(summary(pwSurvivalTime11)$show()) + pwSurvivalTime11CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime11, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime11CodeBased$piecewiseSurvivalTime, pwSurvivalTime11$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$lambda1, pwSurvivalTime11$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$lambda2, pwSurvivalTime11$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$hazardRatio, pwSurvivalTime11$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$pi1, pwSurvivalTime11$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$pi2, pwSurvivalTime11$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$median1, pwSurvivalTime11$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$median2, pwSurvivalTime11$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$eventTime, pwSurvivalTime11$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$kappa, pwSurvivalTime11$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime11$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$delayedResponseAllowed, pwSurvivalTime11$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$delayedResponseEnabled, pwSurvivalTime11$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime11), "character") + df <- as.data.frame(pwSurvivalTime11) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime11) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime12 <- getPiecewiseSurvivalTime(median2 = 5, median1 = 6) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime12' with expected results + expect_equal(pwSurvivalTime12$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$lambda1, 0.11552453, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime12$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$lambda2, 0.13862944, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime12$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$hazardRatio, 0.83333333, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime12$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$median1, 6, label = paste0("c(", paste0(pwSurvivalTime12$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$median2, 5, label = paste0("c(", paste0(pwSurvivalTime12$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime12$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime12$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime12$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime12$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime12), NA))) + expect_output(print(pwSurvivalTime12)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime12), NA))) + expect_output(summary(pwSurvivalTime12)$show()) + pwSurvivalTime12CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime12, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime12CodeBased$piecewiseSurvivalTime, pwSurvivalTime12$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$lambda1, pwSurvivalTime12$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$lambda2, pwSurvivalTime12$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$hazardRatio, pwSurvivalTime12$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$pi1, pwSurvivalTime12$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$pi2, pwSurvivalTime12$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$median1, pwSurvivalTime12$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$median2, pwSurvivalTime12$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$eventTime, pwSurvivalTime12$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$kappa, pwSurvivalTime12$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime12$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$delayedResponseAllowed, pwSurvivalTime12$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$delayedResponseEnabled, pwSurvivalTime12$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime12), "character") + df <- as.data.frame(pwSurvivalTime12) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime12) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime13 <- getPiecewiseSurvivalTime(median2 = 1.386294, lambda1 = c(0.3, 0.4)) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime13' with expected results + expect_equal(pwSurvivalTime13$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime13$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$lambda1, c(0.3, 0.4), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime13$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$lambda2, 0.50000013, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime13$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$hazardRatio, c(0.59999984, 0.79999979), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime13$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime13$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime13$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$median1, c(2.3104906, 1.732868), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime13$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$median2, 1.386294, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime13$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime13$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime13$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime13$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime13$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime13$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime13), NA))) + expect_output(print(pwSurvivalTime13)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime13), NA))) + expect_output(summary(pwSurvivalTime13)$show()) + pwSurvivalTime13CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime13, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime13CodeBased$piecewiseSurvivalTime, pwSurvivalTime13$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$lambda1, pwSurvivalTime13$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$lambda2, pwSurvivalTime13$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$hazardRatio, pwSurvivalTime13$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$pi1, pwSurvivalTime13$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$pi2, pwSurvivalTime13$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$median1, pwSurvivalTime13$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$median2, pwSurvivalTime13$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$eventTime, pwSurvivalTime13$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$kappa, pwSurvivalTime13$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime13$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$delayedResponseAllowed, pwSurvivalTime13$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$delayedResponseEnabled, pwSurvivalTime13$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime13), "character") + df <- as.data.frame(pwSurvivalTime13) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime13) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime14 <- getPiecewiseSurvivalTime(median2 = 5, median1 = c(6:8)) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime14' with expected results + expect_equal(pwSurvivalTime14$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime14$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime14$lambda1, c(0.11552453, 0.099021026, 0.086643398), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime14$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime14$lambda2, 0.13862944, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime14$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime14$hazardRatio, c(0.83333333, 0.71428571, 0.625), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime14$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime14$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime14$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime14$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime14$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime14$median1, c(6, 7, 8), label = paste0("c(", paste0(pwSurvivalTime14$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime14$median2, 5, label = paste0("c(", paste0(pwSurvivalTime14$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime14$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime14$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime14$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime14$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime14$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime14$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime14$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime14$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime14$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime14$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime14), NA))) + expect_output(print(pwSurvivalTime14)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime14), NA))) + expect_output(summary(pwSurvivalTime14)$show()) + pwSurvivalTime14CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime14, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime14CodeBased$piecewiseSurvivalTime, pwSurvivalTime14$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime14CodeBased$lambda1, pwSurvivalTime14$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime14CodeBased$lambda2, pwSurvivalTime14$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime14CodeBased$hazardRatio, pwSurvivalTime14$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime14CodeBased$pi1, pwSurvivalTime14$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime14CodeBased$pi2, pwSurvivalTime14$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime14CodeBased$median1, pwSurvivalTime14$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime14CodeBased$median2, pwSurvivalTime14$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime14CodeBased$eventTime, pwSurvivalTime14$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime14CodeBased$kappa, pwSurvivalTime14$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime14CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime14$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime14CodeBased$delayedResponseAllowed, pwSurvivalTime14$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime14CodeBased$delayedResponseEnabled, pwSurvivalTime14$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime14), "character") + df <- as.data.frame(pwSurvivalTime14) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime14) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime15 <- getPiecewiseSurvivalTime(median2 = 2, hazardRatio = 0.8) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime15' with expected results + expect_equal(pwSurvivalTime15$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime15$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime15$lambda1, 0.27725887, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime15$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime15$lambda2, 0.34657359, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime15$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime15$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime15$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime15$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime15$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime15$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime15$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime15$median1, 2.5, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime15$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime15$median2, 2, label = paste0("c(", paste0(pwSurvivalTime15$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime15$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime15$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime15$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime15$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime15$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime15$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime15$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime15$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime15$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime15$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime15), NA))) + expect_output(print(pwSurvivalTime15)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime15), NA))) + expect_output(summary(pwSurvivalTime15)$show()) + pwSurvivalTime15CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime15, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime15CodeBased$piecewiseSurvivalTime, pwSurvivalTime15$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime15CodeBased$lambda1, pwSurvivalTime15$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime15CodeBased$lambda2, pwSurvivalTime15$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime15CodeBased$hazardRatio, pwSurvivalTime15$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime15CodeBased$pi1, pwSurvivalTime15$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime15CodeBased$pi2, pwSurvivalTime15$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime15CodeBased$median1, pwSurvivalTime15$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime15CodeBased$median2, pwSurvivalTime15$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime15CodeBased$eventTime, pwSurvivalTime15$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime15CodeBased$kappa, pwSurvivalTime15$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime15CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime15$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime15CodeBased$delayedResponseAllowed, pwSurvivalTime15$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime15CodeBased$delayedResponseEnabled, pwSurvivalTime15$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime15), "character") + df <- as.data.frame(pwSurvivalTime15) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime15) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime16 <- getPiecewiseSurvivalTime(median1 = c(2, 2), hazardRatio = c(1.4, 1.4)) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime16' with expected results + expect_equal(pwSurvivalTime16$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime16$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime16$lambda1, c(0.34657359, 0.34657359), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime16$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime16$lambda2, c(0.24755256, 0.24755256), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime16$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime16$hazardRatio, c(1.4, 1.4), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime16$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime16$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime16$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime16$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime16$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime16$median1, c(2, 2), label = paste0("c(", paste0(pwSurvivalTime16$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime16$median2, c(2.8, 2.8), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime16$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime16$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime16$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime16$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime16$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime16$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime16$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime16$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime16$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime16$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime16$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime16), NA))) + expect_output(print(pwSurvivalTime16)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime16), NA))) + expect_output(summary(pwSurvivalTime16)$show()) + pwSurvivalTime16CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime16, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime16CodeBased$piecewiseSurvivalTime, pwSurvivalTime16$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime16CodeBased$lambda1, pwSurvivalTime16$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime16CodeBased$lambda2, pwSurvivalTime16$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime16CodeBased$hazardRatio, pwSurvivalTime16$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime16CodeBased$pi1, pwSurvivalTime16$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime16CodeBased$pi2, pwSurvivalTime16$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime16CodeBased$median1, pwSurvivalTime16$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime16CodeBased$median2, pwSurvivalTime16$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime16CodeBased$eventTime, pwSurvivalTime16$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime16CodeBased$kappa, pwSurvivalTime16$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime16CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime16$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime16CodeBased$delayedResponseAllowed, pwSurvivalTime16$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime16CodeBased$delayedResponseEnabled, pwSurvivalTime16$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime16), "character") + df <- as.data.frame(pwSurvivalTime16) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime16) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime17 <- getPiecewiseSurvivalTime(median1 = c(2, 3), median2 = 4) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime17' with expected results + expect_equal(pwSurvivalTime17$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime17$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime17$lambda1, c(0.34657359, 0.23104906), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime17$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime17$lambda2, 0.1732868, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime17$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime17$hazardRatio, c(2, 1.3333333), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime17$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime17$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime17$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime17$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime17$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime17$median1, c(2, 3), label = paste0("c(", paste0(pwSurvivalTime17$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime17$median2, 4, label = paste0("c(", paste0(pwSurvivalTime17$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime17$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime17$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime17$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime17$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime17$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime17$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime17$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime17$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime17$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime17$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime17), NA))) + expect_output(print(pwSurvivalTime17)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime17), NA))) + expect_output(summary(pwSurvivalTime17)$show()) + pwSurvivalTime17CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime17, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime17CodeBased$piecewiseSurvivalTime, pwSurvivalTime17$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime17CodeBased$lambda1, pwSurvivalTime17$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime17CodeBased$lambda2, pwSurvivalTime17$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime17CodeBased$hazardRatio, pwSurvivalTime17$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime17CodeBased$pi1, pwSurvivalTime17$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime17CodeBased$pi2, pwSurvivalTime17$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime17CodeBased$median1, pwSurvivalTime17$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime17CodeBased$median2, pwSurvivalTime17$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime17CodeBased$eventTime, pwSurvivalTime17$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime17CodeBased$kappa, pwSurvivalTime17$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime17CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime17$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime17CodeBased$delayedResponseAllowed, pwSurvivalTime17$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime17CodeBased$delayedResponseEnabled, pwSurvivalTime17$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime17), "character") + df <- as.data.frame(pwSurvivalTime17) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime17) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime18 <- getPiecewiseSurvivalTime(median1 = c(2, 3), lambda2 = 0.4) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime18' with expected results + expect_equal(pwSurvivalTime18$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime18$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime18$lambda1, c(0.34657359, 0.23104906), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime18$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime18$lambda2, 0.4, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime18$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime18$hazardRatio, c(0.86643398, 0.57762265), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime18$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime18$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime18$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime18$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime18$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime18$median1, c(2, 3), label = paste0("c(", paste0(pwSurvivalTime18$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime18$median2, 1.732868, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime18$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime18$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime18$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime18$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime18$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime18$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime18$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime18$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime18$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime18$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime18$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime18), NA))) + expect_output(print(pwSurvivalTime18)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime18), NA))) + expect_output(summary(pwSurvivalTime18)$show()) + pwSurvivalTime18CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime18, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime18CodeBased$piecewiseSurvivalTime, pwSurvivalTime18$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime18CodeBased$lambda1, pwSurvivalTime18$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime18CodeBased$lambda2, pwSurvivalTime18$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime18CodeBased$hazardRatio, pwSurvivalTime18$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime18CodeBased$pi1, pwSurvivalTime18$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime18CodeBased$pi2, pwSurvivalTime18$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime18CodeBased$median1, pwSurvivalTime18$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime18CodeBased$median2, pwSurvivalTime18$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime18CodeBased$eventTime, pwSurvivalTime18$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime18CodeBased$kappa, pwSurvivalTime18$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime18CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime18$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime18CodeBased$delayedResponseAllowed, pwSurvivalTime18$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime18CodeBased$delayedResponseEnabled, pwSurvivalTime18$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime18), "character") + df <- as.data.frame(pwSurvivalTime18) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime18) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime19 <- getPiecewiseSurvivalTime(pi1 = 0.45) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime19' with expected results + expect_equal(pwSurvivalTime19$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime19$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime19$lambda1, 0.04981975, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime19$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime19$lambda2, 0.018595296, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime19$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime19$hazardRatio, 2.6791588, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime19$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime19$pi1, 0.45, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime19$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime19$pi2, 0.2, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime19$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime19$median1, 13.9131, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime19$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime19$median2, 37.275405, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime19$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime19$eventTime, 12, label = paste0("c(", paste0(pwSurvivalTime19$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime19$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime19$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime19$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime19$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime19$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime19$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime19$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime19$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime19), NA))) + expect_output(print(pwSurvivalTime19)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime19), NA))) + expect_output(summary(pwSurvivalTime19)$show()) + pwSurvivalTime19CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime19, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime19CodeBased$piecewiseSurvivalTime, pwSurvivalTime19$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime19CodeBased$lambda1, pwSurvivalTime19$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime19CodeBased$lambda2, pwSurvivalTime19$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime19CodeBased$hazardRatio, pwSurvivalTime19$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime19CodeBased$pi1, pwSurvivalTime19$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime19CodeBased$pi2, pwSurvivalTime19$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime19CodeBased$median1, pwSurvivalTime19$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime19CodeBased$median2, pwSurvivalTime19$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime19CodeBased$eventTime, pwSurvivalTime19$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime19CodeBased$kappa, pwSurvivalTime19$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime19CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime19$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime19CodeBased$delayedResponseAllowed, pwSurvivalTime19$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime19CodeBased$delayedResponseEnabled, pwSurvivalTime19$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime19), "character") + df <- as.data.frame(pwSurvivalTime19) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime19) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime20 <- getPiecewiseSurvivalTime(median1 = c(2, 4), hazardRatio = c(1.4, 0.7)) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime20' with expected results + expect_equal(pwSurvivalTime20$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime20$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime20$lambda1, c(0.34657359, 0.1732868), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime20$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime20$lambda2, c(0.24755256, 0.24755256), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime20$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime20$hazardRatio, c(1.4, 0.7), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime20$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime20$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime20$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime20$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime20$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime20$median1, c(2, 4), label = paste0("c(", paste0(pwSurvivalTime20$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime20$median2, c(2.8, 2.8), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime20$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime20$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime20$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime20$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime20$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime20$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime20$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime20$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime20$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime20$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime20$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime20), NA))) + expect_output(print(pwSurvivalTime20)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime20), NA))) + expect_output(summary(pwSurvivalTime20)$show()) + pwSurvivalTime20CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime20, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime20CodeBased$piecewiseSurvivalTime, pwSurvivalTime20$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime20CodeBased$lambda1, pwSurvivalTime20$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime20CodeBased$lambda2, pwSurvivalTime20$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime20CodeBased$hazardRatio, pwSurvivalTime20$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime20CodeBased$pi1, pwSurvivalTime20$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime20CodeBased$pi2, pwSurvivalTime20$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime20CodeBased$median1, pwSurvivalTime20$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime20CodeBased$median2, pwSurvivalTime20$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime20CodeBased$eventTime, pwSurvivalTime20$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime20CodeBased$kappa, pwSurvivalTime20$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime20CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime20$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime20CodeBased$delayedResponseAllowed, pwSurvivalTime20$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime20CodeBased$delayedResponseEnabled, pwSurvivalTime20$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime20), "character") + df <- as.data.frame(pwSurvivalTime20) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime20) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime21 <- getPiecewiseSurvivalTime(median1 = 3, hazardRatio = 0.8) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime21' with expected results + expect_equal(pwSurvivalTime21$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime21$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime21$lambda1, 0.23104906, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime21$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime21$lambda2, 0.28881133, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime21$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime21$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime21$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime21$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime21$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime21$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime21$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime21$median1, 3, label = paste0("c(", paste0(pwSurvivalTime21$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime21$median2, 2.4, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime21$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime21$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime21$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime21$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime21$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime21$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime21$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime21$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime21$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime21$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime21$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime21), NA))) + expect_output(print(pwSurvivalTime21)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime21), NA))) + expect_output(summary(pwSurvivalTime21)$show()) + pwSurvivalTime21CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime21, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime21CodeBased$piecewiseSurvivalTime, pwSurvivalTime21$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime21CodeBased$lambda1, pwSurvivalTime21$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime21CodeBased$lambda2, pwSurvivalTime21$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime21CodeBased$hazardRatio, pwSurvivalTime21$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime21CodeBased$pi1, pwSurvivalTime21$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime21CodeBased$pi2, pwSurvivalTime21$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime21CodeBased$median1, pwSurvivalTime21$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime21CodeBased$median2, pwSurvivalTime21$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime21CodeBased$eventTime, pwSurvivalTime21$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime21CodeBased$kappa, pwSurvivalTime21$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime21CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime21$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime21CodeBased$delayedResponseAllowed, pwSurvivalTime21$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime21CodeBased$delayedResponseEnabled, pwSurvivalTime21$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime21), "character") + df <- as.data.frame(pwSurvivalTime21) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime21) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + expect_error(getPiecewiseSurvivalTime(median2 = 1.386294, lambda2 = 0.4, hazardRatio = 0.8)) + expect_error(getPiecewiseSurvivalTime(median2 = c(1.5, 1.7), lambda1 = c(0.3, 0.4))) + expect_error(getPiecewiseSurvivalTime(median1 = c(2, 4), hazardRatio = c(1, 0.7))) + expect_error(getPiecewiseSurvivalTime(median1 = c(2, 4), hazardRatio = 0.7)) + +}) + +test_that("Testing 'getPiecewiseSurvivalTime': vector based definition", { + + # @refFS[Tab.]{fs:tab:output:getPiecewiseSurvivalTime} + pwSurvivalTime1 <- getPiecewiseSurvivalTime( + piecewiseSurvivalTime = c(0, 6, 9), + lambda2 = c(0.025, 0.04, 0.015), hazardRatio = 0.8 + ) + expect_equal(pwSurvivalTime1$hazardRatio, 0.8) + expect_equal(pwSurvivalTime1$lambda1, c(0.025, 0.04, 0.015) * 0.8) + expect_false(pwSurvivalTime1$isDelayedResponseEnabled()) + + .skipTestIfDisabled() + + pwSurvivalTime2 <- getPiecewiseSurvivalTime( + piecewiseSurvivalTime = c(0, 5, 10), + lambda2 = c(0.1, 0.2, 0.8), hazardRatio = 0.8 + ) + expect_true(pwSurvivalTime2$isPiecewiseSurvivalEnabled()) + expect_false(pwSurvivalTime2$isDelayedResponseEnabled()) + expect_equal(pwSurvivalTime2$hazardRatio, 0.8) + expect_equal(pwSurvivalTime2$piecewiseSurvivalTime, c(0, 5, 10)) + expect_equal(pwSurvivalTime2$lambda2, c(0.1, 0.2, 0.8)) + + pwSurvivalTime3 <- getPiecewiseSurvivalTime(c(0, 6), lambda2 = c(0.01, 0.03), hazardRatio = 0.8) + expect_true(pwSurvivalTime3$isPiecewiseSurvivalEnabled()) + expect_false(pwSurvivalTime3$isDelayedResponseEnabled()) + expect_equal(pwSurvivalTime3$hazardRatio, 0.8) + expect_equal(pwSurvivalTime3$piecewiseSurvivalTime, c(0, 6)) + expect_equal(pwSurvivalTime3$lambda2, c(0.01, 0.03)) + + pwSurvivalTime4 <- getPiecewiseSurvivalTime(0, lambda2 = 0.01, hazardRatio = 0.8) + expect_true(pwSurvivalTime4$isPiecewiseSurvivalEnabled()) + expect_false(pwSurvivalTime4$isDelayedResponseEnabled()) + expect_equal(pwSurvivalTime4$hazardRatio, 0.8) + expect_equal(pwSurvivalTime4$piecewiseSurvivalTime, 0) + expect_equal(pwSurvivalTime4$lambda2, 0.01) + expect_equal(pwSurvivalTime4$lambda1, 0.01 * 0.8) + + pwSurvivalTime5 <- getPiecewiseSurvivalTime(NA_real_, lambda2 = 0.01, hazardRatio = 0.8) + expect_true(pwSurvivalTime5$isPiecewiseSurvivalEnabled()) + expect_false(pwSurvivalTime5$isDelayedResponseEnabled()) + expect_equal(pwSurvivalTime5$hazardRatio, 0.8) + expect_equal(pwSurvivalTime5$piecewiseSurvivalTime, 0) + expect_equal(pwSurvivalTime5$lambda2, 0.01) + expect_equal(pwSurvivalTime5$lambda1, 0.01 * 0.8) + + pwSurvivalTime6 <- getPiecewiseSurvivalTime(0, lambda2 = 0.01, lambda1 = 0.008) + expect_true(pwSurvivalTime6$isPiecewiseSurvivalEnabled()) + expect_false(pwSurvivalTime6$isDelayedResponseEnabled()) + expect_equal(pwSurvivalTime6$hazardRatio, 0.8) + expect_equal(pwSurvivalTime6$piecewiseSurvivalTime, 0) + expect_equal(pwSurvivalTime6$lambda2, 0.01) + expect_equal(pwSurvivalTime6$lambda1, 0.008) + + pwSurvivalTime7 <- getPiecewiseSurvivalTime(NA_real_, lambda2 = 0.01, lambda1 = 0.008) + expect_true(pwSurvivalTime7$isPiecewiseSurvivalEnabled()) + expect_false(pwSurvivalTime7$isDelayedResponseEnabled()) + expect_equal(pwSurvivalTime7$hazardRatio, 0.8) + expect_equal(pwSurvivalTime7$piecewiseSurvivalTime, 0) + expect_equal(pwSurvivalTime7$lambda2, 0.01) + expect_equal(pwSurvivalTime7$lambda1, 0.008) + + # case 2.2 + pwSurvivalTime9 <- getPiecewiseSurvivalTime( + piecewiseSurvivalTime = c(0, 6, 9), + lambda2 = c(0.025, 0.04, 0.015), + lambda1 = c(0.025, 0.04, 0.015) * 0.8 + ) + expect_true(pwSurvivalTime9$isPiecewiseSurvivalEnabled()) + expect_false(pwSurvivalTime9$isDelayedResponseEnabled()) + expect_equal(pwSurvivalTime9$hazardRatio, 0.8) + + pwSurvivalTime10 <- getPiecewiseSurvivalTime(lambda2 = 0.025, hazardRatio = 0.8) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime10' with expected results + expect_equal(pwSurvivalTime10$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime10$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$lambda1, 0.02, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$lambda2, 0.025, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime10$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime10$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$median1, 34.657359, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$median2, 27.725887, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime10$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime10$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime10$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime10$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime10$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime10), NA))) + expect_output(print(pwSurvivalTime10)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime10), NA))) + expect_output(summary(pwSurvivalTime10)$show()) + pwSurvivalTime10CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime10, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime10CodeBased$piecewiseSurvivalTime, pwSurvivalTime10$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$lambda1, pwSurvivalTime10$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$lambda2, pwSurvivalTime10$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$hazardRatio, pwSurvivalTime10$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$pi1, pwSurvivalTime10$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$pi2, pwSurvivalTime10$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$median1, pwSurvivalTime10$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$median2, pwSurvivalTime10$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$eventTime, pwSurvivalTime10$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$kappa, pwSurvivalTime10$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime10$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$delayedResponseAllowed, pwSurvivalTime10$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$delayedResponseEnabled, pwSurvivalTime10$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime10), "character") + df <- as.data.frame(pwSurvivalTime10) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime10) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime11 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = 0, lambda2 = 0.025, hazardRatio = 0.8) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime11' with expected results + expect_equal(pwSurvivalTime11$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime11$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$lambda1, 0.02, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$lambda2, 0.025, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime11$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime11$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$median1, 34.657359, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$median2, 27.725887, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime11$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime11$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime11$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime11$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime11$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime11), NA))) + expect_output(print(pwSurvivalTime11)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime11), NA))) + expect_output(summary(pwSurvivalTime11)$show()) + pwSurvivalTime11CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime11, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime11CodeBased$piecewiseSurvivalTime, pwSurvivalTime11$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$lambda1, pwSurvivalTime11$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$lambda2, pwSurvivalTime11$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$hazardRatio, pwSurvivalTime11$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$pi1, pwSurvivalTime11$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$pi2, pwSurvivalTime11$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$median1, pwSurvivalTime11$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$median2, pwSurvivalTime11$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$eventTime, pwSurvivalTime11$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$kappa, pwSurvivalTime11$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime11$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$delayedResponseAllowed, pwSurvivalTime11$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$delayedResponseEnabled, pwSurvivalTime11$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime11), "character") + df <- as.data.frame(pwSurvivalTime11) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime11) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime12 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 6), lambda2 = c(0.025, 0.01), hazardRatio = c(0.8, 0.9)) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime12' with expected results + expect_equal(pwSurvivalTime12$piecewiseSurvivalTime, c(0, 6), label = paste0("c(", paste0(pwSurvivalTime12$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$lambda1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$lambda2, c(0.025, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime12$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$hazardRatio, c(0.8, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime12$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$median1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$median2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime12$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$piecewiseSurvivalEnabled, TRUE, label = paste0("c(", paste0(pwSurvivalTime12$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime12$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime12$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime12), NA))) + expect_output(print(pwSurvivalTime12)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime12), NA))) + expect_output(summary(pwSurvivalTime12)$show()) + pwSurvivalTime12CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime12, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime12CodeBased$piecewiseSurvivalTime, pwSurvivalTime12$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$lambda1, pwSurvivalTime12$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$lambda2, pwSurvivalTime12$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$hazardRatio, pwSurvivalTime12$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$pi1, pwSurvivalTime12$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$pi2, pwSurvivalTime12$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$median1, pwSurvivalTime12$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$median2, pwSurvivalTime12$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$eventTime, pwSurvivalTime12$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$kappa, pwSurvivalTime12$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime12$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$delayedResponseAllowed, pwSurvivalTime12$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$delayedResponseEnabled, pwSurvivalTime12$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime12), "character") + df <- as.data.frame(pwSurvivalTime12) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime12) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime13 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 6), lambda2 = c(0.025, 0.01), hazardRatio = c(0.8, 0.9), delayedResponseAllowed = TRUE) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime13' with expected results + expect_equal(pwSurvivalTime13$piecewiseSurvivalTime, c(0, 6), label = paste0("c(", paste0(pwSurvivalTime13$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$lambda1, c(0.02, 0.009), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime13$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$lambda2, c(0.025, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime13$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$hazardRatio, c(0.8, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime13$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime13$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime13$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$median1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime13$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$median2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime13$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime13$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime13$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$piecewiseSurvivalEnabled, TRUE, label = paste0("c(", paste0(pwSurvivalTime13$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$delayedResponseAllowed, TRUE, label = paste0("c(", paste0(pwSurvivalTime13$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$delayedResponseEnabled, TRUE, label = paste0("c(", paste0(pwSurvivalTime13$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime13), NA))) + expect_output(print(pwSurvivalTime13)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime13), NA))) + expect_output(summary(pwSurvivalTime13)$show()) + pwSurvivalTime13CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime13, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime13CodeBased$piecewiseSurvivalTime, pwSurvivalTime13$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$lambda1, pwSurvivalTime13$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$lambda2, pwSurvivalTime13$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$hazardRatio, pwSurvivalTime13$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$pi1, pwSurvivalTime13$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$pi2, pwSurvivalTime13$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$median1, pwSurvivalTime13$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$median2, pwSurvivalTime13$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$eventTime, pwSurvivalTime13$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$kappa, pwSurvivalTime13$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime13$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$delayedResponseAllowed, pwSurvivalTime13$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$delayedResponseEnabled, pwSurvivalTime13$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime13), "character") + df <- as.data.frame(pwSurvivalTime13) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime13) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # case 2.2: error expected + expect_error(getPiecewiseSurvivalTime( + piecewiseSurvivalTime = c(0, 6, 9), + lambda2 = c(0.025, 0.04, 0.015), + lambda1 = c(0.03, 0.04, 0.025) + ), + paste0( + "Illegal argument: 'hazardRatio' can only be calculated if ", + "'unique(lambda1 / lambda2)' result in a single value; ", + "current result = c(1.2, 1, 1.667) (e.g., delayed response is not allowed)" + ), + fixed = TRUE + ) + + # case 3 + expect_false(getPiecewiseSurvivalTime(delayedResponseAllowed = TRUE)$isPiecewiseSurvivalEnabled()) + expect_false(getPiecewiseSurvivalTime( + piecewiseSurvivalTime = NA, + delayedResponseAllowed = TRUE + )$isPiecewiseSurvivalEnabled()) + + # case 3.1 + pwSurvivalTimeSim1 <- getPiecewiseSurvivalTime( + piecewiseSurvivalTime = c(0, 6, 9), + lambda2 = c(0.025, 0.04, 0.015), hazardRatio = 0.8, + delayedResponseAllowed = TRUE + ) + expect_equal(pwSurvivalTimeSim1$hazardRatio, 0.8) + expect_equal(pwSurvivalTimeSim1$lambda1, c(0.025, 0.04, 0.015) * 0.8) + expect_false(pwSurvivalTimeSim1$isDelayedResponseEnabled()) + + # case 3.2 + pwSurvivalTimeSim2 <- getPiecewiseSurvivalTime( + piecewiseSurvivalTime = c(0, 6, 9), + lambda2 = c(0.025, 0.04, 0.015), + lambda1 = c(0.03, 0.04, 0.025), delayedResponseAllowed = TRUE + ) + expect_true(pwSurvivalTimeSim2$isPiecewiseSurvivalEnabled()) + expect_true(pwSurvivalTimeSim2$isDelayedResponseEnabled()) + expect_equal(pwSurvivalTimeSim2$hazardRatio, c(1.2, 1, 5 / 3)) + + pwsTime1 <- getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), lambda2 = 0.4) + expect_equal(pwsTime1$.isLambdaBased(minNumberOfLambdas = 1), TRUE) + +}) + +test_that("Testing 'getPiecewiseSurvivalTime': check error and warnings", { + + # @refFS[Tab.]{fs:tab:output:getPiecewiseSurvivalTime} + expect_error(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), lambda2 = 0.4, pi2 = 0.4), + "Conflicting arguments: it is not allowed to specify 'pi2' (0.4) and 'lambda2' (0.4) concurrently", + fixed = TRUE + ) + + expect_error(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), lambda2 = 0.4, pi2 = 0.4, pi1 = 0.3), + "Conflicting arguments: it is not allowed to specify 'pi1' (0.3) and 'lambda2' (0.4) concurrently", + fixed = TRUE + ) + + expect_error(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), lambda2 = 0.4, pi2 = 0.4, pi1 = 0.3), + "Conflicting arguments: it is not allowed to specify 'pi1' (0.3) and 'lambda2' (0.4) concurrently", + fixed = TRUE + ) + + expect_error(getPiecewiseSurvivalTime(lambda2 = 0.4, lambda1 = 0.3, pi2 = 0.4, pi1 = 0.3), + "Conflicting arguments: it is not allowed to specify 'pi1' (0.3) and 'lambda1' (0.3) concurrently", + fixed = TRUE + ) + + expect_error(getPiecewiseSurvivalTime(lambda2 = 0.4, lambda1 = 0.3, pi2 = 0.4, pi1 = 0.3), + "Conflicting arguments: it is not allowed to specify 'pi1' (0.3) and 'lambda1' (0.3) concurrently", + fixed = TRUE + ) + + expect_equal(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), pi2 = 0.4)$.isPiBased(), TRUE) + + expect_warning(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), pi2 = 0.4, pi1 = 0.3), + "'hazardRatio' (0.6, 0.8) will be ignored because it will be calculated", + fixed = TRUE + ) + + expect_warning(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), pi1 = 0.3), + "'hazardRatio' (0.6, 0.8) will be ignored because it will be calculated", + fixed = TRUE + ) + + expect_error(getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 6), lambda2 = 0.025, hazardRatio = 0.8, delayedResponseAllowed = TRUE), + "Illegal argument: length of 'piecewiseSurvivalTime' (2) and length of 'lambda2' (1) must be equal", + fixed = TRUE + ) + + expect_error(getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 6, 12), lambda2 = 0.025, hazardRatio = 0.8, delayedResponseAllowed = TRUE), + "Illegal argument: length of 'piecewiseSurvivalTime' (3) and length of 'lambda2' (1) must be equal", + fixed = TRUE + ) + + expect_error(getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 6), lambda2 = 0.025, hazardRatio = 0.8), + "Illegal argument: length of 'piecewiseSurvivalTime' (2) and length of 'lambda2' (1) must be equal", + fixed = TRUE + ) + +}) + +test_that("Testing 'getPiecewiseSurvivalTime': list-wise definition", { + + # @refFS[Tab.]{fs:tab:output:getPiecewiseSurvivalTime} + pwSurvivalTime8 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = list( + "<6" = 0.025, + "6 - <9" = 0.04, + "9 - <15" = 0.015, + "15 - <21" = 0.01, + ">=21" = 0.007 + ), hazardRatio = 0.6) + expect_true(pwSurvivalTime8$isPiecewiseSurvivalEnabled()) + expect_false(pwSurvivalTime8$isDelayedResponseEnabled()) + expect_equal(pwSurvivalTime8$hazardRatio, 0.6) + expect_equal(pwSurvivalTime8$piecewiseSurvivalTime, c(0, 6, 9, 15, 21)) + expect_equal(pwSurvivalTime8$lambda2, c(0.025, 0.040, 0.015, 0.010, 0.007)) + expect_equal(pwSurvivalTime8$lambda1, c(0.0150, 0.0240, 0.0090, 0.0060, 0.0042)) + + .skipTestIfDisabled() + + result1 <- getPiecewiseSurvivalTime(list( + "<5" = 0.1, + "5 - <10" = 0.2, + ">=10" = 0.8 + ), hazardRatio = 0.8) + expect_equal(result1$piecewiseSurvivalTime, c(0, 5, 10)) + expect_equal(result1$lambda2, c(0.1, 0.2, 0.8)) + + result2 <- getPiecewiseSurvivalTime(list( + "0 - <5" = 0.1, + "5 - <10" = 0.2, + "10 - Inf" = 0.8 + ), hazardRatio = 0.8) + expect_equal(result2$piecewiseSurvivalTime, c(0, 5, 10)) + expect_equal(result2$lambda2, c(0.1, 0.2, 0.8)) + + pwSurvivalTime2 <- getPiecewiseSurvivalTime( + piecewiseSurvivalTime = c(0, 5, 10), + lambda2 = c(0.1, 0.2, 0.8), hazardRatio = 0.8 + ) + expect_equal(pwSurvivalTime2$piecewiseSurvivalTime, c(0, 5, 10)) + expect_equal(pwSurvivalTime2$lambda2, c(0.1, 0.2, 0.8)) + + pwSurvivalTime3 <- getPiecewiseSurvivalTime(c(0, 6), lambda2 = c(0.01, 0.03), hazardRatio = 0.8) + expect_equal(pwSurvivalTime3$piecewiseSurvivalTime, c(0, 6)) + expect_equal(pwSurvivalTime3$lambda2, c(0.01, 0.03)) + + pwSurvivalTime4 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = list("0 - ?" = 0.025), + hazardRatio = 0.8, delayedResponseAllowed = TRUE) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime4' with expected results + expect_equal(pwSurvivalTime4$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime4$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime4$lambda1, 0.02, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime4$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime4$lambda2, 0.025, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime4$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime4$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime4$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime4$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime4$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime4$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime4$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime4$median1, 34.657359, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime4$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime4$median2, 27.725887, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime4$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime4$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime4$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime4$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime4$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime4$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime4$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime4$delayedResponseAllowed, TRUE, label = paste0("c(", paste0(pwSurvivalTime4$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime4$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime4$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime4), NA))) + expect_output(print(pwSurvivalTime4)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime4), NA))) + expect_output(summary(pwSurvivalTime4)$show()) + pwSurvivalTime4CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime4, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime4CodeBased$piecewiseSurvivalTime, pwSurvivalTime4$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime4CodeBased$lambda1, pwSurvivalTime4$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime4CodeBased$lambda2, pwSurvivalTime4$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime4CodeBased$hazardRatio, pwSurvivalTime4$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime4CodeBased$pi1, pwSurvivalTime4$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime4CodeBased$pi2, pwSurvivalTime4$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime4CodeBased$median1, pwSurvivalTime4$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime4CodeBased$median2, pwSurvivalTime4$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime4CodeBased$eventTime, pwSurvivalTime4$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime4CodeBased$kappa, pwSurvivalTime4$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime4CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime4$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime4CodeBased$delayedResponseAllowed, pwSurvivalTime4$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime4CodeBased$delayedResponseEnabled, pwSurvivalTime4$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime4), "character") + df <- as.data.frame(pwSurvivalTime4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime5 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = list("x" = 0.025), + hazardRatio = 0.8, delayedResponseAllowed = TRUE) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime5' with expected results + expect_equal(pwSurvivalTime5$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime5$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime5$lambda1, 0.02, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime5$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime5$lambda2, 0.025, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime5$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime5$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime5$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime5$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime5$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime5$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime5$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime5$median1, 34.657359, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime5$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime5$median2, 27.725887, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime5$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime5$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime5$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime5$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime5$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime5$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime5$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime5$delayedResponseAllowed, TRUE, label = paste0("c(", paste0(pwSurvivalTime5$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime5$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime5$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime5), NA))) + expect_output(print(pwSurvivalTime5)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime5), NA))) + expect_output(summary(pwSurvivalTime5)$show()) + pwSurvivalTime5CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime5, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime5CodeBased$piecewiseSurvivalTime, pwSurvivalTime5$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime5CodeBased$lambda1, pwSurvivalTime5$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime5CodeBased$lambda2, pwSurvivalTime5$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime5CodeBased$hazardRatio, pwSurvivalTime5$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime5CodeBased$pi1, pwSurvivalTime5$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime5CodeBased$pi2, pwSurvivalTime5$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime5CodeBased$median1, pwSurvivalTime5$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime5CodeBased$median2, pwSurvivalTime5$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime5CodeBased$eventTime, pwSurvivalTime5$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime5CodeBased$kappa, pwSurvivalTime5$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime5CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime5$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime5CodeBased$delayedResponseAllowed, pwSurvivalTime5$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime5CodeBased$delayedResponseEnabled, pwSurvivalTime5$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime5), "character") + df <- as.data.frame(pwSurvivalTime5) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime5) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime6 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = list("0 - 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime6) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime7 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = list("x" = 0.025), + hazardRatio = 0.8, delayedResponseAllowed = FALSE) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime7' with expected results + expect_equal(pwSurvivalTime7$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime7$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime7$lambda1, 0.02, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime7$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime7$lambda2, 0.025, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime7$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime7$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime7$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime7$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime7$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime7$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime7$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime7$median1, 34.657359, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime7$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime7$median2, 27.725887, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime7$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime7$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime7$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime7$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime7$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime7$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime7$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime7$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime7$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime7$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime7$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime7), NA))) + expect_output(print(pwSurvivalTime7)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime7), NA))) + expect_output(summary(pwSurvivalTime7)$show()) + pwSurvivalTime7CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime7, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime7CodeBased$piecewiseSurvivalTime, pwSurvivalTime7$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime7CodeBased$lambda1, pwSurvivalTime7$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime7CodeBased$lambda2, pwSurvivalTime7$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime7CodeBased$hazardRatio, pwSurvivalTime7$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime7CodeBased$pi1, pwSurvivalTime7$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime7CodeBased$pi2, pwSurvivalTime7$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime7CodeBased$median1, pwSurvivalTime7$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime7CodeBased$median2, pwSurvivalTime7$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime7CodeBased$eventTime, pwSurvivalTime7$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime7CodeBased$kappa, pwSurvivalTime7$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime7CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime7$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime7CodeBased$delayedResponseAllowed, pwSurvivalTime7$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime7CodeBased$delayedResponseEnabled, pwSurvivalTime7$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime7), "character") + df <- as.data.frame(pwSurvivalTime7) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime7) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime8 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = list("0 - 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime8) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + expect_warning(getPiecewiseSurvivalTime(piecewiseSurvivalTime = list("<6" = 0.025), hazardRatio = 0.8), + "Defined time period \"0 - <6\" will be ignored because 'piecewiseSurvivalTime' list has only 1 entry", + fixed = TRUE + ) + +}) + +test_plan_section("Testing Class 'AccrualTime'") + + +test_that("Testing 'getAccrualTime': isAccrualTimeEnabled()", { + expect_true(getAccrualTime()$isAccrualTimeEnabled()) + expect_true(getAccrualTime(maxNumberOfSubjects = 100)$isAccrualTimeEnabled()) + +}) + +test_that("Testing 'getAccrualTime': vector based definition", { + + accrualTime1 <- getAccrualTime( + accrualTime = c(0, 6, 9, 15), + accrualIntensity = c(15, 21, 27), maxNumberOfSubjects = 315 + ) + expect_equal(accrualTime1$accrualTime, c(0, 6, 9, 15)) + expect_equal(accrualTime1$accrualIntensity, c(15, 21, 27)) + expect_equal(accrualTime1$remainingTime, NA_real_) + + accrualTime2 <- getAccrualTime( + accrualTime = c(0, 6, 9), + accrualIntensity = c(15, 21, 27), maxNumberOfSubjects = 1000 + ) + expect_equal(accrualTime2$accrualTime, c(0, 6, 9, 40.37037)) + expect_equal(accrualTime2$accrualIntensity, c(15, 21, 27)) + expect_equal(accrualTime2$remainingTime, 31.37037) + + .skipTestIfDisabled() + + accrualTime3 <- getAccrualTime( + accrualTime = c(0, 12, 13, 14, 15, 16), + accrualIntensity = c(15, 21, 27, 33, 39, 45), maxNumberOfSubjects = 1405 + ) + expect_equal(accrualTime3$accrualTime, c(0, 12, 13, 14, 15, 16, 40.55555556)) + expect_equal(accrualTime3$accrualIntensity, c(15, 21, 27, 33, 39, 45)) + expect_equal(accrualTime3$remainingTime, 24.55555556) + + accrualTime4 <- getAccrualTime( + accrualTime = c(0, 24), + accrualIntensity = c(30), maxNumberOfSubjects = 720 + ) + + ## Comparison of the results of AccrualTime object 'accrualTime4' with expected results + expect_equal(accrualTime4$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime4$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime4$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime4$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime4$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime4$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime4$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime4$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime4$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime4$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime4$accrualTime, c(0, 24), label = paste0("c(", paste0(accrualTime4$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime4$accrualIntensity, 30, label = paste0("c(", paste0(accrualTime4$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime4$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime4$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime4$maxNumberOfSubjects, 720, label = paste0("c(", paste0(accrualTime4$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime4$remainingTime, NA_real_, label = paste0("c(", paste0(accrualTime4$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime4$piecewiseAccrualEnabled, FALSE, label = paste0("c(", paste0(accrualTime4$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime4), NA))) + expect_output(print(accrualTime4)$show()) + invisible(capture.output(expect_error(summary(accrualTime4), NA))) + expect_output(summary(accrualTime4)$show()) + accrualTime4CodeBased <- eval(parse(text = getObjectRCode(accrualTime4, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime4CodeBased$endOfAccrualIsUserDefined, accrualTime4$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$followUpTimeMustBeUserDefined, accrualTime4$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime4$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime4$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$absoluteAccrualIntensityEnabled, accrualTime4$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$accrualTime, accrualTime4$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$accrualIntensity, accrualTime4$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$accrualIntensityRelative, accrualTime4$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$maxNumberOfSubjects, accrualTime4$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$remainingTime, accrualTime4$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$piecewiseAccrualEnabled, accrualTime4$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime4), "character") + df <- as.data.frame(accrualTime4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime5 <- getAccrualTime( + accrualTime = c(0, 24, 30), + accrualIntensity = c(30, 45) + ) + + ## Comparison of the results of AccrualTime object 'accrualTime5' with expected results + expect_equal(accrualTime5$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime5$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime5$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime5$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime5$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime5$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime5$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime5$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime5$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime5$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime5$accrualTime, c(0, 24, 30), label = paste0("c(", paste0(accrualTime5$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime5$accrualIntensity, c(30, 45), label = paste0("c(", paste0(accrualTime5$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime5$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime5$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime5$maxNumberOfSubjects, 990, label = paste0("c(", paste0(accrualTime5$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime5$remainingTime, 6, label = paste0("c(", paste0(accrualTime5$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime5$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime5$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime5), NA))) + expect_output(print(accrualTime5)$show()) + invisible(capture.output(expect_error(summary(accrualTime5), NA))) + expect_output(summary(accrualTime5)$show()) + accrualTime5CodeBased <- eval(parse(text = getObjectRCode(accrualTime5, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime5CodeBased$endOfAccrualIsUserDefined, accrualTime5$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$followUpTimeMustBeUserDefined, accrualTime5$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime5$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime5$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$absoluteAccrualIntensityEnabled, accrualTime5$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$accrualTime, accrualTime5$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$accrualIntensity, accrualTime5$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$accrualIntensityRelative, accrualTime5$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$maxNumberOfSubjects, accrualTime5$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$remainingTime, accrualTime5$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$piecewiseAccrualEnabled, accrualTime5$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime5), "character") + df <- as.data.frame(accrualTime5) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime5) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime6 <- getAccrualTime( + accrualTime = c(0, 24, 30), + accrualIntensity = c(20, 25, 45), maxNumberOfSubjects = 720 + ) + + ## Comparison of the results of AccrualTime object 'accrualTime6' with expected results + expect_equal(accrualTime6$endOfAccrualIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime6$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime6$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime6$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime6$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime6$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime6$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime6$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime6$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime6$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime6$accrualTime, c(0, 24, 30, 32), label = paste0("c(", paste0(accrualTime6$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime6$accrualIntensity, c(20, 25, 45), label = paste0("c(", paste0(accrualTime6$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime6$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime6$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime6$maxNumberOfSubjects, 720, label = paste0("c(", paste0(accrualTime6$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime6$remainingTime, 2, label = paste0("c(", paste0(accrualTime6$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime6$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime6$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime6), NA))) + expect_output(print(accrualTime6)$show()) + invisible(capture.output(expect_error(summary(accrualTime6), NA))) + expect_output(summary(accrualTime6)$show()) + accrualTime6CodeBased <- eval(parse(text = getObjectRCode(accrualTime6, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime6CodeBased$endOfAccrualIsUserDefined, accrualTime6$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$followUpTimeMustBeUserDefined, accrualTime6$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime6$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime6$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$absoluteAccrualIntensityEnabled, accrualTime6$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$accrualTime, accrualTime6$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$accrualIntensity, accrualTime6$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$accrualIntensityRelative, accrualTime6$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$maxNumberOfSubjects, accrualTime6$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$remainingTime, accrualTime6$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$piecewiseAccrualEnabled, accrualTime6$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime6), "character") + df <- as.data.frame(accrualTime6) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime6) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime8 <- getAccrualTime(accrualTime = 0, accrualIntensity = 15, maxNumberOfSubjects = 1000) + + ## Comparison of the results of AccrualTime object 'accrualTime8' with expected results + expect_equal(accrualTime8$endOfAccrualIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime8$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime8$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime8$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime8$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime8$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime8$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime8$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime8$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime8$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime8$accrualTime, c(0, 66.666667), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime8$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime8$accrualIntensity, 15, label = paste0("c(", paste0(accrualTime8$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime8$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime8$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime8$maxNumberOfSubjects, 1000, label = paste0("c(", paste0(accrualTime8$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime8$remainingTime, 66.666667, tolerance = 1e-07, label = paste0("c(", paste0(accrualTime8$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime8$piecewiseAccrualEnabled, FALSE, label = paste0("c(", paste0(accrualTime8$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime8), NA))) + expect_output(print(accrualTime8)$show()) + invisible(capture.output(expect_error(summary(accrualTime8), NA))) + expect_output(summary(accrualTime8)$show()) + accrualTime8CodeBased <- eval(parse(text = getObjectRCode(accrualTime8, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime8CodeBased$endOfAccrualIsUserDefined, accrualTime8$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$followUpTimeMustBeUserDefined, accrualTime8$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime8$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime8$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$absoluteAccrualIntensityEnabled, accrualTime8$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$accrualTime, accrualTime8$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$accrualIntensity, accrualTime8$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$accrualIntensityRelative, accrualTime8$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$maxNumberOfSubjects, accrualTime8$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$remainingTime, accrualTime8$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$piecewiseAccrualEnabled, accrualTime8$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime8), "character") + df <- as.data.frame(accrualTime8) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime8) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime9 <- getAccrualTime(accrualTime = c(0, 5), accrualIntensity = 15) + + ## Comparison of the results of AccrualTime object 'accrualTime9' with expected results + expect_equal(accrualTime9$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime9$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime9$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime9$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime9$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime9$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime9$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime9$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime9$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime9$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime9$accrualTime, c(0, 5), label = paste0("c(", paste0(accrualTime9$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime9$accrualIntensity, 15, label = paste0("c(", paste0(accrualTime9$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime9$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime9$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime9$maxNumberOfSubjects, 75, label = paste0("c(", paste0(accrualTime9$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime9$remainingTime, 5, label = paste0("c(", paste0(accrualTime9$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime9$piecewiseAccrualEnabled, FALSE, label = paste0("c(", paste0(accrualTime9$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime9), NA))) + expect_output(print(accrualTime9)$show()) + invisible(capture.output(expect_error(summary(accrualTime9), NA))) + expect_output(summary(accrualTime9)$show()) + accrualTime9CodeBased <- eval(parse(text = getObjectRCode(accrualTime9, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime9CodeBased$endOfAccrualIsUserDefined, accrualTime9$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$followUpTimeMustBeUserDefined, accrualTime9$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime9$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime9$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$absoluteAccrualIntensityEnabled, accrualTime9$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$accrualTime, accrualTime9$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$accrualIntensity, accrualTime9$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$accrualIntensityRelative, accrualTime9$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$maxNumberOfSubjects, accrualTime9$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$remainingTime, accrualTime9$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$piecewiseAccrualEnabled, accrualTime9$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime9), "character") + df <- as.data.frame(accrualTime9) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime9) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime10 <- getAccrualTime(accrualTime = 0, accrualIntensity = 15, maxNumberOfSubjects = 10) + + ## Comparison of the results of AccrualTime object 'accrualTime10' with expected results + expect_equal(accrualTime10$endOfAccrualIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime10$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime10$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime10$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime10$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime10$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime10$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime10$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime10$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime10$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime10$accrualTime, c(0, 0.66666667), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime10$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime10$accrualIntensity, 15, label = paste0("c(", paste0(accrualTime10$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime10$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime10$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime10$maxNumberOfSubjects, 10, label = paste0("c(", paste0(accrualTime10$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime10$remainingTime, 0.66666667, tolerance = 1e-07, label = paste0("c(", paste0(accrualTime10$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime10$piecewiseAccrualEnabled, FALSE, label = paste0("c(", paste0(accrualTime10$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime10), NA))) + expect_output(print(accrualTime10)$show()) + invisible(capture.output(expect_error(summary(accrualTime10), NA))) + expect_output(summary(accrualTime10)$show()) + accrualTime10CodeBased <- eval(parse(text = getObjectRCode(accrualTime10, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime10CodeBased$endOfAccrualIsUserDefined, accrualTime10$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$followUpTimeMustBeUserDefined, accrualTime10$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime10$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime10$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$absoluteAccrualIntensityEnabled, accrualTime10$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$accrualTime, accrualTime10$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$accrualIntensity, accrualTime10$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$accrualIntensityRelative, accrualTime10$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$maxNumberOfSubjects, accrualTime10$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$remainingTime, accrualTime10$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$piecewiseAccrualEnabled, accrualTime10$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime10), "character") + df <- as.data.frame(accrualTime10) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime10) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime11 <- getAccrualTime(accrualTime = c(0, 5), accrualIntensity = 15, maxNumberOfSubjects = 75) + + ## Comparison of the results of AccrualTime object 'accrualTime11' with expected results + expect_equal(accrualTime11$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime11$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime11$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime11$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime11$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime11$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime11$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime11$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime11$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime11$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime11$accrualTime, c(0, 5), label = paste0("c(", paste0(accrualTime11$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime11$accrualIntensity, 15, label = paste0("c(", paste0(accrualTime11$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime11$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime11$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime11$maxNumberOfSubjects, 75, label = paste0("c(", paste0(accrualTime11$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime11$remainingTime, NA_real_, label = paste0("c(", paste0(accrualTime11$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime11$piecewiseAccrualEnabled, FALSE, label = paste0("c(", paste0(accrualTime11$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime11), NA))) + expect_output(print(accrualTime11)$show()) + invisible(capture.output(expect_error(summary(accrualTime11), NA))) + expect_output(summary(accrualTime11)$show()) + accrualTime11CodeBased <- eval(parse(text = getObjectRCode(accrualTime11, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime11CodeBased$endOfAccrualIsUserDefined, accrualTime11$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime11CodeBased$followUpTimeMustBeUserDefined, accrualTime11$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime11CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime11$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime11CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime11$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime11CodeBased$absoluteAccrualIntensityEnabled, accrualTime11$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime11CodeBased$accrualTime, accrualTime11$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime11CodeBased$accrualIntensity, accrualTime11$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime11CodeBased$accrualIntensityRelative, accrualTime11$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime11CodeBased$maxNumberOfSubjects, accrualTime11$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime11CodeBased$remainingTime, accrualTime11$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime11CodeBased$piecewiseAccrualEnabled, accrualTime11$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime11), "character") + df <- as.data.frame(accrualTime11) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime11) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime12 <- getAccrualTime(accrualTime = c(0, 6, 15, 25), accrualIntensity = c(22, 0, 33)) + + ## Comparison of the results of AccrualTime object 'accrualTime12' with expected results + expect_equal(accrualTime12$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime12$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime12$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime12$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime12$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime12$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime12$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime12$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime12$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime12$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime12$accrualTime, c(0, 6, 15, 25), label = paste0("c(", paste0(accrualTime12$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime12$accrualIntensity, c(22, 0, 33), label = paste0("c(", paste0(accrualTime12$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime12$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime12$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime12$maxNumberOfSubjects, 462, label = paste0("c(", paste0(accrualTime12$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime12$remainingTime, 10, label = paste0("c(", paste0(accrualTime12$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime12$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime12$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime12), NA))) + expect_output(print(accrualTime12)$show()) + invisible(capture.output(expect_error(summary(accrualTime12), NA))) + expect_output(summary(accrualTime12)$show()) + accrualTime12CodeBased <- eval(parse(text = getObjectRCode(accrualTime12, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime12CodeBased$endOfAccrualIsUserDefined, accrualTime12$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$followUpTimeMustBeUserDefined, accrualTime12$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime12$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime12$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$absoluteAccrualIntensityEnabled, accrualTime12$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$accrualTime, accrualTime12$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$accrualIntensity, accrualTime12$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$accrualIntensityRelative, accrualTime12$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$maxNumberOfSubjects, accrualTime12$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$remainingTime, accrualTime12$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$piecewiseAccrualEnabled, accrualTime12$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime12), "character") + df <- as.data.frame(accrualTime12) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime12) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime13 <- getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(22, 33), maxNumberOfSubjects = 1000) + + ## Comparison of the results of AccrualTime object 'accrualTime13' with expected results + expect_equal(accrualTime13$endOfAccrualIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime13$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime13$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime13$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime13$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime13$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime13$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime13$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime13$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime13$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime13$accrualTime, c(0, 6, 32.30303), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime13$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime13$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime13$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime13$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime13$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime13$maxNumberOfSubjects, 1000, label = paste0("c(", paste0(accrualTime13$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime13$remainingTime, 26.30303, tolerance = 1e-07, label = paste0("c(", paste0(accrualTime13$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime13$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime13$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime13), NA))) + expect_output(print(accrualTime13)$show()) + invisible(capture.output(expect_error(summary(accrualTime13), NA))) + expect_output(summary(accrualTime13)$show()) + accrualTime13CodeBased <- eval(parse(text = getObjectRCode(accrualTime13, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime13CodeBased$endOfAccrualIsUserDefined, accrualTime13$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$followUpTimeMustBeUserDefined, accrualTime13$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime13$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime13$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$absoluteAccrualIntensityEnabled, accrualTime13$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$accrualTime, accrualTime13$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$accrualIntensity, accrualTime13$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$accrualIntensityRelative, accrualTime13$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$maxNumberOfSubjects, accrualTime13$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$remainingTime, accrualTime13$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$piecewiseAccrualEnabled, accrualTime13$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime13), "character") + df <- as.data.frame(accrualTime13) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime13) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("Testing 'getAccrualTime': test absolute and relative definition", { + + # @refFS[Tab.]{fs:tab:output:getAccrualTime} + accrualTime1 <- getAccrualTime( + accrualTime = c(0, 6, 30), + accrualIntensity = c(22, 33), maxNumberOfSubjects = 924 + ) + + ## Comparison of the results of AccrualTime object 'accrualTime1' with expected results + expect_equal(accrualTime1$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime1$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime1$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime1$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime1$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime1$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime1$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime1$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime1$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime1$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime1$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime1$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime1$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime1$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime1$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime1$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime1$maxNumberOfSubjects, 924, label = paste0("c(", paste0(accrualTime1$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime1$remainingTime, NA_real_, label = paste0("c(", paste0(accrualTime1$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime1$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime1$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime1), NA))) + expect_output(print(accrualTime1)$show()) + invisible(capture.output(expect_error(summary(accrualTime1), NA))) + expect_output(summary(accrualTime1)$show()) + accrualTime1CodeBased <- eval(parse(text = getObjectRCode(accrualTime1, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime1CodeBased$endOfAccrualIsUserDefined, accrualTime1$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime1CodeBased$followUpTimeMustBeUserDefined, accrualTime1$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime1CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime1$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime1CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime1$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime1CodeBased$absoluteAccrualIntensityEnabled, accrualTime1$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime1CodeBased$accrualTime, accrualTime1$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime1CodeBased$accrualIntensity, accrualTime1$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime1CodeBased$accrualIntensityRelative, accrualTime1$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime1CodeBased$maxNumberOfSubjects, accrualTime1$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime1CodeBased$remainingTime, accrualTime1$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime1CodeBased$piecewiseAccrualEnabled, accrualTime1$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime1), "character") + df <- as.data.frame(accrualTime1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime2 <- getAccrualTime(list( + "0 - <6" = 22, + "6 - <=30" = 33 + ), + maxNumberOfSubjects = 924 + ) + + ## Comparison of the results of AccrualTime object 'accrualTime2' with expected results + expect_equal(accrualTime2$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime2$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime2$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime2$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime2$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime2$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime2$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime2$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime2$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime2$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime2$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime2$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime2$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime2$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime2$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime2$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime2$maxNumberOfSubjects, 924, label = paste0("c(", paste0(accrualTime2$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime2$remainingTime, NA_real_, label = paste0("c(", paste0(accrualTime2$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime2$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime2$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime2), NA))) + expect_output(print(accrualTime2)$show()) + invisible(capture.output(expect_error(summary(accrualTime2), NA))) + expect_output(summary(accrualTime2)$show()) + accrualTime2CodeBased <- eval(parse(text = getObjectRCode(accrualTime2, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime2CodeBased$endOfAccrualIsUserDefined, accrualTime2$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime2CodeBased$followUpTimeMustBeUserDefined, accrualTime2$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime2CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime2$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime2CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime2$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime2CodeBased$absoluteAccrualIntensityEnabled, accrualTime2$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime2CodeBased$accrualTime, accrualTime2$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime2CodeBased$accrualIntensity, accrualTime2$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime2CodeBased$accrualIntensityRelative, accrualTime2$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime2CodeBased$maxNumberOfSubjects, accrualTime2$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime2CodeBased$remainingTime, accrualTime2$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime2CodeBased$piecewiseAccrualEnabled, accrualTime2$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime2), "character") + df <- as.data.frame(accrualTime2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + .skipTestIfDisabled() + + accrualTime3 <- getAccrualTime( + accrualTime = c(0, 6, 30), + accrualIntensity = c(0.22, 0.33), maxNumberOfSubjects = 1000 + ) + + ## Comparison of the results of AccrualTime object 'accrualTime3' with expected results + expect_equal(accrualTime3$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime3$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime3$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime3$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime3$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime3$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime3$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime3$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime3$absoluteAccrualIntensityEnabled, FALSE, label = paste0("c(", paste0(accrualTime3$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime3$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime3$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime3$accrualIntensity, c(23.809524, 35.714286), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime3$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime3$accrualIntensityRelative, c(0.22, 0.33), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime3$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime3$maxNumberOfSubjects, 1000, label = paste0("c(", paste0(accrualTime3$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime3$remainingTime, 24, label = paste0("c(", paste0(accrualTime3$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime3$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime3$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime3), NA))) + expect_output(print(accrualTime3)$show()) + invisible(capture.output(expect_error(summary(accrualTime3), NA))) + expect_output(summary(accrualTime3)$show()) + accrualTime3CodeBased <- eval(parse(text = getObjectRCode(accrualTime3, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime3CodeBased$endOfAccrualIsUserDefined, accrualTime3$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime3CodeBased$followUpTimeMustBeUserDefined, accrualTime3$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime3CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime3$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime3CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime3$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime3CodeBased$absoluteAccrualIntensityEnabled, accrualTime3$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime3CodeBased$accrualTime, accrualTime3$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime3CodeBased$accrualIntensity, accrualTime3$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime3CodeBased$accrualIntensityRelative, accrualTime3$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime3CodeBased$maxNumberOfSubjects, accrualTime3$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime3CodeBased$remainingTime, accrualTime3$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime3CodeBased$piecewiseAccrualEnabled, accrualTime3$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime3), "character") + df <- as.data.frame(accrualTime3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime4 <- getAccrualTime(list( + "0 - <6" = 0.22, + "6 - <=30" = 0.33 + ), + maxNumberOfSubjects = 1000 + ) + + ## Comparison of the results of AccrualTime object 'accrualTime4' with expected results + expect_equal(accrualTime4$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime4$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime4$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime4$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime4$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime4$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime4$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime4$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime4$absoluteAccrualIntensityEnabled, FALSE, label = paste0("c(", paste0(accrualTime4$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime4$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime4$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime4$accrualIntensity, c(23.809524, 35.714286), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime4$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime4$accrualIntensityRelative, c(0.22, 0.33), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime4$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime4$maxNumberOfSubjects, 1000, label = paste0("c(", paste0(accrualTime4$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime4$remainingTime, 24, label = paste0("c(", paste0(accrualTime4$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime4$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime4$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime4), NA))) + expect_output(print(accrualTime4)$show()) + invisible(capture.output(expect_error(summary(accrualTime4), NA))) + expect_output(summary(accrualTime4)$show()) + accrualTime4CodeBased <- eval(parse(text = getObjectRCode(accrualTime4, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime4CodeBased$endOfAccrualIsUserDefined, accrualTime4$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$followUpTimeMustBeUserDefined, accrualTime4$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime4$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime4$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$absoluteAccrualIntensityEnabled, accrualTime4$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$accrualTime, accrualTime4$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$accrualIntensity, accrualTime4$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$accrualIntensityRelative, accrualTime4$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$maxNumberOfSubjects, accrualTime4$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$remainingTime, accrualTime4$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$piecewiseAccrualEnabled, accrualTime4$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime4), "character") + df <- as.data.frame(accrualTime4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime5 <- getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(22, 33)) + + ## Comparison of the results of AccrualTime object 'accrualTime5' with expected results + expect_equal(accrualTime5$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime5$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime5$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime5$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime5$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime5$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime5$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime5$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime5$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime5$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime5$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime5$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime5$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime5$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime5$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime5$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime5$maxNumberOfSubjects, 924, label = paste0("c(", paste0(accrualTime5$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime5$remainingTime, 24, label = paste0("c(", paste0(accrualTime5$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime5$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime5$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime5), NA))) + expect_output(print(accrualTime5)$show()) + invisible(capture.output(expect_error(summary(accrualTime5), NA))) + expect_output(summary(accrualTime5)$show()) + accrualTime5CodeBased <- eval(parse(text = getObjectRCode(accrualTime5, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime5CodeBased$endOfAccrualIsUserDefined, accrualTime5$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$followUpTimeMustBeUserDefined, accrualTime5$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime5$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime5$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$absoluteAccrualIntensityEnabled, accrualTime5$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$accrualTime, accrualTime5$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$accrualIntensity, accrualTime5$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$accrualIntensityRelative, accrualTime5$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$maxNumberOfSubjects, accrualTime5$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$remainingTime, accrualTime5$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$piecewiseAccrualEnabled, accrualTime5$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime5), "character") + df <- as.data.frame(accrualTime5) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime5) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime6 <- getAccrualTime(list( + "0 - <6" = 22, + "6 - <=30" = 33 + )) + + ## Comparison of the results of AccrualTime object 'accrualTime6' with expected results + expect_equal(accrualTime6$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime6$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime6$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime6$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime6$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime6$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime6$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime6$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime6$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime6$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime6$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime6$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime6$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime6$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime6$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime6$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime6$maxNumberOfSubjects, 924, label = paste0("c(", paste0(accrualTime6$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime6$remainingTime, 24, label = paste0("c(", paste0(accrualTime6$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime6$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime6$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime6), NA))) + expect_output(print(accrualTime6)$show()) + invisible(capture.output(expect_error(summary(accrualTime6), NA))) + expect_output(summary(accrualTime6)$show()) + accrualTime6CodeBased <- eval(parse(text = getObjectRCode(accrualTime6, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime6CodeBased$endOfAccrualIsUserDefined, accrualTime6$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$followUpTimeMustBeUserDefined, accrualTime6$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime6$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime6$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$absoluteAccrualIntensityEnabled, accrualTime6$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$accrualTime, accrualTime6$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$accrualIntensity, accrualTime6$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$accrualIntensityRelative, accrualTime6$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$maxNumberOfSubjects, accrualTime6$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$remainingTime, accrualTime6$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$piecewiseAccrualEnabled, accrualTime6$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime6), "character") + df <- as.data.frame(accrualTime6) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime6) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime7 <- getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(0.22, 0.33)) + + ## Comparison of the results of AccrualTime object 'accrualTime7' with expected results + expect_equal(accrualTime7$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime7$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime7$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime7$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime7$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime7$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime7$maxNumberOfSubjectsCanBeCalculatedDirectly, FALSE, label = paste0("c(", paste0(accrualTime7$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime7$absoluteAccrualIntensityEnabled, FALSE, label = paste0("c(", paste0(accrualTime7$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime7$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime7$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime7$accrualIntensity, c(0.22, 0.33), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime7$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime7$accrualIntensityRelative, c(0.22, 0.33), label = paste0("c(", paste0(accrualTime7$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime7$maxNumberOfSubjects, NA_real_, label = paste0("c(", paste0(accrualTime7$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime7$remainingTime, NA_real_, label = paste0("c(", paste0(accrualTime7$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime7$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime7$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime7), NA))) + expect_output(print(accrualTime7)$show()) + invisible(capture.output(expect_error(summary(accrualTime7), NA))) + expect_output(summary(accrualTime7)$show()) + accrualTime7CodeBased <- eval(parse(text = getObjectRCode(accrualTime7, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime7CodeBased$endOfAccrualIsUserDefined, accrualTime7$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime7CodeBased$followUpTimeMustBeUserDefined, accrualTime7$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime7CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime7$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime7CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime7$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime7CodeBased$absoluteAccrualIntensityEnabled, accrualTime7$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime7CodeBased$accrualTime, accrualTime7$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime7CodeBased$accrualIntensity, accrualTime7$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime7CodeBased$accrualIntensityRelative, accrualTime7$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime7CodeBased$maxNumberOfSubjects, accrualTime7$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime7CodeBased$remainingTime, accrualTime7$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime7CodeBased$piecewiseAccrualEnabled, accrualTime7$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime7), "character") + df <- as.data.frame(accrualTime7) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime7) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime8 <- getAccrualTime(list( + "0 - <6" = 0.22, + "6 - <=30" = 0.33 + )) + + ## Comparison of the results of AccrualTime object 'accrualTime8' with expected results + expect_equal(accrualTime8$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime8$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime8$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime8$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime8$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime8$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime8$maxNumberOfSubjectsCanBeCalculatedDirectly, FALSE, label = paste0("c(", paste0(accrualTime8$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime8$absoluteAccrualIntensityEnabled, FALSE, label = paste0("c(", paste0(accrualTime8$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime8$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime8$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime8$accrualIntensity, c(0.22, 0.33), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime8$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime8$accrualIntensityRelative, c(0.22, 0.33), label = paste0("c(", paste0(accrualTime8$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime8$maxNumberOfSubjects, NA_real_, label = paste0("c(", paste0(accrualTime8$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime8$remainingTime, NA_real_, label = paste0("c(", paste0(accrualTime8$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime8$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime8$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime8), NA))) + expect_output(print(accrualTime8)$show()) + invisible(capture.output(expect_error(summary(accrualTime8), NA))) + expect_output(summary(accrualTime8)$show()) + accrualTime8CodeBased <- eval(parse(text = getObjectRCode(accrualTime8, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime8CodeBased$endOfAccrualIsUserDefined, accrualTime8$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$followUpTimeMustBeUserDefined, accrualTime8$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime8$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime8$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$absoluteAccrualIntensityEnabled, accrualTime8$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$accrualTime, accrualTime8$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$accrualIntensity, accrualTime8$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$accrualIntensityRelative, accrualTime8$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$maxNumberOfSubjects, accrualTime8$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$remainingTime, accrualTime8$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$piecewiseAccrualEnabled, accrualTime8$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime8), "character") + df <- as.data.frame(accrualTime8) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime8) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime9 <- getAccrualTime( + accrualTime = c(0, 6), + accrualIntensity = c(22, 33), maxNumberOfSubjects = 1000 + ) + + ## Comparison of the results of AccrualTime object 'accrualTime9' with expected results + expect_equal(accrualTime9$endOfAccrualIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime9$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime9$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime9$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime9$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime9$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime9$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime9$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime9$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime9$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime9$accrualTime, c(0, 6, 32.30303), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime9$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime9$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime9$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime9$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime9$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime9$maxNumberOfSubjects, 1000, label = paste0("c(", paste0(accrualTime9$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime9$remainingTime, 26.30303, tolerance = 1e-07, label = paste0("c(", paste0(accrualTime9$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime9$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime9$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime9), NA))) + expect_output(print(accrualTime9)$show()) + invisible(capture.output(expect_error(summary(accrualTime9), NA))) + expect_output(summary(accrualTime9)$show()) + accrualTime9CodeBased <- eval(parse(text = getObjectRCode(accrualTime9, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime9CodeBased$endOfAccrualIsUserDefined, accrualTime9$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$followUpTimeMustBeUserDefined, accrualTime9$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime9$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime9$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$absoluteAccrualIntensityEnabled, accrualTime9$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$accrualTime, accrualTime9$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$accrualIntensity, accrualTime9$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$accrualIntensityRelative, accrualTime9$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$maxNumberOfSubjects, accrualTime9$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$remainingTime, accrualTime9$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$piecewiseAccrualEnabled, accrualTime9$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime9), "character") + df <- as.data.frame(accrualTime9) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime9) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime10 <- getAccrualTime(list( + "0 - <6" = 22, + "6" = 33 + ), + maxNumberOfSubjects = 1000 + ) + + ## Comparison of the results of AccrualTime object 'accrualTime10' with expected results + expect_equal(accrualTime10$endOfAccrualIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime10$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime10$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime10$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime10$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime10$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime10$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime10$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime10$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime10$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime10$accrualTime, c(0, 6, 32.30303), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime10$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime10$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime10$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime10$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime10$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime10$maxNumberOfSubjects, 1000, label = paste0("c(", paste0(accrualTime10$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime10$remainingTime, 26.30303, tolerance = 1e-07, label = paste0("c(", paste0(accrualTime10$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime10$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime10$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime10), NA))) + expect_output(print(accrualTime10)$show()) + invisible(capture.output(expect_error(summary(accrualTime10), NA))) + expect_output(summary(accrualTime10)$show()) + accrualTime10CodeBased <- eval(parse(text = getObjectRCode(accrualTime10, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime10CodeBased$endOfAccrualIsUserDefined, accrualTime10$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$followUpTimeMustBeUserDefined, accrualTime10$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime10$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime10$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$absoluteAccrualIntensityEnabled, accrualTime10$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$accrualTime, accrualTime10$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$accrualIntensity, accrualTime10$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$accrualIntensityRelative, accrualTime10$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$maxNumberOfSubjects, accrualTime10$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$remainingTime, accrualTime10$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$piecewiseAccrualEnabled, accrualTime10$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime10), "character") + df <- as.data.frame(accrualTime10) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime10) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime12 <- getAccrualTime(list( + "0 - <6" = 0.22, + "6 - <=30" = 0.33 + ), + maxNumberOfSubjects = 1000 + ) + + ## Comparison of the results of AccrualTime object 'accrualTime12' with expected results + expect_equal(accrualTime12$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime12$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime12$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime12$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime12$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime12$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime12$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime12$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime12$absoluteAccrualIntensityEnabled, FALSE, label = paste0("c(", paste0(accrualTime12$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime12$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime12$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime12$accrualIntensity, c(23.809524, 35.714286), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime12$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime12$accrualIntensityRelative, c(0.22, 0.33), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime12$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime12$maxNumberOfSubjects, 1000, label = paste0("c(", paste0(accrualTime12$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime12$remainingTime, 24, label = paste0("c(", paste0(accrualTime12$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime12$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime12$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime12), NA))) + expect_output(print(accrualTime12)$show()) + invisible(capture.output(expect_error(summary(accrualTime12), NA))) + expect_output(summary(accrualTime12)$show()) + accrualTime12CodeBased <- eval(parse(text = getObjectRCode(accrualTime12, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime12CodeBased$endOfAccrualIsUserDefined, accrualTime12$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$followUpTimeMustBeUserDefined, accrualTime12$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime12$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime12$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$absoluteAccrualIntensityEnabled, accrualTime12$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$accrualTime, accrualTime12$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$accrualIntensity, accrualTime12$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$accrualIntensityRelative, accrualTime12$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$maxNumberOfSubjects, accrualTime12$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$remainingTime, accrualTime12$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$piecewiseAccrualEnabled, accrualTime12$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime12), "character") + df <- as.data.frame(accrualTime12) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime12) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime13 <- getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(22, 33)) + + ## Comparison of the results of AccrualTime object 'accrualTime13' with expected results + expect_equal(accrualTime13$endOfAccrualIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime13$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime13$followUpTimeMustBeUserDefined, TRUE, label = paste0("c(", paste0(accrualTime13$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime13$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime13$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime13$maxNumberOfSubjectsCanBeCalculatedDirectly, FALSE, label = paste0("c(", paste0(accrualTime13$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime13$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime13$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime13$accrualTime, c(0, 6), label = paste0("c(", paste0(accrualTime13$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime13$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime13$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime13$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime13$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime13$maxNumberOfSubjects, NA_real_, label = paste0("c(", paste0(accrualTime13$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime13$remainingTime, NA_real_, label = paste0("c(", paste0(accrualTime13$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime13$piecewiseAccrualEnabled, FALSE, label = paste0("c(", paste0(accrualTime13$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime13), NA))) + expect_output(print(accrualTime13)$show()) + invisible(capture.output(expect_error(summary(accrualTime13), NA))) + expect_output(summary(accrualTime13)$show()) + accrualTime13CodeBased <- eval(parse(text = getObjectRCode(accrualTime13, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime13CodeBased$endOfAccrualIsUserDefined, accrualTime13$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$followUpTimeMustBeUserDefined, accrualTime13$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime13$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime13$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$absoluteAccrualIntensityEnabled, accrualTime13$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$accrualTime, accrualTime13$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$accrualIntensity, accrualTime13$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$accrualIntensityRelative, accrualTime13$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$maxNumberOfSubjects, accrualTime13$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$remainingTime, accrualTime13$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$piecewiseAccrualEnabled, accrualTime13$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime13), "character") + df <- as.data.frame(accrualTime13) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime13) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime14 <- getAccrualTime(list( + "0 - <6" = 22, + "6 - <=30" = 33 + )) + + ## Comparison of the results of AccrualTime object 'accrualTime14' with expected results + expect_equal(accrualTime14$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime14$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime14$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime14$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime14$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime14$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime14$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime14$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime14$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime14$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime14$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime14$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime14$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime14$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime14$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime14$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime14$maxNumberOfSubjects, 924, label = paste0("c(", paste0(accrualTime14$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime14$remainingTime, 24, label = paste0("c(", paste0(accrualTime14$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime14$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime14$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime14), NA))) + expect_output(print(accrualTime14)$show()) + invisible(capture.output(expect_error(summary(accrualTime14), NA))) + expect_output(summary(accrualTime14)$show()) + accrualTime14CodeBased <- eval(parse(text = getObjectRCode(accrualTime14, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime14CodeBased$endOfAccrualIsUserDefined, accrualTime14$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime14CodeBased$followUpTimeMustBeUserDefined, accrualTime14$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime14CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime14$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime14CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime14$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime14CodeBased$absoluteAccrualIntensityEnabled, accrualTime14$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime14CodeBased$accrualTime, accrualTime14$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime14CodeBased$accrualIntensity, accrualTime14$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime14CodeBased$accrualIntensityRelative, accrualTime14$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime14CodeBased$maxNumberOfSubjects, accrualTime14$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime14CodeBased$remainingTime, accrualTime14$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime14CodeBased$piecewiseAccrualEnabled, accrualTime14$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime14), "character") + df <- as.data.frame(accrualTime14) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime14) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("Testing 'getAccrualTime': check expected warnings and errors", { + + # @refFS[Tab.]{fs:tab:output:getAccrualTime} + expect_warning(getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(0.22, 0.33)), + paste0("The specified accrual time and intensity cannot be supplemented ", + "automatically with the missing information; therefore further calculations are not possible"), + fixed = TRUE + ) + + expect_warning(getAccrualTime(accrualTime = c(0, 24), accrualIntensity = c(30, 45), maxNumberOfSubjects = 720), + "Last accrual intensity value (45) ignored", + fixed = TRUE + ) + + .skipTestIfDisabled() + + suppressWarnings(expect_warning(getAccrualTime(accrualTime = c(0, 24, 30), + accrualIntensity = c(30, 45, 55), maxNumberOfSubjects = 720), + "Last 2 accrual intensity values (45, 55) ignored", + fixed = TRUE + )) + + suppressWarnings(expect_warning(getAccrualTime(accrualTime = c(0, 24, 30, 40), + accrualIntensity = c(30, 45, 55, 66), maxNumberOfSubjects = 720), + "Last 2 accrual time values (30, 40) ignored", + fixed = TRUE + )) + + suppressWarnings(expect_warning(getAccrualTime(accrualTime = c(0, 24, 30, 40), + accrualIntensity = c(30, 45, 55, 66), maxNumberOfSubjects = 720), + "Last 3 accrual intensity values (45, 55, 66) ignored", + fixed = TRUE + )) + + expect_warning(getAccrualTime(accrualTime = c(0, 6, 15, 25), accrualIntensity = c(0, 22, 33)), + "It makes no sense to start 'accrualIntensity' (0, 22, 33) with 0", + fixed = TRUE + ) + + expect_error(getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(0)), + "Illegal argument: at least one 'accrualIntensity' value must be > 0", + fixed = TRUE + ) + + expect_error(getAccrualTime( + accrualTime = c(0, 6, 30), accrualIntensity = c(22, 33), + maxNumberOfSubjects = 1000 + ), + paste0( + "Conflicting arguments: 'maxNumberOfSubjects' (1000) disagrees with the defined ", + "accrual time (0, 6, 30) and intensity: 6 * 22 + 24 * 33 = 924" + ), + fixed = TRUE + ) + +}) + +test_that("Testing 'getAccrualTime': list-wise definition", { + + accrualTime1 <- list( + "0 - <12" = 15, + "12 - <13" = 21, + "13 - <14" = 27, + "14 - <15" = 33, + "15 - <16" = 39, + ">=16" = 45 + ) + + # @refFS[Tab.]{fs:tab:output:getAccrualTime} + accrualTime4 <- getAccrualTime(accrualTime = accrualTime1, maxNumberOfSubjects = 1405) + expect_equal(accrualTime4$accrualTime, c(0, 12, 13, 14, 15, 16, 40.55555556)) + expect_equal(accrualTime4$accrualIntensity, c(15, 21, 27, 33, 39, 45)) + expect_equal(accrualTime4$remainingTime, 24.55555556) + + .skipTestIfDisabled() + + accrualTime2 <- list( + "0 - <12" = 15, + "12 - <13" = 21, + "13 - <14" = 27, + "14 - <15" = 33, + "15 - <16" = 39, + "16 - ?" = 45 + ) + accrualTime5 <- getAccrualTime(accrualTime = accrualTime2, maxNumberOfSubjects = 1405) + expect_equal(accrualTime5$accrualTime, c(0, 12, 13, 14, 15, 16, 40.55555556)) + expect_equal(accrualTime5$accrualIntensity, c(15, 21, 27, 33, 39, 45)) + expect_equal(accrualTime5$remainingTime, 24.55555556) + + accrualTime3 <- list( + "0 - <11" = 20, + "11 - <16" = 40, + ">=16" = 60 + ) + accrualTime6 <- getAccrualTime(accrualTime = accrualTime3, maxNumberOfSubjects = 800) + expect_equal(accrualTime6$accrualTime, c(0, 11, 16, 22.3333333)) + expect_equal(accrualTime6$accrualIntensity, c(20, 40, 60)) + expect_equal(accrualTime6$remainingTime, 6.33333333) + + accrualTime7 <- list( + "0 - <11" = 20, + "11 - <16" = 40, + "16 - ?" = 60 + ) + accrualTime8 <- getAccrualTime(accrualTime = accrualTime7, maxNumberOfSubjects = 800) + expect_equal(accrualTime8$accrualTime, c(0, 11, 16, 22.3333333)) + expect_equal(accrualTime8$accrualIntensity, c(20, 40, 60)) + expect_equal(accrualTime8$remainingTime, 6.33333333) + +}) + +test_that("Testing 'getPiecewiseSurvivalTime': mixed arguments", { + + # @refFS[Tab.]{fs:tab:output:getPiecewiseSurvivalTime} + pwSurvivalTime1 <- getPiecewiseSurvivalTime(median1 = 37, hazardRatio = 0.8) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime1' with expected results + expect_equal(pwSurvivalTime1$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime1$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$lambda1, 0.018733708, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$lambda2, 0.023417134, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime1$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime1$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$median1, 37, label = paste0("c(", paste0(pwSurvivalTime1$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$median2, 29.6, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime1$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime1$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime1$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime1$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime1$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime1), NA))) + expect_output(print(pwSurvivalTime1)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime1), NA))) + expect_output(summary(pwSurvivalTime1)$show()) + pwSurvivalTime1CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime1, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime1CodeBased$piecewiseSurvivalTime, pwSurvivalTime1$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$lambda1, pwSurvivalTime1$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$lambda2, pwSurvivalTime1$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$hazardRatio, pwSurvivalTime1$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$pi1, pwSurvivalTime1$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$pi2, pwSurvivalTime1$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$median1, pwSurvivalTime1$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$median2, pwSurvivalTime1$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$eventTime, pwSurvivalTime1$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$kappa, pwSurvivalTime1$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime1$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$delayedResponseAllowed, pwSurvivalTime1$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$delayedResponseEnabled, pwSurvivalTime1$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime1), "character") + df <- as.data.frame(pwSurvivalTime1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime2 <- getPiecewiseSurvivalTime(lambda1 = 0.01873371, median2 = 29.6) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime2' with expected results + expect_equal(pwSurvivalTime2$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime2$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$lambda1, 0.01873371, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$lambda2, 0.023417134, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$hazardRatio, 0.8000001, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime2$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime2$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$median1, 36.999995, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$median2, 29.6, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime2$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime2$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime2), NA))) + expect_output(print(pwSurvivalTime2)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime2), NA))) + expect_output(summary(pwSurvivalTime2)$show()) + pwSurvivalTime2CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime2, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalTime, pwSurvivalTime2$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$lambda1, pwSurvivalTime2$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$lambda2, pwSurvivalTime2$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$hazardRatio, pwSurvivalTime2$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$pi1, pwSurvivalTime2$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$pi2, pwSurvivalTime2$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$median1, pwSurvivalTime2$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$median2, pwSurvivalTime2$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$eventTime, pwSurvivalTime2$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$kappa, pwSurvivalTime2$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime2$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$delayedResponseAllowed, pwSurvivalTime2$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$delayedResponseEnabled, pwSurvivalTime2$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime2), "character") + df <- as.data.frame(pwSurvivalTime2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime3 <- getPiecewiseSurvivalTime(median1 = 37, lambda2 = 0.02341713) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime3' with expected results + expect_equal(pwSurvivalTime3$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime3$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$lambda1, 0.018733708, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$lambda2, 0.02341713, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$hazardRatio, 0.80000015, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime3$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime3$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$median1, 37, label = paste0("c(", paste0(pwSurvivalTime3$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$median2, 29.600006, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime3$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime3$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime3$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime3$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime3$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime3), NA))) + expect_output(print(pwSurvivalTime3)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime3), NA))) + expect_output(summary(pwSurvivalTime3)$show()) + pwSurvivalTime3CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime3, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime3CodeBased$piecewiseSurvivalTime, pwSurvivalTime3$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$lambda1, pwSurvivalTime3$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$lambda2, pwSurvivalTime3$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$hazardRatio, pwSurvivalTime3$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$pi1, pwSurvivalTime3$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$pi2, pwSurvivalTime3$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$median1, pwSurvivalTime3$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$median2, pwSurvivalTime3$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$eventTime, pwSurvivalTime3$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$kappa, pwSurvivalTime3$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime3$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$delayedResponseAllowed, pwSurvivalTime3$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$delayedResponseEnabled, pwSurvivalTime3$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime3), "character") + df <- as.data.frame(pwSurvivalTime3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + expect_warning(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), pi1 = 0.3), + "'hazardRatio' (0.6, 0.8) will be ignored because it will be calculated", + fixed = TRUE + ) + +}) + diff --git a/tests/testthat/test-f_analysis_base_rates.R b/tests/testthat/test-f_analysis_base_rates.R index e725c25d..1743491c 100644 --- a/tests/testthat/test-f_analysis_base_rates.R +++ b/tests/testthat/test-f_analysis_base_rates.R @@ -1,2433 +1,2434 @@ -## | -## | *Unit tests* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | RPACT package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File name: test-f_analysis_base_rates.R -## | Creation date: 08 November 2023, 08:51:06 -## | File version: $Revision$ -## | Last changed: $Date$ -## | Last changed by: $Author$ -## | - -test_plan_section("Testing the Analysis Rates Functionality for One Treatment") - - -test_that("'getAnalysisResults' for a group sequential design and one treatment", { - .skipTestIfDisabled() - - design0 <- getDesignGroupSequential( - kMax = 2, alpha = 0.025, informationRates = c(0.2, 1), - typeOfDesign = "asKD", gammaA = 2.8 - ) - - dataExample0 <- getDataset( - n = c(33), - events = c(23) - ) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateAlternativeSmaller} - # @refFS[Formula]{fs:testStatisticGroupSequential} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - x0 <- getAnalysisResults( - design = design0, dataInput = dataExample0, - thetaH0 = 0.4, normalApproximation = FALSE, directionUpper = TRUE - ) - - ## Comparison of the results of AnalysisResultsGroupSequential object 'x0' with expected results - expect_equal(x0$pi1, 0.6969697, tolerance = 1e-06, label = paste0("c(", paste0(x0$pi1, collapse = ", "), ")")) - expect_equal(x0$testActions, c("continue", NA_character_), label = paste0("c(", paste0(x0$testActions, collapse = ", "), ")")) - expect_equal(x0$conditionalRejectionProbabilities, c(0.28801679, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(x0$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x0$conditionalPower, c(NA_real_, NA_real_), label = paste0("c(", paste0(x0$conditionalPower, collapse = ", "), ")")) - expect_equal(x0$repeatedConfidenceIntervalLowerBounds, c(0.38475339, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(x0$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x0$repeatedConfidenceIntervalUpperBounds, c(0.91556361, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(x0$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x0$repeatedPValues, c(0.048557231, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(x0$repeatedPValues, collapse = ", "), ")")) - expect_equal(x0$finalStage, NA_integer_, label = paste0("c(", paste0(x0$finalStage, collapse = ", "), ")")) - expect_equal(x0$finalPValues, c(NA_real_, NA_real_), label = paste0("c(", paste0(x0$finalPValues, collapse = ", "), ")")) - expect_equal(x0$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_), label = paste0("c(", paste0(x0$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x0$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_), label = paste0("c(", paste0(x0$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x0$medianUnbiasedEstimates, c(NA_real_, NA_real_), label = paste0("c(", paste0(x0$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x0), NA))) - expect_output(print(x0)$show()) - invisible(capture.output(expect_error(summary(x0), NA))) - expect_output(summary(x0)$show()) - x0CodeBased <- eval(parse(text = getObjectRCode(x0, stringWrapParagraphWidth = NULL))) - expect_equal(x0CodeBased$pi1, x0$pi1, tolerance = 1e-06) - expect_equal(x0CodeBased$testActions, x0$testActions, tolerance = 1e-06) - expect_equal(x0CodeBased$conditionalRejectionProbabilities, x0$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(x0CodeBased$conditionalPower, x0$conditionalPower, tolerance = 1e-06) - expect_equal(x0CodeBased$repeatedConfidenceIntervalLowerBounds, x0$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(x0CodeBased$repeatedConfidenceIntervalUpperBounds, x0$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(x0CodeBased$repeatedPValues, x0$repeatedPValues, tolerance = 1e-06) - expect_equal(x0CodeBased$finalStage, x0$finalStage, tolerance = 1e-06) - expect_equal(x0CodeBased$finalPValues, x0$finalPValues, tolerance = 1e-06) - expect_equal(x0CodeBased$finalConfidenceIntervalLowerBounds, x0$finalConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(x0CodeBased$finalConfidenceIntervalUpperBounds, x0$finalConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(x0CodeBased$medianUnbiasedEstimates, x0$medianUnbiasedEstimates, tolerance = 1e-06) - expect_type(names(x0), "character") - df <- as.data.frame(x0) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x0) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getAnalysisResults' for a four-stage group sequential design and one treatment", { - - .skipTestIfDisabled() - - design1 <- getDesignGroupSequential( - kMax = 4, alpha = 0.025, informationRates = c(0.2, 0.4, 0.8, 1), - futilityBounds = c(-0.5, 0, 0.5), typeOfDesign = "asKD", gammaA = 2.8 - ) - - dataExample1 <- getDataset( - n = c(10, 10, 20, 11), - events = c(4, 5, 5, 6) - ) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateAlternativeSmaller} - # @refFS[Formula]{fs:testStatisticGroupSequential} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - x1 <- getAnalysisResults( - design = design1, dataInput = dataExample1, - stage = 2, thetaH0 = 0.75, normalApproximation = FALSE, directionUpper = FALSE - ) - - ## Comparison of the results of AnalysisResultsGroupSequential object 'x1' with expected results - expect_equal(x1$pi1, 0.45, tolerance = 1e-07, label = paste0("c(", paste0(x1$pi1, collapse = ", "), ")")) - expect_equal(x1$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x1$testActions, collapse = ", "), ")")) - expect_equal(x1$conditionalRejectionProbabilities, c(0.13502024, 0.39663603, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x1$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower, collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(0.035340833, 0.15564775, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.88809209, 0.77284164, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x1$repeatedPValues, c(0.49999905, 0.056127482, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues, collapse = ", "), ")")) - expect_equal(x1$finalStage, NA_integer_, label = paste0("c(", paste0(x1$finalStage, collapse = ", "), ")")) - expect_equal(x1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalPValues, collapse = ", "), ")")) - expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x1), NA))) - expect_output(print(x1)$show()) - invisible(capture.output(expect_error(summary(x1), NA))) - expect_output(summary(x1)$show()) - x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) - expect_equal(x1CodeBased$pi1, x1$pi1, tolerance = 1e-07) - expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-07) - expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x1), "character") - df <- as.data.frame(x1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeSmaller} - # @refFS[Formula]{fs:testStatisticGroupSequential} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:orderingPValueUpper} - # @refFS[Formula]{fs:finalCIOneRate} - # @refFS[Formula]{fs:medianUnbiasedEstimate} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - x2 <- getAnalysisResults( - design = design1, dataInput = dataExample1, - stage = 3, thetaH0 = 0.75, normalApproximation = TRUE, directionUpper = FALSE - ) - - ## Comparison of the results of AnalysisResultsGroupSequential object 'x2' with expected results - expect_equal(x2$pi1, 0.35, tolerance = 1e-07, label = paste0("c(", paste0(x2$pi1, collapse = ", "), ")")) - expect_equal(x2$testActions, c("continue", "reject and stop", "reject and stop", NA_character_), label = paste0("c(", paste0(x2$testActions, collapse = ", "), ")")) - expect_equal(x2$conditionalRejectionProbabilities, c(0.21465031, 0.55995383, 1, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x2$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower, collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(0.08898791, 0.19243551, 0.206358, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.81981977, 0.73748168, 0.52720845, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x2$repeatedPValues, c(0.47958473, 0.014066714, 1.9536724e-06, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues, collapse = ", "), ")")) - expect_equal(x2$finalStage, 2, label = paste0("c(", paste0(x2$finalStage, collapse = ", "), ")")) - expect_equal(x2$finalPValues, c(NA_real_, 0.0011783609, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalPValues, collapse = ", "), ")")) - expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, 0.18821106, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, 0.62661997, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, 0.40681825, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x2), NA))) - expect_output(print(x2)$show()) - invisible(capture.output(expect_error(summary(x2), NA))) - expect_output(summary(x2)$show()) - x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) - expect_equal(x2CodeBased$pi1, x2$pi1, tolerance = 1e-07) - expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) - expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-07) - expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-07) - expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x2), "character") - df <- as.data.frame(x2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateAlternativeSmaller} - # @refFS[Formula]{fs:testStatisticGroupSequential} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerOneRateEffect} - x3 <- getAnalysisResults( - design = design1, dataInput = dataExample1, - stage = 2, thetaH0 = 0.75, nPlanned = c(12, 6), pi1 = 0.5, - normalApproximation = FALSE, directionUpper = FALSE - ) - - ## Comparison of the results of AnalysisResultsGroupSequential object 'x3' with expected results - expect_equal(x3$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x3$testActions, collapse = ", "), ")")) - expect_equal(x3$conditionalRejectionProbabilities, c(0.13502024, 0.39663603, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x3$conditionalPower, c(NA_real_, NA_real_, 0.85193241, 0.94869662), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalPower, collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalLowerBounds, c(0.035340833, 0.15564775, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalUpperBounds, c(0.88809209, 0.77284164, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x3$repeatedPValues, c(0.49999905, 0.056127482, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues, collapse = ", "), ")")) - expect_equal(x3$finalStage, NA_integer_, label = paste0("c(", paste0(x3$finalStage, collapse = ", "), ")")) - expect_equal(x3$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalPValues, collapse = ", "), ")")) - expect_equal(x3$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x3$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x3$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x3), NA))) - expect_output(print(x3)$show()) - invisible(capture.output(expect_error(summary(x3), NA))) - expect_output(summary(x3)$show()) - x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) - expect_equal(x3CodeBased$testActions, x3$testActions, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) - expect_equal(x3CodeBased$finalStage, x3$finalStage, tolerance = 1e-07) - expect_equal(x3CodeBased$finalPValues, x3$finalPValues, tolerance = 1e-07) - expect_equal(x3CodeBased$finalConfidenceIntervalLowerBounds, x3$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$finalConfidenceIntervalUpperBounds, x3$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$medianUnbiasedEstimates, x3$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x3), "character") - df <- as.data.frame(x3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData1 <- testGetAnalysisResultsPlotData(x3, piTreatmentRange = seq(0.45, 0.75, 0.05)) - - ## Comparison of the results of list object 'plotData1' with expected results - expect_equal(plotData1$xValues, c(0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$xValues, collapse = ", "), ")")) - expect_equal(plotData1$condPowerValues, c(0.98024945, 0.94869662, 0.88988709, 0.79611571, 0.66506207, 0.50313626, 0.32784789), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData1$likelihoodValues, c(1, 0.9039239, 0.66761715, 0.40289032, 0.19865977, 0.080038099, 0.026347981), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData1$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData1$main, collapse = ", "), ")")) - expect_equal(plotData1$xlab, "pi1", label = paste0("c(", paste0(plotData1$xlab, collapse = ", "), ")")) - expect_equal(plotData1$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData1$ylab, collapse = ", "), ")")) - expect_equal(plotData1$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData1$sub, collapse = ", "), ")")) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeSmaller} - # @refFS[Formula]{fs:testStatisticGroupSequential} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:orderingPValueUpper} - # @refFS[Formula]{fs:medianUnbiasedEstimate} - # @refFS[Formula]{fs:finalCIOneRate} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerOneRateEffect} - x4 <- getAnalysisResults( - design = design1, dataInput = dataExample1, - stage = 2, thetaH0 = 0.75, nPlanned = c(12, 6), pi1 = 0.5, - normalApproximation = TRUE, directionUpper = FALSE - ) - - ## Comparison of the results of AnalysisResultsGroupSequential object 'x4' with expected results - expect_equal(x4$testActions, c("continue", "reject and stop", NA_character_, NA_character_), label = paste0("c(", paste0(x4$testActions, collapse = ", "), ")")) - expect_equal(x4$conditionalRejectionProbabilities, c(0.21465031, 0.55995383, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x4$conditionalPower, c(NA_real_, NA_real_, 0.9494174, 0.9843063), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalPower, collapse = ", "), ")")) - expect_equal(x4$repeatedConfidenceIntervalLowerBounds, c(0.08898791, 0.19243551, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x4$repeatedConfidenceIntervalUpperBounds, c(0.81981977, 0.73748168, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x4$repeatedPValues, c(0.47958473, 0.014066714, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedPValues, collapse = ", "), ")")) - expect_equal(x4$finalStage, 2, label = paste0("c(", paste0(x4$finalStage, collapse = ", "), ")")) - expect_equal(x4$finalPValues, c(NA_real_, 0.0011783609, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$finalPValues, collapse = ", "), ")")) - expect_equal(x4$finalConfidenceIntervalLowerBounds, c(NA_real_, 0.18821106, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x4$finalConfidenceIntervalUpperBounds, c(NA_real_, 0.62661997, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x4$medianUnbiasedEstimates, c(NA_real_, 0.40681825, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x4), NA))) - expect_output(print(x4)$show()) - invisible(capture.output(expect_error(summary(x4), NA))) - expect_output(summary(x4)$show()) - x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) - expect_equal(x4CodeBased$testActions, x4$testActions, tolerance = 1e-07) - expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-07) - expect_equal(x4CodeBased$finalStage, x4$finalStage, tolerance = 1e-07) - expect_equal(x4CodeBased$finalPValues, x4$finalPValues, tolerance = 1e-07) - expect_equal(x4CodeBased$finalConfidenceIntervalLowerBounds, x4$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$finalConfidenceIntervalUpperBounds, x4$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$medianUnbiasedEstimates, x4$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x4), "character") - df <- as.data.frame(x4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData2 <- testGetAnalysisResultsPlotData(x4, piTreatmentRange = seq(0.45, 0.75, 0.05)) - - ## Comparison of the results of list object 'plotData2' with expected results - expect_equal(plotData2$xValues, c(0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$xValues, collapse = ", "), ")")) - expect_equal(plotData2$condPowerValues, c(0.99501417, 0.9843063, 0.96005739, 0.91353722, 0.83535366, 0.71802165, 0.55995335), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData2$likelihoodValues, c(1, 0.9039239, 0.66761715, 0.40289032, 0.19865977, 0.080038099, 0.026347981), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData2$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData2$main, collapse = ", "), ")")) - expect_equal(plotData2$xlab, "pi1", label = paste0("c(", paste0(plotData2$xlab, collapse = ", "), ")")) - expect_equal(plotData2$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData2$ylab, collapse = ", "), ")")) - expect_equal(plotData2$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData2$sub, collapse = ", "), ")")) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} - # @refFS[Formula]{fs:testStatisticGroupSequential} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerOneRateEffect} - x5 <- getAnalysisResults( - design = design1, dataInput = dataExample1, - stage = 3, thetaH0 = 0.25, normalApproximation = FALSE, directionUpper = TRUE - ) - - ## Comparison of the results of AnalysisResultsGroupSequential object 'x5' with expected results - expect_equal(x5$pi1, 0.35, tolerance = 1e-07, label = paste0("c(", paste0(x5$pi1, collapse = ", "), ")")) - expect_equal(x5$testActions, c("continue", "continue", "continue", NA_character_), label = paste0("c(", paste0(x5$testActions, collapse = ", "), ")")) - expect_equal(x5$conditionalRejectionProbabilities, c(0.033369687, 0.13517192, 0.020135528, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x5$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$conditionalPower, collapse = ", "), ")")) - expect_equal(x5$repeatedConfidenceIntervalLowerBounds, c(0.035340833, 0.15564775, 0.18966473, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x5$repeatedConfidenceIntervalUpperBounds, c(0.88809209, 0.77284164, 0.53925561, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x5$repeatedPValues, c(0.49999905, 0.49999905, 0.20027888, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedPValues, collapse = ", "), ")")) - expect_equal(x5$finalStage, NA_integer_, label = paste0("c(", paste0(x5$finalStage, collapse = ", "), ")")) - expect_equal(x5$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$finalPValues, collapse = ", "), ")")) - expect_equal(x5$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x5$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x5$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x5), NA))) - expect_output(print(x5)$show()) - invisible(capture.output(expect_error(summary(x5), NA))) - expect_output(summary(x5)$show()) - x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) - expect_equal(x5CodeBased$pi1, x5$pi1, tolerance = 1e-07) - expect_equal(x5CodeBased$testActions, x5$testActions, tolerance = 1e-07) - expect_equal(x5CodeBased$conditionalRejectionProbabilities, x5$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x5CodeBased$conditionalPower, x5$conditionalPower, tolerance = 1e-07) - expect_equal(x5CodeBased$repeatedConfidenceIntervalLowerBounds, x5$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x5CodeBased$repeatedConfidenceIntervalUpperBounds, x5$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x5CodeBased$repeatedPValues, x5$repeatedPValues, tolerance = 1e-07) - expect_equal(x5CodeBased$finalStage, x5$finalStage, tolerance = 1e-07) - expect_equal(x5CodeBased$finalPValues, x5$finalPValues, tolerance = 1e-07) - expect_equal(x5CodeBased$finalConfidenceIntervalLowerBounds, x5$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x5CodeBased$finalConfidenceIntervalUpperBounds, x5$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x5CodeBased$medianUnbiasedEstimates, x5$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x5), "character") - df <- as.data.frame(x5) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x5) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} - # @refFS[Formula]{fs:testStatisticGroupSequential} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerOneRateEffect} - x6 <- getAnalysisResults( - design = design1, dataInput = dataExample1, - stage = 3, thetaH0 = 0.25, normalApproximation = TRUE, directionUpper = TRUE - ) - - ## Comparison of the results of AnalysisResultsGroupSequential object 'x6' with expected results - expect_equal(x6$pi1, 0.35, tolerance = 1e-07, label = paste0("c(", paste0(x6$pi1, collapse = ", "), ")")) - expect_equal(x6$testActions, c("continue", "continue", "continue", NA_character_), label = paste0("c(", paste0(x6$testActions, collapse = ", "), ")")) - expect_equal(x6$conditionalRejectionProbabilities, c(0.049321562, 0.20984263, 0.048813267, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x6$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$conditionalPower, collapse = ", "), ")")) - expect_equal(x6$repeatedConfidenceIntervalLowerBounds, c(0.08898791, 0.19243551, 0.206358, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x6$repeatedConfidenceIntervalUpperBounds, c(0.81981977, 0.73748168, 0.52720845, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x6$repeatedPValues, c(0.49999905, 0.27035282, 0.14086509, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedPValues, collapse = ", "), ")")) - expect_equal(x6$finalStage, NA_integer_, label = paste0("c(", paste0(x6$finalStage, collapse = ", "), ")")) - expect_equal(x6$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$finalPValues, collapse = ", "), ")")) - expect_equal(x6$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x6$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x6$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x6), NA))) - expect_output(print(x6)$show()) - invisible(capture.output(expect_error(summary(x6), NA))) - expect_output(summary(x6)$show()) - x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) - expect_equal(x6CodeBased$pi1, x6$pi1, tolerance = 1e-07) - expect_equal(x6CodeBased$testActions, x6$testActions, tolerance = 1e-07) - expect_equal(x6CodeBased$conditionalRejectionProbabilities, x6$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x6CodeBased$conditionalPower, x6$conditionalPower, tolerance = 1e-07) - expect_equal(x6CodeBased$repeatedConfidenceIntervalLowerBounds, x6$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x6CodeBased$repeatedConfidenceIntervalUpperBounds, x6$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x6CodeBased$repeatedPValues, x6$repeatedPValues, tolerance = 1e-07) - expect_equal(x6CodeBased$finalStage, x6$finalStage, tolerance = 1e-07) - expect_equal(x6CodeBased$finalPValues, x6$finalPValues, tolerance = 1e-07) - expect_equal(x6CodeBased$finalConfidenceIntervalLowerBounds, x6$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x6CodeBased$finalConfidenceIntervalUpperBounds, x6$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x6CodeBased$medianUnbiasedEstimates, x6$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x6), "character") - df <- as.data.frame(x6) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x6) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} - # @refFS[Formula]{fs:testStatisticGroupSequential} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerOneRateEffect} - x7 <- getAnalysisResults( - design = design1, dataInput = dataExample1, - stage = 2, thetaH0 = 0.25, nPlanned = c(12, 6), pi1 = 0.5, - normalApproximation = FALSE, directionUpper = TRUE - ) - - ## Comparison of the results of AnalysisResultsGroupSequential object 'x7' with expected results - expect_equal(x7$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x7$testActions, collapse = ", "), ")")) - expect_equal(x7$conditionalRejectionProbabilities, c(0.033369687, 0.13517192, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x7$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x7$conditionalPower, c(NA_real_, NA_real_, 0.58576815, 0.82581584), tolerance = 1e-07, label = paste0("c(", paste0(x7$conditionalPower, collapse = ", "), ")")) - expect_equal(x7$repeatedConfidenceIntervalLowerBounds, c(0.035340833, 0.15564775, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x7$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x7$repeatedConfidenceIntervalUpperBounds, c(0.88809209, 0.77284164, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x7$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x7$repeatedPValues, c(0.49999905, 0.49999905, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x7$repeatedPValues, collapse = ", "), ")")) - expect_equal(x7$finalStage, NA_integer_, label = paste0("c(", paste0(x7$finalStage, collapse = ", "), ")")) - expect_equal(x7$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$finalPValues, collapse = ", "), ")")) - expect_equal(x7$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x7$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x7$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x7), NA))) - expect_output(print(x7)$show()) - invisible(capture.output(expect_error(summary(x7), NA))) - expect_output(summary(x7)$show()) - x7CodeBased <- eval(parse(text = getObjectRCode(x7, stringWrapParagraphWidth = NULL))) - expect_equal(x7CodeBased$testActions, x7$testActions, tolerance = 1e-07) - expect_equal(x7CodeBased$conditionalRejectionProbabilities, x7$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x7CodeBased$conditionalPower, x7$conditionalPower, tolerance = 1e-07) - expect_equal(x7CodeBased$repeatedConfidenceIntervalLowerBounds, x7$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x7CodeBased$repeatedConfidenceIntervalUpperBounds, x7$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x7CodeBased$repeatedPValues, x7$repeatedPValues, tolerance = 1e-07) - expect_equal(x7CodeBased$finalStage, x7$finalStage, tolerance = 1e-07) - expect_equal(x7CodeBased$finalPValues, x7$finalPValues, tolerance = 1e-07) - expect_equal(x7CodeBased$finalConfidenceIntervalLowerBounds, x7$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x7CodeBased$finalConfidenceIntervalUpperBounds, x7$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x7CodeBased$medianUnbiasedEstimates, x7$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x7), "character") - df <- as.data.frame(x7) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x7) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData3 <- testGetAnalysisResultsPlotData(x7, piTreatmentRange = seq(0.25, 0.55, 0.05)) - - ## Comparison of the results of list object 'plotData3' with expected results - expect_equal(plotData3$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55), tolerance = 1e-07, label = paste0("c(", paste0(plotData3$xValues, collapse = ", "), ")")) - expect_equal(plotData3$condPowerValues, c(0.099723848, 0.21903134, 0.37478113, 0.54310492, 0.6994843, 0.82581584, 0.91388884), tolerance = 1e-07, label = paste0("c(", paste0(plotData3$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData3$likelihoodValues, c(0.19865977, 0.40289032, 0.66761715, 0.9039239, 1, 0.9039239, 0.66761715), tolerance = 1e-07, label = paste0("c(", paste0(plotData3$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData3$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData3$main, collapse = ", "), ")")) - expect_equal(plotData3$xlab, "pi1", label = paste0("c(", paste0(plotData3$xlab, collapse = ", "), ")")) - expect_equal(plotData3$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData3$ylab, collapse = ", "), ")")) - expect_equal(plotData3$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData3$sub, collapse = ", "), ")")) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} - # @refFS[Formula]{fs:testStatisticGroupSequential} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerOneRateEffect} - x8 <- getAnalysisResults( - design = design1, dataInput = dataExample1, - stage = 2, thetaH0 = 0.25, nPlanned = c(12, 6), pi1 = 0.5, - normalApproximation = TRUE, directionUpper = TRUE - ) - - ## Comparison of the results of AnalysisResultsGroupSequential object 'x8' with expected results - expect_equal(x8$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x8$testActions, collapse = ", "), ")")) - expect_equal(x8$conditionalRejectionProbabilities, c(0.049321562, 0.20984263, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x8$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x8$conditionalPower, c(NA_real_, NA_real_, 0.76152324, 0.91259792), tolerance = 1e-07, label = paste0("c(", paste0(x8$conditionalPower, collapse = ", "), ")")) - expect_equal(x8$repeatedConfidenceIntervalLowerBounds, c(0.08898791, 0.19243551, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x8$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x8$repeatedConfidenceIntervalUpperBounds, c(0.81981977, 0.73748168, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x8$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x8$repeatedPValues, c(0.49999905, 0.27035282, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x8$repeatedPValues, collapse = ", "), ")")) - expect_equal(x8$finalStage, NA_integer_, label = paste0("c(", paste0(x8$finalStage, collapse = ", "), ")")) - expect_equal(x8$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$finalPValues, collapse = ", "), ")")) - expect_equal(x8$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x8$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x8$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x8), NA))) - expect_output(print(x8)$show()) - invisible(capture.output(expect_error(summary(x8), NA))) - expect_output(summary(x8)$show()) - x8CodeBased <- eval(parse(text = getObjectRCode(x8, stringWrapParagraphWidth = NULL))) - expect_equal(x8CodeBased$testActions, x8$testActions, tolerance = 1e-07) - expect_equal(x8CodeBased$conditionalRejectionProbabilities, x8$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x8CodeBased$conditionalPower, x8$conditionalPower, tolerance = 1e-07) - expect_equal(x8CodeBased$repeatedConfidenceIntervalLowerBounds, x8$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x8CodeBased$repeatedConfidenceIntervalUpperBounds, x8$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x8CodeBased$repeatedPValues, x8$repeatedPValues, tolerance = 1e-07) - expect_equal(x8CodeBased$finalStage, x8$finalStage, tolerance = 1e-07) - expect_equal(x8CodeBased$finalPValues, x8$finalPValues, tolerance = 1e-07) - expect_equal(x8CodeBased$finalConfidenceIntervalLowerBounds, x8$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x8CodeBased$finalConfidenceIntervalUpperBounds, x8$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x8CodeBased$medianUnbiasedEstimates, x8$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x8), "character") - df <- as.data.frame(x8) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x8) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData4 <- testGetAnalysisResultsPlotData(x8, piTreatmentRange = seq(0.25, 0.55, 0.05)) - - ## Comparison of the results of list object 'plotData4' with expected results - expect_equal(plotData4$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$xValues, collapse = ", "), ")")) - expect_equal(plotData4$condPowerValues, c(0.20983879, 0.3743042, 0.5481143, 0.70471917, 0.82789376, 0.91259792, 0.96272982), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData4$likelihoodValues, c(0.19865977, 0.40289032, 0.66761715, 0.9039239, 1, 0.9039239, 0.66761715), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData4$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData4$main, collapse = ", "), ")")) - expect_equal(plotData4$xlab, "pi1", label = paste0("c(", paste0(plotData4$xlab, collapse = ", "), ")")) - expect_equal(plotData4$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData4$ylab, collapse = ", "), ")")) - expect_equal(plotData4$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData4$sub, collapse = ", "), ")")) - -}) - -test_that("'getAnalysisResults' for a four-stage inverse sequential design and one treatment", { - - .skipTestIfDisabled() - - design2 <- getDesignInverseNormal( - kMax = 4, alpha = 0.025, informationRates = c(0.2, 0.4, 0.8, 1), - futilityBounds = c(-0.5, 0, 0.5), typeOfDesign = "asKD", gammaA = 2.8 - ) - - dataExample2 <- getDataset( - n = c(8, 10, 9, 11), # cumsum, overall n = (8, 18, 27, 38) - events = c(4, 5, 5, 6) # cumsum, overall events = (4, 9, 14, 20) - ) - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} - # @refFS[Formula]{fs:testStatisticNormalCombinationTest} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - - x1 <- getAnalysisResults( - design = design2, dataInput = dataExample2, - stage = 3, thetaH0 = 0.75, normalApproximation = FALSE, directionUpper = FALSE - ) - - ## Comparison of the results of AnalysisResultsInverseNormal object 'x1' with expected results - expect_equal(x1$pi1, 0.51851852, tolerance = 1e-07, label = paste0("c(", paste0(x1$pi1, collapse = ", "), ")")) - expect_equal(x1$testActions, c("continue", "continue", "continue", NA_character_), label = paste0("c(", paste0(x1$testActions, collapse = ", "), ")")) - expect_equal(x1$conditionalRejectionProbabilities, c(0.055828725, 0.15918316, 0.28098687, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x1$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower, collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(0.046266926, 0.16132369, 0.26858957, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.95373307, 0.83867631, 0.76870127, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x1$repeatedPValues, c(0.49999905, 0.43799317, 0.045574143, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues, collapse = ", "), ")")) - expect_equal(x1$finalStage, NA_integer_, label = paste0("c(", paste0(x1$finalStage, collapse = ", "), ")")) - expect_equal(x1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalPValues, collapse = ", "), ")")) - expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x1), NA))) - expect_output(print(x1)$show()) - invisible(capture.output(expect_error(summary(x1), NA))) - expect_output(summary(x1)$show()) - x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) - expect_equal(x1CodeBased$pi1, x1$pi1, tolerance = 1e-07) - expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-07) - expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x1), "character") - df <- as.data.frame(x1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - .skipTestIfDisabled() - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} - # @refFS[Formula]{fs:testStatisticNormalCombinationTest} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:orderingPValueUpper} - # @refFS[Formula]{fs:finalCIOneRate} - # @refFS[Formula]{fs:medianUnbiasedEstimate} - x2 <- getAnalysisResults( - design = design2, dataInput = dataExample2, - stage = 3, thetaH0 = 0.75, normalApproximation = TRUE, directionUpper = FALSE - ) - - ## Comparison of the results of AnalysisResultsInverseNormal object 'x2' with expected results - expect_equal(x2$pi1, 0.51851852, tolerance = 1e-07, label = paste0("c(", paste0(x2$pi1, collapse = ", "), ")")) - expect_equal(x2$testActions, c("continue", "continue", "reject and stop", NA_character_), label = paste0("c(", paste0(x2$testActions, collapse = ", "), ")")) - expect_equal(x2$conditionalRejectionProbabilities, c(0.08807963, 0.32350578, 0.78413539, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x2$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower, collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(0.11314487, 0.21610036, 0.31861038, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.88685513, 0.78389964, 0.72001945, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x2$repeatedPValues, c(0.49999905, 0.1020964, 0.0075111702, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues, collapse = ", "), ")")) - expect_equal(x2$finalStage, 3, label = paste0("c(", paste0(x2$finalStage, collapse = ", "), ")")) - expect_equal(x2$finalPValues, c(NA_real_, NA_real_, 0.0050707339, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalPValues, collapse = ", "), ")")) - expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, 0.3041323, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, 0.68870859, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, NA_real_, 0.49547717, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x2), NA))) - expect_output(print(x2)$show()) - invisible(capture.output(expect_error(summary(x2), NA))) - expect_output(summary(x2)$show()) - x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) - expect_equal(x2CodeBased$pi1, x2$pi1, tolerance = 1e-07) - expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) - expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-07) - expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-07) - expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x2), "character") - df <- as.data.frame(x2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} - # @refFS[Formula]{fs:testStatisticNormalCombinationTest} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - x3 <- getAnalysisResults( - design = design2, dataInput = dataExample2, - stage = 2, thetaH0 = 0.75, nPlanned = c(12, 6), pi1 = 0.5, - normalApproximation = FALSE, directionUpper = FALSE - ) - - ## Comparison of the results of AnalysisResultsInverseNormal object 'x3' with expected results - expect_equal(x3$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x3$testActions, collapse = ", "), ")")) - expect_equal(x3$conditionalRejectionProbabilities, c(0.055828725, 0.15918316, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x3$conditionalPower, c(NA_real_, NA_real_, 0.69921202, 0.88465983), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalPower, collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalLowerBounds, c(0.046266926, 0.16132369, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalUpperBounds, c(0.95373307, 0.83867631, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x3$repeatedPValues, c(0.49999905, 0.43799317, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues, collapse = ", "), ")")) - expect_equal(x3$finalStage, NA_integer_, label = paste0("c(", paste0(x3$finalStage, collapse = ", "), ")")) - expect_equal(x3$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalPValues, collapse = ", "), ")")) - expect_equal(x3$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x3$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x3$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x3), NA))) - expect_output(print(x3)$show()) - invisible(capture.output(expect_error(summary(x3), NA))) - expect_output(summary(x3)$show()) - x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) - expect_equal(x3CodeBased$testActions, x3$testActions, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) - expect_equal(x3CodeBased$finalStage, x3$finalStage, tolerance = 1e-07) - expect_equal(x3CodeBased$finalPValues, x3$finalPValues, tolerance = 1e-07) - expect_equal(x3CodeBased$finalConfidenceIntervalLowerBounds, x3$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$finalConfidenceIntervalUpperBounds, x3$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$medianUnbiasedEstimates, x3$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x3), "character") - df <- as.data.frame(x3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData1 <- testGetAnalysisResultsPlotData(x3, piTreatmentRange = seq(0.45, 0.75, 0.05)) - - ## Comparison of the results of list object 'plotData1' with expected results - expect_equal(plotData1$xValues, c(0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$xValues, collapse = ", "), ")")) - expect_equal(plotData1$condPowerValues, c(0.94793138, 0.88465983, 0.78396384, 0.64581102, 0.48045808, 0.30888817, 0.15917802), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData1$likelihoodValues, c(0.91393119, 1, 0.91393119, 0.69767633, 0.44485807, 0.23692776, 0.10539922), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData1$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData1$main, collapse = ", "), ")")) - expect_equal(plotData1$xlab, "pi1", label = paste0("c(", paste0(plotData1$xlab, collapse = ", "), ")")) - expect_equal(plotData1$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData1$ylab, collapse = ", "), ")")) - expect_equal(plotData1$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData1$sub, collapse = ", "), ")")) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} - # @refFS[Formula]{fs:testStatisticNormalCombinationTest} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - x4 <- getAnalysisResults( - design = design2, dataInput = dataExample2, - stage = 2, thetaH0 = 0.75, nPlanned = c(12, 6), pi1 = 0.5, - normalApproximation = TRUE, directionUpper = FALSE - ) - - ## Comparison of the results of AnalysisResultsInverseNormal object 'x4' with expected results - expect_equal(x4$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x4$testActions, collapse = ", "), ")")) - expect_equal(x4$conditionalRejectionProbabilities, c(0.08807963, 0.32350578, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x4$conditionalPower, c(NA_real_, NA_real_, 0.85385983, 0.95015898), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalPower, collapse = ", "), ")")) - expect_equal(x4$repeatedConfidenceIntervalLowerBounds, c(0.11314487, 0.21610036, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x4$repeatedConfidenceIntervalUpperBounds, c(0.88685513, 0.78389964, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x4$repeatedPValues, c(0.49999905, 0.1020964, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedPValues, collapse = ", "), ")")) - expect_equal(x4$finalStage, NA_integer_, label = paste0("c(", paste0(x4$finalStage, collapse = ", "), ")")) - expect_equal(x4$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalPValues, collapse = ", "), ")")) - expect_equal(x4$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x4$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x4$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x4), NA))) - expect_output(print(x4)$show()) - invisible(capture.output(expect_error(summary(x4), NA))) - expect_output(summary(x4)$show()) - x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) - expect_equal(x4CodeBased$testActions, x4$testActions, tolerance = 1e-07) - expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-07) - expect_equal(x4CodeBased$finalStage, x4$finalStage, tolerance = 1e-07) - expect_equal(x4CodeBased$finalPValues, x4$finalPValues, tolerance = 1e-07) - expect_equal(x4CodeBased$finalConfidenceIntervalLowerBounds, x4$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$finalConfidenceIntervalUpperBounds, x4$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$medianUnbiasedEstimates, x4$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x4), "character") - df <- as.data.frame(x4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData2 <- testGetAnalysisResultsPlotData(x4, piTreatmentRange = seq(0.45, 0.75, 0.05)) - - ## Comparison of the results of list object 'plotData2' with expected results - expect_equal(plotData2$xValues, c(0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$xValues, collapse = ", "), ")")) - expect_equal(plotData2$condPowerValues, c(0.98088099, 0.95015898, 0.89232289, 0.79901831, 0.66708346, 0.50248974, 0.32350375), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData2$likelihoodValues, c(0.91393119, 1, 0.91393119, 0.69767633, 0.44485807, 0.23692776, 0.10539922), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData2$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData2$main, collapse = ", "), ")")) - expect_equal(plotData2$xlab, "pi1", label = paste0("c(", paste0(plotData2$xlab, collapse = ", "), ")")) - expect_equal(plotData2$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData2$ylab, collapse = ", "), ")")) - expect_equal(plotData2$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData2$sub, collapse = ", "), ")")) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} - # @refFS[Formula]{fs:testStatisticNormalCombinationTest} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - x5 <- getAnalysisResults( - design = design2, dataInput = dataExample2, - stage = 3, thetaH0 = 0.25, normalApproximation = FALSE, directionUpper = TRUE - ) - - ## Comparison of the results of AnalysisResultsInverseNormal object 'x5' with expected results - expect_equal(x5$pi1, 0.51851852, tolerance = 1e-07, label = paste0("c(", paste0(x5$pi1, collapse = ", "), ")")) - expect_equal(x5$testActions, c("continue", "continue", "reject and stop", NA_character_), label = paste0("c(", paste0(x5$testActions, collapse = ", "), ")")) - expect_equal(x5$conditionalRejectionProbabilities, c(0.055828725, 0.15918316, 0.65085211, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x5$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$conditionalPower, collapse = ", "), ")")) - expect_equal(x5$repeatedConfidenceIntervalLowerBounds, c(0.046266926, 0.16132369, 0.26858957, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x5$repeatedConfidenceIntervalUpperBounds, c(0.95373307, 0.83867631, 0.76870127, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x5$repeatedPValues, c(0.49999905, 0.43799317, 0.013282796, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedPValues, collapse = ", "), ")")) - expect_equal(x5$finalStage, 3, label = paste0("c(", paste0(x5$finalStage, collapse = ", "), ")")) - expect_equal(x5$finalPValues, c(NA_real_, NA_real_, 0.007752129, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$finalPValues, collapse = ", "), ")")) - expect_equal(x5$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, 0.29554194, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x5$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, 0.67875285, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x5$medianUnbiasedEstimates, c(NA_real_, NA_real_, 0.48769629, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x5), NA))) - expect_output(print(x5)$show()) - invisible(capture.output(expect_error(summary(x5), NA))) - expect_output(summary(x5)$show()) - x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) - expect_equal(x5CodeBased$pi1, x5$pi1, tolerance = 1e-07) - expect_equal(x5CodeBased$testActions, x5$testActions, tolerance = 1e-07) - expect_equal(x5CodeBased$conditionalRejectionProbabilities, x5$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x5CodeBased$conditionalPower, x5$conditionalPower, tolerance = 1e-07) - expect_equal(x5CodeBased$repeatedConfidenceIntervalLowerBounds, x5$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x5CodeBased$repeatedConfidenceIntervalUpperBounds, x5$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x5CodeBased$repeatedPValues, x5$repeatedPValues, tolerance = 1e-07) - expect_equal(x5CodeBased$finalStage, x5$finalStage, tolerance = 1e-07) - expect_equal(x5CodeBased$finalPValues, x5$finalPValues, tolerance = 1e-07) - expect_equal(x5CodeBased$finalConfidenceIntervalLowerBounds, x5$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x5CodeBased$finalConfidenceIntervalUpperBounds, x5$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x5CodeBased$medianUnbiasedEstimates, x5$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x5), "character") - df <- as.data.frame(x5) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x5) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} - # @refFS[Formula]{fs:testStatisticNormalCombinationTest} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - x6 <- getAnalysisResults( - design = design2, dataInput = dataExample2, - stage = 3, thetaH0 = 0.25, normalApproximation = TRUE, directionUpper = TRUE - ) - - ## Comparison of the results of AnalysisResultsInverseNormal object 'x6' with expected results - expect_equal(x6$pi1, 0.51851852, tolerance = 1e-07, label = paste0("c(", paste0(x6$pi1, collapse = ", "), ")")) - expect_equal(x6$testActions, c("continue", "continue", "reject and stop", NA_character_), label = paste0("c(", paste0(x6$testActions, collapse = ", "), ")")) - expect_equal(x6$conditionalRejectionProbabilities, c(0.08807963, 0.32350578, 0.96959663, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x6$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$conditionalPower, collapse = ", "), ")")) - expect_equal(x6$repeatedConfidenceIntervalLowerBounds, c(0.11314487, 0.21610036, 0.31861038, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x6$repeatedConfidenceIntervalUpperBounds, c(0.88685513, 0.78389964, 0.72001945, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x6$repeatedPValues, c(0.49999905, 0.1020964, 0.0013103922, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedPValues, collapse = ", "), ")")) - expect_equal(x6$finalStage, 3, label = paste0("c(", paste0(x6$finalStage, collapse = ", "), ")")) - expect_equal(x6$finalPValues, c(NA_real_, NA_real_, 0.002378519, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$finalPValues, collapse = ", "), ")")) - expect_equal(x6$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, 0.3437363, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x6$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, 0.73847376, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x6$medianUnbiasedEstimates, c(NA_real_, NA_real_, 0.54446903, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x6), NA))) - expect_output(print(x6)$show()) - invisible(capture.output(expect_error(summary(x6), NA))) - expect_output(summary(x6)$show()) - x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) - expect_equal(x6CodeBased$pi1, x6$pi1, tolerance = 1e-07) - expect_equal(x6CodeBased$testActions, x6$testActions, tolerance = 1e-07) - expect_equal(x6CodeBased$conditionalRejectionProbabilities, x6$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x6CodeBased$conditionalPower, x6$conditionalPower, tolerance = 1e-07) - expect_equal(x6CodeBased$repeatedConfidenceIntervalLowerBounds, x6$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x6CodeBased$repeatedConfidenceIntervalUpperBounds, x6$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x6CodeBased$repeatedPValues, x6$repeatedPValues, tolerance = 1e-07) - expect_equal(x6CodeBased$finalStage, x6$finalStage, tolerance = 1e-07) - expect_equal(x6CodeBased$finalPValues, x6$finalPValues, tolerance = 1e-07) - expect_equal(x6CodeBased$finalConfidenceIntervalLowerBounds, x6$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x6CodeBased$finalConfidenceIntervalUpperBounds, x6$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x6CodeBased$medianUnbiasedEstimates, x6$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x6), "character") - df <- as.data.frame(x6) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x6) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerOneRateEffect} - x7 <- getAnalysisResults( - design = design2, dataInput = dataExample2, - stage = 2, thetaH0 = 0.25, nPlanned = c(12, 6), pi1 = 0.5, - normalApproximation = FALSE, directionUpper = TRUE - ) - - ## Comparison of the results of AnalysisResultsInverseNormal object 'x7' with expected results - expect_equal(x7$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x7$testActions, collapse = ", "), ")")) - expect_equal(x7$conditionalRejectionProbabilities, c(0.055828725, 0.15918316, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x7$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x7$conditionalPower, c(NA_real_, NA_real_, 0.69921202, 0.88465983), tolerance = 1e-07, label = paste0("c(", paste0(x7$conditionalPower, collapse = ", "), ")")) - expect_equal(x7$repeatedConfidenceIntervalLowerBounds, c(0.046266926, 0.16132369, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x7$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x7$repeatedConfidenceIntervalUpperBounds, c(0.95373307, 0.83867631, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x7$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x7$repeatedPValues, c(0.49999905, 0.43799317, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x7$repeatedPValues, collapse = ", "), ")")) - expect_equal(x7$finalStage, NA_integer_, label = paste0("c(", paste0(x7$finalStage, collapse = ", "), ")")) - expect_equal(x7$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$finalPValues, collapse = ", "), ")")) - expect_equal(x7$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x7$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x7$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x7), NA))) - expect_output(print(x7)$show()) - invisible(capture.output(expect_error(summary(x7), NA))) - expect_output(summary(x7)$show()) - x7CodeBased <- eval(parse(text = getObjectRCode(x7, stringWrapParagraphWidth = NULL))) - expect_equal(x7CodeBased$testActions, x7$testActions, tolerance = 1e-07) - expect_equal(x7CodeBased$conditionalRejectionProbabilities, x7$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x7CodeBased$conditionalPower, x7$conditionalPower, tolerance = 1e-07) - expect_equal(x7CodeBased$repeatedConfidenceIntervalLowerBounds, x7$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x7CodeBased$repeatedConfidenceIntervalUpperBounds, x7$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x7CodeBased$repeatedPValues, x7$repeatedPValues, tolerance = 1e-07) - expect_equal(x7CodeBased$finalStage, x7$finalStage, tolerance = 1e-07) - expect_equal(x7CodeBased$finalPValues, x7$finalPValues, tolerance = 1e-07) - expect_equal(x7CodeBased$finalConfidenceIntervalLowerBounds, x7$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x7CodeBased$finalConfidenceIntervalUpperBounds, x7$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x7CodeBased$medianUnbiasedEstimates, x7$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x7), "character") - df <- as.data.frame(x7) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x7) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData3 <- testGetAnalysisResultsPlotData(x7, piTreatmentRange = seq(0.25, 0.55, 0.05)) - - ## Comparison of the results of list object 'plotData3' with expected results - expect_equal(plotData3$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55), tolerance = 1e-07, label = paste0("c(", paste0(plotData3$xValues, collapse = ", "), ")")) - expect_equal(plotData3$condPowerValues, c(0.15917802, 0.30888817, 0.48045808, 0.64581102, 0.78396384, 0.88465983, 0.94793138), tolerance = 1e-07, label = paste0("c(", paste0(plotData3$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData3$likelihoodValues, c(0.10539922, 0.23692776, 0.44485807, 0.69767633, 0.91393119, 1, 0.91393119), tolerance = 1e-07, label = paste0("c(", paste0(plotData3$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData3$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData3$main, collapse = ", "), ")")) - expect_equal(plotData3$xlab, "pi1", label = paste0("c(", paste0(plotData3$xlab, collapse = ", "), ")")) - expect_equal(plotData3$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData3$ylab, collapse = ", "), ")")) - expect_equal(plotData3$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData3$sub, collapse = ", "), ")")) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerOneRateEffect} - x8 <- getAnalysisResults( - design = design2, dataInput = dataExample2, - stage = 2, thetaH0 = 0.25, nPlanned = c(12, 6), pi1 = 0.5, - normalApproximation = TRUE, directionUpper = TRUE - ) - - ## Comparison of the results of AnalysisResultsInverseNormal object 'x8' with expected results - expect_equal(x8$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x8$testActions, collapse = ", "), ")")) - expect_equal(x8$conditionalRejectionProbabilities, c(0.08807963, 0.32350578, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x8$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x8$conditionalPower, c(NA_real_, NA_real_, 0.85385983, 0.95015898), tolerance = 1e-07, label = paste0("c(", paste0(x8$conditionalPower, collapse = ", "), ")")) - expect_equal(x8$repeatedConfidenceIntervalLowerBounds, c(0.11314487, 0.21610036, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x8$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x8$repeatedConfidenceIntervalUpperBounds, c(0.88685513, 0.78389964, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x8$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x8$repeatedPValues, c(0.49999905, 0.1020964, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x8$repeatedPValues, collapse = ", "), ")")) - expect_equal(x8$finalStage, NA_integer_, label = paste0("c(", paste0(x8$finalStage, collapse = ", "), ")")) - expect_equal(x8$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$finalPValues, collapse = ", "), ")")) - expect_equal(x8$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x8$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x8$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x8), NA))) - expect_output(print(x8)$show()) - invisible(capture.output(expect_error(summary(x8), NA))) - expect_output(summary(x8)$show()) - x8CodeBased <- eval(parse(text = getObjectRCode(x8, stringWrapParagraphWidth = NULL))) - expect_equal(x8CodeBased$testActions, x8$testActions, tolerance = 1e-07) - expect_equal(x8CodeBased$conditionalRejectionProbabilities, x8$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x8CodeBased$conditionalPower, x8$conditionalPower, tolerance = 1e-07) - expect_equal(x8CodeBased$repeatedConfidenceIntervalLowerBounds, x8$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x8CodeBased$repeatedConfidenceIntervalUpperBounds, x8$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x8CodeBased$repeatedPValues, x8$repeatedPValues, tolerance = 1e-07) - expect_equal(x8CodeBased$finalStage, x8$finalStage, tolerance = 1e-07) - expect_equal(x8CodeBased$finalPValues, x8$finalPValues, tolerance = 1e-07) - expect_equal(x8CodeBased$finalConfidenceIntervalLowerBounds, x8$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x8CodeBased$finalConfidenceIntervalUpperBounds, x8$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x8CodeBased$medianUnbiasedEstimates, x8$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x8), "character") - df <- as.data.frame(x8) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x8) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData4 <- testGetAnalysisResultsPlotData(x8, piTreatmentRange = seq(0.25, 0.55, 0.05)) - - ## Comparison of the results of list object 'plotData4' with expected results - expect_equal(plotData4$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$xValues, collapse = ", "), ")")) - expect_equal(plotData4$condPowerValues, c(0.32350375, 0.50248974, 0.66708346, 0.79901831, 0.89232289, 0.95015898, 0.98088099), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData4$likelihoodValues, c(0.10539922, 0.23692776, 0.44485807, 0.69767633, 0.91393119, 1, 0.91393119), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData4$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData4$main, collapse = ", "), ")")) - expect_equal(plotData4$xlab, "pi1", label = paste0("c(", paste0(plotData4$xlab, collapse = ", "), ")")) - expect_equal(plotData4$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData4$ylab, collapse = ", "), ")")) - expect_equal(plotData4$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData4$sub, collapse = ", "), ")")) - -}) - -test_that("'getAnalysisResults' for a four-stage Fisher design and one treatment", { - - .skipTestIfDisabled() - - design3 <- getDesignFisher(kMax = 4, alpha = 0.025, informationRates = c(0.2, 0.4, 0.8, 1)) - - dataExample3 <- getDataset( - n = c(8, 10, 9, 11), # cumsum, overall n = (8, 18, 27, 38) - events = c(4, 5, 5, 6) # cumsum, overall events = (4, 9, 14, 20) - ) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} - # @refFS[Formula]{fs:testStatisticFisherCombinationTest} - # @refFS[Formula]{fs:definitionRCIFisherCombination} - # @refFS[Formula]{fs:calculationRepeatedpValue} - x1 <- getAnalysisResults( - design = design3, dataInput = dataExample3, - stage = 3, thetaH0 = 0.75, normalApproximation = FALSE, - directionUpper = FALSE, iterations = 1000, seed = 123 - ) - - ## Comparison of the results of AnalysisResultsFisher object 'x1' with expected results - expect_equal(x1$pi1, 0.51851852, tolerance = 1e-07, label = paste0("c(", paste0(x1$pi1, collapse = ", "), ")")) - expect_equal(x1$testActions, c("continue", "continue", "continue", NA_character_), label = paste0("c(", paste0(x1$testActions, collapse = ", "), ")")) - expect_equal(x1$conditionalRejectionProbabilities, c(0.027980027, 0.040164764, 0.018233808, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x1$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower, collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(0.12025548, 0.19023888, 0.23521677, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.87974452, 0.80976112, 0.79971589, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x1$repeatedPValues, c(0.23393398, 0.11483365, 0.11050779, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues, collapse = ", "), ")")) - expect_equal(x1$finalStage, NA_integer_, label = paste0("c(", paste0(x1$finalStage, collapse = ", "), ")")) - expect_equal(x1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalPValues, collapse = ", "), ")")) - expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x1), NA))) - expect_output(print(x1)$show()) - invisible(capture.output(expect_error(summary(x1), NA))) - expect_output(summary(x1)$show()) - x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) - expect_equal(x1CodeBased$pi1, x1$pi1, tolerance = 1e-07) - expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-07) - expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x1), "character") - df <- as.data.frame(x1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} - # @refFS[Formula]{fs:testStatisticFisherCombinationTest} - # @refFS[Formula]{fs:definitionRCIFisherCombination} - # @refFS[Formula]{fs:calculationRepeatedpValue} - x2 <- getAnalysisResults( - design = design3, dataInput = dataExample3, - stage = 3, thetaH0 = 0.75, normalApproximation = TRUE, - directionUpper = FALSE, iterations = 1000, seed = 123 - ) - - ## Comparison of the results of AnalysisResultsFisher object 'x2' with expected results - expect_equal(x2$pi1, 0.51851852, tolerance = 1e-07, label = paste0("c(", paste0(x2$pi1, collapse = ", "), ")")) - expect_equal(x2$testActions, c("continue", "continue", "reject and stop", NA_character_), label = paste0("c(", paste0(x2$testActions, collapse = ", "), ")")) - expect_equal(x2$conditionalRejectionProbabilities, c(0.051264101, 0.1206033, 1, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x2$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower, collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(0.18175814, 0.2424364, 0.28642867, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.81824186, 0.7575636, 0.7496417, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x2$repeatedPValues, c(0.11554509, 0.032131177, 0.024656293, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues, collapse = ", "), ")")) - expect_equal(x2$finalStage, NA_integer_, label = paste0("c(", paste0(x2$finalStage, collapse = ", "), ")")) - expect_equal(x2$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalPValues, collapse = ", "), ")")) - expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x2), NA))) - expect_output(print(x2)$show()) - invisible(capture.output(expect_error(summary(x2), NA))) - expect_output(summary(x2)$show()) - x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) - expect_equal(x2CodeBased$pi1, x2$pi1, tolerance = 1e-07) - expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) - expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-07) - expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-07) - expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x2), "character") - df <- as.data.frame(x2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} - # @refFS[Formula]{fs:testStatisticFisherCombinationTest} - # @refFS[Formula]{fs:definitionRCIFisherCombination} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionFisherInterim} - x3 <- getAnalysisResults( - design = design3, dataInput = dataExample3, - stage = 2, thetaH0 = 0.75, nPlanned = c(12, 6), pi1 = 0.5, normalApproximation = FALSE, - directionUpper = FALSE, iterations = 1000, seed = 123 - ) - - ## Comparison of the results of AnalysisResultsFisher object 'x3' with expected results - expect_equal(x3$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x3$testActions, collapse = ", "), ")")) - expect_equal(x3$conditionalRejectionProbabilities, c(0.027980027, 0.040164764, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalLowerBounds, c(0.12025548, 0.19023888, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalUpperBounds, c(0.87974452, 0.80976112, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x3$repeatedPValues, c(0.23393398, 0.11483365, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues, collapse = ", "), ")")) - expect_equal(x3$finalStage, NA_integer_, label = paste0("c(", paste0(x3$finalStage, collapse = ", "), ")")) - expect_equal(x3$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalPValues, collapse = ", "), ")")) - expect_equal(x3$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x3$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x3$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$medianUnbiasedEstimates, collapse = ", "), ")")) - expect_equal(x3$conditionalPowerSimulated, c(NA_real_, NA_real_, 0.522, 0.672), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalPowerSimulated, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x3), NA))) - expect_output(print(x3)$show()) - invisible(capture.output(expect_error(summary(x3), NA))) - expect_output(summary(x3)$show()) - x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) - expect_equal(x3CodeBased$testActions, x3$testActions, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) - expect_equal(x3CodeBased$finalStage, x3$finalStage, tolerance = 1e-07) - expect_equal(x3CodeBased$finalPValues, x3$finalPValues, tolerance = 1e-07) - expect_equal(x3CodeBased$finalConfidenceIntervalLowerBounds, x3$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$finalConfidenceIntervalUpperBounds, x3$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$medianUnbiasedEstimates, x3$medianUnbiasedEstimates, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalPowerSimulated, x3$conditionalPowerSimulated, tolerance = 1e-07) - expect_type(names(x3), "character") - df <- as.data.frame(x3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData1 <- testGetAnalysisResultsPlotData(x3, piTreatmentRange = seq(0.25, 0.55, 0.05)) - - ## Comparison of the results of list object 'plotData1' with expected results - expect_equal(plotData1$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$xValues, collapse = ", "), ")")) - expect_equal(plotData1$condPowerValues, c(0.997, 0.99, 0.967, 0.9, 0.822, 0.659, 0.534), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData1$likelihoodValues, c(0.10539922, 0.23692776, 0.44485807, 0.69767633, 0.91393119, 1, 0.91393119), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData1$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData1$main, collapse = ", "), ")")) - expect_equal(plotData1$xlab, "pi1", label = paste0("c(", paste0(plotData1$xlab, collapse = ", "), ")")) - expect_equal(plotData1$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData1$ylab, collapse = ", "), ")")) - expect_equal(plotData1$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData1$sub, collapse = ", "), ")")) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} - # @refFS[Formula]{fs:testStatisticFisherCombinationTest} - # @refFS[Formula]{fs:definitionRCIFisherCombination} - # @refFS[Formula]{fs:calculationRepeatedpValue} - x4 <- getAnalysisResults( - design = design3, dataInput = dataExample3, - stage = 3, thetaH0 = 0.25, normalApproximation = FALSE, - directionUpper = TRUE, iterations = 1000, seed = 123 - ) - - ## Comparison of the results of AnalysisResultsFisher object 'x4' with expected results - expect_equal(x4$pi1, 0.51851852, tolerance = 1e-07, label = paste0("c(", paste0(x4$pi1, collapse = ", "), ")")) - expect_equal(x4$testActions, c("continue", "continue", "continue", NA_character_), label = paste0("c(", paste0(x4$testActions, collapse = ", "), ")")) - expect_equal(x4$conditionalRejectionProbabilities, c(0.027980027, 0.040164764, 0.10237226, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x4$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$conditionalPower, collapse = ", "), ")")) - expect_equal(x4$repeatedConfidenceIntervalLowerBounds, c(0.12025548, 0.19023888, 0.23521677, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x4$repeatedConfidenceIntervalUpperBounds, c(0.87974452, 0.80976112, 0.79971589, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x4$repeatedPValues, c(0.23393398, 0.11483365, 0.040061917, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedPValues, collapse = ", "), ")")) - expect_equal(x4$finalStage, NA_integer_, label = paste0("c(", paste0(x4$finalStage, collapse = ", "), ")")) - expect_equal(x4$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalPValues, collapse = ", "), ")")) - expect_equal(x4$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x4$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x4$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x4), NA))) - expect_output(print(x4)$show()) - invisible(capture.output(expect_error(summary(x4), NA))) - expect_output(summary(x4)$show()) - x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) - expect_equal(x4CodeBased$pi1, x4$pi1, tolerance = 1e-07) - expect_equal(x4CodeBased$testActions, x4$testActions, tolerance = 1e-07) - expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-07) - expect_equal(x4CodeBased$finalStage, x4$finalStage, tolerance = 1e-07) - expect_equal(x4CodeBased$finalPValues, x4$finalPValues, tolerance = 1e-07) - expect_equal(x4CodeBased$finalConfidenceIntervalLowerBounds, x4$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$finalConfidenceIntervalUpperBounds, x4$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$medianUnbiasedEstimates, x4$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x4), "character") - df <- as.data.frame(x4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} - # @refFS[Formula]{fs:testStatisticFisherCombinationTest} - # @refFS[Formula]{fs:definitionRCIFisherCombination} - # @refFS[Formula]{fs:calculationRepeatedpValue} - x5 <- getAnalysisResults( - design = design3, dataInput = dataExample3, - stage = 3, thetaH0 = 0.25, normalApproximation = TRUE, - directionUpper = TRUE, iterations = 1000, seed = 123 - ) - - ## Comparison of the results of AnalysisResultsFisher object 'x5' with expected results - expect_equal(x5$pi1, 0.51851852, tolerance = 1e-07, label = paste0("c(", paste0(x5$pi1, collapse = ", "), ")")) - expect_equal(x5$testActions, c("continue", "continue", "reject and stop", NA_character_), label = paste0("c(", paste0(x5$testActions, collapse = ", "), ")")) - expect_equal(x5$conditionalRejectionProbabilities, c(0.051264101, 0.1206033, 1, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x5$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$conditionalPower, collapse = ", "), ")")) - expect_equal(x5$repeatedConfidenceIntervalLowerBounds, c(0.18175814, 0.2424364, 0.28642867, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x5$repeatedConfidenceIntervalUpperBounds, c(0.81824186, 0.7575636, 0.7496417, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x5$repeatedPValues, c(0.11554509, 0.032131177, 0.0055275316, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedPValues, collapse = ", "), ")")) - expect_equal(x5$finalStage, NA_integer_, label = paste0("c(", paste0(x5$finalStage, collapse = ", "), ")")) - expect_equal(x5$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$finalPValues, collapse = ", "), ")")) - expect_equal(x5$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x5$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x5$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x5), NA))) - expect_output(print(x5)$show()) - invisible(capture.output(expect_error(summary(x5), NA))) - expect_output(summary(x5)$show()) - x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) - expect_equal(x5CodeBased$pi1, x5$pi1, tolerance = 1e-07) - expect_equal(x5CodeBased$testActions, x5$testActions, tolerance = 1e-07) - expect_equal(x5CodeBased$conditionalRejectionProbabilities, x5$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x5CodeBased$conditionalPower, x5$conditionalPower, tolerance = 1e-07) - expect_equal(x5CodeBased$repeatedConfidenceIntervalLowerBounds, x5$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x5CodeBased$repeatedConfidenceIntervalUpperBounds, x5$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x5CodeBased$repeatedPValues, x5$repeatedPValues, tolerance = 1e-07) - expect_equal(x5CodeBased$finalStage, x5$finalStage, tolerance = 1e-07) - expect_equal(x5CodeBased$finalPValues, x5$finalPValues, tolerance = 1e-07) - expect_equal(x5CodeBased$finalConfidenceIntervalLowerBounds, x5$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x5CodeBased$finalConfidenceIntervalUpperBounds, x5$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x5CodeBased$medianUnbiasedEstimates, x5$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x5), "character") - df <- as.data.frame(x5) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x5) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} - # @refFS[Formula]{fs:testStatisticFisherCombinationTest} - # @refFS[Formula]{fs:definitionRCIFisherCombination} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionFisherInterim} - x6 <- getAnalysisResults( - design = design3, dataInput = dataExample3, - stage = 2, thetaH0 = 0.25, nPlanned = c(12, 6), pi1 = 0.5, normalApproximation = FALSE, - directionUpper = TRUE, iterations = 1000, seed = 123 - ) - - ## Comparison of the results of AnalysisResultsFisher object 'x6' with expected results - expect_equal(x6$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x6$testActions, collapse = ", "), ")")) - expect_equal(x6$conditionalRejectionProbabilities, c(0.027980027, 0.040164764, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x6$repeatedConfidenceIntervalLowerBounds, c(0.12025548, 0.19023888, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x6$repeatedConfidenceIntervalUpperBounds, c(0.87974452, 0.80976112, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x6$repeatedPValues, c(0.23393398, 0.11483365, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedPValues, collapse = ", "), ")")) - expect_equal(x6$finalStage, NA_integer_, label = paste0("c(", paste0(x6$finalStage, collapse = ", "), ")")) - expect_equal(x6$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$finalPValues, collapse = ", "), ")")) - expect_equal(x6$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x6$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x6$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$medianUnbiasedEstimates, collapse = ", "), ")")) - expect_equal(x6$conditionalPowerSimulated, c(NA_real_, NA_real_, 0.522, 0.672), tolerance = 1e-07, label = paste0("c(", paste0(x6$conditionalPowerSimulated, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x6), NA))) - expect_output(print(x6)$show()) - invisible(capture.output(expect_error(summary(x6), NA))) - expect_output(summary(x6)$show()) - x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) - expect_equal(x6CodeBased$testActions, x6$testActions, tolerance = 1e-07) - expect_equal(x6CodeBased$conditionalRejectionProbabilities, x6$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x6CodeBased$repeatedConfidenceIntervalLowerBounds, x6$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x6CodeBased$repeatedConfidenceIntervalUpperBounds, x6$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x6CodeBased$repeatedPValues, x6$repeatedPValues, tolerance = 1e-07) - expect_equal(x6CodeBased$finalStage, x6$finalStage, tolerance = 1e-07) - expect_equal(x6CodeBased$finalPValues, x6$finalPValues, tolerance = 1e-07) - expect_equal(x6CodeBased$finalConfidenceIntervalLowerBounds, x6$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x6CodeBased$finalConfidenceIntervalUpperBounds, x6$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x6CodeBased$medianUnbiasedEstimates, x6$medianUnbiasedEstimates, tolerance = 1e-07) - expect_equal(x6CodeBased$conditionalPowerSimulated, x6$conditionalPowerSimulated, tolerance = 1e-07) - expect_type(names(x6), "character") - df <- as.data.frame(x6) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x6) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData2 <- testGetAnalysisResultsPlotData(x6, piTreatmentRange = seq(0.25, 0.55, 0.05)) - - ## Comparison of the results of list object 'plotData2' with expected results - expect_equal(plotData2$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$xValues, collapse = ", "), ")")) - expect_equal(plotData2$condPowerValues, c(0.039, 0.114, 0.208, 0.363, 0.54, 0.659, 0.817), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData2$likelihoodValues, c(0.10539922, 0.23692776, 0.44485807, 0.69767633, 0.91393119, 1, 0.91393119), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData2$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData2$main, collapse = ", "), ")")) - expect_equal(plotData2$xlab, "pi1", label = paste0("c(", paste0(plotData2$xlab, collapse = ", "), ")")) - expect_equal(plotData2$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData2$ylab, collapse = ", "), ")")) - expect_equal(plotData2$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData2$sub, collapse = ", "), ")")) - -}) - -test_plan_section("Testing the Analysis Rates Functionality for Two Treatments") - - -test_that("'getAnalysisResults' for a four-stage group sequential design and two treatments", { - .skipTestIfDisabled() - - design7 <- getDesignGroupSequential( - kMax = 4, alpha = 0.025, - typeOfDesign = "WT", deltaWT = 0.25, informationRates = c(0.2, 0.4, 0.8, 1), - futilityBounds = c(0, 0.5, 0.8), bindingFutility = TRUE - ) - - dataExample5 <- getDataset( - n1 = c(17, 18, 22), - n2 = c(18, 17, 19), - events1 = c(11, 12, 17), - events2 = c(5, 10, 7) - ) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} - # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} - # @refFS[Formula]{fs:testStatisticGroupSequential} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} - # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} - x1 <- getAnalysisResults(design7, dataExample5, - thetaH0 = 0, stage = 2, nPlanned = c(60, 30), - pi2 = 0.4, pi1 = 0.8, directionUpper = TRUE, allocationRatioPlanned = 2 - ) - - ## Comparison of the results of AnalysisResultsGroupSequential object 'x1' with expected results - expect_equal(x1$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x1$testActions, collapse = ", "), ")")) - expect_equal(x1$conditionalRejectionProbabilities, c(0.19002543, 0.18837824, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x1$conditionalPower, c(NA_real_, NA_real_, 0.97639752, 0.99770454), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPower, collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(-0.14000084, -0.07626859, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.72492429, 0.4944942, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x1$repeatedPValues, c(0.083297609, 0.074571507, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues, collapse = ", "), ")")) - expect_equal(x1$finalStage, NA_integer_, label = paste0("c(", paste0(x1$finalStage, collapse = ", "), ")")) - expect_equal(x1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalPValues, collapse = ", "), ")")) - expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x1), NA))) - expect_output(print(x1)$show()) - invisible(capture.output(expect_error(summary(x1), NA))) - expect_output(summary(x1)$show()) - x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) - expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-07) - expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x1), "character") - df <- as.data.frame(x1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData1 <- testGetAnalysisResultsPlotData(x1, piTreatmentRange = seq(0.5, 0.8, 0.05), allocationRatioPlanned = 2) - - ## Comparison of the results of list object 'plotData1' with expected results - expect_equal(plotData1$xValues, c(0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$xValues, collapse = ", "), ")")) - expect_equal(plotData1$condPowerValues, c(0.47726473, 0.64780315, 0.79588169, 0.90153211, 0.96202912, 0.98889368, 0.99770454), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData1$likelihoodValues, c(0.14689674, 0.40998118, 0.77598415, 0.99604498, 0.86704618, 0.51184997, 0.20491809), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData1$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData1$main, collapse = ", "), ")")) - expect_equal(plotData1$xlab, "pi1", label = paste0("c(", paste0(plotData1$xlab, collapse = ", "), ")")) - expect_equal(plotData1$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData1$ylab, collapse = ", "), ")")) - expect_equal(plotData1$sub, "Stage = 2, # of remaining subjects = 90, pi2 = 0.4, allocation ratio = 2", label = paste0("c(", paste0(plotData1$sub, collapse = ", "), ")")) - - # reversed "directionUpper" - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} - # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} - # @refFS[Formula]{fs:testStatisticGroupSequential} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} - # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} - - x2 <- getAnalysisResults(design7, dataExample5, - thetaH0 = 0, stage = 2, nPlanned = c(60, 30), - pi2 = 0.8, pi1 = 0.4, directionUpper = FALSE, allocationRatioPlanned = 0.5 - ) - - ## Comparison of the results of AnalysisResultsGroupSequential object 'x2' with expected results - expect_equal(x2$testActions, c("accept and stop", "accept and stop", NA_character_, NA_character_), label = paste0("c(", paste0(x2$testActions, collapse = ", "), ")")) - expect_equal(x2$conditionalRejectionProbabilities, c(0, 0, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x2$conditionalPower, c(NA_real_, NA_real_, 0.037603851, 0.34743098), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalPower, collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(-0.14000084, -0.07626859, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.72492429, 0.4944942, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x2$repeatedPValues, c(0.49999905, 0.49999905, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues, collapse = ", "), ")")) - expect_equal(x2$finalStage, 1, label = paste0("c(", paste0(x2$finalStage, collapse = ", "), ")")) - expect_equal(x2$finalPValues, c(0.98580558, NA_real_, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalPValues, collapse = ", "), ")")) - expect_equal(x2$finalConfidenceIntervalLowerBounds, c(0.039328966, NA_real_, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x2$finalConfidenceIntervalUpperBounds, c(0.62730979, NA_real_, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x2$medianUnbiasedEstimates, c(0.36928105, NA_real_, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x2), NA))) - expect_output(print(x2)$show()) - invisible(capture.output(expect_error(summary(x2), NA))) - expect_output(summary(x2)$show()) - x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) - expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) - expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-07) - expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-07) - expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x2), "character") - df <- as.data.frame(x2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData2 <- testGetAnalysisResultsPlotData(x2, piTreatmentRange = seq(0.2, 0.5, 0.05), allocationRatioPlanned = 0.5) - - ## Comparison of the results of list object 'plotData2' with expected results - expect_equal(plotData2$xValues, c(0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$xValues, collapse = ", "), ")")) - expect_equal(plotData2$condPowerValues, c(0.98964948, 0.93182725, 0.78360503, 0.56553646, 0.34743098, 0.18277547, 0.082851862), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData2$likelihoodValues, c(8.9244677e-08, 2.5604189e-06, 4.9816924e-05, 0.00065732471, 0.0058819346, 0.035694195, 0.14689674), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData2$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData2$main, collapse = ", "), ")")) - expect_equal(plotData2$xlab, "pi1", label = paste0("c(", paste0(plotData2$xlab, collapse = ", "), ")")) - expect_equal(plotData2$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData2$ylab, collapse = ", "), ")")) - expect_equal(plotData2$sub, "Stage = 2, # of remaining subjects = 90, pi2 = 0.8, allocation ratio = 0.5", label = paste0("c(", paste0(plotData2$sub, collapse = ", "), ")")) - -}) - -test_that("'getAnalysisResults' for a four-stage inverse normal design and two treatments", { - - .skipTestIfDisabled() - - design8 <- getDesignInverseNormal( - kMax = 4, alpha = 0.025, - typeOfDesign = "WT", deltaWT = 0.25, informationRates = c(0.2, 0.4, 0.8, 1), - futilityBounds = c(0, 0.5, 0.8), bindingFutility = TRUE - ) - - dataExample6 <- getDataset( - n1 = c(17, 18, 22), - n2 = c(18, 17, 19), - events1 = c(11, 12, 17), - events2 = c(5, 10, 7) - ) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} - # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} - # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} - # @refFS[Formula]{fs:testStatisticNormalCombinationTest} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} - # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} - x1 <- getAnalysisResults(design8, dataExample6, - thetaH0 = 0.0, stage = 2, nPlanned = c(30, 30), - pi2 = 0.2, pi1 = 0.4, directionUpper = TRUE - ) - - ## Comparison of the results of AnalysisResultsInverseNormal object 'x1' with expected results - expect_equal(x1$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x1$testActions, collapse = ", "), ")")) - expect_equal(x1$conditionalRejectionProbabilities, c(0.19002543, 0.18093983, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x1$conditionalPower, c(NA_real_, NA_real_, 0.51829859, 0.74637814), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPower, collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(-0.14000084, -0.078581193, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.72492429, 0.48870113, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x1$repeatedPValues, c(0.083297609, 0.077943692, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues, collapse = ", "), ")")) - expect_equal(x1$finalStage, NA_integer_, label = paste0("c(", paste0(x1$finalStage, collapse = ", "), ")")) - expect_equal(x1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalPValues, collapse = ", "), ")")) - expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x1), NA))) - expect_output(print(x1)$show()) - invisible(capture.output(expect_error(summary(x1), NA))) - expect_output(summary(x1)$show()) - x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) - expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-07) - expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x1), "character") - df <- as.data.frame(x1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData1 <- testGetAnalysisResultsPlotData(x1, piTreatmentRange = seq(0.4, 0.7, 0.05), nPlanned = c(30, 30)) - - ## Comparison of the results of list object 'plotData1' with expected results - expect_equal(plotData1$xValues, c(0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$xValues, collapse = ", "), ")")) - expect_equal(plotData1$condPowerValues, c(0.74637814, 0.85191228, 0.92421447, 0.96693166, 0.98816058, 0.99670572, 0.99934119), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData1$likelihoodValues, c(0.0058819346, 0.035694195, 0.14689674, 0.40998118, 0.77598415, 0.99604498, 0.86704618), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData1$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData1$main, collapse = ", "), ")")) - expect_equal(plotData1$xlab, "pi1", label = paste0("c(", paste0(plotData1$xlab, collapse = ", "), ")")) - expect_equal(plotData1$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData1$ylab, collapse = ", "), ")")) - expect_equal(plotData1$sub, "Stage = 2, # of remaining subjects = 60, pi2 = 0.2, allocation ratio = 1", label = paste0("c(", paste0(plotData1$sub, collapse = ", "), ")")) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} - # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} - # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} - # @refFS[Formula]{fs:testStatisticNormalCombinationTest} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} - # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} - x3 <- getAnalysisResults(design8, dataExample6, - thetaH0 = 0, stage = 2, nPlanned = c(60, 30), - pi2 = 0.4, pi1 = 0.8, directionUpper = TRUE, allocationRatioPlanned = 2 - ) - - ## Comparison of the results of AnalysisResultsInverseNormal object 'x3' with expected results - expect_equal(x3$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x3$testActions, collapse = ", "), ")")) - expect_equal(x3$conditionalRejectionProbabilities, c(0.19002543, 0.18093983, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x3$conditionalPower, c(NA_real_, NA_real_, 0.97637134, 0.99770045), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalPower, collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalLowerBounds, c(-0.14000084, -0.078581193, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalUpperBounds, c(0.72492429, 0.48870113, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x3$repeatedPValues, c(0.083297609, 0.077943692, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues, collapse = ", "), ")")) - expect_equal(x3$finalStage, NA_integer_, label = paste0("c(", paste0(x3$finalStage, collapse = ", "), ")")) - expect_equal(x3$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalPValues, collapse = ", "), ")")) - expect_equal(x3$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x3$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x3$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x3), NA))) - expect_output(print(x3)$show()) - invisible(capture.output(expect_error(summary(x3), NA))) - expect_output(summary(x3)$show()) - x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) - expect_equal(x3CodeBased$testActions, x3$testActions, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) - expect_equal(x3CodeBased$finalStage, x3$finalStage, tolerance = 1e-07) - expect_equal(x3CodeBased$finalPValues, x3$finalPValues, tolerance = 1e-07) - expect_equal(x3CodeBased$finalConfidenceIntervalLowerBounds, x3$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$finalConfidenceIntervalUpperBounds, x3$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$medianUnbiasedEstimates, x3$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x3), "character") - df <- as.data.frame(x3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData4 <- testGetAnalysisResultsPlotData(x3, piTreatmentRange = seq(0.5, 0.8, 0.05), allocationRatioPlanned = 2) - - ## Comparison of the results of list object 'plotData4' with expected results - expect_equal(plotData4$xValues, c(0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$xValues, collapse = ", "), ")")) - expect_equal(plotData4$condPowerValues, c(0.4771434, 0.64764919, 0.79574037, 0.90143545, 0.96198044, 0.98887633, 0.99770045), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData4$likelihoodValues, c(0.14689674, 0.40998118, 0.77598415, 0.99604498, 0.86704618, 0.51184997, 0.20491809), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData4$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData4$main, collapse = ", "), ")")) - expect_equal(plotData4$xlab, "pi1", label = paste0("c(", paste0(plotData4$xlab, collapse = ", "), ")")) - expect_equal(plotData4$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData4$ylab, collapse = ", "), ")")) - expect_equal(plotData4$sub, "Stage = 2, # of remaining subjects = 90, pi2 = 0.4, allocation ratio = 2", label = paste0("c(", paste0(plotData4$sub, collapse = ", "), ")")) - - # reversed "directionUpper" - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} - # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} - # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} - # @refFS[Formula]{fs:testStatisticNormalCombinationTest} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} - # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} - x4 <- getAnalysisResults(design8, dataExample6, - thetaH0 = 0, stage = 2, nPlanned = c(60, 30), - pi2 = 0.8, pi1 = 0.4, directionUpper = FALSE, allocationRatioPlanned = 0.5 - ) - - ## Comparison of the results of AnalysisResultsInverseNormal object 'x4' with expected results - expect_equal(x4$testActions, c("accept and stop", "accept and stop", NA_character_, NA_character_), label = paste0("c(", paste0(x4$testActions, collapse = ", "), ")")) - expect_equal(x4$conditionalRejectionProbabilities, c(0, 0, NA_real_, NA_real_), label = paste0("c(", paste0(x4$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x4$conditionalPower, c(NA_real_, NA_real_, 0.037603851, 0.34743098), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalPower, collapse = ", "), ")")) - expect_equal(x4$repeatedConfidenceIntervalLowerBounds, c(-0.14000084, -0.078581193, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x4$repeatedConfidenceIntervalUpperBounds, c(0.72492429, 0.48870113, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x4$repeatedPValues, c(0.49999905, 0.49999905, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedPValues, collapse = ", "), ")")) - expect_equal(x4$finalStage, 1, label = paste0("c(", paste0(x4$finalStage, collapse = ", "), ")")) - expect_equal(x4$finalPValues, c(0.98580558, NA_real_, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$finalPValues, collapse = ", "), ")")) - expect_equal(x4$finalConfidenceIntervalLowerBounds, c(0.039328966, NA_real_, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x4$finalConfidenceIntervalUpperBounds, c(0.62730979, NA_real_, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x4$medianUnbiasedEstimates, c(0.36928105, NA_real_, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x4), NA))) - expect_output(print(x4)$show()) - invisible(capture.output(expect_error(summary(x4), NA))) - expect_output(summary(x4)$show()) - x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) - expect_equal(x4CodeBased$testActions, x4$testActions, tolerance = 1e-07) - expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-07) - expect_equal(x4CodeBased$finalStage, x4$finalStage, tolerance = 1e-07) - expect_equal(x4CodeBased$finalPValues, x4$finalPValues, tolerance = 1e-07) - expect_equal(x4CodeBased$finalConfidenceIntervalLowerBounds, x4$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$finalConfidenceIntervalUpperBounds, x4$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$medianUnbiasedEstimates, x4$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x4), "character") - df <- as.data.frame(x4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData5 <- testGetAnalysisResultsPlotData(x4, piTreatmentRange = seq(0.2, 0.5, 0.05), allocationRatioPlanned = 0.5) - - ## Comparison of the results of list object 'plotData5' with expected results - expect_equal(plotData5$xValues, c(0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5), tolerance = 1e-07, label = paste0("c(", paste0(plotData5$xValues, collapse = ", "), ")")) - expect_equal(plotData5$condPowerValues, c(0.98964948, 0.93182725, 0.78360503, 0.56553646, 0.34743098, 0.18277547, 0.082851862), tolerance = 1e-07, label = paste0("c(", paste0(plotData5$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData5$likelihoodValues, c(8.9244677e-08, 2.5604189e-06, 4.9816924e-05, 0.00065732471, 0.0058819346, 0.035694195, 0.14689674), tolerance = 1e-07, label = paste0("c(", paste0(plotData5$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData5$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData5$main, collapse = ", "), ")")) - expect_equal(plotData5$xlab, "pi1", label = paste0("c(", paste0(plotData5$xlab, collapse = ", "), ")")) - expect_equal(plotData5$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData5$ylab, collapse = ", "), ")")) - expect_equal(plotData5$sub, "Stage = 2, # of remaining subjects = 90, pi2 = 0.8, allocation ratio = 0.5", label = paste0("c(", paste0(plotData5$sub, collapse = ", "), ")")) - -}) - -test_that("'getAnalysisResults' for a four-stage Fisher design and two treatments", { - - .skipTestIfDisabled() - - design9 <- getDesignFisher( - kMax = 4, alpha = 0.025, method = "equalAlpha", - informationRates = c(0.2, 0.4, 0.8, 1) - ) - - dataExample7 <- getDataset( - n1 = c(17, 23, 22), - n2 = c(18, 20, 19), - events1 = c(11, 12, 17), - events2 = c(5, 10, 7) - ) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} - # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} - # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} - # @refFS[Formula]{fs:testStatisticFisherCombinationTest} - # @refFS[Formula]{fs:definitionRCIFisherCombination} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionFisherInterim} - # @refFS[Formula]{fs:conditionalRejectionFisherLastInterim} - # @refFS[Formula]{fs:conditionalRejectionFisherweights} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} - # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} - x1 <- getAnalysisResults(design9, dataExample7, - thetaH0 = 0, stage = 2, nPlanned = c(60, 30), - pi2 = 0.4, pi1 = 0.8, directionUpper = TRUE, allocationRatioPlanned = 2, seed = 123 - ) - - ## Comparison of the results of AnalysisResultsFisher object 'x1' with expected results - expect_equal(x1$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x1$testActions, collapse = ", "), ")")) - expect_equal(x1$conditionalRejectionProbabilities, c(0.13898608, 0.050808351, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(-0.023853561, -0.068378457, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.66428984, 0.40418869, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x1$repeatedPValues, c(0.035427069, 0.088523734, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues, collapse = ", "), ")")) - expect_equal(x1$finalStage, NA_integer_, label = paste0("c(", paste0(x1$finalStage, collapse = ", "), ")")) - expect_equal(x1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalPValues, collapse = ", "), ")")) - expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$medianUnbiasedEstimates, collapse = ", "), ")")) - expect_equal(x1$conditionalPowerSimulated, c(NA_real_, NA_real_, 0.925, 0.972), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPowerSimulated, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x1), NA))) - expect_output(print(x1)$show()) - invisible(capture.output(expect_error(summary(x1), NA))) - expect_output(summary(x1)$show()) - x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) - expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-07) - expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalPowerSimulated, x1$conditionalPowerSimulated, tolerance = 1e-07) - expect_type(names(x1), "character") - df <- as.data.frame(x1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData1 <- testGetAnalysisResultsPlotData(x1, piTreatmentRange = seq(0.5, 0.8, 0.05), allocationRatioPlanned = 2) - - ## Comparison of the results of list object 'plotData1' with expected results - expect_equal(plotData1$xValues, c(0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$xValues, collapse = ", "), ")")) - expect_equal(plotData1$condPowerValues, c(0.199, 0.364, 0.506, 0.686, 0.839, 0.927, 0.979), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData1$likelihoodValues, c(0.63105765, 0.95013529, 0.95013529, 0.63105765, 0.27837883, 0.081561833, 0.015871623), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData1$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData1$main, collapse = ", "), ")")) - expect_equal(plotData1$xlab, "pi1", label = paste0("c(", paste0(plotData1$xlab, collapse = ", "), ")")) - expect_equal(plotData1$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData1$ylab, collapse = ", "), ")")) - expect_equal(plotData1$sub, "Stage = 2, # of remaining subjects = 90, pi2 = 0.4, allocation ratio = 2", label = paste0("c(", paste0(plotData1$sub, collapse = ", "), ")")) - - # reversed "directionUpper" - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} - # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} - # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} - # @refFS[Formula]{fs:testStatisticFisherCombinationTest} - # @refFS[Formula]{fs:definitionRCIFisherCombination} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionFisherInterim} - # @refFS[Formula]{fs:conditionalRejectionFisherLastInterim} - # @refFS[Formula]{fs:conditionalRejectionFisherweights} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} - # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} - - x2 <- getAnalysisResults(design9, dataExample7, - thetaH0 = 0, stage = 2, nPlanned = c(60, 30), - pi2 = 0.8, pi1 = 0.4, directionUpper = FALSE, allocationRatioPlanned = 0.5, seed = 123 - ) - - ## Comparison of the results of AnalysisResultsFisher object 'x2' with expected results - expect_equal(x2$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x2$testActions, collapse = ", "), ")")) - expect_equal(x2$conditionalRejectionProbabilities, c(0.0056634595, 0.0023089469, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(-0.023853561, -0.068378457, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.66428984, 0.40418869, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x2$repeatedPValues, c(0.49999905, 0.49999905, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues, collapse = ", "), ")")) - expect_equal(x2$finalStage, NA_integer_, label = paste0("c(", paste0(x2$finalStage, collapse = ", "), ")")) - expect_equal(x2$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalPValues, collapse = ", "), ")")) - expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$medianUnbiasedEstimates, collapse = ", "), ")")) - expect_equal(x2$conditionalPowerSimulated, c(NA_real_, NA_real_, 0.591, 0.788), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalPowerSimulated, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x2), NA))) - expect_output(print(x2)$show()) - invisible(capture.output(expect_error(summary(x2), NA))) - expect_output(summary(x2)$show()) - x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) - expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) - expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-07) - expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-07) - expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalPowerSimulated, x2$conditionalPowerSimulated, tolerance = 1e-07) - expect_type(names(x2), "character") - df <- as.data.frame(x2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData2 <- testGetAnalysisResultsPlotData(x2, piTreatmentRange = seq(0.2, 0.5, 0.05), allocationRatioPlanned = 0.5) - - ## Comparison of the results of list object 'plotData2' with expected results - expect_equal(plotData2$xValues, c(0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$xValues, collapse = ", "), ")")) - expect_equal(plotData2$condPowerValues, c(0.998, 0.992, 0.967, 0.892, 0.807, 0.623, 0.493), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData2$likelihoodValues, c(1.003982e-05, 0.00017609247, 0.0020513476, 0.015871623, 0.081561833, 0.27837883, 0.63105765), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData2$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData2$main, collapse = ", "), ")")) - expect_equal(plotData2$xlab, "pi1", label = paste0("c(", paste0(plotData2$xlab, collapse = ", "), ")")) - expect_equal(plotData2$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData2$ylab, collapse = ", "), ")")) - expect_equal(plotData2$sub, "Stage = 2, # of remaining subjects = 90, pi2 = 0.8, allocation ratio = 0.5", label = paste0("c(", paste0(plotData2$sub, collapse = ", "), ")")) - -}) - -test_that("'getAnalysisResults' produces the correct exact tests and final CIs", { - - .skipTestIfDisabled() - - dataExample8 <- getDataset( - n2 = c(31, 72), - n1 = c(30, 69), - events2 = c(8, 54), - events1 = c(6, 45) - ) - - design10 <- getDesignGroupSequential( - kMax = 2, alpha = 0.025, - typeOfDesign = "WT", deltaWT = 0.1, informationRates = c(0.3, 1) - ) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} - # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} - # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} - # @refFS[Formula]{fs:testStatisticNormalCombinationTest} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} - # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} - # @refFS[Formula]{fs:orderingPValueUpper} - # @refFS[Formula]{fs:finalCITwoRates} - # @refFS[Formula]{fs:medianUnbiasedEstimate} - x1 <- getAnalysisResults(design10, dataExample8, - thetaH0 = 0, stage = 2, directionUpper = FALSE, - normalApproximation = FALSE - ) - - ## Comparison of the results of AnalysisResultsGroupSequential object 'x1' with expected results - expect_equal(x1$pi1, 0.51515152, tolerance = 1e-07, label = paste0("c(", paste0(x1$pi1, collapse = ", "), ")")) - expect_equal(x1$pi2, 0.60194175, tolerance = 1e-07, label = paste0("c(", paste0(x1$pi2, collapse = ", "), ")")) - expect_equal(x1$testActions, c("continue", "accept"), label = paste0("c(", paste0(x1$testActions, collapse = ", "), ")")) - expect_equal(x1$conditionalRejectionProbabilities, c(0.013966781, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x1$conditionalPower, c(NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower, collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(-0.39509356, -0.22101238), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.29306133, 0.050448655), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x1$repeatedPValues, c(0.49999905, 0.15271161), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues, collapse = ", "), ")")) - expect_equal(x1$finalStage, 2, label = paste0("c(", paste0(x1$finalStage, collapse = ", "), ")")) - expect_equal(x1$finalPValues, c(NA_real_, 0.13570939), tolerance = 1e-07, label = paste0("c(", paste0(x1$finalPValues, collapse = ", "), ")")) - expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, -0.21309581), tolerance = 1e-07, label = paste0("c(", paste0(x1$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, 0.059922132), tolerance = 1e-07, label = paste0("c(", paste0(x1$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, -0.076600295), tolerance = 1e-07, label = paste0("c(", paste0(x1$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x1), NA))) - expect_output(print(x1)$show()) - invisible(capture.output(expect_error(summary(x1), NA))) - expect_output(summary(x1)$show()) - x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) - expect_equal(x1CodeBased$pi1, x1$pi1, tolerance = 1e-07) - expect_equal(x1CodeBased$pi2, x1$pi2, tolerance = 1e-07) - expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-07) - expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x1), "character") - df <- as.data.frame(x1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - design11 <- getDesignInverseNormal( - kMax = 2, alpha = 0.025, - typeOfDesign = "WT", deltaWT = 0.1, informationRates = c(0.3, 1) - ) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} - # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} - # @refFS[Formula]{fs:testStatisticNormalCombinationTest} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} - # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} - x2 <- getAnalysisResults(design11, dataExample8, - thetaH0 = 0, stage = 2, directionUpper = FALSE, - normalApproximation = FALSE - ) - - ## Comparison of the results of AnalysisResultsInverseNormal object 'x2' with expected results - expect_equal(x2$pi1, 0.51515152, tolerance = 1e-07, label = paste0("c(", paste0(x2$pi1, collapse = ", "), ")")) - expect_equal(x2$pi2, 0.60194175, tolerance = 1e-07, label = paste0("c(", paste0(x2$pi2, collapse = ", "), ")")) - expect_equal(x2$testActions, c("continue", "accept"), label = paste0("c(", paste0(x2$testActions, collapse = ", "), ")")) - expect_equal(x2$conditionalRejectionProbabilities, c(0.013966781, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x2$conditionalPower, c(NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower, collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(-0.39509356, -0.20744977), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.29306133, 0.038390636), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x2$repeatedPValues, c(0.49999905, 0.171251), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues, collapse = ", "), ")")) - expect_equal(x2$finalStage, 2, label = paste0("c(", paste0(x2$finalStage, collapse = ", "), ")")) - expect_equal(x2$finalPValues, c(NA_real_, 0.15026298), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalPValues, collapse = ", "), ")")) - expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, -0.20860056), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, 0.064410651), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, -0.072106168), tolerance = 1e-07, label = paste0("c(", paste0(x2$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x2), NA))) - expect_output(print(x2)$show()) - invisible(capture.output(expect_error(summary(x2), NA))) - expect_output(summary(x2)$show()) - x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) - expect_equal(x2CodeBased$pi1, x2$pi1, tolerance = 1e-07) - expect_equal(x2CodeBased$pi2, x2$pi2, tolerance = 1e-07) - expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) - expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-07) - expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-07) - expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x2), "character") - df <- as.data.frame(x2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - design12 <- getDesignFisher( - kMax = 2, alpha = 0.025, method = "fullAlpha", - informationRates = c(0.3, 1) - ) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} - # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} - # @refFS[Formula]{fs:testStatisticFisherCombinationTest} - # @refFS[Formula]{fs:definitionRCIFisherCombination} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionFisherInterim} - # @refFS[Formula]{fs:conditionalRejectionFisherLastInterim} - # @refFS[Formula]{fs:conditionalRejectionFisherweights} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} - # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} - x3 <- getAnalysisResults(design12, dataExample8, - thetaH0 = 0, stage = 2, directionUpper = FALSE, - normalApproximation = FALSE, seed = 123 - ) - - ## Comparison of the results of AnalysisResultsFisher object 'x3' with expected results - expect_equal(x3$pi1, 0.51515152, tolerance = 1e-07, label = paste0("c(", paste0(x3$pi1, collapse = ", "), ")")) - expect_equal(x3$pi2, 0.60194175, tolerance = 1e-07, label = paste0("c(", paste0(x3$pi2, collapse = ", "), ")")) - expect_equal(x3$testActions, c("continue", "accept"), label = paste0("c(", paste0(x3$testActions, collapse = ", "), ")")) - expect_equal(x3$conditionalRejectionProbabilities, c(0.016431334, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x3$conditionalPower, c(NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPower, collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalLowerBounds, c(-0.39357809, -0.2198965), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalUpperBounds, c(0.29140184, 0.047490149), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x3$repeatedPValues, c(0.49999905, 0.18563047), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues, collapse = ", "), ")")) - expect_equal(x3$finalStage, 2, label = paste0("c(", paste0(x3$finalStage, collapse = ", "), ")")) - expect_equal(x3$finalPValues, c(NA_real_, 0.18562957), tolerance = 1e-07, label = paste0("c(", paste0(x3$finalPValues, collapse = ", "), ")")) - expect_equal(x3$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x3$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x3$medianUnbiasedEstimates, c(NA_real_, NA_real_), label = paste0("c(", paste0(x3$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x3), NA))) - expect_output(print(x3)$show()) - invisible(capture.output(expect_error(summary(x3), NA))) - expect_output(summary(x3)$show()) - x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) - expect_equal(x3CodeBased$pi1, x3$pi1, tolerance = 1e-07) - expect_equal(x3CodeBased$pi2, x3$pi2, tolerance = 1e-07) - expect_equal(x3CodeBased$testActions, x3$testActions, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) - expect_equal(x3CodeBased$finalStage, x3$finalStage, tolerance = 1e-07) - expect_equal(x3CodeBased$finalPValues, x3$finalPValues, tolerance = 1e-07) - expect_equal(x3CodeBased$finalConfidenceIntervalLowerBounds, x3$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$finalConfidenceIntervalUpperBounds, x3$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$medianUnbiasedEstimates, x3$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x3), "character") - df <- as.data.frame(x3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getAnalysisResults' produces the correct non-inferiority results for a group sequential design", { - - .skipTestIfDisabled() - - design13 <- getDesignGroupSequential( - kMax = 2, alpha = 0.025, - typeOfDesign = "WT", deltaWT = 0.1, informationRates = c(0.3, 1) - ) - - dataExample9 <- getDataset( - n1 = c(29, 70), - n2 = c(31, 71), - events1 = c(8, 54), - events2 = c(6, 45) - ) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} - # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} - # @refFS[Formula]{fs:testStatisticGroupSequential} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:EstimatesDiffFarringtonManning} - x1 <- getAnalysisResults(design13, dataExample9, - thetaH0 = -0.1, stage = 2, directionUpper = TRUE, - normalApproximation = TRUE - ) - - ## Comparison of the results of AnalysisResultsGroupSequential object 'x1' with expected results - expect_equal(x1$pi1, 0.62626263, tolerance = 1e-07, label = paste0("c(", paste0(x1$pi1, collapse = ", "), ")")) - expect_equal(x1$pi2, 0.5, tolerance = 1e-07, label = paste0("c(", paste0(x1$pi2, collapse = ", "), ")")) - expect_equal(x1$testActions, c("continue", "reject"), label = paste0("c(", paste0(x1$testActions, collapse = ", "), ")")) - expect_equal(x1$conditionalRejectionProbabilities, c(0.1027905, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x1$conditionalPower, c(NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower, collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(-0.26992436, -0.011398056), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.42527258, 0.25916391), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x1$repeatedPValues, c(0.17488831, 0.00058560119), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues, collapse = ", "), ")")) - expect_equal(x1$finalStage, 2, label = paste0("c(", paste0(x1$finalStage, collapse = ", "), ")")) - expect_equal(x1$finalPValues, c(NA_real_, 0.0012732763), tolerance = 1e-07, label = paste0("c(", paste0(x1$finalPValues, collapse = ", "), ")")) - expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, -0.016122347), tolerance = 1e-07, label = paste0("c(", paste0(x1$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, 0.26034096), tolerance = 1e-07, label = paste0("c(", paste0(x1$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, 0.12355576), tolerance = 1e-07, label = paste0("c(", paste0(x1$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x1), NA))) - expect_output(print(x1)$show()) - invisible(capture.output(expect_error(summary(x1), NA))) - expect_output(summary(x1)$show()) - x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) - expect_equal(x1CodeBased$pi1, x1$pi1, tolerance = 1e-07) - expect_equal(x1CodeBased$pi2, x1$pi2, tolerance = 1e-07) - expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-07) - expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x1), "character") - df <- as.data.frame(x1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} - # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} - # @refFS[Formula]{fs:testStatisticGroupSequential} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:EstimatesDiffFarringtonManning} - x2 <- getAnalysisResults(design13, dataExample9, - thetaH0 = -0.1, stage = 1, nPlanned = 40, - pi1 = 0.45, pi2 = 0.4, directionUpper = TRUE, normalApproximation = TRUE - ) - - ## Comparison of the results of AnalysisResultsGroupSequential object 'x2' with expected results - expect_equal(x2$testActions, c("continue", NA_character_), label = paste0("c(", paste0(x2$testActions, collapse = ", "), ")")) - expect_equal(x2$conditionalRejectionProbabilities, c(0.1027905, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x2$conditionalPower, c(NA_real_, 0.38169554), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalPower, collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(-0.26992436, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.42527258, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x2$repeatedPValues, c(0.17488831, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues, collapse = ", "), ")")) - expect_equal(x2$finalStage, NA_integer_, label = paste0("c(", paste0(x2$finalStage, collapse = ", "), ")")) - expect_equal(x2$finalPValues, c(NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalPValues, collapse = ", "), ")")) - expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, NA_real_), label = paste0("c(", paste0(x2$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x2), NA))) - expect_output(print(x2)$show()) - invisible(capture.output(expect_error(summary(x2), NA))) - expect_output(summary(x2)$show()) - x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) - expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) - expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-07) - expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-07) - expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x2), "character") - df <- as.data.frame(x2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData1 <- testGetAnalysisResultsPlotData(x2, piTreatmentRange = seq(0.25, 0.7, 0.05)) - - ## Comparison of the results of list object 'plotData1' with expected results - expect_equal(plotData1$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$xValues, collapse = ", "), ")")) - expect_equal(plotData1$condPowerValues, c(0.053165998, 0.1027905, 0.17500031, 0.26934912, 0.38169554, 0.50456648, 0.62825352, 0.74249459, 0.83846571, 0.91065807), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData1$likelihoodValues, c(0.95261056, 0.95859015, 0.67101367, 0.32674624, 0.11068039, 0.026080239, 0.0042749722, 0.00048745649, 3.866511e-05, 2.1334549e-06), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData1$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData1$main, collapse = ", "), ")")) - expect_equal(plotData1$xlab, "pi1", label = paste0("c(", paste0(plotData1$xlab, collapse = ", "), ")")) - expect_equal(plotData1$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData1$ylab, collapse = ", "), ")")) - expect_equal(plotData1$sub, "Stage = 1, # of remaining subjects = 40, pi2 = 0.4, allocation ratio = 1", label = paste0("c(", paste0(plotData1$sub, collapse = ", "), ")")) - - # non-inferiority, reversed "directionUpper" - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} - # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} - # @refFS[Formula]{fs:testStatisticGroupSequential} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:EstimatesDiffFarringtonManning} - x3 <- getAnalysisResults(design13, dataExample9, - thetaH0 = 0.1, stage = 2, directionUpper = FALSE, - normalApproximation = TRUE - ) - - ## Comparison of the results of AnalysisResultsGroupSequential object 'x3' with expected results - expect_equal(x3$pi1, 0.62626263, tolerance = 1e-07, label = paste0("c(", paste0(x3$pi1, collapse = ", "), ")")) - expect_equal(x3$pi2, 0.5, tolerance = 1e-07, label = paste0("c(", paste0(x3$pi2, collapse = ", "), ")")) - expect_equal(x3$testActions, c("continue", "accept"), label = paste0("c(", paste0(x3$testActions, collapse = ", "), ")")) - expect_equal(x3$conditionalRejectionProbabilities, c(0.012395218, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x3$conditionalPower, c(NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPower, collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalLowerBounds, c(-0.26992436, -0.011398056), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalUpperBounds, c(0.42527258, 0.25916391), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x3$repeatedPValues, c(0.49999905, 0.49999905), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues, collapse = ", "), ")")) - expect_equal(x3$finalStage, 2, label = paste0("c(", paste0(x3$finalStage, collapse = ", "), ")")) - expect_equal(x3$finalPValues, c(NA_real_, 0.64703032), tolerance = 1e-07, label = paste0("c(", paste0(x3$finalPValues, collapse = ", "), ")")) - expect_equal(x3$finalConfidenceIntervalLowerBounds, c(NA_real_, -0.0098227441), tolerance = 1e-07, label = paste0("c(", paste0(x3$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x3$finalConfidenceIntervalUpperBounds, c(NA_real_, 0.26218829), tolerance = 1e-07, label = paste0("c(", paste0(x3$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x3$medianUnbiasedEstimates, c(NA_real_, 0.12618258), tolerance = 1e-07, label = paste0("c(", paste0(x3$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x3), NA))) - expect_output(print(x3)$show()) - invisible(capture.output(expect_error(summary(x3), NA))) - expect_output(summary(x3)$show()) - x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) - expect_equal(x3CodeBased$pi1, x3$pi1, tolerance = 1e-07) - expect_equal(x3CodeBased$pi2, x3$pi2, tolerance = 1e-07) - expect_equal(x3CodeBased$testActions, x3$testActions, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) - expect_equal(x3CodeBased$finalStage, x3$finalStage, tolerance = 1e-07) - expect_equal(x3CodeBased$finalPValues, x3$finalPValues, tolerance = 1e-07) - expect_equal(x3CodeBased$finalConfidenceIntervalLowerBounds, x3$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$finalConfidenceIntervalUpperBounds, x3$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$medianUnbiasedEstimates, x3$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x3), "character") - df <- as.data.frame(x3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} - # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} - # @refFS[Formula]{fs:testStatisticGroupSequential} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:EstimatesDiffFarringtonManning} - x4 <- getAnalysisResults(design13, dataExample9, - thetaH0 = 0.1, stage = 1, nPlanned = 40, - pi1 = 0.4, pi2 = 0.45, directionUpper = FALSE, normalApproximation = TRUE - ) - - ## Comparison of the results of AnalysisResultsGroupSequential object 'x4' with expected results - expect_equal(x4$testActions, c("continue", NA_character_), label = paste0("c(", paste0(x4$testActions, collapse = ", "), ")")) - expect_equal(x4$conditionalRejectionProbabilities, c(0.012395218, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x4$conditionalPower, c(NA_real_, 0.10084143), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalPower, collapse = ", "), ")")) - expect_equal(x4$repeatedConfidenceIntervalLowerBounds, c(-0.26992436, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x4$repeatedConfidenceIntervalUpperBounds, c(0.42527258, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x4$repeatedPValues, c(0.49999905, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedPValues, collapse = ", "), ")")) - expect_equal(x4$finalStage, NA_integer_, label = paste0("c(", paste0(x4$finalStage, collapse = ", "), ")")) - expect_equal(x4$finalPValues, c(NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalPValues, collapse = ", "), ")")) - expect_equal(x4$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x4$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x4$medianUnbiasedEstimates, c(NA_real_, NA_real_), label = paste0("c(", paste0(x4$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x4), NA))) - expect_output(print(x4)$show()) - invisible(capture.output(expect_error(summary(x4), NA))) - expect_output(summary(x4)$show()) - x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) - expect_equal(x4CodeBased$testActions, x4$testActions, tolerance = 1e-07) - expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-07) - expect_equal(x4CodeBased$finalStage, x4$finalStage, tolerance = 1e-07) - expect_equal(x4CodeBased$finalPValues, x4$finalPValues, tolerance = 1e-07) - expect_equal(x4CodeBased$finalConfidenceIntervalLowerBounds, x4$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$finalConfidenceIntervalUpperBounds, x4$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$medianUnbiasedEstimates, x4$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x4), "character") - df <- as.data.frame(x4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getAnalysisResults' with a dataset of rates and without defining a design", { - - .skipTestIfDisabled() - - data <- getDataset( - n1 = c(10), - n2 = c(15), - events1 = c(8), - events2 = c(6) - ) - - # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} - # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} - analysisResults1 <- getAnalysisResults(data, alpha = 0.02) - - ## Comparison of the results of AnalysisResultsInverseNormal object 'analysisResults1' with expected results - expect_equal(analysisResults1$pi1, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(analysisResults1$pi1, collapse = ", "), ")")) - expect_equal(analysisResults1$pi2, 0.4, tolerance = 1e-07, label = paste0("c(", paste0(analysisResults1$pi2, collapse = ", "), ")")) - expect_equal(analysisResults1$testActions, "accept", label = paste0("c(", paste0(analysisResults1$testActions, collapse = ", "), ")")) - expect_equal(analysisResults1$repeatedConfidenceIntervalLowerBounds, -0.016534109, tolerance = 1e-07, label = paste0("c(", paste0(analysisResults1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(analysisResults1$repeatedConfidenceIntervalUpperBounds, 0.68698828, tolerance = 1e-07, label = paste0("c(", paste0(analysisResults1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(analysisResults1$repeatedPValues, 0.024199112, tolerance = 1e-07, label = paste0("c(", paste0(analysisResults1$repeatedPValues, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(analysisResults1), NA))) - expect_output(print(analysisResults1)$show()) - invisible(capture.output(expect_error(summary(analysisResults1), NA))) - expect_output(summary(analysisResults1)$show()) - analysisResults1CodeBased <- eval(parse(text = getObjectRCode(analysisResults1, stringWrapParagraphWidth = NULL))) - expect_equal(analysisResults1CodeBased$pi1, analysisResults1$pi1, tolerance = 1e-07) - expect_equal(analysisResults1CodeBased$pi2, analysisResults1$pi2, tolerance = 1e-07) - expect_equal(analysisResults1CodeBased$testActions, analysisResults1$testActions, tolerance = 1e-07) - expect_equal(analysisResults1CodeBased$repeatedConfidenceIntervalLowerBounds, analysisResults1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(analysisResults1CodeBased$repeatedConfidenceIntervalUpperBounds, analysisResults1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(analysisResults1CodeBased$repeatedPValues, analysisResults1$repeatedPValues, tolerance = 1e-07) - expect_type(names(analysisResults1), "character") - df <- as.data.frame(analysisResults1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(analysisResults1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getAnalysisResults' produces the correct critical values for a boundary recalculation at the last stage", { - - .skipTestIfDisabled() - - data1 <- getDataset( - overallN = c(22, 33, 45), - overallEvents = c(11, 18, 28) - ) - data2 <- getDataset( - overallN = c(22, 33, 40), - overallEvents = c(11, 18, 23) - ) - data3 <- getDataset( - overallN = c(22, 33, 38), - overallEvents = c(11, 18, 21) - ) - design <- getDesignGroupSequential( - typeOfDesign = "asP" - ) - - # @refFS[Formula]{fs:getAnalysisResults:maxInformation} - # @refFS[Formula]{fs:getAnalysisResults:maxInformation:methods} - expect_warning(result1 <- getAnalysisResults(design, data1, - thetaH0 = 0.5, maxInformation = 40 - )) - result2 <- getAnalysisResults(design, data2, - thetaH0 = 0.5, maxInformation = 40 - ) - expect_warning(result3 <- getAnalysisResults(design, data3, - thetaH0 = 0.5, maxInformation = 40, informationEpsilon = 2 - )) - expect_equal(result1$.design$criticalValues[1:2], result2$.design$criticalValues[1:2], tolerance = 1e-07) - expect_equal(result1$.design$criticalValues[1:2], result3$.design$criticalValues[1:2], tolerance = 1e-07) - expect_equal(result2$.design$criticalValues[1:2], result3$.design$criticalValues[1:2], tolerance = 1e-07) -}) - +## | +## | *Unit tests* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | RPACT package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File name: test-f_analysis_base_rates.R +## | Creation date: 08 November 2023, 08:51:06 +## | File version: $Revision$ +## | Last changed: $Date$ +## | Last changed by: $Author$ +## | + +test_plan_section("Testing the Analysis Rates Functionality for One Treatment") + + +test_that("'getAnalysisResults' for a group sequential design and one treatment", { + .skipTestIfDisabled() + + design0 <- getDesignGroupSequential( + kMax = 2, alpha = 0.025, informationRates = c(0.2, 1), + typeOfDesign = "asKD", gammaA = 2.8 + ) + + dataExample0 <- getDataset( + n = c(33), + events = c(23) + ) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateAlternativeSmaller} + # @refFS[Formula]{fs:testStatisticGroupSequential} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + x0 <- getAnalysisResults( + design = design0, dataInput = dataExample0, + thetaH0 = 0.4, normalApproximation = FALSE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsGroupSequential object 'x0' with expected results + expect_equal(x0$pi1, 0.6969697, tolerance = 1e-06, label = paste0("c(", paste0(x0$pi1, collapse = ", "), ")")) + expect_equal(x0$testActions, c("continue", NA_character_), label = paste0("c(", paste0(x0$testActions, collapse = ", "), ")")) + expect_equal(x0$conditionalRejectionProbabilities, c(0.28801679, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(x0$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x0$conditionalPower, c(NA_real_, NA_real_), label = paste0("c(", paste0(x0$conditionalPower, collapse = ", "), ")")) + expect_equal(x0$repeatedConfidenceIntervalLowerBounds, c(0.38475339, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(x0$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x0$repeatedConfidenceIntervalUpperBounds, c(0.91556361, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(x0$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x0$repeatedPValues, c(0.048557231, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(x0$repeatedPValues, collapse = ", "), ")")) + expect_equal(x0$finalStage, NA_integer_, label = paste0("c(", paste0(x0$finalStage, collapse = ", "), ")")) + expect_equal(x0$finalPValues, c(NA_real_, NA_real_), label = paste0("c(", paste0(x0$finalPValues, collapse = ", "), ")")) + expect_equal(x0$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_), label = paste0("c(", paste0(x0$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x0$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_), label = paste0("c(", paste0(x0$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x0$medianUnbiasedEstimates, c(NA_real_, NA_real_), label = paste0("c(", paste0(x0$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x0), NA))) + expect_output(print(x0)$show()) + invisible(capture.output(expect_error(summary(x0), NA))) + expect_output(summary(x0)$show()) + x0CodeBased <- eval(parse(text = getObjectRCode(x0, stringWrapParagraphWidth = NULL))) + expect_equal(x0CodeBased$pi1, x0$pi1, tolerance = 1e-06) + expect_equal(x0CodeBased$testActions, x0$testActions, tolerance = 1e-06) + expect_equal(x0CodeBased$conditionalRejectionProbabilities, x0$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(x0CodeBased$conditionalPower, x0$conditionalPower, tolerance = 1e-06) + expect_equal(x0CodeBased$repeatedConfidenceIntervalLowerBounds, x0$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(x0CodeBased$repeatedConfidenceIntervalUpperBounds, x0$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(x0CodeBased$repeatedPValues, x0$repeatedPValues, tolerance = 1e-06) + expect_equal(x0CodeBased$finalStage, x0$finalStage, tolerance = 1e-06) + expect_equal(x0CodeBased$finalPValues, x0$finalPValues, tolerance = 1e-06) + expect_equal(x0CodeBased$finalConfidenceIntervalLowerBounds, x0$finalConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(x0CodeBased$finalConfidenceIntervalUpperBounds, x0$finalConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(x0CodeBased$medianUnbiasedEstimates, x0$medianUnbiasedEstimates, tolerance = 1e-06) + expect_type(names(x0), "character") + df <- as.data.frame(x0) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x0) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getAnalysisResults' for a four-stage group sequential design and one treatment", { + + .skipTestIfDisabled() + + design1 <- getDesignGroupSequential( + kMax = 4, alpha = 0.025, informationRates = c(0.2, 0.4, 0.8, 1), + futilityBounds = c(-0.5, 0, 0.5), typeOfDesign = "asKD", gammaA = 2.8 + ) + + dataExample1 <- getDataset( + n = c(10, 10, 20, 11), + events = c(4, 5, 5, 6) + ) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateAlternativeSmaller} + # @refFS[Formula]{fs:testStatisticGroupSequential} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + x1 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + stage = 2, thetaH0 = 0.75, normalApproximation = FALSE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsGroupSequential object 'x1' with expected results + expect_equal(x1$pi1, 0.45, tolerance = 1e-07, label = paste0("c(", paste0(x1$pi1, collapse = ", "), ")")) + expect_equal(x1$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x1$testActions, collapse = ", "), ")")) + expect_equal(x1$conditionalRejectionProbabilities, c(0.13502024, 0.39663603, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x1$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower, collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(0.035340833, 0.15564775, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.88809209, 0.77284164, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x1$repeatedPValues, c(0.49999905, 0.056127482, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues, collapse = ", "), ")")) + expect_equal(x1$finalStage, NA_integer_, label = paste0("c(", paste0(x1$finalStage, collapse = ", "), ")")) + expect_equal(x1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalPValues, collapse = ", "), ")")) + expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x1), NA))) + expect_output(print(x1)$show()) + invisible(capture.output(expect_error(summary(x1), NA))) + expect_output(summary(x1)$show()) + x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) + expect_equal(x1CodeBased$pi1, x1$pi1, tolerance = 1e-07) + expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-07) + expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x1), "character") + df <- as.data.frame(x1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeSmaller} + # @refFS[Formula]{fs:testStatisticGroupSequential} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:orderingPValueUpper} + # @refFS[Formula]{fs:finalCIOneRate} + # @refFS[Formula]{fs:medianUnbiasedEstimate} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + x2 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + stage = 3, thetaH0 = 0.75, normalApproximation = TRUE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsGroupSequential object 'x2' with expected results + expect_equal(x2$pi1, 0.35, tolerance = 1e-07, label = paste0("c(", paste0(x2$pi1, collapse = ", "), ")")) + expect_equal(x2$testActions, c("continue", "reject and stop", "reject and stop", NA_character_), label = paste0("c(", paste0(x2$testActions, collapse = ", "), ")")) + expect_equal(x2$conditionalRejectionProbabilities, c(0.21465031, 0.55995383, 1, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x2$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower, collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(0.08898791, 0.19243551, 0.206358, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.81981977, 0.73748168, 0.52720845, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x2$repeatedPValues, c(0.47958473, 0.014066714, 1.9536724e-06, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues, collapse = ", "), ")")) + expect_equal(x2$finalStage, 2, label = paste0("c(", paste0(x2$finalStage, collapse = ", "), ")")) + expect_equal(x2$finalPValues, c(NA_real_, 0.0011783609, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalPValues, collapse = ", "), ")")) + expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, 0.18821106, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, 0.62661997, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, 0.40681825, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x2), NA))) + expect_output(print(x2)$show()) + invisible(capture.output(expect_error(summary(x2), NA))) + expect_output(summary(x2)$show()) + x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) + expect_equal(x2CodeBased$pi1, x2$pi1, tolerance = 1e-07) + expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) + expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-07) + expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-07) + expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x2), "character") + df <- as.data.frame(x2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateAlternativeSmaller} + # @refFS[Formula]{fs:testStatisticGroupSequential} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerOneRateEffect} + x3 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + stage = 2, thetaH0 = 0.75, nPlanned = c(12, 6), pi1 = 0.5, + normalApproximation = FALSE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsGroupSequential object 'x3' with expected results + expect_equal(x3$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x3$testActions, collapse = ", "), ")")) + expect_equal(x3$conditionalRejectionProbabilities, c(0.13502024, 0.39663603, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x3$conditionalPower, c(NA_real_, NA_real_, 0.85193241, 0.94869662), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalPower, collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalLowerBounds, c(0.035340833, 0.15564775, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalUpperBounds, c(0.88809209, 0.77284164, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x3$repeatedPValues, c(0.49999905, 0.056127482, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues, collapse = ", "), ")")) + expect_equal(x3$finalStage, NA_integer_, label = paste0("c(", paste0(x3$finalStage, collapse = ", "), ")")) + expect_equal(x3$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalPValues, collapse = ", "), ")")) + expect_equal(x3$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x3$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x3$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x3), NA))) + expect_output(print(x3)$show()) + invisible(capture.output(expect_error(summary(x3), NA))) + expect_output(summary(x3)$show()) + x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) + expect_equal(x3CodeBased$testActions, x3$testActions, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) + expect_equal(x3CodeBased$finalStage, x3$finalStage, tolerance = 1e-07) + expect_equal(x3CodeBased$finalPValues, x3$finalPValues, tolerance = 1e-07) + expect_equal(x3CodeBased$finalConfidenceIntervalLowerBounds, x3$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$finalConfidenceIntervalUpperBounds, x3$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$medianUnbiasedEstimates, x3$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x3), "character") + df <- as.data.frame(x3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData1 <- testGetAnalysisResultsPlotData(x3, piTreatmentRange = seq(0.45, 0.75, 0.05)) + + ## Comparison of the results of list object 'plotData1' with expected results + expect_equal(plotData1$xValues, c(0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$xValues, collapse = ", "), ")")) + expect_equal(plotData1$condPowerValues, c(0.98024945, 0.94869662, 0.88988709, 0.79611571, 0.66506207, 0.50313626, 0.32784789), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData1$likelihoodValues, c(1, 0.9039239, 0.66761715, 0.40289032, 0.19865977, 0.080038099, 0.026347981), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData1$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData1$main, collapse = ", "), ")")) + expect_equal(plotData1$xlab, "pi1", label = paste0("c(", paste0(plotData1$xlab, collapse = ", "), ")")) + expect_equal(plotData1$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData1$ylab, collapse = ", "), ")")) + expect_equal(plotData1$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData1$sub, collapse = ", "), ")")) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeSmaller} + # @refFS[Formula]{fs:testStatisticGroupSequential} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:orderingPValueUpper} + # @refFS[Formula]{fs:medianUnbiasedEstimate} + # @refFS[Formula]{fs:finalCIOneRate} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerOneRateEffect} + x4 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + stage = 2, thetaH0 = 0.75, nPlanned = c(12, 6), pi1 = 0.5, + normalApproximation = TRUE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsGroupSequential object 'x4' with expected results + expect_equal(x4$testActions, c("continue", "reject and stop", NA_character_, NA_character_), label = paste0("c(", paste0(x4$testActions, collapse = ", "), ")")) + expect_equal(x4$conditionalRejectionProbabilities, c(0.21465031, 0.55995383, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x4$conditionalPower, c(NA_real_, NA_real_, 0.9494174, 0.9843063), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalPower, collapse = ", "), ")")) + expect_equal(x4$repeatedConfidenceIntervalLowerBounds, c(0.08898791, 0.19243551, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x4$repeatedConfidenceIntervalUpperBounds, c(0.81981977, 0.73748168, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x4$repeatedPValues, c(0.47958473, 0.014066714, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedPValues, collapse = ", "), ")")) + expect_equal(x4$finalStage, 2, label = paste0("c(", paste0(x4$finalStage, collapse = ", "), ")")) + expect_equal(x4$finalPValues, c(NA_real_, 0.0011783609, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$finalPValues, collapse = ", "), ")")) + expect_equal(x4$finalConfidenceIntervalLowerBounds, c(NA_real_, 0.18821106, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x4$finalConfidenceIntervalUpperBounds, c(NA_real_, 0.62661997, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x4$medianUnbiasedEstimates, c(NA_real_, 0.40681825, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x4), NA))) + expect_output(print(x4)$show()) + invisible(capture.output(expect_error(summary(x4), NA))) + expect_output(summary(x4)$show()) + x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) + expect_equal(x4CodeBased$testActions, x4$testActions, tolerance = 1e-07) + expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-07) + expect_equal(x4CodeBased$finalStage, x4$finalStage, tolerance = 1e-07) + expect_equal(x4CodeBased$finalPValues, x4$finalPValues, tolerance = 1e-07) + expect_equal(x4CodeBased$finalConfidenceIntervalLowerBounds, x4$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$finalConfidenceIntervalUpperBounds, x4$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$medianUnbiasedEstimates, x4$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x4), "character") + df <- as.data.frame(x4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData2 <- testGetAnalysisResultsPlotData(x4, piTreatmentRange = seq(0.45, 0.75, 0.05)) + + ## Comparison of the results of list object 'plotData2' with expected results + expect_equal(plotData2$xValues, c(0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$xValues, collapse = ", "), ")")) + expect_equal(plotData2$condPowerValues, c(0.99501417, 0.9843063, 0.96005739, 0.91353722, 0.83535366, 0.71802165, 0.55995335), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData2$likelihoodValues, c(1, 0.9039239, 0.66761715, 0.40289032, 0.19865977, 0.080038099, 0.026347981), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData2$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData2$main, collapse = ", "), ")")) + expect_equal(plotData2$xlab, "pi1", label = paste0("c(", paste0(plotData2$xlab, collapse = ", "), ")")) + expect_equal(plotData2$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData2$ylab, collapse = ", "), ")")) + expect_equal(plotData2$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData2$sub, collapse = ", "), ")")) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} + # @refFS[Formula]{fs:testStatisticGroupSequential} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerOneRateEffect} + x5 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + stage = 3, thetaH0 = 0.25, normalApproximation = FALSE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsGroupSequential object 'x5' with expected results + expect_equal(x5$pi1, 0.35, tolerance = 1e-07, label = paste0("c(", paste0(x5$pi1, collapse = ", "), ")")) + expect_equal(x5$testActions, c("continue", "continue", "continue", NA_character_), label = paste0("c(", paste0(x5$testActions, collapse = ", "), ")")) + expect_equal(x5$conditionalRejectionProbabilities, c(0.033369687, 0.13517192, 0.020135528, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x5$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$conditionalPower, collapse = ", "), ")")) + expect_equal(x5$repeatedConfidenceIntervalLowerBounds, c(0.035340833, 0.15564775, 0.18966473, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x5$repeatedConfidenceIntervalUpperBounds, c(0.88809209, 0.77284164, 0.53925561, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x5$repeatedPValues, c(0.49999905, 0.49999905, 0.20027888, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedPValues, collapse = ", "), ")")) + expect_equal(x5$finalStage, NA_integer_, label = paste0("c(", paste0(x5$finalStage, collapse = ", "), ")")) + expect_equal(x5$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$finalPValues, collapse = ", "), ")")) + expect_equal(x5$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x5$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x5$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x5), NA))) + expect_output(print(x5)$show()) + invisible(capture.output(expect_error(summary(x5), NA))) + expect_output(summary(x5)$show()) + x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) + expect_equal(x5CodeBased$pi1, x5$pi1, tolerance = 1e-07) + expect_equal(x5CodeBased$testActions, x5$testActions, tolerance = 1e-07) + expect_equal(x5CodeBased$conditionalRejectionProbabilities, x5$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x5CodeBased$conditionalPower, x5$conditionalPower, tolerance = 1e-07) + expect_equal(x5CodeBased$repeatedConfidenceIntervalLowerBounds, x5$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x5CodeBased$repeatedConfidenceIntervalUpperBounds, x5$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x5CodeBased$repeatedPValues, x5$repeatedPValues, tolerance = 1e-07) + expect_equal(x5CodeBased$finalStage, x5$finalStage, tolerance = 1e-07) + expect_equal(x5CodeBased$finalPValues, x5$finalPValues, tolerance = 1e-07) + expect_equal(x5CodeBased$finalConfidenceIntervalLowerBounds, x5$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x5CodeBased$finalConfidenceIntervalUpperBounds, x5$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x5CodeBased$medianUnbiasedEstimates, x5$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x5), "character") + df <- as.data.frame(x5) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x5) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} + # @refFS[Formula]{fs:testStatisticGroupSequential} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerOneRateEffect} + x6 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + stage = 3, thetaH0 = 0.25, normalApproximation = TRUE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsGroupSequential object 'x6' with expected results + expect_equal(x6$pi1, 0.35, tolerance = 1e-07, label = paste0("c(", paste0(x6$pi1, collapse = ", "), ")")) + expect_equal(x6$testActions, c("continue", "continue", "continue", NA_character_), label = paste0("c(", paste0(x6$testActions, collapse = ", "), ")")) + expect_equal(x6$conditionalRejectionProbabilities, c(0.049321562, 0.20984263, 0.048813267, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x6$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$conditionalPower, collapse = ", "), ")")) + expect_equal(x6$repeatedConfidenceIntervalLowerBounds, c(0.08898791, 0.19243551, 0.206358, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x6$repeatedConfidenceIntervalUpperBounds, c(0.81981977, 0.73748168, 0.52720845, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x6$repeatedPValues, c(0.49999905, 0.27035282, 0.14086509, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedPValues, collapse = ", "), ")")) + expect_equal(x6$finalStage, NA_integer_, label = paste0("c(", paste0(x6$finalStage, collapse = ", "), ")")) + expect_equal(x6$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$finalPValues, collapse = ", "), ")")) + expect_equal(x6$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x6$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x6$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x6), NA))) + expect_output(print(x6)$show()) + invisible(capture.output(expect_error(summary(x6), NA))) + expect_output(summary(x6)$show()) + x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) + expect_equal(x6CodeBased$pi1, x6$pi1, tolerance = 1e-07) + expect_equal(x6CodeBased$testActions, x6$testActions, tolerance = 1e-07) + expect_equal(x6CodeBased$conditionalRejectionProbabilities, x6$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x6CodeBased$conditionalPower, x6$conditionalPower, tolerance = 1e-07) + expect_equal(x6CodeBased$repeatedConfidenceIntervalLowerBounds, x6$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x6CodeBased$repeatedConfidenceIntervalUpperBounds, x6$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x6CodeBased$repeatedPValues, x6$repeatedPValues, tolerance = 1e-07) + expect_equal(x6CodeBased$finalStage, x6$finalStage, tolerance = 1e-07) + expect_equal(x6CodeBased$finalPValues, x6$finalPValues, tolerance = 1e-07) + expect_equal(x6CodeBased$finalConfidenceIntervalLowerBounds, x6$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x6CodeBased$finalConfidenceIntervalUpperBounds, x6$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x6CodeBased$medianUnbiasedEstimates, x6$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x6), "character") + df <- as.data.frame(x6) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x6) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} + # @refFS[Formula]{fs:testStatisticGroupSequential} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerOneRateEffect} + x7 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + stage = 2, thetaH0 = 0.25, nPlanned = c(12, 6), pi1 = 0.5, + normalApproximation = FALSE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsGroupSequential object 'x7' with expected results + expect_equal(x7$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x7$testActions, collapse = ", "), ")")) + expect_equal(x7$conditionalRejectionProbabilities, c(0.033369687, 0.13517192, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x7$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x7$conditionalPower, c(NA_real_, NA_real_, 0.58576815, 0.82581584), tolerance = 1e-07, label = paste0("c(", paste0(x7$conditionalPower, collapse = ", "), ")")) + expect_equal(x7$repeatedConfidenceIntervalLowerBounds, c(0.035340833, 0.15564775, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x7$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x7$repeatedConfidenceIntervalUpperBounds, c(0.88809209, 0.77284164, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x7$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x7$repeatedPValues, c(0.49999905, 0.49999905, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x7$repeatedPValues, collapse = ", "), ")")) + expect_equal(x7$finalStage, NA_integer_, label = paste0("c(", paste0(x7$finalStage, collapse = ", "), ")")) + expect_equal(x7$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$finalPValues, collapse = ", "), ")")) + expect_equal(x7$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x7$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x7$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x7), NA))) + expect_output(print(x7)$show()) + invisible(capture.output(expect_error(summary(x7), NA))) + expect_output(summary(x7)$show()) + x7CodeBased <- eval(parse(text = getObjectRCode(x7, stringWrapParagraphWidth = NULL))) + expect_equal(x7CodeBased$testActions, x7$testActions, tolerance = 1e-07) + expect_equal(x7CodeBased$conditionalRejectionProbabilities, x7$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x7CodeBased$conditionalPower, x7$conditionalPower, tolerance = 1e-07) + expect_equal(x7CodeBased$repeatedConfidenceIntervalLowerBounds, x7$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x7CodeBased$repeatedConfidenceIntervalUpperBounds, x7$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x7CodeBased$repeatedPValues, x7$repeatedPValues, tolerance = 1e-07) + expect_equal(x7CodeBased$finalStage, x7$finalStage, tolerance = 1e-07) + expect_equal(x7CodeBased$finalPValues, x7$finalPValues, tolerance = 1e-07) + expect_equal(x7CodeBased$finalConfidenceIntervalLowerBounds, x7$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x7CodeBased$finalConfidenceIntervalUpperBounds, x7$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x7CodeBased$medianUnbiasedEstimates, x7$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x7), "character") + df <- as.data.frame(x7) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x7) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData3 <- testGetAnalysisResultsPlotData(x7, piTreatmentRange = seq(0.25, 0.55, 0.05)) + + ## Comparison of the results of list object 'plotData3' with expected results + expect_equal(plotData3$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55), tolerance = 1e-07, label = paste0("c(", paste0(plotData3$xValues, collapse = ", "), ")")) + expect_equal(plotData3$condPowerValues, c(0.099723848, 0.21903134, 0.37478113, 0.54310492, 0.6994843, 0.82581584, 0.91388884), tolerance = 1e-07, label = paste0("c(", paste0(plotData3$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData3$likelihoodValues, c(0.19865977, 0.40289032, 0.66761715, 0.9039239, 1, 0.9039239, 0.66761715), tolerance = 1e-07, label = paste0("c(", paste0(plotData3$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData3$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData3$main, collapse = ", "), ")")) + expect_equal(plotData3$xlab, "pi1", label = paste0("c(", paste0(plotData3$xlab, collapse = ", "), ")")) + expect_equal(plotData3$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData3$ylab, collapse = ", "), ")")) + expect_equal(plotData3$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData3$sub, collapse = ", "), ")")) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} + # @refFS[Formula]{fs:testStatisticGroupSequential} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerOneRateEffect} + x8 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + stage = 2, thetaH0 = 0.25, nPlanned = c(12, 6), pi1 = 0.5, + normalApproximation = TRUE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsGroupSequential object 'x8' with expected results + expect_equal(x8$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x8$testActions, collapse = ", "), ")")) + expect_equal(x8$conditionalRejectionProbabilities, c(0.049321562, 0.20984263, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x8$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x8$conditionalPower, c(NA_real_, NA_real_, 0.76152324, 0.91259792), tolerance = 1e-07, label = paste0("c(", paste0(x8$conditionalPower, collapse = ", "), ")")) + expect_equal(x8$repeatedConfidenceIntervalLowerBounds, c(0.08898791, 0.19243551, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x8$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x8$repeatedConfidenceIntervalUpperBounds, c(0.81981977, 0.73748168, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x8$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x8$repeatedPValues, c(0.49999905, 0.27035282, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x8$repeatedPValues, collapse = ", "), ")")) + expect_equal(x8$finalStage, NA_integer_, label = paste0("c(", paste0(x8$finalStage, collapse = ", "), ")")) + expect_equal(x8$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$finalPValues, collapse = ", "), ")")) + expect_equal(x8$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x8$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x8$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x8), NA))) + expect_output(print(x8)$show()) + invisible(capture.output(expect_error(summary(x8), NA))) + expect_output(summary(x8)$show()) + x8CodeBased <- eval(parse(text = getObjectRCode(x8, stringWrapParagraphWidth = NULL))) + expect_equal(x8CodeBased$testActions, x8$testActions, tolerance = 1e-07) + expect_equal(x8CodeBased$conditionalRejectionProbabilities, x8$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x8CodeBased$conditionalPower, x8$conditionalPower, tolerance = 1e-07) + expect_equal(x8CodeBased$repeatedConfidenceIntervalLowerBounds, x8$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x8CodeBased$repeatedConfidenceIntervalUpperBounds, x8$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x8CodeBased$repeatedPValues, x8$repeatedPValues, tolerance = 1e-07) + expect_equal(x8CodeBased$finalStage, x8$finalStage, tolerance = 1e-07) + expect_equal(x8CodeBased$finalPValues, x8$finalPValues, tolerance = 1e-07) + expect_equal(x8CodeBased$finalConfidenceIntervalLowerBounds, x8$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x8CodeBased$finalConfidenceIntervalUpperBounds, x8$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x8CodeBased$medianUnbiasedEstimates, x8$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x8), "character") + df <- as.data.frame(x8) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x8) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData4 <- testGetAnalysisResultsPlotData(x8, piTreatmentRange = seq(0.25, 0.55, 0.05)) + + ## Comparison of the results of list object 'plotData4' with expected results + expect_equal(plotData4$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$xValues, collapse = ", "), ")")) + expect_equal(plotData4$condPowerValues, c(0.20983879, 0.3743042, 0.5481143, 0.70471917, 0.82789376, 0.91259792, 0.96272982), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData4$likelihoodValues, c(0.19865977, 0.40289032, 0.66761715, 0.9039239, 1, 0.9039239, 0.66761715), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData4$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData4$main, collapse = ", "), ")")) + expect_equal(plotData4$xlab, "pi1", label = paste0("c(", paste0(plotData4$xlab, collapse = ", "), ")")) + expect_equal(plotData4$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData4$ylab, collapse = ", "), ")")) + expect_equal(plotData4$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData4$sub, collapse = ", "), ")")) + +}) + +test_that("'getAnalysisResults' for a four-stage inverse sequential design and one treatment", { + + .skipTestIfDisabled() + + design2 <- getDesignInverseNormal( + kMax = 4, alpha = 0.025, informationRates = c(0.2, 0.4, 0.8, 1), + futilityBounds = c(-0.5, 0, 0.5), typeOfDesign = "asKD", gammaA = 2.8 + ) + + dataExample2 <- getDataset( + n = c(8, 10, 9, 11), # cumsum, overall n = (8, 18, 27, 38) + events = c(4, 5, 5, 6) # cumsum, overall events = (4, 9, 14, 20) + ) + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} + # @refFS[Formula]{fs:testStatisticNormalCombinationTest} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + + x1 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + stage = 3, thetaH0 = 0.75, normalApproximation = FALSE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsInverseNormal object 'x1' with expected results + expect_equal(x1$pi1, 0.51851852, tolerance = 1e-07, label = paste0("c(", paste0(x1$pi1, collapse = ", "), ")")) + expect_equal(x1$testActions, c("continue", "continue", "continue", NA_character_), label = paste0("c(", paste0(x1$testActions, collapse = ", "), ")")) + expect_equal(x1$conditionalRejectionProbabilities, c(0.055828725, 0.15918316, 0.28098687, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x1$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower, collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(0.046266926, 0.16132369, 0.26858957, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.95373307, 0.83867631, 0.76870127, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x1$repeatedPValues, c(0.49999905, 0.43799317, 0.045574143, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues, collapse = ", "), ")")) + expect_equal(x1$finalStage, NA_integer_, label = paste0("c(", paste0(x1$finalStage, collapse = ", "), ")")) + expect_equal(x1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalPValues, collapse = ", "), ")")) + expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x1), NA))) + expect_output(print(x1)$show()) + invisible(capture.output(expect_error(summary(x1), NA))) + expect_output(summary(x1)$show()) + x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) + expect_equal(x1CodeBased$pi1, x1$pi1, tolerance = 1e-07) + expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-07) + expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x1), "character") + df <- as.data.frame(x1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + .skipTestIfDisabled() + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} + # @refFS[Formula]{fs:testStatisticNormalCombinationTest} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:orderingPValueUpper} + # @refFS[Formula]{fs:finalCIOneRate} + # @refFS[Formula]{fs:medianUnbiasedEstimate} + x2 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + stage = 3, thetaH0 = 0.75, normalApproximation = TRUE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsInverseNormal object 'x2' with expected results + expect_equal(x2$pi1, 0.51851852, tolerance = 1e-07, label = paste0("c(", paste0(x2$pi1, collapse = ", "), ")")) + expect_equal(x2$testActions, c("continue", "continue", "reject and stop", NA_character_), label = paste0("c(", paste0(x2$testActions, collapse = ", "), ")")) + expect_equal(x2$conditionalRejectionProbabilities, c(0.08807963, 0.32350578, 0.78413539, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x2$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower, collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(0.11314487, 0.21610036, 0.31861038, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.88685513, 0.78389964, 0.72001945, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x2$repeatedPValues, c(0.49999905, 0.1020964, 0.0075111702, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues, collapse = ", "), ")")) + expect_equal(x2$finalStage, 3, label = paste0("c(", paste0(x2$finalStage, collapse = ", "), ")")) + expect_equal(x2$finalPValues, c(NA_real_, NA_real_, 0.0050707339, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalPValues, collapse = ", "), ")")) + expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, 0.3041323, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, 0.68870859, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, NA_real_, 0.49547717, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x2), NA))) + expect_output(print(x2)$show()) + invisible(capture.output(expect_error(summary(x2), NA))) + expect_output(summary(x2)$show()) + x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) + expect_equal(x2CodeBased$pi1, x2$pi1, tolerance = 1e-07) + expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) + expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-07) + expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-07) + expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x2), "character") + df <- as.data.frame(x2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} + # @refFS[Formula]{fs:testStatisticNormalCombinationTest} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + x3 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + stage = 2, thetaH0 = 0.75, nPlanned = c(12, 6), pi1 = 0.5, + normalApproximation = FALSE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsInverseNormal object 'x3' with expected results + expect_equal(x3$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x3$testActions, collapse = ", "), ")")) + expect_equal(x3$conditionalRejectionProbabilities, c(0.055828725, 0.15918316, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x3$conditionalPower, c(NA_real_, NA_real_, 0.69921202, 0.88465983), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalPower, collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalLowerBounds, c(0.046266926, 0.16132369, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalUpperBounds, c(0.95373307, 0.83867631, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x3$repeatedPValues, c(0.49999905, 0.43799317, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues, collapse = ", "), ")")) + expect_equal(x3$finalStage, NA_integer_, label = paste0("c(", paste0(x3$finalStage, collapse = ", "), ")")) + expect_equal(x3$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalPValues, collapse = ", "), ")")) + expect_equal(x3$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x3$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x3$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x3), NA))) + expect_output(print(x3)$show()) + invisible(capture.output(expect_error(summary(x3), NA))) + expect_output(summary(x3)$show()) + x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) + expect_equal(x3CodeBased$testActions, x3$testActions, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) + expect_equal(x3CodeBased$finalStage, x3$finalStage, tolerance = 1e-07) + expect_equal(x3CodeBased$finalPValues, x3$finalPValues, tolerance = 1e-07) + expect_equal(x3CodeBased$finalConfidenceIntervalLowerBounds, x3$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$finalConfidenceIntervalUpperBounds, x3$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$medianUnbiasedEstimates, x3$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x3), "character") + df <- as.data.frame(x3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData1 <- testGetAnalysisResultsPlotData(x3, piTreatmentRange = seq(0.45, 0.75, 0.05)) + + ## Comparison of the results of list object 'plotData1' with expected results + expect_equal(plotData1$xValues, c(0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$xValues, collapse = ", "), ")")) + expect_equal(plotData1$condPowerValues, c(0.94793138, 0.88465983, 0.78396384, 0.64581102, 0.48045808, 0.30888817, 0.15917802), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData1$likelihoodValues, c(0.91393119, 1, 0.91393119, 0.69767633, 0.44485807, 0.23692776, 0.10539922), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData1$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData1$main, collapse = ", "), ")")) + expect_equal(plotData1$xlab, "pi1", label = paste0("c(", paste0(plotData1$xlab, collapse = ", "), ")")) + expect_equal(plotData1$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData1$ylab, collapse = ", "), ")")) + expect_equal(plotData1$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData1$sub, collapse = ", "), ")")) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} + # @refFS[Formula]{fs:testStatisticNormalCombinationTest} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + x4 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + stage = 2, thetaH0 = 0.75, nPlanned = c(12, 6), pi1 = 0.5, + normalApproximation = TRUE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsInverseNormal object 'x4' with expected results + expect_equal(x4$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x4$testActions, collapse = ", "), ")")) + expect_equal(x4$conditionalRejectionProbabilities, c(0.08807963, 0.32350578, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x4$conditionalPower, c(NA_real_, NA_real_, 0.85385983, 0.95015898), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalPower, collapse = ", "), ")")) + expect_equal(x4$repeatedConfidenceIntervalLowerBounds, c(0.11314487, 0.21610036, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x4$repeatedConfidenceIntervalUpperBounds, c(0.88685513, 0.78389964, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x4$repeatedPValues, c(0.49999905, 0.1020964, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedPValues, collapse = ", "), ")")) + expect_equal(x4$finalStage, NA_integer_, label = paste0("c(", paste0(x4$finalStage, collapse = ", "), ")")) + expect_equal(x4$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalPValues, collapse = ", "), ")")) + expect_equal(x4$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x4$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x4$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x4), NA))) + expect_output(print(x4)$show()) + invisible(capture.output(expect_error(summary(x4), NA))) + expect_output(summary(x4)$show()) + x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) + expect_equal(x4CodeBased$testActions, x4$testActions, tolerance = 1e-07) + expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-07) + expect_equal(x4CodeBased$finalStage, x4$finalStage, tolerance = 1e-07) + expect_equal(x4CodeBased$finalPValues, x4$finalPValues, tolerance = 1e-07) + expect_equal(x4CodeBased$finalConfidenceIntervalLowerBounds, x4$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$finalConfidenceIntervalUpperBounds, x4$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$medianUnbiasedEstimates, x4$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x4), "character") + df <- as.data.frame(x4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData2 <- testGetAnalysisResultsPlotData(x4, piTreatmentRange = seq(0.45, 0.75, 0.05)) + + ## Comparison of the results of list object 'plotData2' with expected results + expect_equal(plotData2$xValues, c(0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$xValues, collapse = ", "), ")")) + expect_equal(plotData2$condPowerValues, c(0.98088099, 0.95015898, 0.89232289, 0.79901831, 0.66708346, 0.50248974, 0.32350375), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData2$likelihoodValues, c(0.91393119, 1, 0.91393119, 0.69767633, 0.44485807, 0.23692776, 0.10539922), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData2$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData2$main, collapse = ", "), ")")) + expect_equal(plotData2$xlab, "pi1", label = paste0("c(", paste0(plotData2$xlab, collapse = ", "), ")")) + expect_equal(plotData2$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData2$ylab, collapse = ", "), ")")) + expect_equal(plotData2$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData2$sub, collapse = ", "), ")")) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} + # @refFS[Formula]{fs:testStatisticNormalCombinationTest} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + x5 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + stage = 3, thetaH0 = 0.25, normalApproximation = FALSE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsInverseNormal object 'x5' with expected results + expect_equal(x5$pi1, 0.51851852, tolerance = 1e-07, label = paste0("c(", paste0(x5$pi1, collapse = ", "), ")")) + expect_equal(x5$testActions, c("continue", "continue", "reject and stop", NA_character_), label = paste0("c(", paste0(x5$testActions, collapse = ", "), ")")) + expect_equal(x5$conditionalRejectionProbabilities, c(0.055828725, 0.15918316, 0.65085211, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x5$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$conditionalPower, collapse = ", "), ")")) + expect_equal(x5$repeatedConfidenceIntervalLowerBounds, c(0.046266926, 0.16132369, 0.26858957, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x5$repeatedConfidenceIntervalUpperBounds, c(0.95373307, 0.83867631, 0.76870127, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x5$repeatedPValues, c(0.49999905, 0.43799317, 0.013282796, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedPValues, collapse = ", "), ")")) + expect_equal(x5$finalStage, 3, label = paste0("c(", paste0(x5$finalStage, collapse = ", "), ")")) + expect_equal(x5$finalPValues, c(NA_real_, NA_real_, 0.007752129, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$finalPValues, collapse = ", "), ")")) + expect_equal(x5$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, 0.29554194, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x5$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, 0.67875285, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x5$medianUnbiasedEstimates, c(NA_real_, NA_real_, 0.48769629, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x5), NA))) + expect_output(print(x5)$show()) + invisible(capture.output(expect_error(summary(x5), NA))) + expect_output(summary(x5)$show()) + x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) + expect_equal(x5CodeBased$pi1, x5$pi1, tolerance = 1e-07) + expect_equal(x5CodeBased$testActions, x5$testActions, tolerance = 1e-07) + expect_equal(x5CodeBased$conditionalRejectionProbabilities, x5$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x5CodeBased$conditionalPower, x5$conditionalPower, tolerance = 1e-07) + expect_equal(x5CodeBased$repeatedConfidenceIntervalLowerBounds, x5$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x5CodeBased$repeatedConfidenceIntervalUpperBounds, x5$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x5CodeBased$repeatedPValues, x5$repeatedPValues, tolerance = 1e-07) + expect_equal(x5CodeBased$finalStage, x5$finalStage, tolerance = 1e-07) + expect_equal(x5CodeBased$finalPValues, x5$finalPValues, tolerance = 1e-07) + expect_equal(x5CodeBased$finalConfidenceIntervalLowerBounds, x5$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x5CodeBased$finalConfidenceIntervalUpperBounds, x5$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x5CodeBased$medianUnbiasedEstimates, x5$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x5), "character") + df <- as.data.frame(x5) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x5) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} + # @refFS[Formula]{fs:testStatisticNormalCombinationTest} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + x6 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + stage = 3, thetaH0 = 0.25, normalApproximation = TRUE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsInverseNormal object 'x6' with expected results + expect_equal(x6$pi1, 0.51851852, tolerance = 1e-07, label = paste0("c(", paste0(x6$pi1, collapse = ", "), ")")) + expect_equal(x6$testActions, c("continue", "continue", "reject and stop", NA_character_), label = paste0("c(", paste0(x6$testActions, collapse = ", "), ")")) + expect_equal(x6$conditionalRejectionProbabilities, c(0.08807963, 0.32350578, 0.96959663, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x6$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$conditionalPower, collapse = ", "), ")")) + expect_equal(x6$repeatedConfidenceIntervalLowerBounds, c(0.11314487, 0.21610036, 0.31861038, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x6$repeatedConfidenceIntervalUpperBounds, c(0.88685513, 0.78389964, 0.72001945, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x6$repeatedPValues, c(0.49999905, 0.1020964, 0.0013103922, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedPValues, collapse = ", "), ")")) + expect_equal(x6$finalStage, 3, label = paste0("c(", paste0(x6$finalStage, collapse = ", "), ")")) + expect_equal(x6$finalPValues, c(NA_real_, NA_real_, 0.002378519, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$finalPValues, collapse = ", "), ")")) + expect_equal(x6$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, 0.3437363, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x6$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, 0.73847376, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x6$medianUnbiasedEstimates, c(NA_real_, NA_real_, 0.54446903, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x6), NA))) + expect_output(print(x6)$show()) + invisible(capture.output(expect_error(summary(x6), NA))) + expect_output(summary(x6)$show()) + x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) + expect_equal(x6CodeBased$pi1, x6$pi1, tolerance = 1e-07) + expect_equal(x6CodeBased$testActions, x6$testActions, tolerance = 1e-07) + expect_equal(x6CodeBased$conditionalRejectionProbabilities, x6$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x6CodeBased$conditionalPower, x6$conditionalPower, tolerance = 1e-07) + expect_equal(x6CodeBased$repeatedConfidenceIntervalLowerBounds, x6$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x6CodeBased$repeatedConfidenceIntervalUpperBounds, x6$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x6CodeBased$repeatedPValues, x6$repeatedPValues, tolerance = 1e-07) + expect_equal(x6CodeBased$finalStage, x6$finalStage, tolerance = 1e-07) + expect_equal(x6CodeBased$finalPValues, x6$finalPValues, tolerance = 1e-07) + expect_equal(x6CodeBased$finalConfidenceIntervalLowerBounds, x6$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x6CodeBased$finalConfidenceIntervalUpperBounds, x6$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x6CodeBased$medianUnbiasedEstimates, x6$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x6), "character") + df <- as.data.frame(x6) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x6) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerOneRateEffect} + x7 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + stage = 2, thetaH0 = 0.25, nPlanned = c(12, 6), pi1 = 0.5, + normalApproximation = FALSE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsInverseNormal object 'x7' with expected results + expect_equal(x7$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x7$testActions, collapse = ", "), ")")) + expect_equal(x7$conditionalRejectionProbabilities, c(0.055828725, 0.15918316, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x7$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x7$conditionalPower, c(NA_real_, NA_real_, 0.69921202, 0.88465983), tolerance = 1e-07, label = paste0("c(", paste0(x7$conditionalPower, collapse = ", "), ")")) + expect_equal(x7$repeatedConfidenceIntervalLowerBounds, c(0.046266926, 0.16132369, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x7$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x7$repeatedConfidenceIntervalUpperBounds, c(0.95373307, 0.83867631, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x7$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x7$repeatedPValues, c(0.49999905, 0.43799317, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x7$repeatedPValues, collapse = ", "), ")")) + expect_equal(x7$finalStage, NA_integer_, label = paste0("c(", paste0(x7$finalStage, collapse = ", "), ")")) + expect_equal(x7$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$finalPValues, collapse = ", "), ")")) + expect_equal(x7$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x7$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x7$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x7), NA))) + expect_output(print(x7)$show()) + invisible(capture.output(expect_error(summary(x7), NA))) + expect_output(summary(x7)$show()) + x7CodeBased <- eval(parse(text = getObjectRCode(x7, stringWrapParagraphWidth = NULL))) + expect_equal(x7CodeBased$testActions, x7$testActions, tolerance = 1e-07) + expect_equal(x7CodeBased$conditionalRejectionProbabilities, x7$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x7CodeBased$conditionalPower, x7$conditionalPower, tolerance = 1e-07) + expect_equal(x7CodeBased$repeatedConfidenceIntervalLowerBounds, x7$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x7CodeBased$repeatedConfidenceIntervalUpperBounds, x7$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x7CodeBased$repeatedPValues, x7$repeatedPValues, tolerance = 1e-07) + expect_equal(x7CodeBased$finalStage, x7$finalStage, tolerance = 1e-07) + expect_equal(x7CodeBased$finalPValues, x7$finalPValues, tolerance = 1e-07) + expect_equal(x7CodeBased$finalConfidenceIntervalLowerBounds, x7$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x7CodeBased$finalConfidenceIntervalUpperBounds, x7$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x7CodeBased$medianUnbiasedEstimates, x7$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x7), "character") + df <- as.data.frame(x7) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x7) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData3 <- testGetAnalysisResultsPlotData(x7, piTreatmentRange = seq(0.25, 0.55, 0.05)) + + ## Comparison of the results of list object 'plotData3' with expected results + expect_equal(plotData3$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55), tolerance = 1e-07, label = paste0("c(", paste0(plotData3$xValues, collapse = ", "), ")")) + expect_equal(plotData3$condPowerValues, c(0.15917802, 0.30888817, 0.48045808, 0.64581102, 0.78396384, 0.88465983, 0.94793138), tolerance = 1e-07, label = paste0("c(", paste0(plotData3$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData3$likelihoodValues, c(0.10539922, 0.23692776, 0.44485807, 0.69767633, 0.91393119, 1, 0.91393119), tolerance = 1e-07, label = paste0("c(", paste0(plotData3$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData3$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData3$main, collapse = ", "), ")")) + expect_equal(plotData3$xlab, "pi1", label = paste0("c(", paste0(plotData3$xlab, collapse = ", "), ")")) + expect_equal(plotData3$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData3$ylab, collapse = ", "), ")")) + expect_equal(plotData3$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData3$sub, collapse = ", "), ")")) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerOneRateEffect} + x8 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + stage = 2, thetaH0 = 0.25, nPlanned = c(12, 6), pi1 = 0.5, + normalApproximation = TRUE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsInverseNormal object 'x8' with expected results + expect_equal(x8$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x8$testActions, collapse = ", "), ")")) + expect_equal(x8$conditionalRejectionProbabilities, c(0.08807963, 0.32350578, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x8$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x8$conditionalPower, c(NA_real_, NA_real_, 0.85385983, 0.95015898), tolerance = 1e-07, label = paste0("c(", paste0(x8$conditionalPower, collapse = ", "), ")")) + expect_equal(x8$repeatedConfidenceIntervalLowerBounds, c(0.11314487, 0.21610036, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x8$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x8$repeatedConfidenceIntervalUpperBounds, c(0.88685513, 0.78389964, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x8$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x8$repeatedPValues, c(0.49999905, 0.1020964, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x8$repeatedPValues, collapse = ", "), ")")) + expect_equal(x8$finalStage, NA_integer_, label = paste0("c(", paste0(x8$finalStage, collapse = ", "), ")")) + expect_equal(x8$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$finalPValues, collapse = ", "), ")")) + expect_equal(x8$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x8$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x8$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x8), NA))) + expect_output(print(x8)$show()) + invisible(capture.output(expect_error(summary(x8), NA))) + expect_output(summary(x8)$show()) + x8CodeBased <- eval(parse(text = getObjectRCode(x8, stringWrapParagraphWidth = NULL))) + expect_equal(x8CodeBased$testActions, x8$testActions, tolerance = 1e-07) + expect_equal(x8CodeBased$conditionalRejectionProbabilities, x8$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x8CodeBased$conditionalPower, x8$conditionalPower, tolerance = 1e-07) + expect_equal(x8CodeBased$repeatedConfidenceIntervalLowerBounds, x8$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x8CodeBased$repeatedConfidenceIntervalUpperBounds, x8$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x8CodeBased$repeatedPValues, x8$repeatedPValues, tolerance = 1e-07) + expect_equal(x8CodeBased$finalStage, x8$finalStage, tolerance = 1e-07) + expect_equal(x8CodeBased$finalPValues, x8$finalPValues, tolerance = 1e-07) + expect_equal(x8CodeBased$finalConfidenceIntervalLowerBounds, x8$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x8CodeBased$finalConfidenceIntervalUpperBounds, x8$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x8CodeBased$medianUnbiasedEstimates, x8$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x8), "character") + df <- as.data.frame(x8) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x8) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData4 <- testGetAnalysisResultsPlotData(x8, piTreatmentRange = seq(0.25, 0.55, 0.05)) + + ## Comparison of the results of list object 'plotData4' with expected results + expect_equal(plotData4$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$xValues, collapse = ", "), ")")) + expect_equal(plotData4$condPowerValues, c(0.32350375, 0.50248974, 0.66708346, 0.79901831, 0.89232289, 0.95015898, 0.98088099), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData4$likelihoodValues, c(0.10539922, 0.23692776, 0.44485807, 0.69767633, 0.91393119, 1, 0.91393119), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData4$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData4$main, collapse = ", "), ")")) + expect_equal(plotData4$xlab, "pi1", label = paste0("c(", paste0(plotData4$xlab, collapse = ", "), ")")) + expect_equal(plotData4$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData4$ylab, collapse = ", "), ")")) + expect_equal(plotData4$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData4$sub, collapse = ", "), ")")) + +}) + +test_that("'getAnalysisResults' for a four-stage Fisher design and one treatment", { + + .skipTestIfDisabled() + + design3 <- getDesignFisher(kMax = 4, alpha = 0.025, informationRates = c(0.2, 0.4, 0.8, 1)) + + dataExample3 <- getDataset( + n = c(8, 10, 9, 11), # cumsum, overall n = (8, 18, 27, 38) + events = c(4, 5, 5, 6) # cumsum, overall events = (4, 9, 14, 20) + ) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} + # @refFS[Formula]{fs:testStatisticFisherCombinationTest} + # @refFS[Formula]{fs:definitionRCIFisherCombination} + # @refFS[Formula]{fs:calculationRepeatedpValue} + x1 <- getAnalysisResults( + design = design3, dataInput = dataExample3, + stage = 3, thetaH0 = 0.75, normalApproximation = FALSE, + directionUpper = FALSE, iterations = 1000, seed = 123 + ) + + ## Comparison of the results of AnalysisResultsFisher object 'x1' with expected results + expect_equal(x1$pi1, 0.51851852, tolerance = 1e-07, label = paste0("c(", paste0(x1$pi1, collapse = ", "), ")")) + expect_equal(x1$testActions, c("continue", "continue", "continue", NA_character_), label = paste0("c(", paste0(x1$testActions, collapse = ", "), ")")) + expect_equal(x1$conditionalRejectionProbabilities, c(0.027980027, 0.040164764, 0.018233808, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x1$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower, collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(0.12025548, 0.19023888, 0.23521677, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.87974452, 0.80976112, 0.79971589, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x1$repeatedPValues, c(0.23393398, 0.11483365, 0.11050779, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues, collapse = ", "), ")")) + expect_equal(x1$finalStage, NA_integer_, label = paste0("c(", paste0(x1$finalStage, collapse = ", "), ")")) + expect_equal(x1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalPValues, collapse = ", "), ")")) + expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x1), NA))) + expect_output(print(x1)$show()) + invisible(capture.output(expect_error(summary(x1), NA))) + expect_output(summary(x1)$show()) + x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) + expect_equal(x1CodeBased$pi1, x1$pi1, tolerance = 1e-07) + expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-07) + expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x1), "character") + df <- as.data.frame(x1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} + # @refFS[Formula]{fs:testStatisticFisherCombinationTest} + # @refFS[Formula]{fs:definitionRCIFisherCombination} + # @refFS[Formula]{fs:calculationRepeatedpValue} + x2 <- getAnalysisResults( + design = design3, dataInput = dataExample3, + stage = 3, thetaH0 = 0.75, normalApproximation = TRUE, + directionUpper = FALSE, iterations = 1000, seed = 123 + ) + + ## Comparison of the results of AnalysisResultsFisher object 'x2' with expected results + expect_equal(x2$pi1, 0.51851852, tolerance = 1e-07, label = paste0("c(", paste0(x2$pi1, collapse = ", "), ")")) + expect_equal(x2$testActions, c("continue", "continue", "reject and stop", NA_character_), label = paste0("c(", paste0(x2$testActions, collapse = ", "), ")")) + expect_equal(x2$conditionalRejectionProbabilities, c(0.051264101, 0.1206033, 1, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x2$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower, collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(0.18175814, 0.2424364, 0.28642867, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.81824186, 0.7575636, 0.7496417, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x2$repeatedPValues, c(0.11554509, 0.032131177, 0.024656293, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues, collapse = ", "), ")")) + expect_equal(x2$finalStage, NA_integer_, label = paste0("c(", paste0(x2$finalStage, collapse = ", "), ")")) + expect_equal(x2$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalPValues, collapse = ", "), ")")) + expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x2), NA))) + expect_output(print(x2)$show()) + invisible(capture.output(expect_error(summary(x2), NA))) + expect_output(summary(x2)$show()) + x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) + expect_equal(x2CodeBased$pi1, x2$pi1, tolerance = 1e-07) + expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) + expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-07) + expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-07) + expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x2), "character") + df <- as.data.frame(x2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} + # @refFS[Formula]{fs:testStatisticFisherCombinationTest} + # @refFS[Formula]{fs:definitionRCIFisherCombination} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionFisherInterim} + x3 <- getAnalysisResults( + design = design3, dataInput = dataExample3, + stage = 2, thetaH0 = 0.75, nPlanned = c(12, 6), pi1 = 0.5, normalApproximation = FALSE, + directionUpper = FALSE, iterations = 1000, seed = 123 + ) + + ## Comparison of the results of AnalysisResultsFisher object 'x3' with expected results + expect_equal(x3$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x3$testActions, collapse = ", "), ")")) + expect_equal(x3$conditionalRejectionProbabilities, c(0.027980027, 0.040164764, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalLowerBounds, c(0.12025548, 0.19023888, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalUpperBounds, c(0.87974452, 0.80976112, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x3$repeatedPValues, c(0.23393398, 0.11483365, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues, collapse = ", "), ")")) + expect_equal(x3$finalStage, NA_integer_, label = paste0("c(", paste0(x3$finalStage, collapse = ", "), ")")) + expect_equal(x3$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalPValues, collapse = ", "), ")")) + expect_equal(x3$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x3$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x3$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$medianUnbiasedEstimates, collapse = ", "), ")")) + expect_equal(x3$conditionalPowerSimulated, c(NA_real_, NA_real_, 0.522, 0.672), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalPowerSimulated, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x3), NA))) + expect_output(print(x3)$show()) + invisible(capture.output(expect_error(summary(x3), NA))) + expect_output(summary(x3)$show()) + x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) + expect_equal(x3CodeBased$testActions, x3$testActions, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) + expect_equal(x3CodeBased$finalStage, x3$finalStage, tolerance = 1e-07) + expect_equal(x3CodeBased$finalPValues, x3$finalPValues, tolerance = 1e-07) + expect_equal(x3CodeBased$finalConfidenceIntervalLowerBounds, x3$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$finalConfidenceIntervalUpperBounds, x3$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$medianUnbiasedEstimates, x3$medianUnbiasedEstimates, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalPowerSimulated, x3$conditionalPowerSimulated, tolerance = 1e-07) + expect_type(names(x3), "character") + df <- as.data.frame(x3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData1 <- testGetAnalysisResultsPlotData(x3, piTreatmentRange = seq(0.25, 0.55, 0.05)) + + ## Comparison of the results of list object 'plotData1' with expected results + expect_equal(plotData1$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$xValues, collapse = ", "), ")")) + expect_equal(plotData1$condPowerValues, c(0.997, 0.99, 0.967, 0.9, 0.822, 0.659, 0.534), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData1$likelihoodValues, c(0.10539922, 0.23692776, 0.44485807, 0.69767633, 0.91393119, 1, 0.91393119), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData1$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData1$main, collapse = ", "), ")")) + expect_equal(plotData1$xlab, "pi1", label = paste0("c(", paste0(plotData1$xlab, collapse = ", "), ")")) + expect_equal(plotData1$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData1$ylab, collapse = ", "), ")")) + expect_equal(plotData1$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData1$sub, collapse = ", "), ")")) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} + # @refFS[Formula]{fs:testStatisticFisherCombinationTest} + # @refFS[Formula]{fs:definitionRCIFisherCombination} + # @refFS[Formula]{fs:calculationRepeatedpValue} + x4 <- getAnalysisResults( + design = design3, dataInput = dataExample3, + stage = 3, thetaH0 = 0.25, normalApproximation = FALSE, + directionUpper = TRUE, iterations = 1000, seed = 123 + ) + + ## Comparison of the results of AnalysisResultsFisher object 'x4' with expected results + expect_equal(x4$pi1, 0.51851852, tolerance = 1e-07, label = paste0("c(", paste0(x4$pi1, collapse = ", "), ")")) + expect_equal(x4$testActions, c("continue", "continue", "continue", NA_character_), label = paste0("c(", paste0(x4$testActions, collapse = ", "), ")")) + expect_equal(x4$conditionalRejectionProbabilities, c(0.027980027, 0.040164764, 0.10237226, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x4$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$conditionalPower, collapse = ", "), ")")) + expect_equal(x4$repeatedConfidenceIntervalLowerBounds, c(0.12025548, 0.19023888, 0.23521677, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x4$repeatedConfidenceIntervalUpperBounds, c(0.87974452, 0.80976112, 0.79971589, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x4$repeatedPValues, c(0.23393398, 0.11483365, 0.040061917, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedPValues, collapse = ", "), ")")) + expect_equal(x4$finalStage, NA_integer_, label = paste0("c(", paste0(x4$finalStage, collapse = ", "), ")")) + expect_equal(x4$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalPValues, collapse = ", "), ")")) + expect_equal(x4$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x4$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x4$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x4), NA))) + expect_output(print(x4)$show()) + invisible(capture.output(expect_error(summary(x4), NA))) + expect_output(summary(x4)$show()) + x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) + expect_equal(x4CodeBased$pi1, x4$pi1, tolerance = 1e-07) + expect_equal(x4CodeBased$testActions, x4$testActions, tolerance = 1e-07) + expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-07) + expect_equal(x4CodeBased$finalStage, x4$finalStage, tolerance = 1e-07) + expect_equal(x4CodeBased$finalPValues, x4$finalPValues, tolerance = 1e-07) + expect_equal(x4CodeBased$finalConfidenceIntervalLowerBounds, x4$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$finalConfidenceIntervalUpperBounds, x4$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$medianUnbiasedEstimates, x4$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x4), "character") + df <- as.data.frame(x4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} + # @refFS[Formula]{fs:testStatisticFisherCombinationTest} + # @refFS[Formula]{fs:definitionRCIFisherCombination} + # @refFS[Formula]{fs:calculationRepeatedpValue} + x5 <- getAnalysisResults( + design = design3, dataInput = dataExample3, + stage = 3, thetaH0 = 0.25, normalApproximation = TRUE, + directionUpper = TRUE, iterations = 1000, seed = 123 + ) + + ## Comparison of the results of AnalysisResultsFisher object 'x5' with expected results + expect_equal(x5$pi1, 0.51851852, tolerance = 1e-07, label = paste0("c(", paste0(x5$pi1, collapse = ", "), ")")) + expect_equal(x5$testActions, c("continue", "continue", "reject and stop", NA_character_), label = paste0("c(", paste0(x5$testActions, collapse = ", "), ")")) + expect_equal(x5$conditionalRejectionProbabilities, c(0.051264101, 0.1206033, 1, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x5$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$conditionalPower, collapse = ", "), ")")) + expect_equal(x5$repeatedConfidenceIntervalLowerBounds, c(0.18175814, 0.2424364, 0.28642867, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x5$repeatedConfidenceIntervalUpperBounds, c(0.81824186, 0.7575636, 0.7496417, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x5$repeatedPValues, c(0.11554509, 0.032131177, 0.0055275316, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedPValues, collapse = ", "), ")")) + expect_equal(x5$finalStage, NA_integer_, label = paste0("c(", paste0(x5$finalStage, collapse = ", "), ")")) + expect_equal(x5$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$finalPValues, collapse = ", "), ")")) + expect_equal(x5$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x5$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x5$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x5), NA))) + expect_output(print(x5)$show()) + invisible(capture.output(expect_error(summary(x5), NA))) + expect_output(summary(x5)$show()) + x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) + expect_equal(x5CodeBased$pi1, x5$pi1, tolerance = 1e-07) + expect_equal(x5CodeBased$testActions, x5$testActions, tolerance = 1e-07) + expect_equal(x5CodeBased$conditionalRejectionProbabilities, x5$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x5CodeBased$conditionalPower, x5$conditionalPower, tolerance = 1e-07) + expect_equal(x5CodeBased$repeatedConfidenceIntervalLowerBounds, x5$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x5CodeBased$repeatedConfidenceIntervalUpperBounds, x5$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x5CodeBased$repeatedPValues, x5$repeatedPValues, tolerance = 1e-07) + expect_equal(x5CodeBased$finalStage, x5$finalStage, tolerance = 1e-07) + expect_equal(x5CodeBased$finalPValues, x5$finalPValues, tolerance = 1e-07) + expect_equal(x5CodeBased$finalConfidenceIntervalLowerBounds, x5$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x5CodeBased$finalConfidenceIntervalUpperBounds, x5$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x5CodeBased$medianUnbiasedEstimates, x5$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x5), "character") + df <- as.data.frame(x5) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x5) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} + # @refFS[Formula]{fs:testStatisticFisherCombinationTest} + # @refFS[Formula]{fs:definitionRCIFisherCombination} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionFisherInterim} + x6 <- getAnalysisResults( + design = design3, dataInput = dataExample3, + stage = 2, thetaH0 = 0.25, nPlanned = c(12, 6), pi1 = 0.5, normalApproximation = FALSE, + directionUpper = TRUE, iterations = 1000, seed = 123 + ) + + ## Comparison of the results of AnalysisResultsFisher object 'x6' with expected results + expect_equal(x6$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x6$testActions, collapse = ", "), ")")) + expect_equal(x6$conditionalRejectionProbabilities, c(0.027980027, 0.040164764, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x6$repeatedConfidenceIntervalLowerBounds, c(0.12025548, 0.19023888, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x6$repeatedConfidenceIntervalUpperBounds, c(0.87974452, 0.80976112, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x6$repeatedPValues, c(0.23393398, 0.11483365, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedPValues, collapse = ", "), ")")) + expect_equal(x6$finalStage, NA_integer_, label = paste0("c(", paste0(x6$finalStage, collapse = ", "), ")")) + expect_equal(x6$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$finalPValues, collapse = ", "), ")")) + expect_equal(x6$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x6$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x6$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$medianUnbiasedEstimates, collapse = ", "), ")")) + expect_equal(x6$conditionalPowerSimulated, c(NA_real_, NA_real_, 0.522, 0.672), tolerance = 1e-07, label = paste0("c(", paste0(x6$conditionalPowerSimulated, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x6), NA))) + expect_output(print(x6)$show()) + invisible(capture.output(expect_error(summary(x6), NA))) + expect_output(summary(x6)$show()) + x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) + expect_equal(x6CodeBased$testActions, x6$testActions, tolerance = 1e-07) + expect_equal(x6CodeBased$conditionalRejectionProbabilities, x6$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x6CodeBased$repeatedConfidenceIntervalLowerBounds, x6$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x6CodeBased$repeatedConfidenceIntervalUpperBounds, x6$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x6CodeBased$repeatedPValues, x6$repeatedPValues, tolerance = 1e-07) + expect_equal(x6CodeBased$finalStage, x6$finalStage, tolerance = 1e-07) + expect_equal(x6CodeBased$finalPValues, x6$finalPValues, tolerance = 1e-07) + expect_equal(x6CodeBased$finalConfidenceIntervalLowerBounds, x6$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x6CodeBased$finalConfidenceIntervalUpperBounds, x6$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x6CodeBased$medianUnbiasedEstimates, x6$medianUnbiasedEstimates, tolerance = 1e-07) + expect_equal(x6CodeBased$conditionalPowerSimulated, x6$conditionalPowerSimulated, tolerance = 1e-07) + expect_type(names(x6), "character") + df <- as.data.frame(x6) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x6) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData2 <- testGetAnalysisResultsPlotData(x6, piTreatmentRange = seq(0.25, 0.55, 0.05)) + + ## Comparison of the results of list object 'plotData2' with expected results + expect_equal(plotData2$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$xValues, collapse = ", "), ")")) + expect_equal(plotData2$condPowerValues, c(0.039, 0.114, 0.208, 0.363, 0.54, 0.659, 0.817), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData2$likelihoodValues, c(0.10539922, 0.23692776, 0.44485807, 0.69767633, 0.91393119, 1, 0.91393119), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData2$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData2$main, collapse = ", "), ")")) + expect_equal(plotData2$xlab, "pi1", label = paste0("c(", paste0(plotData2$xlab, collapse = ", "), ")")) + expect_equal(plotData2$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData2$ylab, collapse = ", "), ")")) + expect_equal(plotData2$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData2$sub, collapse = ", "), ")")) + +}) + +test_plan_section("Testing the Analysis Rates Functionality for Two Treatments") + + +test_that("'getAnalysisResults' for a four-stage group sequential design and two treatments", { + .skipTestIfDisabled() + + design7 <- getDesignGroupSequential( + kMax = 4, alpha = 0.025, + typeOfDesign = "WT", deltaWT = 0.25, informationRates = c(0.2, 0.4, 0.8, 1), + futilityBounds = c(0, 0.5, 0.8), bindingFutility = TRUE + ) + + dataExample5 <- getDataset( + n1 = c(17, 18, 22), + n2 = c(18, 17, 19), + events1 = c(11, 12, 17), + events2 = c(5, 10, 7) + ) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} + # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} + # @refFS[Formula]{fs:testStatisticGroupSequential} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} + # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} + x1 <- getAnalysisResults(design7, dataExample5, + thetaH0 = 0, stage = 2, nPlanned = c(60, 30), + pi2 = 0.4, pi1 = 0.8, directionUpper = TRUE, allocationRatioPlanned = 2 + ) + + ## Comparison of the results of AnalysisResultsGroupSequential object 'x1' with expected results + expect_equal(x1$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x1$testActions, collapse = ", "), ")")) + expect_equal(x1$conditionalRejectionProbabilities, c(0.19002543, 0.18837824, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x1$conditionalPower, c(NA_real_, NA_real_, 0.97639752, 0.99770454), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPower, collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(-0.14000084, -0.07626859, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.72492429, 0.4944942, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x1$repeatedPValues, c(0.083297609, 0.074571507, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues, collapse = ", "), ")")) + expect_equal(x1$finalStage, NA_integer_, label = paste0("c(", paste0(x1$finalStage, collapse = ", "), ")")) + expect_equal(x1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalPValues, collapse = ", "), ")")) + expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x1), NA))) + expect_output(print(x1)$show()) + invisible(capture.output(expect_error(summary(x1), NA))) + expect_output(summary(x1)$show()) + x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) + expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-07) + expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x1), "character") + df <- as.data.frame(x1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData1 <- testGetAnalysisResultsPlotData(x1, piTreatmentRange = seq(0.5, 0.8, 0.05), allocationRatioPlanned = 2) + + ## Comparison of the results of list object 'plotData1' with expected results + expect_equal(plotData1$xValues, c(0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$xValues, collapse = ", "), ")")) + expect_equal(plotData1$condPowerValues, c(0.47726473, 0.64780315, 0.79588169, 0.90153211, 0.96202912, 0.98889368, 0.99770454), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData1$likelihoodValues, c(0.14689674, 0.40998118, 0.77598415, 0.99604498, 0.86704618, 0.51184997, 0.20491809), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData1$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData1$main, collapse = ", "), ")")) + expect_equal(plotData1$xlab, "pi1", label = paste0("c(", paste0(plotData1$xlab, collapse = ", "), ")")) + expect_equal(plotData1$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData1$ylab, collapse = ", "), ")")) + expect_equal(plotData1$sub, "Stage = 2, # of remaining subjects = 90, pi2 = 0.4, allocation ratio = 2", label = paste0("c(", paste0(plotData1$sub, collapse = ", "), ")")) + + # reversed "directionUpper" + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} + # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} + # @refFS[Formula]{fs:testStatisticGroupSequential} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} + # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} + + x2 <- getAnalysisResults(design7, dataExample5, + thetaH0 = 0, stage = 2, nPlanned = c(60, 30), + pi2 = 0.8, pi1 = 0.4, directionUpper = FALSE, allocationRatioPlanned = 0.5 + ) + + ## Comparison of the results of AnalysisResultsGroupSequential object 'x2' with expected results + expect_equal(x2$testActions, c("accept and stop", "accept and stop", NA_character_, NA_character_), label = paste0("c(", paste0(x2$testActions, collapse = ", "), ")")) + expect_equal(x2$conditionalRejectionProbabilities, c(0, 0, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x2$conditionalPower, c(NA_real_, NA_real_, 0.037603851, 0.34743098), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalPower, collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(-0.14000084, -0.07626859, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.72492429, 0.4944942, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x2$repeatedPValues, c(0.49999905, 0.49999905, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues, collapse = ", "), ")")) + expect_equal(x2$finalStage, 1, label = paste0("c(", paste0(x2$finalStage, collapse = ", "), ")")) + expect_equal(x2$finalPValues, c(0.98580558, NA_real_, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalPValues, collapse = ", "), ")")) + expect_equal(x2$finalConfidenceIntervalLowerBounds, c(0.039328966, NA_real_, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x2$finalConfidenceIntervalUpperBounds, c(0.62730979, NA_real_, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x2$medianUnbiasedEstimates, c(0.36928105, NA_real_, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x2), NA))) + expect_output(print(x2)$show()) + invisible(capture.output(expect_error(summary(x2), NA))) + expect_output(summary(x2)$show()) + x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) + expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) + expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-07) + expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-07) + expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x2), "character") + df <- as.data.frame(x2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData2 <- testGetAnalysisResultsPlotData(x2, piTreatmentRange = seq(0.2, 0.5, 0.05), allocationRatioPlanned = 0.5) + + ## Comparison of the results of list object 'plotData2' with expected results + expect_equal(plotData2$xValues, c(0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$xValues, collapse = ", "), ")")) + expect_equal(plotData2$condPowerValues, c(0.98964948, 0.93182725, 0.78360503, 0.56553646, 0.34743098, 0.18277547, 0.082851862), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData2$likelihoodValues, c(8.9244677e-08, 2.5604189e-06, 4.9816924e-05, 0.00065732471, 0.0058819346, 0.035694195, 0.14689674), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData2$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData2$main, collapse = ", "), ")")) + expect_equal(plotData2$xlab, "pi1", label = paste0("c(", paste0(plotData2$xlab, collapse = ", "), ")")) + expect_equal(plotData2$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData2$ylab, collapse = ", "), ")")) + expect_equal(plotData2$sub, "Stage = 2, # of remaining subjects = 90, pi2 = 0.8, allocation ratio = 0.5", label = paste0("c(", paste0(plotData2$sub, collapse = ", "), ")")) + +}) + +test_that("'getAnalysisResults' for a four-stage inverse normal design and two treatments", { + + .skipTestIfDisabled() + + design8 <- getDesignInverseNormal( + kMax = 4, alpha = 0.025, + typeOfDesign = "WT", deltaWT = 0.25, informationRates = c(0.2, 0.4, 0.8, 1), + futilityBounds = c(0, 0.5, 0.8), bindingFutility = TRUE + ) + + dataExample6 <- getDataset( + n1 = c(17, 18, 22), + n2 = c(18, 17, 19), + events1 = c(11, 12, 17), + events2 = c(5, 10, 7) + ) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} + # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} + # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} + # @refFS[Formula]{fs:testStatisticNormalCombinationTest} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} + # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} + x1 <- getAnalysisResults(design8, dataExample6, + thetaH0 = 0.0, stage = 2, nPlanned = c(30, 30), + pi2 = 0.2, pi1 = 0.4, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsInverseNormal object 'x1' with expected results + expect_equal(x1$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x1$testActions, collapse = ", "), ")")) + expect_equal(x1$conditionalRejectionProbabilities, c(0.19002543, 0.18093983, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x1$conditionalPower, c(NA_real_, NA_real_, 0.51829859, 0.74637814), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPower, collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(-0.14000084, -0.078581193, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.72492429, 0.48870113, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x1$repeatedPValues, c(0.083297609, 0.077943692, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues, collapse = ", "), ")")) + expect_equal(x1$finalStage, NA_integer_, label = paste0("c(", paste0(x1$finalStage, collapse = ", "), ")")) + expect_equal(x1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalPValues, collapse = ", "), ")")) + expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x1), NA))) + expect_output(print(x1)$show()) + invisible(capture.output(expect_error(summary(x1), NA))) + expect_output(summary(x1)$show()) + x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) + expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-07) + expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x1), "character") + df <- as.data.frame(x1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData1 <- testGetAnalysisResultsPlotData(x1, piTreatmentRange = seq(0.4, 0.7, 0.05), nPlanned = c(30, 30)) + + ## Comparison of the results of list object 'plotData1' with expected results + expect_equal(plotData1$xValues, c(0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$xValues, collapse = ", "), ")")) + expect_equal(plotData1$condPowerValues, c(0.74637814, 0.85191228, 0.92421447, 0.96693166, 0.98816058, 0.99670572, 0.99934119), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData1$likelihoodValues, c(0.0058819346, 0.035694195, 0.14689674, 0.40998118, 0.77598415, 0.99604498, 0.86704618), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData1$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData1$main, collapse = ", "), ")")) + expect_equal(plotData1$xlab, "pi1", label = paste0("c(", paste0(plotData1$xlab, collapse = ", "), ")")) + expect_equal(plotData1$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData1$ylab, collapse = ", "), ")")) + expect_equal(plotData1$sub, "Stage = 2, # of remaining subjects = 60, pi2 = 0.2, allocation ratio = 1", label = paste0("c(", paste0(plotData1$sub, collapse = ", "), ")")) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} + # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} + # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} + # @refFS[Formula]{fs:testStatisticNormalCombinationTest} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} + # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} + x3 <- getAnalysisResults(design8, dataExample6, + thetaH0 = 0, stage = 2, nPlanned = c(60, 30), + pi2 = 0.4, pi1 = 0.8, directionUpper = TRUE, allocationRatioPlanned = 2 + ) + + ## Comparison of the results of AnalysisResultsInverseNormal object 'x3' with expected results + expect_equal(x3$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x3$testActions, collapse = ", "), ")")) + expect_equal(x3$conditionalRejectionProbabilities, c(0.19002543, 0.18093983, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x3$conditionalPower, c(NA_real_, NA_real_, 0.97637134, 0.99770045), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalPower, collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalLowerBounds, c(-0.14000084, -0.078581193, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalUpperBounds, c(0.72492429, 0.48870113, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x3$repeatedPValues, c(0.083297609, 0.077943692, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues, collapse = ", "), ")")) + expect_equal(x3$finalStage, NA_integer_, label = paste0("c(", paste0(x3$finalStage, collapse = ", "), ")")) + expect_equal(x3$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalPValues, collapse = ", "), ")")) + expect_equal(x3$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x3$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x3$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x3), NA))) + expect_output(print(x3)$show()) + invisible(capture.output(expect_error(summary(x3), NA))) + expect_output(summary(x3)$show()) + x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) + expect_equal(x3CodeBased$testActions, x3$testActions, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) + expect_equal(x3CodeBased$finalStage, x3$finalStage, tolerance = 1e-07) + expect_equal(x3CodeBased$finalPValues, x3$finalPValues, tolerance = 1e-07) + expect_equal(x3CodeBased$finalConfidenceIntervalLowerBounds, x3$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$finalConfidenceIntervalUpperBounds, x3$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$medianUnbiasedEstimates, x3$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x3), "character") + df <- as.data.frame(x3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData4 <- testGetAnalysisResultsPlotData(x3, piTreatmentRange = seq(0.5, 0.8, 0.05), allocationRatioPlanned = 2) + + ## Comparison of the results of list object 'plotData4' with expected results + expect_equal(plotData4$xValues, c(0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$xValues, collapse = ", "), ")")) + expect_equal(plotData4$condPowerValues, c(0.4771434, 0.64764919, 0.79574037, 0.90143545, 0.96198044, 0.98887633, 0.99770045), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData4$likelihoodValues, c(0.14689674, 0.40998118, 0.77598415, 0.99604498, 0.86704618, 0.51184997, 0.20491809), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData4$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData4$main, collapse = ", "), ")")) + expect_equal(plotData4$xlab, "pi1", label = paste0("c(", paste0(plotData4$xlab, collapse = ", "), ")")) + expect_equal(plotData4$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData4$ylab, collapse = ", "), ")")) + expect_equal(plotData4$sub, "Stage = 2, # of remaining subjects = 90, pi2 = 0.4, allocation ratio = 2", label = paste0("c(", paste0(plotData4$sub, collapse = ", "), ")")) + + # reversed "directionUpper" + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} + # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} + # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} + # @refFS[Formula]{fs:testStatisticNormalCombinationTest} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} + # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} + x4 <- getAnalysisResults(design8, dataExample6, + thetaH0 = 0, stage = 2, nPlanned = c(60, 30), + pi2 = 0.8, pi1 = 0.4, directionUpper = FALSE, allocationRatioPlanned = 0.5 + ) + + ## Comparison of the results of AnalysisResultsInverseNormal object 'x4' with expected results + expect_equal(x4$testActions, c("accept and stop", "accept and stop", NA_character_, NA_character_), label = paste0("c(", paste0(x4$testActions, collapse = ", "), ")")) + expect_equal(x4$conditionalRejectionProbabilities, c(0, 0, NA_real_, NA_real_), label = paste0("c(", paste0(x4$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x4$conditionalPower, c(NA_real_, NA_real_, 0.037603851, 0.34743098), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalPower, collapse = ", "), ")")) + expect_equal(x4$repeatedConfidenceIntervalLowerBounds, c(-0.14000084, -0.078581193, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x4$repeatedConfidenceIntervalUpperBounds, c(0.72492429, 0.48870113, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x4$repeatedPValues, c(0.49999905, 0.49999905, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedPValues, collapse = ", "), ")")) + expect_equal(x4$finalStage, 1, label = paste0("c(", paste0(x4$finalStage, collapse = ", "), ")")) + expect_equal(x4$finalPValues, c(0.98580558, NA_real_, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$finalPValues, collapse = ", "), ")")) + expect_equal(x4$finalConfidenceIntervalLowerBounds, c(0.039328966, NA_real_, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x4$finalConfidenceIntervalUpperBounds, c(0.62730979, NA_real_, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x4$medianUnbiasedEstimates, c(0.36928105, NA_real_, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x4), NA))) + expect_output(print(x4)$show()) + invisible(capture.output(expect_error(summary(x4), NA))) + expect_output(summary(x4)$show()) + x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) + expect_equal(x4CodeBased$testActions, x4$testActions, tolerance = 1e-07) + expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-07) + expect_equal(x4CodeBased$finalStage, x4$finalStage, tolerance = 1e-07) + expect_equal(x4CodeBased$finalPValues, x4$finalPValues, tolerance = 1e-07) + expect_equal(x4CodeBased$finalConfidenceIntervalLowerBounds, x4$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$finalConfidenceIntervalUpperBounds, x4$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$medianUnbiasedEstimates, x4$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x4), "character") + df <- as.data.frame(x4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData5 <- testGetAnalysisResultsPlotData(x4, piTreatmentRange = seq(0.2, 0.5, 0.05), allocationRatioPlanned = 0.5) + + ## Comparison of the results of list object 'plotData5' with expected results + expect_equal(plotData5$xValues, c(0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5), tolerance = 1e-07, label = paste0("c(", paste0(plotData5$xValues, collapse = ", "), ")")) + expect_equal(plotData5$condPowerValues, c(0.98964948, 0.93182725, 0.78360503, 0.56553646, 0.34743098, 0.18277547, 0.082851862), tolerance = 1e-07, label = paste0("c(", paste0(plotData5$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData5$likelihoodValues, c(8.9244677e-08, 2.5604189e-06, 4.9816924e-05, 0.00065732471, 0.0058819346, 0.035694195, 0.14689674), tolerance = 1e-07, label = paste0("c(", paste0(plotData5$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData5$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData5$main, collapse = ", "), ")")) + expect_equal(plotData5$xlab, "pi1", label = paste0("c(", paste0(plotData5$xlab, collapse = ", "), ")")) + expect_equal(plotData5$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData5$ylab, collapse = ", "), ")")) + expect_equal(plotData5$sub, "Stage = 2, # of remaining subjects = 90, pi2 = 0.8, allocation ratio = 0.5", label = paste0("c(", paste0(plotData5$sub, collapse = ", "), ")")) + +}) + +test_that("'getAnalysisResults' for a four-stage Fisher design and two treatments", { + + .skipTestIfDisabled() + + design9 <- getDesignFisher( + kMax = 4, alpha = 0.025, method = "equalAlpha", + informationRates = c(0.2, 0.4, 0.8, 1) + ) + + dataExample7 <- getDataset( + n1 = c(17, 23, 22), + n2 = c(18, 20, 19), + events1 = c(11, 12, 17), + events2 = c(5, 10, 7) + ) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} + # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} + # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} + # @refFS[Formula]{fs:testStatisticFisherCombinationTest} + # @refFS[Formula]{fs:definitionRCIFisherCombination} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionFisherInterim} + # @refFS[Formula]{fs:conditionalRejectionFisherLastInterim} + # @refFS[Formula]{fs:conditionalRejectionFisherweights} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} + # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} + x1 <- getAnalysisResults(design9, dataExample7, + thetaH0 = 0, stage = 2, nPlanned = c(60, 30), + pi2 = 0.4, pi1 = 0.8, directionUpper = TRUE, allocationRatioPlanned = 2, seed = 123 + ) + + ## Comparison of the results of AnalysisResultsFisher object 'x1' with expected results + expect_equal(x1$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x1$testActions, collapse = ", "), ")")) + expect_equal(x1$conditionalRejectionProbabilities, c(0.13898608, 0.050808351, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(-0.023853561, -0.068378457, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.66428984, 0.40418869, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x1$repeatedPValues, c(0.035427069, 0.088523734, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues, collapse = ", "), ")")) + expect_equal(x1$finalStage, NA_integer_, label = paste0("c(", paste0(x1$finalStage, collapse = ", "), ")")) + expect_equal(x1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalPValues, collapse = ", "), ")")) + expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$medianUnbiasedEstimates, collapse = ", "), ")")) + expect_equal(x1$conditionalPowerSimulated, c(NA_real_, NA_real_, 0.925, 0.972), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPowerSimulated, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x1), NA))) + expect_output(print(x1)$show()) + invisible(capture.output(expect_error(summary(x1), NA))) + expect_output(summary(x1)$show()) + x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) + expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-07) + expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalPowerSimulated, x1$conditionalPowerSimulated, tolerance = 1e-07) + expect_type(names(x1), "character") + df <- as.data.frame(x1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData1 <- testGetAnalysisResultsPlotData(x1, piTreatmentRange = seq(0.5, 0.8, 0.05), allocationRatioPlanned = 2) + + ## Comparison of the results of list object 'plotData1' with expected results + expect_equal(plotData1$xValues, c(0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$xValues, collapse = ", "), ")")) + expect_equal(plotData1$condPowerValues, c(0.199, 0.364, 0.506, 0.686, 0.839, 0.927, 0.979), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData1$likelihoodValues, c(0.63105765, 0.95013529, 0.95013529, 0.63105765, 0.27837883, 0.081561833, 0.015871623), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData1$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData1$main, collapse = ", "), ")")) + expect_equal(plotData1$xlab, "pi1", label = paste0("c(", paste0(plotData1$xlab, collapse = ", "), ")")) + expect_equal(plotData1$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData1$ylab, collapse = ", "), ")")) + expect_equal(plotData1$sub, "Stage = 2, # of remaining subjects = 90, pi2 = 0.4, allocation ratio = 2", label = paste0("c(", paste0(plotData1$sub, collapse = ", "), ")")) + + # reversed "directionUpper" + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} + # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} + # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} + # @refFS[Formula]{fs:testStatisticFisherCombinationTest} + # @refFS[Formula]{fs:definitionRCIFisherCombination} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionFisherInterim} + # @refFS[Formula]{fs:conditionalRejectionFisherLastInterim} + # @refFS[Formula]{fs:conditionalRejectionFisherweights} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} + # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} + + x2 <- getAnalysisResults(design9, dataExample7, + thetaH0 = 0, stage = 2, nPlanned = c(60, 30), + pi2 = 0.8, pi1 = 0.4, directionUpper = FALSE, allocationRatioPlanned = 0.5, seed = 123 + ) + + ## Comparison of the results of AnalysisResultsFisher object 'x2' with expected results + expect_equal(x2$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x2$testActions, collapse = ", "), ")")) + expect_equal(x2$conditionalRejectionProbabilities, c(0.0056634595, 0.0023089469, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(-0.023853561, -0.068378457, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.66428984, 0.40418869, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x2$repeatedPValues, c(0.49999905, 0.49999905, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues, collapse = ", "), ")")) + expect_equal(x2$finalStage, NA_integer_, label = paste0("c(", paste0(x2$finalStage, collapse = ", "), ")")) + expect_equal(x2$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalPValues, collapse = ", "), ")")) + expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$medianUnbiasedEstimates, collapse = ", "), ")")) + expect_equal(x2$conditionalPowerSimulated, c(NA_real_, NA_real_, 0.591, 0.788), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalPowerSimulated, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x2), NA))) + expect_output(print(x2)$show()) + invisible(capture.output(expect_error(summary(x2), NA))) + expect_output(summary(x2)$show()) + x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) + expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) + expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-07) + expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-07) + expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalPowerSimulated, x2$conditionalPowerSimulated, tolerance = 1e-07) + expect_type(names(x2), "character") + df <- as.data.frame(x2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData2 <- testGetAnalysisResultsPlotData(x2, piTreatmentRange = seq(0.2, 0.5, 0.05), allocationRatioPlanned = 0.5) + + ## Comparison of the results of list object 'plotData2' with expected results + expect_equal(plotData2$xValues, c(0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$xValues, collapse = ", "), ")")) + expect_equal(plotData2$condPowerValues, c(0.998, 0.992, 0.967, 0.892, 0.807, 0.623, 0.493), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData2$likelihoodValues, c(1.003982e-05, 0.00017609247, 0.0020513476, 0.015871623, 0.081561833, 0.27837883, 0.63105765), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData2$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData2$main, collapse = ", "), ")")) + expect_equal(plotData2$xlab, "pi1", label = paste0("c(", paste0(plotData2$xlab, collapse = ", "), ")")) + expect_equal(plotData2$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData2$ylab, collapse = ", "), ")")) + expect_equal(plotData2$sub, "Stage = 2, # of remaining subjects = 90, pi2 = 0.8, allocation ratio = 0.5", label = paste0("c(", paste0(plotData2$sub, collapse = ", "), ")")) + +}) + +test_that("'getAnalysisResults' produces the correct exact tests and final CIs", { + + .skipTestIfDisabled() + + dataExample8 <- getDataset( + n2 = c(31, 72), + n1 = c(30, 69), + events2 = c(8, 54), + events1 = c(6, 45) + ) + + design10 <- getDesignGroupSequential( + kMax = 2, alpha = 0.025, + typeOfDesign = "WT", deltaWT = 0.1, informationRates = c(0.3, 1) + ) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} + # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} + # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} + # @refFS[Formula]{fs:testStatisticNormalCombinationTest} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} + # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} + # @refFS[Formula]{fs:orderingPValueUpper} + # @refFS[Formula]{fs:finalCITwoRates} + # @refFS[Formula]{fs:medianUnbiasedEstimate} + x1 <- getAnalysisResults(design10, dataExample8, + thetaH0 = 0, stage = 2, directionUpper = FALSE, + normalApproximation = FALSE + ) + + ## Comparison of the results of AnalysisResultsGroupSequential object 'x1' with expected results + expect_equal(x1$pi1, 0.51515152, tolerance = 1e-07, label = paste0("c(", paste0(x1$pi1, collapse = ", "), ")")) + expect_equal(x1$pi2, 0.60194175, tolerance = 1e-07, label = paste0("c(", paste0(x1$pi2, collapse = ", "), ")")) + expect_equal(x1$testActions, c("continue", "accept"), label = paste0("c(", paste0(x1$testActions, collapse = ", "), ")")) + expect_equal(x1$conditionalRejectionProbabilities, c(0.013966781, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x1$conditionalPower, c(NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower, collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(-0.39509356, -0.22101238), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.29306133, 0.050448655), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x1$repeatedPValues, c(0.49999905, 0.15271161), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues, collapse = ", "), ")")) + expect_equal(x1$finalStage, 2, label = paste0("c(", paste0(x1$finalStage, collapse = ", "), ")")) + expect_equal(x1$finalPValues, c(NA_real_, 0.13570939), tolerance = 1e-07, label = paste0("c(", paste0(x1$finalPValues, collapse = ", "), ")")) + expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, -0.21309581), tolerance = 1e-07, label = paste0("c(", paste0(x1$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, 0.059922132), tolerance = 1e-07, label = paste0("c(", paste0(x1$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, -0.076600295), tolerance = 1e-07, label = paste0("c(", paste0(x1$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x1), NA))) + expect_output(print(x1)$show()) + invisible(capture.output(expect_error(summary(x1), NA))) + expect_output(summary(x1)$show()) + x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) + expect_equal(x1CodeBased$pi1, x1$pi1, tolerance = 1e-07) + expect_equal(x1CodeBased$pi2, x1$pi2, tolerance = 1e-07) + expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-07) + expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x1), "character") + df <- as.data.frame(x1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + design11 <- getDesignInverseNormal( + kMax = 2, alpha = 0.025, + typeOfDesign = "WT", deltaWT = 0.1, informationRates = c(0.3, 1) + ) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} + # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} + # @refFS[Formula]{fs:testStatisticNormalCombinationTest} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} + # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} + x2 <- getAnalysisResults(design11, dataExample8, + thetaH0 = 0, stage = 2, directionUpper = FALSE, + normalApproximation = FALSE + ) + + ## Comparison of the results of AnalysisResultsInverseNormal object 'x2' with expected results + expect_equal(x2$pi1, 0.51515152, tolerance = 1e-07, label = paste0("c(", paste0(x2$pi1, collapse = ", "), ")")) + expect_equal(x2$pi2, 0.60194175, tolerance = 1e-07, label = paste0("c(", paste0(x2$pi2, collapse = ", "), ")")) + expect_equal(x2$testActions, c("continue", "accept"), label = paste0("c(", paste0(x2$testActions, collapse = ", "), ")")) + expect_equal(x2$conditionalRejectionProbabilities, c(0.013966781, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x2$conditionalPower, c(NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower, collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(-0.39509356, -0.20744977), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.29306133, 0.038390636), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x2$repeatedPValues, c(0.49999905, 0.171251), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues, collapse = ", "), ")")) + expect_equal(x2$finalStage, 2, label = paste0("c(", paste0(x2$finalStage, collapse = ", "), ")")) + expect_equal(x2$finalPValues, c(NA_real_, 0.15026298), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalPValues, collapse = ", "), ")")) + expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, -0.20860056), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, 0.064410651), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, -0.072106168), tolerance = 1e-07, label = paste0("c(", paste0(x2$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x2), NA))) + expect_output(print(x2)$show()) + invisible(capture.output(expect_error(summary(x2), NA))) + expect_output(summary(x2)$show()) + x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) + expect_equal(x2CodeBased$pi1, x2$pi1, tolerance = 1e-07) + expect_equal(x2CodeBased$pi2, x2$pi2, tolerance = 1e-07) + expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) + expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-07) + expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-07) + expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x2), "character") + df <- as.data.frame(x2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + design12 <- getDesignFisher( + kMax = 2, alpha = 0.025, method = "fullAlpha", + informationRates = c(0.3, 1) + ) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} + # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} + # @refFS[Formula]{fs:testStatisticFisherCombinationTest} + # @refFS[Formula]{fs:definitionRCIFisherCombination} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionFisherInterim} + # @refFS[Formula]{fs:conditionalRejectionFisherLastInterim} + # @refFS[Formula]{fs:conditionalRejectionFisherweights} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} + # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} + x3 <- getAnalysisResults(design12, dataExample8, + thetaH0 = 0, stage = 2, directionUpper = FALSE, + normalApproximation = FALSE, seed = 123 + ) + + ## Comparison of the results of AnalysisResultsFisher object 'x3' with expected results + expect_equal(x3$pi1, 0.51515152, tolerance = 1e-07, label = paste0("c(", paste0(x3$pi1, collapse = ", "), ")")) + expect_equal(x3$pi2, 0.60194175, tolerance = 1e-07, label = paste0("c(", paste0(x3$pi2, collapse = ", "), ")")) + expect_equal(x3$testActions, c("continue", "accept"), label = paste0("c(", paste0(x3$testActions, collapse = ", "), ")")) + expect_equal(x3$conditionalRejectionProbabilities, c(0.016431334, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x3$conditionalPower, c(NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPower, collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalLowerBounds, c(-0.39357809, -0.2198965), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalUpperBounds, c(0.29140184, 0.047490149), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x3$repeatedPValues, c(0.49999905, 0.18563047), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues, collapse = ", "), ")")) + expect_equal(x3$finalStage, 2, label = paste0("c(", paste0(x3$finalStage, collapse = ", "), ")")) + expect_equal(x3$finalPValues, c(NA_real_, 0.18562957), tolerance = 1e-07, label = paste0("c(", paste0(x3$finalPValues, collapse = ", "), ")")) + expect_equal(x3$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x3$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x3$medianUnbiasedEstimates, c(NA_real_, NA_real_), label = paste0("c(", paste0(x3$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x3), NA))) + expect_output(print(x3)$show()) + invisible(capture.output(expect_error(summary(x3), NA))) + expect_output(summary(x3)$show()) + x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) + expect_equal(x3CodeBased$pi1, x3$pi1, tolerance = 1e-07) + expect_equal(x3CodeBased$pi2, x3$pi2, tolerance = 1e-07) + expect_equal(x3CodeBased$testActions, x3$testActions, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) + expect_equal(x3CodeBased$finalStage, x3$finalStage, tolerance = 1e-07) + expect_equal(x3CodeBased$finalPValues, x3$finalPValues, tolerance = 1e-07) + expect_equal(x3CodeBased$finalConfidenceIntervalLowerBounds, x3$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$finalConfidenceIntervalUpperBounds, x3$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$medianUnbiasedEstimates, x3$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x3), "character") + df <- as.data.frame(x3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getAnalysisResults' produces the correct non-inferiority results for a group sequential design", { + + .skipTestIfDisabled() + + design13 <- getDesignGroupSequential( + kMax = 2, alpha = 0.025, + typeOfDesign = "WT", deltaWT = 0.1, informationRates = c(0.3, 1) + ) + + dataExample9 <- getDataset( + n1 = c(29, 70), + n2 = c(31, 71), + events1 = c(8, 54), + events2 = c(6, 45) + ) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} + # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} + # @refFS[Formula]{fs:testStatisticGroupSequential} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:EstimatesDiffFarringtonManning} + x1 <- getAnalysisResults(design13, dataExample9, + thetaH0 = -0.1, stage = 2, directionUpper = TRUE, + normalApproximation = TRUE + ) + + ## Comparison of the results of AnalysisResultsGroupSequential object 'x1' with expected results + expect_equal(x1$pi1, 0.62626263, tolerance = 1e-07, label = paste0("c(", paste0(x1$pi1, collapse = ", "), ")")) + expect_equal(x1$pi2, 0.5, tolerance = 1e-07, label = paste0("c(", paste0(x1$pi2, collapse = ", "), ")")) + expect_equal(x1$testActions, c("continue", "reject"), label = paste0("c(", paste0(x1$testActions, collapse = ", "), ")")) + expect_equal(x1$conditionalRejectionProbabilities, c(0.1027905, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x1$conditionalPower, c(NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower, collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(-0.26992436, -0.011398056), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.42527258, 0.25916391), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x1$repeatedPValues, c(0.17488831, 0.00058560119), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues, collapse = ", "), ")")) + expect_equal(x1$finalStage, 2, label = paste0("c(", paste0(x1$finalStage, collapse = ", "), ")")) + expect_equal(x1$finalPValues, c(NA_real_, 0.0012732763), tolerance = 1e-07, label = paste0("c(", paste0(x1$finalPValues, collapse = ", "), ")")) + expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, -0.016122347), tolerance = 1e-07, label = paste0("c(", paste0(x1$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, 0.26034096), tolerance = 1e-07, label = paste0("c(", paste0(x1$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, 0.12355576), tolerance = 1e-07, label = paste0("c(", paste0(x1$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x1), NA))) + expect_output(print(x1)$show()) + invisible(capture.output(expect_error(summary(x1), NA))) + expect_output(summary(x1)$show()) + x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) + expect_equal(x1CodeBased$pi1, x1$pi1, tolerance = 1e-07) + expect_equal(x1CodeBased$pi2, x1$pi2, tolerance = 1e-07) + expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-07) + expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x1), "character") + df <- as.data.frame(x1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} + # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} + # @refFS[Formula]{fs:testStatisticGroupSequential} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:EstimatesDiffFarringtonManning} + x2 <- getAnalysisResults(design13, dataExample9, + thetaH0 = -0.1, stage = 1, nPlanned = 40, + pi1 = 0.45, pi2 = 0.4, directionUpper = TRUE, normalApproximation = TRUE + ) + + ## Comparison of the results of AnalysisResultsGroupSequential object 'x2' with expected results + expect_equal(x2$testActions, c("continue", NA_character_), label = paste0("c(", paste0(x2$testActions, collapse = ", "), ")")) + expect_equal(x2$conditionalRejectionProbabilities, c(0.1027905, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x2$conditionalPower, c(NA_real_, 0.38169554), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalPower, collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(-0.26992436, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.42527258, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x2$repeatedPValues, c(0.17488831, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues, collapse = ", "), ")")) + expect_equal(x2$finalStage, NA_integer_, label = paste0("c(", paste0(x2$finalStage, collapse = ", "), ")")) + expect_equal(x2$finalPValues, c(NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalPValues, collapse = ", "), ")")) + expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, NA_real_), label = paste0("c(", paste0(x2$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x2), NA))) + expect_output(print(x2)$show()) + invisible(capture.output(expect_error(summary(x2), NA))) + expect_output(summary(x2)$show()) + x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) + expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) + expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-07) + expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-07) + expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x2), "character") + df <- as.data.frame(x2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData1 <- testGetAnalysisResultsPlotData(x2, piTreatmentRange = seq(0.25, 0.7, 0.05)) + + ## Comparison of the results of list object 'plotData1' with expected results + expect_equal(plotData1$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$xValues, collapse = ", "), ")")) + expect_equal(plotData1$condPowerValues, c(0.053165998, 0.1027905, 0.17500031, 0.26934912, 0.38169554, 0.50456648, 0.62825352, 0.74249459, 0.83846571, 0.91065807), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData1$likelihoodValues, c(0.95261056, 0.95859015, 0.67101367, 0.32674624, 0.11068039, 0.026080239, 0.0042749722, 0.00048745649, 3.866511e-05, 2.1334549e-06), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData1$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData1$main, collapse = ", "), ")")) + expect_equal(plotData1$xlab, "pi1", label = paste0("c(", paste0(plotData1$xlab, collapse = ", "), ")")) + expect_equal(plotData1$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData1$ylab, collapse = ", "), ")")) + expect_equal(plotData1$sub, "Stage = 1, # of remaining subjects = 40, pi2 = 0.4, allocation ratio = 1", label = paste0("c(", paste0(plotData1$sub, collapse = ", "), ")")) + + # non-inferiority, reversed "directionUpper" + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} + # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} + # @refFS[Formula]{fs:testStatisticGroupSequential} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:EstimatesDiffFarringtonManning} + x3 <- getAnalysisResults(design13, dataExample9, + thetaH0 = 0.1, stage = 2, directionUpper = FALSE, + normalApproximation = TRUE + ) + + ## Comparison of the results of AnalysisResultsGroupSequential object 'x3' with expected results + expect_equal(x3$pi1, 0.62626263, tolerance = 1e-07, label = paste0("c(", paste0(x3$pi1, collapse = ", "), ")")) + expect_equal(x3$pi2, 0.5, tolerance = 1e-07, label = paste0("c(", paste0(x3$pi2, collapse = ", "), ")")) + expect_equal(x3$testActions, c("continue", "accept"), label = paste0("c(", paste0(x3$testActions, collapse = ", "), ")")) + expect_equal(x3$conditionalRejectionProbabilities, c(0.012395218, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x3$conditionalPower, c(NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPower, collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalLowerBounds, c(-0.26992436, -0.011398056), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalUpperBounds, c(0.42527258, 0.25916391), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x3$repeatedPValues, c(0.49999905, 0.49999905), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues, collapse = ", "), ")")) + expect_equal(x3$finalStage, 2, label = paste0("c(", paste0(x3$finalStage, collapse = ", "), ")")) + expect_equal(x3$finalPValues, c(NA_real_, 0.64703032), tolerance = 1e-07, label = paste0("c(", paste0(x3$finalPValues, collapse = ", "), ")")) + expect_equal(x3$finalConfidenceIntervalLowerBounds, c(NA_real_, -0.0098227441), tolerance = 1e-07, label = paste0("c(", paste0(x3$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x3$finalConfidenceIntervalUpperBounds, c(NA_real_, 0.26218829), tolerance = 1e-07, label = paste0("c(", paste0(x3$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x3$medianUnbiasedEstimates, c(NA_real_, 0.12618258), tolerance = 1e-07, label = paste0("c(", paste0(x3$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x3), NA))) + expect_output(print(x3)$show()) + invisible(capture.output(expect_error(summary(x3), NA))) + expect_output(summary(x3)$show()) + x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) + expect_equal(x3CodeBased$pi1, x3$pi1, tolerance = 1e-07) + expect_equal(x3CodeBased$pi2, x3$pi2, tolerance = 1e-07) + expect_equal(x3CodeBased$testActions, x3$testActions, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) + expect_equal(x3CodeBased$finalStage, x3$finalStage, tolerance = 1e-07) + expect_equal(x3CodeBased$finalPValues, x3$finalPValues, tolerance = 1e-07) + expect_equal(x3CodeBased$finalConfidenceIntervalLowerBounds, x3$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$finalConfidenceIntervalUpperBounds, x3$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$medianUnbiasedEstimates, x3$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x3), "character") + df <- as.data.frame(x3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} + # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} + # @refFS[Formula]{fs:testStatisticGroupSequential} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:EstimatesDiffFarringtonManning} + x4 <- getAnalysisResults(design13, dataExample9, + thetaH0 = 0.1, stage = 1, nPlanned = 40, + pi1 = 0.4, pi2 = 0.45, directionUpper = FALSE, normalApproximation = TRUE + ) + + ## Comparison of the results of AnalysisResultsGroupSequential object 'x4' with expected results + expect_equal(x4$testActions, c("continue", NA_character_), label = paste0("c(", paste0(x4$testActions, collapse = ", "), ")")) + expect_equal(x4$conditionalRejectionProbabilities, c(0.012395218, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x4$conditionalPower, c(NA_real_, 0.10084143), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalPower, collapse = ", "), ")")) + expect_equal(x4$repeatedConfidenceIntervalLowerBounds, c(-0.26992436, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x4$repeatedConfidenceIntervalUpperBounds, c(0.42527258, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x4$repeatedPValues, c(0.49999905, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedPValues, collapse = ", "), ")")) + expect_equal(x4$finalStage, NA_integer_, label = paste0("c(", paste0(x4$finalStage, collapse = ", "), ")")) + expect_equal(x4$finalPValues, c(NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalPValues, collapse = ", "), ")")) + expect_equal(x4$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x4$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x4$medianUnbiasedEstimates, c(NA_real_, NA_real_), label = paste0("c(", paste0(x4$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x4), NA))) + expect_output(print(x4)$show()) + invisible(capture.output(expect_error(summary(x4), NA))) + expect_output(summary(x4)$show()) + x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) + expect_equal(x4CodeBased$testActions, x4$testActions, tolerance = 1e-07) + expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-07) + expect_equal(x4CodeBased$finalStage, x4$finalStage, tolerance = 1e-07) + expect_equal(x4CodeBased$finalPValues, x4$finalPValues, tolerance = 1e-07) + expect_equal(x4CodeBased$finalConfidenceIntervalLowerBounds, x4$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$finalConfidenceIntervalUpperBounds, x4$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$medianUnbiasedEstimates, x4$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x4), "character") + df <- as.data.frame(x4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getAnalysisResults' with a dataset of rates and without defining a design", { + + .skipTestIfDisabled() + + data <- getDataset( + n1 = c(10), + n2 = c(15), + events1 = c(8), + events2 = c(6) + ) + + # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} + # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} + analysisResults1 <- getAnalysisResults(data, alpha = 0.02) + + ## Comparison of the results of AnalysisResultsInverseNormal object 'analysisResults1' with expected results + expect_equal(analysisResults1$pi1, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(analysisResults1$pi1, collapse = ", "), ")")) + expect_equal(analysisResults1$pi2, 0.4, tolerance = 1e-07, label = paste0("c(", paste0(analysisResults1$pi2, collapse = ", "), ")")) + expect_equal(analysisResults1$testActions, "accept", label = paste0("c(", paste0(analysisResults1$testActions, collapse = ", "), ")")) + expect_equal(analysisResults1$repeatedConfidenceIntervalLowerBounds, -0.016534109, tolerance = 1e-07, label = paste0("c(", paste0(analysisResults1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(analysisResults1$repeatedConfidenceIntervalUpperBounds, 0.68698828, tolerance = 1e-07, label = paste0("c(", paste0(analysisResults1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(analysisResults1$repeatedPValues, 0.024199112, tolerance = 1e-07, label = paste0("c(", paste0(analysisResults1$repeatedPValues, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(analysisResults1), NA))) + expect_output(print(analysisResults1)$show()) + invisible(capture.output(expect_error(summary(analysisResults1), NA))) + expect_output(summary(analysisResults1)$show()) + analysisResults1CodeBased <- eval(parse(text = getObjectRCode(analysisResults1, stringWrapParagraphWidth = NULL))) + expect_equal(analysisResults1CodeBased$pi1, analysisResults1$pi1, tolerance = 1e-07) + expect_equal(analysisResults1CodeBased$pi2, analysisResults1$pi2, tolerance = 1e-07) + expect_equal(analysisResults1CodeBased$testActions, analysisResults1$testActions, tolerance = 1e-07) + expect_equal(analysisResults1CodeBased$repeatedConfidenceIntervalLowerBounds, analysisResults1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(analysisResults1CodeBased$repeatedConfidenceIntervalUpperBounds, analysisResults1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(analysisResults1CodeBased$repeatedPValues, analysisResults1$repeatedPValues, tolerance = 1e-07) + expect_type(names(analysisResults1), "character") + df <- as.data.frame(analysisResults1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(analysisResults1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getAnalysisResults' produces the correct critical values for a boundary recalculation at the last stage", { + + .skipTestIfDisabled() + + data1 <- getDataset( + overallN = c(22, 33, 45), + overallEvents = c(11, 18, 28) + ) + data2 <- getDataset( + overallN = c(22, 33, 40), + overallEvents = c(11, 18, 23) + ) + data3 <- getDataset( + overallN = c(22, 33, 38), + overallEvents = c(11, 18, 21) + ) + design <- getDesignGroupSequential( + typeOfDesign = "asP" + ) + + # @refFS[Formula]{fs:getAnalysisResults:maxInformation} + # @refFS[Formula]{fs:getAnalysisResults:maxInformation:methods} + expect_warning(result1 <- getAnalysisResults(design, data1, + thetaH0 = 0.5, maxInformation = 40 + )) + result2 <- getAnalysisResults(design, data2, + thetaH0 = 0.5, maxInformation = 40 + ) + expect_warning(result3 <- getAnalysisResults(design, data3, + thetaH0 = 0.5, maxInformation = 40, informationEpsilon = 2 + )) + expect_equal(result1$.design$criticalValues[1:2], result2$.design$criticalValues[1:2], tolerance = 1e-07) + expect_equal(result1$.design$criticalValues[1:2], result3$.design$criticalValues[1:2], tolerance = 1e-07) + expect_equal(result2$.design$criticalValues[1:2], result3$.design$criticalValues[1:2], tolerance = 1e-07) + +}) + diff --git a/tests/testthat/test-f_analysis_enrichment_rates.R b/tests/testthat/test-f_analysis_enrichment_rates.R index e55e90bf..489ba7d6 100644 --- a/tests/testthat/test-f_analysis_enrichment_rates.R +++ b/tests/testthat/test-f_analysis_enrichment_rates.R @@ -1,667 +1,668 @@ -## | -## | *Unit tests* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | RPACT package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File name: test-f_analysis_enrichment_rates.R -## | Creation date: 08 November 2023, 08:54:54 -## | File version: $Revision$ -## | Last changed: $Date$ -## | Last changed by: $Author$ -## | - -test_plan_section("Testing Analysis Enrichment Rates Function") - - -test_that("'getAnalysisResults': enrichment rates, one sub-population, non-stratified input, select S1 at second IA, directionUpper = FALSE, gMax = 2", { - .skipTestIfDisabled() - - # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} - # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} - # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} - # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentRates} - # @refFS[Formula]{fs:computeRCIsEnrichment} - # @refFS[Formula]{fs:conditionalPowerEnrichment} - # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} - # @refFS[Formula]{fs:stratifiedTestEnrichmentRates} - # @refFS[Formula]{fs:testStatisticEnrichmentRates} - design1 <- getDesignInverseNormal(kMax = 3, alpha = 0.02, typeOfDesign = "P", informationRates = c(0.4, 0.7, 1)) - - S1 <- getDataset( - sampleSize1 = c(22, 31, 37), - sampleSize2 = c(28, 33, 39), - events1 = c(7, 16, 17), - events2 = c(18, 21, 19) - ) - - F <- getDataset( - sampleSize1 = c(46, 54, NA), - sampleSize2 = c(49, 62, NA), - events1 = c(16, 31, NA), - events2 = c(29, 35, NA) - ) - - dataInput1 <- getDataset(S1 = S1, F = F) - - ## Comparison of the results of DatasetRates object 'dataInput1' with expected results - expect_equal(dataInput1$overallSampleSizes, c(22, 46, 28, 49, 53, 100, 61, 111, 90, NA_real_, 100, NA_real_), label = paste0("c(", paste0(dataInput1$overallSampleSizes, collapse = ", "), ")")) - expect_equal(dataInput1$overallEvents, c(7, 16, 18, 29, 23, 47, 39, 64, 40, NA_real_, 58, NA_real_), label = paste0("c(", paste0(dataInput1$overallEvents, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dataInput1), NA))) - expect_output(print(dataInput1)$show()) - invisible(capture.output(expect_error(summary(dataInput1), NA))) - expect_output(summary(dataInput1)$show()) - dataInput1CodeBased <- eval(parse(text = getObjectRCode(dataInput1, stringWrapParagraphWidth = NULL))) - expect_equal(dataInput1CodeBased$overallSampleSizes, dataInput1$overallSampleSizes, tolerance = 1e-07) - expect_equal(dataInput1CodeBased$overallEvents, dataInput1$overallEvents, tolerance = 1e-07) - expect_type(names(dataInput1), "character") - df <- as.data.frame(dataInput1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dataInput1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x1 <- getAnalysisResults(design1, dataInput1, - stratifiedAnalysis = FALSE, - intersectionTest = "SpiessensDebois", - allocationRatioPlanned = 0.5, - directionUpper = FALSE, - normalApproximation = TRUE, - stage = 2, - nPlanned = c(80) - ) - - ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x1' with expected results - expect_equal(x1$piTreatments[1, ], 0.43396226, tolerance = 1e-07, label = paste0("c(", paste0(x1$piTreatments[1, ], collapse = ", "), ")")) - expect_equal(x1$piTreatments[2, ], 0.47, tolerance = 1e-07, label = paste0("c(", paste0(x1$piTreatments[2, ], collapse = ", "), ")")) - expect_equal(x1$conditionalRejectionProbabilities[1, ], c(0.17935289, 0.13861558, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(x1$conditionalRejectionProbabilities[2, ], c(0.17935289, 0.047432959, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(x1$conditionalPower[1, ], c(NA_real_, NA_real_, 0.74825773), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(x1$conditionalPower[2, ], c(NA_real_, NA_real_, 0.22069678), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.61149604, -0.44933531, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.47492191, -0.29772839, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalUpperBounds[1, ], c(0.040176497, 0.029772743, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalUpperBounds[2, ], c(0.018732449, 0.06513775, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(x1$repeatedPValues[1, ], c(0.031827909, 0.031827909, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(x1$repeatedPValues[2, ], c(0.031827909, 0.031827909, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(x1$piControls[1, ], 0.63934426, tolerance = 1e-07, label = paste0("c(", paste0(x1$piControls[1, ], collapse = ", "), ")")) - expect_equal(x1$piControls[2, ], 0.57657658, tolerance = 1e-07, label = paste0("c(", paste0(x1$piControls[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x1), NA))) - expect_output(print(x1)$show()) - invisible(capture.output(expect_error(summary(x1), NA))) - expect_output(summary(x1)$show()) - x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) - expect_equal(x1CodeBased$piTreatments, x1$piTreatments, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$piControls, x1$piControls, tolerance = 1e-07) - expect_type(names(x1), "character") - df <- as.data.frame(x1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - .skipTestIfDisabled() - - x2 <- getAnalysisResults(design1, dataInput1, - stratifiedAnalysis = FALSE, - intersectionTest = "Bonferroni", - allocationRatioPlanned = 0.5, - directionUpper = FALSE, - normalApproximation = TRUE, - stage = 2, - nPlanned = c(80) - ) - - ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x2' with expected results - expect_equal(x2$piTreatments[1, ], 0.43396226, tolerance = 1e-07, label = paste0("c(", paste0(x2$piTreatments[1, ], collapse = ", "), ")")) - expect_equal(x2$piTreatments[2, ], 0.47, tolerance = 1e-07, label = paste0("c(", paste0(x2$piTreatments[2, ], collapse = ", "), ")")) - expect_equal(x2$conditionalRejectionProbabilities[1, ], c(0.16289564, 0.075460476, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(x2$conditionalRejectionProbabilities[2, ], c(0.16289564, 0.047432959, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(x2$conditionalPower[1, ], c(NA_real_, NA_real_, 0.62405214), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(x2$conditionalPower[2, ], c(NA_real_, NA_real_, 0.22069678), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.61554799, -0.46343398, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.47860086, -0.31516617, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalUpperBounds[1, ], c(0.046721667, 0.044120395, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalUpperBounds[2, ], c(0.02350445, 0.081574104, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(x2$repeatedPValues[1, ], c(0.036684009, 0.036684009, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(x2$repeatedPValues[2, ], c(0.036684009, 0.036684009, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(x2$piControls[1, ], 0.63934426, tolerance = 1e-07, label = paste0("c(", paste0(x2$piControls[1, ], collapse = ", "), ")")) - expect_equal(x2$piControls[2, ], 0.57657658, tolerance = 1e-07, label = paste0("c(", paste0(x2$piControls[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x2), NA))) - expect_output(print(x2)$show()) - invisible(capture.output(expect_error(summary(x2), NA))) - expect_output(summary(x2)$show()) - x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) - expect_equal(x2CodeBased$piTreatments, x2$piTreatments, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) - expect_equal(x2CodeBased$piControls, x2$piControls, tolerance = 1e-07) - expect_type(names(x2), "character") - df <- as.data.frame(x2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getAnalysisResults': enrichment rates, one sub-population, stratified input, select S1 at second IA, directionUpper = FALSE, gMax = 2", { - - .skipTestIfDisabled() - - # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} - # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} - # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} - # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentRates} - # @refFS[Formula]{fs:computeRCIsEnrichment} - # @refFS[Formula]{fs:conditionalPowerEnrichment} - # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} - # @refFS[Formula]{fs:stratifiedTestEnrichmentRates} - # @refFS[Formula]{fs:testStatisticEnrichmentRates} - design1 <- getDesignInverseNormal(kMax = 3, alpha = 0.05, typeOfDesign = "WT", deltaWT = 0.1, informationRates = c(0.4, 0.7, 1)) - - S1 <- getDataset( - sampleSize1 = c(22, 31, 37), - sampleSize2 = c(28, 33, 39), - events1 = c(7, 16, 10), - events2 = c(18, 21, 19) - ) - - R <- getDataset( - sampleSize1 = c(24, 23, NA), - sampleSize2 = c(21, 29, NA), - events1 = c(9, 15, NA), - events2 = c(11, 14, NA) - ) - - dataInput2 <- getDataset(S1 = S1, R = R) - - ## Comparison of the results of DatasetRates object 'dataInput2' with expected results - expect_equal(dataInput2$overallSampleSizes, c(22, 24, 28, 21, 53, 47, 61, 50, 90, NA_real_, 100, NA_real_), label = paste0("c(", paste0(dataInput2$overallSampleSizes, collapse = ", "), ")")) - expect_equal(dataInput2$overallEvents, c(7, 9, 18, 11, 23, 24, 39, 25, 33, NA_real_, 58, NA_real_), label = paste0("c(", paste0(dataInput2$overallEvents, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dataInput2), NA))) - expect_output(print(dataInput2)$show()) - invisible(capture.output(expect_error(summary(dataInput2), NA))) - expect_output(summary(dataInput2)$show()) - dataInput2CodeBased <- eval(parse(text = getObjectRCode(dataInput2, stringWrapParagraphWidth = NULL))) - expect_equal(dataInput2CodeBased$overallSampleSizes, dataInput2$overallSampleSizes, tolerance = 1e-07) - expect_equal(dataInput2CodeBased$overallEvents, dataInput2$overallEvents, tolerance = 1e-07) - expect_type(names(dataInput2), "character") - df <- as.data.frame(dataInput2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dataInput2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x3 <- getAnalysisResults(design1, dataInput2, - stratifiedAnalysis = FALSE, - intersectionTest = "Simes", - directionUpper = FALSE, - normalApproximation = FALSE - ) - - ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x3' with expected results - expect_equal(x3$piTreatments[1, ], 0.36666667, tolerance = 1e-07, label = paste0("c(", paste0(x3$piTreatments[1, ], collapse = ", "), ")")) - expect_equal(x3$piTreatments[2, ], NA_real_, label = paste0("c(", paste0(x3$piTreatments[2, ], collapse = ", "), ")")) - expect_equal(x3$conditionalRejectionProbabilities[1, ], c(0.34476337, 0.21123906, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(x3$conditionalRejectionProbabilities[2, ], c(0.34476337, 0.16889178, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(x3$conditionalPower[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(x3$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.62776669, -0.44175544, -0.38366304), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.4897991, -0.29886557, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalUpperBounds[1, ], c(0.066751342, 0.016446892, -0.050014598), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalUpperBounds[2, ], c(0.038157503, 0.063536395, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(x3$repeatedPValues[1, ], c(0.10653002, 0.10653002, 0.014413851), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(x3$repeatedPValues[2, ], c(0.10653002, 0.10653002, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(x3$piControls[1, ], 0.58, tolerance = 1e-07, label = paste0("c(", paste0(x3$piControls[1, ], collapse = ", "), ")")) - expect_equal(x3$piControls[2, ], NA_real_, label = paste0("c(", paste0(x3$piControls[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x3), NA))) - expect_output(print(x3)$show()) - invisible(capture.output(expect_error(summary(x3), NA))) - expect_output(summary(x3)$show()) - x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) - expect_equal(x3CodeBased$piTreatments, x3$piTreatments, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) - expect_equal(x3CodeBased$piControls, x3$piControls, tolerance = 1e-07) - expect_type(names(x3), "character") - df <- as.data.frame(x3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x4 <- getAnalysisResults(design1, dataInput2, - stratifiedAnalysis = TRUE, - intersectionTest = "Simes", - directionUpper = FALSE, - normalApproximation = TRUE - ) - - ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x4' with expected results - expect_equal(x4$piTreatments[1, ], 0.36666667, tolerance = 1e-07, label = paste0("c(", paste0(x4$piTreatments[1, ], collapse = ", "), ")")) - expect_equal(x4$piTreatments[2, ], NA_real_, label = paste0("c(", paste0(x4$piTreatments[2, ], collapse = ", "), ")")) - expect_equal(x4$conditionalRejectionProbabilities[1, ], c(0.4519333, 0.45336181, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(x4$conditionalRejectionProbabilities[2, ], c(0.4519333, 0.2823056, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(x4$conditionalPower[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(x4$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(x4$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.62776669, -0.44175544, -0.38366304), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(x4$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.48811625, -0.29740945, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(x4$repeatedConfidenceIntervalUpperBounds[1, ], c(0.066751342, 0.016446892, -0.050014598), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(x4$repeatedConfidenceIntervalUpperBounds[2, ], c(0.041874626, 0.06452777, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(x4$repeatedPValues[1, ], c(0.07212343, 0.050354903, 0.0033350387), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(x4$repeatedPValues[2, ], c(0.07212343, 0.065501128, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(x4$piControls[1, ], 0.58, tolerance = 1e-07, label = paste0("c(", paste0(x4$piControls[1, ], collapse = ", "), ")")) - expect_equal(x4$piControls[2, ], NA_real_, label = paste0("c(", paste0(x4$piControls[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x4), NA))) - expect_output(print(x4)$show()) - invisible(capture.output(expect_error(summary(x4), NA))) - expect_output(summary(x4)$show()) - x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) - expect_equal(x4CodeBased$piTreatments, x4$piTreatments, tolerance = 1e-07) - expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-07) - expect_equal(x4CodeBased$piControls, x4$piControls, tolerance = 1e-07) - expect_type(names(x4), "character") - df <- as.data.frame(x4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getAnalysisResults': enrichment rates, more sub-populations, select S1 and S2 at first IA, select S1 at second, directionUpper = TRUE, gMax = 3", { - - .skipTestIfDisabled() - - # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} - # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} - # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} - # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentRates} - # @refFS[Formula]{fs:computeRCIsEnrichment} - # @refFS[Formula]{fs:conditionalPowerEnrichment} - # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} - # @refFS[Formula]{fs:stratifiedTestEnrichmentRates} - # @refFS[Formula]{fs:testStatisticEnrichmentRates} - S1 <- getDataset( - sampleSize1 = c(47, 33, 37), - sampleSize2 = c(48, 47, 39), - events1 = c(18, 13, 17), - events2 = c(12, 11, 9) - ) - - S2 <- getDataset( - sampleSize1 = c(49, NA, NA), - sampleSize2 = c(45, NA, NA), - events1 = c(12, NA, NA), - events2 = c(13, NA, NA) - ) - - S12 <- getDataset( - sampleSize1 = c(35, 42, NA), - sampleSize2 = c(36, 47, NA), - events1 = c(19, 10, NA), - events2 = c(13, 17, NA) - ) - - R <- getDataset( - sampleSize1 = c(43, NA, NA), - sampleSize2 = c(39, NA, NA), - events1 = c(17, NA, NA), - events2 = c(14, NA, NA) - ) - - dataInput3 <- getDataset(S1 = S1, S2 = S2, S12 = S12, R = R) - - ## Comparison of the results of DatasetRates object 'dataInput3' with expected results - expect_equal(dataInput3$overallSampleSizes, c(47, 49, 35, 43, 48, 45, 36, 39, 80, NA_real_, 77, NA_real_, 95, NA_real_, 83, NA_real_, 117, NA_real_, NA_real_, NA_real_, 134, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(dataInput3$overallSampleSizes, collapse = ", "), ")")) - expect_equal(dataInput3$overallEvents, c(18, 12, 19, 17, 12, 13, 13, 14, 31, NA_real_, 29, NA_real_, 23, NA_real_, 30, NA_real_, 48, NA_real_, NA_real_, NA_real_, 32, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(dataInput3$overallEvents, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dataInput3), NA))) - expect_output(print(dataInput3)$show()) - invisible(capture.output(expect_error(summary(dataInput3), NA))) - expect_output(summary(dataInput3)$show()) - dataInput3CodeBased <- eval(parse(text = getObjectRCode(dataInput3, stringWrapParagraphWidth = NULL))) - expect_equal(dataInput3CodeBased$overallSampleSizes, dataInput3$overallSampleSizes, tolerance = 1e-07) - expect_equal(dataInput3CodeBased$overallEvents, dataInput3$overallEvents, tolerance = 1e-07) - expect_type(names(dataInput3), "character") - df <- as.data.frame(dataInput3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dataInput3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - design1 <- getDesignInverseNormal(kMax = 3, alpha = 0.05, typeOfDesign = "WT", deltaWT = 0.1, informationRates = c(0.4, 0.7, 1)) - - x1 <- getAnalysisResults(design1, dataInput3, - directionUpper = TRUE, - stratifiedAnalysis = FALSE, - intersectionTest = "Sidak", - allocationRatioPlanned = 3, - normalApproximation = FALSE, - nPlanned = c(80), - piControls = c(0.2, NA, NA), - piTreatments = c(0.55, NA, NA), - stage = 2 - ) - - ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x1' with expected results - expect_equal(x1$conditionalRejectionProbabilities[1, ], c(0.15297113, 0.049132584, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(x1$conditionalRejectionProbabilities[2, ], c(0.034063149, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(x1$conditionalRejectionProbabilities[3, ], c(0.064895921, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(x1$conditionalPower[1, ], c(NA_real_, NA_real_, 0.89354539), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(x1$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(x1$conditionalPower[3, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.062823383, -0.036086154, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.16425035, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalLowerBounds[3, ], c(-0.078510197, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalUpperBounds[1, ], c(0.35743976, 0.21982839, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalUpperBounds[2, ], c(0.25557989, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalUpperBounds[3, ], c(0.21491638, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(x1$repeatedPValues[1, ], c(0.23298603, 0.23298603, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(x1$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(x1$repeatedPValues[3, ], c(0.389024, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x1), NA))) - expect_output(print(x1)$show()) - invisible(capture.output(expect_error(summary(x1), NA))) - expect_output(summary(x1)$show()) - x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) - expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) - expect_type(names(x1), "character") - df <- as.data.frame(x1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - design2 <- getDesignFisher(kMax = 3, method = "equalAlpha", alpha = 0.05, informationRates = c(0.4, 0.7, 1)) - - x2 <- getAnalysisResults(design2, dataInput3, - directionUpper = TRUE, - stratifiedAnalysis = FALSE, - intersectionTest = "Sidak", - normalApproximation = FALSE, - stage = 3 - ) - - ## Comparison of the results of AnalysisResultsEnrichmentFisher object 'x2' with expected results - expect_equal(x2$piTreatments[1, ], 0.41025641, tolerance = 1e-07, label = paste0("c(", paste0(x2$piTreatments[1, ], collapse = ", "), ")")) - expect_equal(x2$piTreatments[2, ], NA_real_, label = paste0("c(", paste0(x2$piTreatments[2, ], collapse = ", "), ")")) - expect_equal(x2$piTreatments[3, ], NA_real_, label = paste0("c(", paste0(x2$piTreatments[3, ], collapse = ", "), ")")) - expect_equal(x2$conditionalRejectionProbabilities[1, ], c(0.075105953, 0.018243594, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(x2$conditionalRejectionProbabilities[2, ], c(0.020009021, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(x2$conditionalRejectionProbabilities[3, ], c(0.031471245, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(x2$conditionalPower[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(x2$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(x2$conditionalPower[3, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.023654531, -0.034180226, 0.008300518), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.12625532, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalLowerBounds[3, ], c(-0.051634044, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalUpperBounds[1, ], c(0.32239366, 0.19556, 0.21299371), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalUpperBounds[2, ], c(0.21912956, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalUpperBounds[3, ], c(0.1890798, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(x2$repeatedPValues[1, ], c(0.14811777, 0.14811777, 0.07171335), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(x2$repeatedPValues[2, ], c(0.46979052, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(x2$repeatedPValues[3, ], c(0.32146776, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(x2$piControls[1, ], 0.23880597, tolerance = 1e-07, label = paste0("c(", paste0(x2$piControls[1, ], collapse = ", "), ")")) - expect_equal(x2$piControls[2, ], NA_real_, label = paste0("c(", paste0(x2$piControls[2, ], collapse = ", "), ")")) - expect_equal(x2$piControls[3, ], NA_real_, label = paste0("c(", paste0(x2$piControls[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x2), NA))) - expect_output(print(x2)$show()) - invisible(capture.output(expect_error(summary(x2), NA))) - expect_output(summary(x2)$show()) - x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) - expect_equal(x2CodeBased$piTreatments, x2$piTreatments, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) - expect_equal(x2CodeBased$piControls, x2$piControls, tolerance = 1e-07) - expect_type(names(x2), "character") - df <- as.data.frame(x2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getAnalysisResults': enrichment rates, more sub-populations, non-stratified input, select S1 and S2 at first IA, select S1 at second, directionUpper = FALSE, gMax = 4", { - - .skipTestIfDisabled() - - # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} - # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} - # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} - # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentRates} - # @refFS[Formula]{fs:computeRCIsEnrichment} - # @refFS[Formula]{fs:conditionalPowerEnrichment} - # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} - # @refFS[Formula]{fs:stratifiedTestEnrichmentRates} - # @refFS[Formula]{fs:testStatisticEnrichmentRates} - S1 <- getDataset( - sampleSize1 = c(84, 94, 25), - sampleSize2 = c(82, 75, 23), - events1 = c(21, 28, 13), - events2 = c(32, 23, 20) - ) - - S2 <- getDataset( - sampleSize1 = c(81, 95, NA), - sampleSize2 = c(84, 64, NA), - events1 = c(26, 29, NA), - events2 = c(31, 26, NA) - ) - - S3 <- getDataset( - sampleSize1 = c(71, NA, NA), - sampleSize2 = c(74, NA, NA), - events1 = c(16, NA, NA), - events2 = c(21, NA, NA) - ) - - F <- getDataset( - sampleSize1 = c(248, NA, NA), - sampleSize2 = c(254, NA, NA), - events1 = c(75, NA, NA), - events2 = c(98, NA, NA) - ) - - R <- getDataset( - sampleSize1 = c(12, NA, NA), - sampleSize2 = c(14, NA, NA), - events1 = c(12, NA, NA), - events2 = c(14, NA, NA) - ) - - dataInput4 <- getDataset(S1 = S1, S2 = S2, S3 = S3, F = F) - - ## Comparison of the results of DatasetRates object 'dataInput4' with expected results - expect_equal(dataInput4$overallSampleSizes, c(84, 81, 71, 248, 82, 84, 74, 254, 178, 176, NA_real_, NA_real_, 157, 148, NA_real_, NA_real_, 203, NA_real_, NA_real_, NA_real_, 180, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(dataInput4$overallSampleSizes, collapse = ", "), ")")) - expect_equal(dataInput4$overallEvents, c(21, 26, 16, 75, 32, 31, 21, 98, 49, 55, NA_real_, NA_real_, 55, 57, NA_real_, NA_real_, 62, NA_real_, NA_real_, NA_real_, 75, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(dataInput4$overallEvents, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dataInput4), NA))) - expect_output(print(dataInput4)$show()) - invisible(capture.output(expect_error(summary(dataInput4), NA))) - expect_output(summary(dataInput4)$show()) - dataInput4CodeBased <- eval(parse(text = getObjectRCode(dataInput4, stringWrapParagraphWidth = NULL))) - expect_equal(dataInput4CodeBased$overallSampleSizes, dataInput4$overallSampleSizes, tolerance = 1e-07) - expect_equal(dataInput4CodeBased$overallEvents, dataInput4$overallEvents, tolerance = 1e-07) - expect_type(names(dataInput4), "character") - df <- as.data.frame(dataInput4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dataInput4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - design1 <- getDesignInverseNormal(kMax = 3, alpha = 0.05, typeOfDesign = "asKD", gammaA = 2, informationRates = c(0.4, 0.7, 1)) - - x3 <- getAnalysisResults(design1, dataInput4, - directionUpper = FALSE, - stratifiedAnalysis = FALSE, - intersectionTest = "Sidak", - allocationRatioPlanned = 1, - stage = 3, - normalApproximation = TRUE - ) - - ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x3' with expected results - expect_equal(x3$piTreatments[1, ], 0.30541872, tolerance = 1e-07, label = paste0("c(", paste0(x3$piTreatments[1, ], collapse = ", "), ")")) - expect_equal(x3$piTreatments[2, ], NA_real_, label = paste0("c(", paste0(x3$piTreatments[2, ], collapse = ", "), ")")) - expect_equal(x3$piTreatments[3, ], NA_real_, label = paste0("c(", paste0(x3$piTreatments[3, ], collapse = ", "), ")")) - expect_equal(x3$piTreatments[4, ], NA_real_, label = paste0("c(", paste0(x3$piTreatments[4, ], collapse = ", "), ")")) - expect_equal(x3$conditionalRejectionProbabilities[1, ], c(0.13745997, 0.082835151, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(x3$conditionalRejectionProbabilities[2, ], c(0.023915975, 0.064596491, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(x3$conditionalRejectionProbabilities[3, ], c(0.023915975, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(x3$conditionalRejectionProbabilities[4, ], c(0.13745997, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities[4, ], collapse = ", "), ")")) - expect_equal(x3$conditionalPower[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(x3$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(x3$conditionalPower[3, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(x3$conditionalPower[4, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPower[4, ], collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.33926099, -0.22469062, -0.248011), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.255132, -0.21555052, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalLowerBounds[3, ], c(-0.26390722, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalLowerBounds[4, ], c(-0.20314825, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds[4, ], collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalUpperBounds[1, ], c(0.068268149, 0.059220127, -0.0081515662), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalUpperBounds[2, ], c(0.16378176, 0.07555087, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalUpperBounds[3, ], c(0.15232186, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalUpperBounds[4, ], c(0.038730826, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds[4, ], collapse = ", "), ")")) - expect_equal(x3$repeatedPValues[1, ], c(0.5, 0.26483774, 0.01063254), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(x3$repeatedPValues[2, ], c(0.5, 0.30264322, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(x3$repeatedPValues[3, ], c(0.5, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(x3$repeatedPValues[4, ], c(0.5, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues[4, ], collapse = ", "), ")")) - expect_equal(x3$piControls[1, ], 0.41666667, tolerance = 1e-07, label = paste0("c(", paste0(x3$piControls[1, ], collapse = ", "), ")")) - expect_equal(x3$piControls[2, ], NA_real_, label = paste0("c(", paste0(x3$piControls[2, ], collapse = ", "), ")")) - expect_equal(x3$piControls[3, ], NA_real_, label = paste0("c(", paste0(x3$piControls[3, ], collapse = ", "), ")")) - expect_equal(x3$piControls[4, ], NA_real_, label = paste0("c(", paste0(x3$piControls[4, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x3), NA))) - expect_output(print(x3)$show()) - invisible(capture.output(expect_error(summary(x3), NA))) - expect_output(summary(x3)$show()) - x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) - expect_equal(x3CodeBased$piTreatments, x3$piTreatments, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) - expect_equal(x3CodeBased$piControls, x3$piControls, tolerance = 1e-07) - expect_type(names(x3), "character") - df <- as.data.frame(x3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getAnalysisResults': enrichment rates, expected warning for empty subsets", { - - .skipTestIfDisabled() - - S1 <- getDataset( - sampleSize1 = c(84, 94, 25), - sampleSize2 = c(82, 75, 23), - events1 = c(21, 28, 13), - events2 = c(32, 23, 20) - ) - - S2 <- getDataset( - sampleSize1 = c(81, 95, NA), - sampleSize2 = c(84, 64, NA), - events1 = c(26, 29, NA), - events2 = c(31, 26, NA) - ) - - S3 <- getDataset( - sampleSize1 = c(71, NA, NA), - sampleSize2 = c(74, NA, NA), - events1 = c(16, NA, NA), - events2 = c(21, NA, NA) - ) - - R <- getDataset( - sampleSize1 = c(12, NA, NA), - sampleSize2 = c(14, NA, NA), - events1 = c(12, NA, NA), - events2 = c(14, NA, NA) - ) - - expect_warning(getDataset(S1 = S1, S2 = S2, S3 = S3, R = R), - "The 4 undefined subsets S12, S13, S23, S123 were defined as empty subsets", - fixed = TRUE - ) -}) - +## | +## | *Unit tests* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | RPACT package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File name: test-f_analysis_enrichment_rates.R +## | Creation date: 08 November 2023, 08:54:54 +## | File version: $Revision$ +## | Last changed: $Date$ +## | Last changed by: $Author$ +## | + +test_plan_section("Testing Analysis Enrichment Rates Function") + + +test_that("'getAnalysisResults': enrichment rates, one sub-population, non-stratified input, select S1 at second IA, directionUpper = FALSE, gMax = 2", { + .skipTestIfDisabled() + + # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} + # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} + # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} + # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentRates} + # @refFS[Formula]{fs:computeRCIsEnrichment} + # @refFS[Formula]{fs:conditionalPowerEnrichment} + # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} + # @refFS[Formula]{fs:stratifiedTestEnrichmentRates} + # @refFS[Formula]{fs:testStatisticEnrichmentRates} + design1 <- getDesignInverseNormal(kMax = 3, alpha = 0.02, typeOfDesign = "P", informationRates = c(0.4, 0.7, 1)) + + S1 <- getDataset( + sampleSize1 = c(22, 31, 37), + sampleSize2 = c(28, 33, 39), + events1 = c(7, 16, 17), + events2 = c(18, 21, 19) + ) + + F <- getDataset( + sampleSize1 = c(46, 54, NA), + sampleSize2 = c(49, 62, NA), + events1 = c(16, 31, NA), + events2 = c(29, 35, NA) + ) + + dataInput1 <- getDataset(S1 = S1, F = F) + + ## Comparison of the results of DatasetRates object 'dataInput1' with expected results + expect_equal(dataInput1$overallSampleSizes, c(22, 46, 28, 49, 53, 100, 61, 111, 90, NA_real_, 100, NA_real_), label = paste0("c(", paste0(dataInput1$overallSampleSizes, collapse = ", "), ")")) + expect_equal(dataInput1$overallEvents, c(7, 16, 18, 29, 23, 47, 39, 64, 40, NA_real_, 58, NA_real_), label = paste0("c(", paste0(dataInput1$overallEvents, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dataInput1), NA))) + expect_output(print(dataInput1)$show()) + invisible(capture.output(expect_error(summary(dataInput1), NA))) + expect_output(summary(dataInput1)$show()) + dataInput1CodeBased <- eval(parse(text = getObjectRCode(dataInput1, stringWrapParagraphWidth = NULL))) + expect_equal(dataInput1CodeBased$overallSampleSizes, dataInput1$overallSampleSizes, tolerance = 1e-07) + expect_equal(dataInput1CodeBased$overallEvents, dataInput1$overallEvents, tolerance = 1e-07) + expect_type(names(dataInput1), "character") + df <- as.data.frame(dataInput1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dataInput1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x1 <- getAnalysisResults(design1, dataInput1, + stratifiedAnalysis = FALSE, + intersectionTest = "SpiessensDebois", + allocationRatioPlanned = 0.5, + directionUpper = FALSE, + normalApproximation = TRUE, + stage = 2, + nPlanned = c(80) + ) + + ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x1' with expected results + expect_equal(x1$piTreatments[1, ], 0.43396226, tolerance = 1e-07, label = paste0("c(", paste0(x1$piTreatments[1, ], collapse = ", "), ")")) + expect_equal(x1$piTreatments[2, ], 0.47, tolerance = 1e-07, label = paste0("c(", paste0(x1$piTreatments[2, ], collapse = ", "), ")")) + expect_equal(x1$conditionalRejectionProbabilities[1, ], c(0.17935289, 0.13861558, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(x1$conditionalRejectionProbabilities[2, ], c(0.17935289, 0.047432959, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(x1$conditionalPower[1, ], c(NA_real_, NA_real_, 0.74825773), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(x1$conditionalPower[2, ], c(NA_real_, NA_real_, 0.22069678), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.61149604, -0.44933531, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.47492191, -0.29772839, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalUpperBounds[1, ], c(0.040176497, 0.029772743, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalUpperBounds[2, ], c(0.018732449, 0.06513775, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(x1$repeatedPValues[1, ], c(0.031827909, 0.031827909, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(x1$repeatedPValues[2, ], c(0.031827909, 0.031827909, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(x1$piControls[1, ], 0.63934426, tolerance = 1e-07, label = paste0("c(", paste0(x1$piControls[1, ], collapse = ", "), ")")) + expect_equal(x1$piControls[2, ], 0.57657658, tolerance = 1e-07, label = paste0("c(", paste0(x1$piControls[2, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x1), NA))) + expect_output(print(x1)$show()) + invisible(capture.output(expect_error(summary(x1), NA))) + expect_output(summary(x1)$show()) + x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) + expect_equal(x1CodeBased$piTreatments, x1$piTreatments, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$piControls, x1$piControls, tolerance = 1e-07) + expect_type(names(x1), "character") + df <- as.data.frame(x1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + .skipTestIfDisabled() + + x2 <- getAnalysisResults(design1, dataInput1, + stratifiedAnalysis = FALSE, + intersectionTest = "Bonferroni", + allocationRatioPlanned = 0.5, + directionUpper = FALSE, + normalApproximation = TRUE, + stage = 2, + nPlanned = c(80) + ) + + ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x2' with expected results + expect_equal(x2$piTreatments[1, ], 0.43396226, tolerance = 1e-07, label = paste0("c(", paste0(x2$piTreatments[1, ], collapse = ", "), ")")) + expect_equal(x2$piTreatments[2, ], 0.47, tolerance = 1e-07, label = paste0("c(", paste0(x2$piTreatments[2, ], collapse = ", "), ")")) + expect_equal(x2$conditionalRejectionProbabilities[1, ], c(0.16289564, 0.075460476, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(x2$conditionalRejectionProbabilities[2, ], c(0.16289564, 0.047432959, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(x2$conditionalPower[1, ], c(NA_real_, NA_real_, 0.62405214), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(x2$conditionalPower[2, ], c(NA_real_, NA_real_, 0.22069678), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.61554799, -0.46343398, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.47860086, -0.31516617, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalUpperBounds[1, ], c(0.046721667, 0.044120395, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalUpperBounds[2, ], c(0.02350445, 0.081574104, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(x2$repeatedPValues[1, ], c(0.036684009, 0.036684009, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(x2$repeatedPValues[2, ], c(0.036684009, 0.036684009, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(x2$piControls[1, ], 0.63934426, tolerance = 1e-07, label = paste0("c(", paste0(x2$piControls[1, ], collapse = ", "), ")")) + expect_equal(x2$piControls[2, ], 0.57657658, tolerance = 1e-07, label = paste0("c(", paste0(x2$piControls[2, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x2), NA))) + expect_output(print(x2)$show()) + invisible(capture.output(expect_error(summary(x2), NA))) + expect_output(summary(x2)$show()) + x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) + expect_equal(x2CodeBased$piTreatments, x2$piTreatments, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) + expect_equal(x2CodeBased$piControls, x2$piControls, tolerance = 1e-07) + expect_type(names(x2), "character") + df <- as.data.frame(x2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getAnalysisResults': enrichment rates, one sub-population, stratified input, select S1 at second IA, directionUpper = FALSE, gMax = 2", { + + .skipTestIfDisabled() + + # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} + # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} + # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} + # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentRates} + # @refFS[Formula]{fs:computeRCIsEnrichment} + # @refFS[Formula]{fs:conditionalPowerEnrichment} + # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} + # @refFS[Formula]{fs:stratifiedTestEnrichmentRates} + # @refFS[Formula]{fs:testStatisticEnrichmentRates} + design1 <- getDesignInverseNormal(kMax = 3, alpha = 0.05, typeOfDesign = "WT", deltaWT = 0.1, informationRates = c(0.4, 0.7, 1)) + + S1 <- getDataset( + sampleSize1 = c(22, 31, 37), + sampleSize2 = c(28, 33, 39), + events1 = c(7, 16, 10), + events2 = c(18, 21, 19) + ) + + R <- getDataset( + sampleSize1 = c(24, 23, NA), + sampleSize2 = c(21, 29, NA), + events1 = c(9, 15, NA), + events2 = c(11, 14, NA) + ) + + dataInput2 <- getDataset(S1 = S1, R = R) + + ## Comparison of the results of DatasetRates object 'dataInput2' with expected results + expect_equal(dataInput2$overallSampleSizes, c(22, 24, 28, 21, 53, 47, 61, 50, 90, NA_real_, 100, NA_real_), label = paste0("c(", paste0(dataInput2$overallSampleSizes, collapse = ", "), ")")) + expect_equal(dataInput2$overallEvents, c(7, 9, 18, 11, 23, 24, 39, 25, 33, NA_real_, 58, NA_real_), label = paste0("c(", paste0(dataInput2$overallEvents, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dataInput2), NA))) + expect_output(print(dataInput2)$show()) + invisible(capture.output(expect_error(summary(dataInput2), NA))) + expect_output(summary(dataInput2)$show()) + dataInput2CodeBased <- eval(parse(text = getObjectRCode(dataInput2, stringWrapParagraphWidth = NULL))) + expect_equal(dataInput2CodeBased$overallSampleSizes, dataInput2$overallSampleSizes, tolerance = 1e-07) + expect_equal(dataInput2CodeBased$overallEvents, dataInput2$overallEvents, tolerance = 1e-07) + expect_type(names(dataInput2), "character") + df <- as.data.frame(dataInput2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dataInput2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x3 <- getAnalysisResults(design1, dataInput2, + stratifiedAnalysis = FALSE, + intersectionTest = "Simes", + directionUpper = FALSE, + normalApproximation = FALSE + ) + + ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x3' with expected results + expect_equal(x3$piTreatments[1, ], 0.36666667, tolerance = 1e-07, label = paste0("c(", paste0(x3$piTreatments[1, ], collapse = ", "), ")")) + expect_equal(x3$piTreatments[2, ], NA_real_, label = paste0("c(", paste0(x3$piTreatments[2, ], collapse = ", "), ")")) + expect_equal(x3$conditionalRejectionProbabilities[1, ], c(0.34476337, 0.21123906, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(x3$conditionalRejectionProbabilities[2, ], c(0.34476337, 0.16889178, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(x3$conditionalPower[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(x3$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.62776669, -0.44175544, -0.38366304), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.4897991, -0.29886557, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalUpperBounds[1, ], c(0.066751342, 0.016446892, -0.050014598), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalUpperBounds[2, ], c(0.038157503, 0.063536395, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(x3$repeatedPValues[1, ], c(0.10653002, 0.10653002, 0.014413851), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(x3$repeatedPValues[2, ], c(0.10653002, 0.10653002, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(x3$piControls[1, ], 0.58, tolerance = 1e-07, label = paste0("c(", paste0(x3$piControls[1, ], collapse = ", "), ")")) + expect_equal(x3$piControls[2, ], NA_real_, label = paste0("c(", paste0(x3$piControls[2, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x3), NA))) + expect_output(print(x3)$show()) + invisible(capture.output(expect_error(summary(x3), NA))) + expect_output(summary(x3)$show()) + x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) + expect_equal(x3CodeBased$piTreatments, x3$piTreatments, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) + expect_equal(x3CodeBased$piControls, x3$piControls, tolerance = 1e-07) + expect_type(names(x3), "character") + df <- as.data.frame(x3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x4 <- getAnalysisResults(design1, dataInput2, + stratifiedAnalysis = TRUE, + intersectionTest = "Simes", + directionUpper = FALSE, + normalApproximation = TRUE + ) + + ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x4' with expected results + expect_equal(x4$piTreatments[1, ], 0.36666667, tolerance = 1e-07, label = paste0("c(", paste0(x4$piTreatments[1, ], collapse = ", "), ")")) + expect_equal(x4$piTreatments[2, ], NA_real_, label = paste0("c(", paste0(x4$piTreatments[2, ], collapse = ", "), ")")) + expect_equal(x4$conditionalRejectionProbabilities[1, ], c(0.4519333, 0.45336181, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(x4$conditionalRejectionProbabilities[2, ], c(0.4519333, 0.2823056, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(x4$conditionalPower[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(x4$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(x4$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.62776669, -0.44175544, -0.38366304), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(x4$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.48811625, -0.29740945, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(x4$repeatedConfidenceIntervalUpperBounds[1, ], c(0.066751342, 0.016446892, -0.050014598), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(x4$repeatedConfidenceIntervalUpperBounds[2, ], c(0.041874626, 0.06452777, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(x4$repeatedPValues[1, ], c(0.07212343, 0.050354903, 0.0033350387), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(x4$repeatedPValues[2, ], c(0.07212343, 0.065501128, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(x4$piControls[1, ], 0.58, tolerance = 1e-07, label = paste0("c(", paste0(x4$piControls[1, ], collapse = ", "), ")")) + expect_equal(x4$piControls[2, ], NA_real_, label = paste0("c(", paste0(x4$piControls[2, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x4), NA))) + expect_output(print(x4)$show()) + invisible(capture.output(expect_error(summary(x4), NA))) + expect_output(summary(x4)$show()) + x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) + expect_equal(x4CodeBased$piTreatments, x4$piTreatments, tolerance = 1e-07) + expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-07) + expect_equal(x4CodeBased$piControls, x4$piControls, tolerance = 1e-07) + expect_type(names(x4), "character") + df <- as.data.frame(x4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getAnalysisResults': enrichment rates, more sub-populations, select S1 and S2 at first IA, select S1 at second, directionUpper = TRUE, gMax = 3", { + + .skipTestIfDisabled() + + # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} + # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} + # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} + # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentRates} + # @refFS[Formula]{fs:computeRCIsEnrichment} + # @refFS[Formula]{fs:conditionalPowerEnrichment} + # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} + # @refFS[Formula]{fs:stratifiedTestEnrichmentRates} + # @refFS[Formula]{fs:testStatisticEnrichmentRates} + S1 <- getDataset( + sampleSize1 = c(47, 33, 37), + sampleSize2 = c(48, 47, 39), + events1 = c(18, 13, 17), + events2 = c(12, 11, 9) + ) + + S2 <- getDataset( + sampleSize1 = c(49, NA, NA), + sampleSize2 = c(45, NA, NA), + events1 = c(12, NA, NA), + events2 = c(13, NA, NA) + ) + + S12 <- getDataset( + sampleSize1 = c(35, 42, NA), + sampleSize2 = c(36, 47, NA), + events1 = c(19, 10, NA), + events2 = c(13, 17, NA) + ) + + R <- getDataset( + sampleSize1 = c(43, NA, NA), + sampleSize2 = c(39, NA, NA), + events1 = c(17, NA, NA), + events2 = c(14, NA, NA) + ) + + dataInput3 <- getDataset(S1 = S1, S2 = S2, S12 = S12, R = R) + + ## Comparison of the results of DatasetRates object 'dataInput3' with expected results + expect_equal(dataInput3$overallSampleSizes, c(47, 49, 35, 43, 48, 45, 36, 39, 80, NA_real_, 77, NA_real_, 95, NA_real_, 83, NA_real_, 117, NA_real_, NA_real_, NA_real_, 134, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(dataInput3$overallSampleSizes, collapse = ", "), ")")) + expect_equal(dataInput3$overallEvents, c(18, 12, 19, 17, 12, 13, 13, 14, 31, NA_real_, 29, NA_real_, 23, NA_real_, 30, NA_real_, 48, NA_real_, NA_real_, NA_real_, 32, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(dataInput3$overallEvents, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dataInput3), NA))) + expect_output(print(dataInput3)$show()) + invisible(capture.output(expect_error(summary(dataInput3), NA))) + expect_output(summary(dataInput3)$show()) + dataInput3CodeBased <- eval(parse(text = getObjectRCode(dataInput3, stringWrapParagraphWidth = NULL))) + expect_equal(dataInput3CodeBased$overallSampleSizes, dataInput3$overallSampleSizes, tolerance = 1e-07) + expect_equal(dataInput3CodeBased$overallEvents, dataInput3$overallEvents, tolerance = 1e-07) + expect_type(names(dataInput3), "character") + df <- as.data.frame(dataInput3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dataInput3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + design1 <- getDesignInverseNormal(kMax = 3, alpha = 0.05, typeOfDesign = "WT", deltaWT = 0.1, informationRates = c(0.4, 0.7, 1)) + + x1 <- getAnalysisResults(design1, dataInput3, + directionUpper = TRUE, + stratifiedAnalysis = FALSE, + intersectionTest = "Sidak", + allocationRatioPlanned = 3, + normalApproximation = FALSE, + nPlanned = c(80), + piControls = c(0.2, NA, NA), + piTreatments = c(0.55, NA, NA), + stage = 2 + ) + + ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x1' with expected results + expect_equal(x1$conditionalRejectionProbabilities[1, ], c(0.15297113, 0.049132584, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(x1$conditionalRejectionProbabilities[2, ], c(0.034063149, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(x1$conditionalRejectionProbabilities[3, ], c(0.064895921, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(x1$conditionalPower[1, ], c(NA_real_, NA_real_, 0.89354539), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(x1$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(x1$conditionalPower[3, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.062823383, -0.036086154, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.16425035, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalLowerBounds[3, ], c(-0.078510197, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalUpperBounds[1, ], c(0.35743976, 0.21982839, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalUpperBounds[2, ], c(0.25557989, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalUpperBounds[3, ], c(0.21491638, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(x1$repeatedPValues[1, ], c(0.23298603, 0.23298603, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(x1$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(x1$repeatedPValues[3, ], c(0.389024, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x1), NA))) + expect_output(print(x1)$show()) + invisible(capture.output(expect_error(summary(x1), NA))) + expect_output(summary(x1)$show()) + x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) + expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) + expect_type(names(x1), "character") + df <- as.data.frame(x1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + design2 <- getDesignFisher(kMax = 3, method = "equalAlpha", alpha = 0.05, informationRates = c(0.4, 0.7, 1)) + + x2 <- getAnalysisResults(design2, dataInput3, + directionUpper = TRUE, + stratifiedAnalysis = FALSE, + intersectionTest = "Sidak", + normalApproximation = FALSE, + stage = 3 + ) + + ## Comparison of the results of AnalysisResultsEnrichmentFisher object 'x2' with expected results + expect_equal(x2$piTreatments[1, ], 0.41025641, tolerance = 1e-07, label = paste0("c(", paste0(x2$piTreatments[1, ], collapse = ", "), ")")) + expect_equal(x2$piTreatments[2, ], NA_real_, label = paste0("c(", paste0(x2$piTreatments[2, ], collapse = ", "), ")")) + expect_equal(x2$piTreatments[3, ], NA_real_, label = paste0("c(", paste0(x2$piTreatments[3, ], collapse = ", "), ")")) + expect_equal(x2$conditionalRejectionProbabilities[1, ], c(0.075105953, 0.018243594, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(x2$conditionalRejectionProbabilities[2, ], c(0.020009021, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(x2$conditionalRejectionProbabilities[3, ], c(0.031471245, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(x2$conditionalPower[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(x2$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(x2$conditionalPower[3, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.023654531, -0.034180226, 0.008300518), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.12625532, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalLowerBounds[3, ], c(-0.051634044, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalUpperBounds[1, ], c(0.32239366, 0.19556, 0.21299371), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalUpperBounds[2, ], c(0.21912956, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalUpperBounds[3, ], c(0.1890798, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(x2$repeatedPValues[1, ], c(0.14811777, 0.14811777, 0.07171335), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(x2$repeatedPValues[2, ], c(0.46979052, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(x2$repeatedPValues[3, ], c(0.32146776, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(x2$piControls[1, ], 0.23880597, tolerance = 1e-07, label = paste0("c(", paste0(x2$piControls[1, ], collapse = ", "), ")")) + expect_equal(x2$piControls[2, ], NA_real_, label = paste0("c(", paste0(x2$piControls[2, ], collapse = ", "), ")")) + expect_equal(x2$piControls[3, ], NA_real_, label = paste0("c(", paste0(x2$piControls[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x2), NA))) + expect_output(print(x2)$show()) + invisible(capture.output(expect_error(summary(x2), NA))) + expect_output(summary(x2)$show()) + x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) + expect_equal(x2CodeBased$piTreatments, x2$piTreatments, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) + expect_equal(x2CodeBased$piControls, x2$piControls, tolerance = 1e-07) + expect_type(names(x2), "character") + df <- as.data.frame(x2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getAnalysisResults': enrichment rates, more sub-populations, non-stratified input, select S1 and S2 at first IA, select S1 at second, directionUpper = FALSE, gMax = 4", { + + .skipTestIfDisabled() + + # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} + # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} + # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} + # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentRates} + # @refFS[Formula]{fs:computeRCIsEnrichment} + # @refFS[Formula]{fs:conditionalPowerEnrichment} + # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} + # @refFS[Formula]{fs:stratifiedTestEnrichmentRates} + # @refFS[Formula]{fs:testStatisticEnrichmentRates} + S1 <- getDataset( + sampleSize1 = c(84, 94, 25), + sampleSize2 = c(82, 75, 23), + events1 = c(21, 28, 13), + events2 = c(32, 23, 20) + ) + + S2 <- getDataset( + sampleSize1 = c(81, 95, NA), + sampleSize2 = c(84, 64, NA), + events1 = c(26, 29, NA), + events2 = c(31, 26, NA) + ) + + S3 <- getDataset( + sampleSize1 = c(71, NA, NA), + sampleSize2 = c(74, NA, NA), + events1 = c(16, NA, NA), + events2 = c(21, NA, NA) + ) + + F <- getDataset( + sampleSize1 = c(248, NA, NA), + sampleSize2 = c(254, NA, NA), + events1 = c(75, NA, NA), + events2 = c(98, NA, NA) + ) + + R <- getDataset( + sampleSize1 = c(12, NA, NA), + sampleSize2 = c(14, NA, NA), + events1 = c(12, NA, NA), + events2 = c(14, NA, NA) + ) + + dataInput4 <- getDataset(S1 = S1, S2 = S2, S3 = S3, F = F) + + ## Comparison of the results of DatasetRates object 'dataInput4' with expected results + expect_equal(dataInput4$overallSampleSizes, c(84, 81, 71, 248, 82, 84, 74, 254, 178, 176, NA_real_, NA_real_, 157, 148, NA_real_, NA_real_, 203, NA_real_, NA_real_, NA_real_, 180, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(dataInput4$overallSampleSizes, collapse = ", "), ")")) + expect_equal(dataInput4$overallEvents, c(21, 26, 16, 75, 32, 31, 21, 98, 49, 55, NA_real_, NA_real_, 55, 57, NA_real_, NA_real_, 62, NA_real_, NA_real_, NA_real_, 75, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(dataInput4$overallEvents, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dataInput4), NA))) + expect_output(print(dataInput4)$show()) + invisible(capture.output(expect_error(summary(dataInput4), NA))) + expect_output(summary(dataInput4)$show()) + dataInput4CodeBased <- eval(parse(text = getObjectRCode(dataInput4, stringWrapParagraphWidth = NULL))) + expect_equal(dataInput4CodeBased$overallSampleSizes, dataInput4$overallSampleSizes, tolerance = 1e-07) + expect_equal(dataInput4CodeBased$overallEvents, dataInput4$overallEvents, tolerance = 1e-07) + expect_type(names(dataInput4), "character") + df <- as.data.frame(dataInput4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dataInput4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + design1 <- getDesignInverseNormal(kMax = 3, alpha = 0.05, typeOfDesign = "asKD", gammaA = 2, informationRates = c(0.4, 0.7, 1)) + + x3 <- getAnalysisResults(design1, dataInput4, + directionUpper = FALSE, + stratifiedAnalysis = FALSE, + intersectionTest = "Sidak", + allocationRatioPlanned = 1, + stage = 3, + normalApproximation = TRUE + ) + + ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x3' with expected results + expect_equal(x3$piTreatments[1, ], 0.30541872, tolerance = 1e-07, label = paste0("c(", paste0(x3$piTreatments[1, ], collapse = ", "), ")")) + expect_equal(x3$piTreatments[2, ], NA_real_, label = paste0("c(", paste0(x3$piTreatments[2, ], collapse = ", "), ")")) + expect_equal(x3$piTreatments[3, ], NA_real_, label = paste0("c(", paste0(x3$piTreatments[3, ], collapse = ", "), ")")) + expect_equal(x3$piTreatments[4, ], NA_real_, label = paste0("c(", paste0(x3$piTreatments[4, ], collapse = ", "), ")")) + expect_equal(x3$conditionalRejectionProbabilities[1, ], c(0.13745997, 0.082835151, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(x3$conditionalRejectionProbabilities[2, ], c(0.023915975, 0.064596491, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(x3$conditionalRejectionProbabilities[3, ], c(0.023915975, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(x3$conditionalRejectionProbabilities[4, ], c(0.13745997, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities[4, ], collapse = ", "), ")")) + expect_equal(x3$conditionalPower[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(x3$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(x3$conditionalPower[3, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(x3$conditionalPower[4, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPower[4, ], collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.33926099, -0.22469062, -0.248011), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.255132, -0.21555052, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalLowerBounds[3, ], c(-0.26390722, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalLowerBounds[4, ], c(-0.20314825, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds[4, ], collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalUpperBounds[1, ], c(0.068268149, 0.059220127, -0.0081515662), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalUpperBounds[2, ], c(0.16378176, 0.07555087, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalUpperBounds[3, ], c(0.15232186, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalUpperBounds[4, ], c(0.038730826, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds[4, ], collapse = ", "), ")")) + expect_equal(x3$repeatedPValues[1, ], c(0.5, 0.26483774, 0.01063254), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(x3$repeatedPValues[2, ], c(0.5, 0.30264322, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(x3$repeatedPValues[3, ], c(0.5, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(x3$repeatedPValues[4, ], c(0.5, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues[4, ], collapse = ", "), ")")) + expect_equal(x3$piControls[1, ], 0.41666667, tolerance = 1e-07, label = paste0("c(", paste0(x3$piControls[1, ], collapse = ", "), ")")) + expect_equal(x3$piControls[2, ], NA_real_, label = paste0("c(", paste0(x3$piControls[2, ], collapse = ", "), ")")) + expect_equal(x3$piControls[3, ], NA_real_, label = paste0("c(", paste0(x3$piControls[3, ], collapse = ", "), ")")) + expect_equal(x3$piControls[4, ], NA_real_, label = paste0("c(", paste0(x3$piControls[4, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x3), NA))) + expect_output(print(x3)$show()) + invisible(capture.output(expect_error(summary(x3), NA))) + expect_output(summary(x3)$show()) + x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) + expect_equal(x3CodeBased$piTreatments, x3$piTreatments, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) + expect_equal(x3CodeBased$piControls, x3$piControls, tolerance = 1e-07) + expect_type(names(x3), "character") + df <- as.data.frame(x3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getAnalysisResults': enrichment rates, expected warning for empty subsets", { + + .skipTestIfDisabled() + + S1 <- getDataset( + sampleSize1 = c(84, 94, 25), + sampleSize2 = c(82, 75, 23), + events1 = c(21, 28, 13), + events2 = c(32, 23, 20) + ) + + S2 <- getDataset( + sampleSize1 = c(81, 95, NA), + sampleSize2 = c(84, 64, NA), + events1 = c(26, 29, NA), + events2 = c(31, 26, NA) + ) + + S3 <- getDataset( + sampleSize1 = c(71, NA, NA), + sampleSize2 = c(74, NA, NA), + events1 = c(16, NA, NA), + events2 = c(21, NA, NA) + ) + + R <- getDataset( + sampleSize1 = c(12, NA, NA), + sampleSize2 = c(14, NA, NA), + events1 = c(12, NA, NA), + events2 = c(14, NA, NA) + ) + + expect_warning(getDataset(S1 = S1, S2 = S2, S3 = S3, R = R), + "The 4 undefined subsets S12, S13, S23, S123 were defined as empty subsets", + fixed = TRUE + ) + +}) + diff --git a/tests/testthat/test-f_analysis_enrichment_survival.R b/tests/testthat/test-f_analysis_enrichment_survival.R index 2d2f9703..3a91c15f 100644 --- a/tests/testthat/test-f_analysis_enrichment_survival.R +++ b/tests/testthat/test-f_analysis_enrichment_survival.R @@ -1,561 +1,556 @@ -## | +## | ## | *Unit tests* -## | +## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | +## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | +## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org -## | +## | ## | Contact us for information about our services: info@rpact.com -## | +## | ## | File name: test-f_analysis_enrichment_survival.R ## | Creation date: 08 November 2023, 08:55:32 -## | File version: $Revision$ -## | Last changed: $Date$ -## | Last changed by: $Author$ -## | +## | File version: $Revision: 7682 $ +## | Last changed: $Date: 2024-03-05 07:53:40 +0100 (Di, 05 Mrz 2024) $ +## | Last changed by: $Author: pahlke $ +## | test_plan_section("Testing Analysis Enrichment Survival Function") test_that("'getAnalysisResults': enrichment survival, one sub-population, non-stratified analysis, select S1 at second, gMax = 2", { - .skipTestIfDisabled() - - # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} - # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} - # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} - # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentSurvival} - # @refFS[Formula]{fs:computeRCIsEnrichment} - # @refFS[Formula]{fs:conditionalPowerEnrichment} - # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} - # @refFS[Formula]{fs:stratifiedTestEnrichmentSurvival} - # @refFS[Formula]{fs:testStatisticEnrichmentSurvival} - S1 <- getDataset( - events = c(37, 35, 22), - logRanks = c(1.66, 1.38, 1.22), - allocationRatios = c(1, 1, 1) - ) - - F <- getDataset( - events = c(66, 55, NA), - logRanks = c(1.98, 1.57, NA), - allocationRatios = c(1, 1, NA) - ) - - dataInput1 <- getDataset(S1 = S1, F = F) - - ## Comparison of the results of DatasetSurvival object 'dataInput1' with expected results - expect_equal(dataInput1$events, c(37, 66, 35, 55, 22, NA_real_), label = paste0("c(", paste0(dataInput1$events, collapse = ", "), ")")) - expect_equal(dataInput1$allocationRatios, c(1, 1, 1, 1, 1, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(dataInput1$allocationRatios, collapse = ", "), ")")) - expect_equal(dataInput1$logRanks, c(1.66, 1.98, 1.38, 1.57, 1.22, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(dataInput1$logRanks, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dataInput1), NA))) - expect_output(print(dataInput1)$show()) - invisible(capture.output(expect_error(summary(dataInput1), NA))) - expect_output(summary(dataInput1)$show()) - dataInput1CodeBased <- eval(parse(text = getObjectRCode(dataInput1, stringWrapParagraphWidth = NULL))) - expect_equal(dataInput1CodeBased$events, dataInput1$events, tolerance = 1e-07) - expect_equal(dataInput1CodeBased$allocationRatios, dataInput1$allocationRatios, tolerance = 1e-07) - expect_equal(dataInput1CodeBased$logRanks, dataInput1$logRanks, tolerance = 1e-07) - expect_type(names(dataInput1), "character") - df <- as.data.frame(dataInput1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dataInput1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - design1 <- getDesignInverseNormal( - kMax = 3, typeOfDesign = "asP", typeBetaSpending = "bsKD", gammaB = 1.3, alpha = 0.025, - informationRates = c(0.4, 0.7, 1), bindingFutility = FALSE, beta = 0.1 - ) - - x1 <- getAnalysisResults( - design = design1, - dataInput = dataInput1, - directionUpper = TRUE, - stage = 3, - allocationRatioPlanned = 1, - intersectionTest = "SpiessensDebois" - ) - - ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x1' with expected results - expect_equal(x1$thetaH1[1, ], 1.6657832, tolerance = 1e-07, label = paste0("c(", paste0(x1$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(x1$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(x1$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(x1$conditionalRejectionProbabilities[1, ], c(0.082268614, 0.17873234, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(x1$conditionalRejectionProbabilities[2, ], c(0.10062355, 0.20651301, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(x1$conditionalPower[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(x1$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalLowerBounds[1, ], c(0.77807561, 0.90042934, 0.98057987), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalLowerBounds[2, ], c(0.89663851, 0.98596182, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalUpperBounds[1, ], c(3.8287578, 3.0779077, 2.841847), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalUpperBounds[2, ], c(2.9564444, 2.541245, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(x1$repeatedPValues[1, ], c(0.09262834, 0.035310721, 0.016798032), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(x1$repeatedPValues[2, ], c(0.074049848, 0.03027247, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x1), NA))) - expect_output(print(x1)$show()) - invisible(capture.output(expect_error(summary(x1), NA))) - expect_output(summary(x1)$show()) - x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) - expect_equal(x1CodeBased$thetaH1, x1$thetaH1, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) - expect_type(names(x1), "character") - df <- as.data.frame(x1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - .skipTestIfDisabled() - - x2 <- getAnalysisResults( - design = design1, - dataInput = dataInput1, - directionUpper = TRUE, - stage = 3, - allocationRatioPlanned = 1, - intersectionTest = "Sidak" - ) - - ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x2' with expected results - expect_equal(x2$thetaH1[1, ], 1.6657832, tolerance = 1e-07, label = paste0("c(", paste0(x2$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(x2$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(x2$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(x2$conditionalRejectionProbabilities[1, ], c(0.082268614, 0.14135111, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(x2$conditionalRejectionProbabilities[2, ], c(0.08442718, 0.14135111, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(x2$conditionalPower[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(x2$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalLowerBounds[1, ], c(0.76355966, 0.87078132, 0.95099133), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalLowerBounds[2, ], c(0.88408373, 0.96064864, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalUpperBounds[1, ], c(3.9015478, 3.1815164, 2.9283489), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalUpperBounds[2, ], c(2.9984281, 2.606883, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(x2$repeatedPValues[1, ], c(0.09262834, 0.044241863, 0.02067471), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(x2$repeatedPValues[2, ], c(0.090100155, 0.044241863, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x2), NA))) - expect_output(print(x2)$show()) - invisible(capture.output(expect_error(summary(x2), NA))) - expect_output(summary(x2)$show()) - x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) - expect_equal(x2CodeBased$thetaH1, x2$thetaH1, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) - expect_type(names(x2), "character") - df <- as.data.frame(x2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - design2 <- getDesignFisher(kMax = 3, method = "equalAlpha", alpha = 0.025, informationRates = c(0.4, 0.7, 1)) - - x3 <- getAnalysisResults( - design = design2, - dataInput = dataInput1, - stratifiedAnalysis = TRUE, - directionUpper = TRUE, - stage = 2, - nPlanned = 30, - allocationRatioPlanned = 1, - intersectionTest = "SpiessensDebois" - ) - - ## Comparison of the results of AnalysisResultsEnrichmentFisher object 'x3' with expected results - expect_equal(x3$thetaH1[1, ], 1.6607445, tolerance = 1e-07, label = paste0("c(", paste0(x3$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(x3$thetaH1[2, ], 1.5814324, tolerance = 1e-07, label = paste0("c(", paste0(x3$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(x3$conditionalRejectionProbabilities[1, ], c(0.058300881, 0.080849353, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(x3$conditionalRejectionProbabilities[2, ], c(0.073230444, 0.10089716, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(x3$conditionalPower[1, ], c(NA_real_, NA_real_, 0.49594042), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(x3$conditionalPower[2, ], c(NA_real_, NA_real_, 0.49151717), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalLowerBounds[1, ], c(0.77887293, 0.87495539, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalLowerBounds[2, ], c(0.89732572, 0.9655589, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalUpperBounds[1, ], c(3.8248388, 3.1694642, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalUpperBounds[2, ], c(2.9541783, 2.6004037, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(x3$repeatedPValues[1, ], c(0.086600177, 0.047636937, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(x3$repeatedPValues[2, ], c(0.070085432, 0.040357555, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x3), NA))) - expect_output(print(x3)$show()) - invisible(capture.output(expect_error(summary(x3), NA))) - expect_output(summary(x3)$show()) - x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) - expect_equal(x3CodeBased$thetaH1, x3$thetaH1, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) - expect_type(names(x3), "character") - df <- as.data.frame(x3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - + .skipTestIfDisabled() + + # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} + # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} + # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} + # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentSurvival} + # @refFS[Formula]{fs:computeRCIsEnrichment} + # @refFS[Formula]{fs:conditionalPowerEnrichment} + # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} + # @refFS[Formula]{fs:stratifiedTestEnrichmentSurvival} + # @refFS[Formula]{fs:testStatisticEnrichmentSurvival} + S1 <- getDataset( + events = c(37, 35, 22), + logRanks = c(1.66, 1.38, 1.22), + allocationRatios = c(1, 1, 1) + ) + + F <- getDataset( + events = c(66, 55, NA), + logRanks = c(1.98, 1.57, NA), + allocationRatios = c(1, 1, NA) + ) + + dataInput1 <- getDataset(S1 = S1, F = F) + + ## Comparison of the results of DatasetSurvival object 'dataInput1' with expected results + expect_equal(dataInput1$events, c(37, 66, 35, 55, 22, NA_real_), label = paste0("c(", paste0(dataInput1$events, collapse = ", "), ")")) + expect_equal(dataInput1$allocationRatios, c(1, 1, 1, 1, 1, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(dataInput1$allocationRatios, collapse = ", "), ")")) + expect_equal(dataInput1$logRanks, c(1.66, 1.98, 1.38, 1.57, 1.22, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(dataInput1$logRanks, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dataInput1), NA))) + expect_output(print(dataInput1)$show()) + invisible(capture.output(expect_error(summary(dataInput1), NA))) + expect_output(summary(dataInput1)$show()) + dataInput1CodeBased <- eval(parse(text = getObjectRCode(dataInput1, stringWrapParagraphWidth = NULL))) + expect_equal(dataInput1CodeBased$events, dataInput1$events, tolerance = 1e-07) + expect_equal(dataInput1CodeBased$allocationRatios, dataInput1$allocationRatios, tolerance = 1e-07) + expect_equal(dataInput1CodeBased$logRanks, dataInput1$logRanks, tolerance = 1e-07) + expect_type(names(dataInput1), "character") + df <- as.data.frame(dataInput1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dataInput1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + design1 <- getDesignInverseNormal( + kMax = 3, typeOfDesign = "asP", typeBetaSpending = "bsKD", gammaB = 1.3, alpha = 0.025, + informationRates = c(0.4, 0.7, 1), bindingFutility = FALSE, beta = 0.1 + ) + + x1 <- getAnalysisResults( + design = design1, + dataInput = dataInput1, + directionUpper = TRUE, + stage = 3, + allocationRatioPlanned = 1, + intersectionTest = "SpiessensDebois" + ) + + ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x1' with expected results + expect_equal(x1$thetaH1[1, ], 1.6657832, tolerance = 1e-07, label = paste0("c(", paste0(x1$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(x1$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(x1$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(x1$conditionalRejectionProbabilities[1, ], c(0.082268614, 0.17873234, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(x1$conditionalRejectionProbabilities[2, ], c(0.10062355, 0.20651301, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(x1$conditionalPower[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(x1$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalLowerBounds[1, ], c(0.77807561, 0.90042934, 0.98057987), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalLowerBounds[2, ], c(0.89663851, 0.98596182, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalUpperBounds[1, ], c(3.8287578, 3.0779077, 2.841847), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalUpperBounds[2, ], c(2.9564444, 2.541245, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(x1$repeatedPValues[1, ], c(0.09262834, 0.035310721, 0.016798032), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(x1$repeatedPValues[2, ], c(0.074049848, 0.03027247, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues[2, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x1), NA))) + expect_output(print(x1)$show()) + invisible(capture.output(expect_error(summary(x1), NA))) + expect_output(summary(x1)$show()) + x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) + expect_equal(x1CodeBased$thetaH1, x1$thetaH1, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) + expect_type(names(x1), "character") + df <- as.data.frame(x1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + .skipTestIfDisabled() + + x2 <- getAnalysisResults( + design = design1, + dataInput = dataInput1, + directionUpper = TRUE, + stage = 3, + allocationRatioPlanned = 1, + intersectionTest = "Sidak" + ) + + ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x2' with expected results + expect_equal(x2$thetaH1[1, ], 1.6657832, tolerance = 1e-07, label = paste0("c(", paste0(x2$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(x2$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(x2$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(x2$conditionalRejectionProbabilities[1, ], c(0.082268614, 0.14135111, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(x2$conditionalRejectionProbabilities[2, ], c(0.08442718, 0.14135111, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(x2$conditionalPower[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(x2$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalLowerBounds[1, ], c(0.76355966, 0.87078132, 0.95099133), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalLowerBounds[2, ], c(0.88408373, 0.96064864, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalUpperBounds[1, ], c(3.9015478, 3.1815164, 2.9283489), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalUpperBounds[2, ], c(2.9984281, 2.606883, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(x2$repeatedPValues[1, ], c(0.09262834, 0.044241863, 0.02067471), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(x2$repeatedPValues[2, ], c(0.090100155, 0.044241863, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues[2, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x2), NA))) + expect_output(print(x2)$show()) + invisible(capture.output(expect_error(summary(x2), NA))) + expect_output(summary(x2)$show()) + x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) + expect_equal(x2CodeBased$thetaH1, x2$thetaH1, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) + expect_type(names(x2), "character") + df <- as.data.frame(x2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + design2 <- getDesignFisher(kMax = 3, method = "equalAlpha", alpha = 0.025, informationRates = c(0.4, 0.7, 1)) + + x3 <- getAnalysisResults( + design = design2, + dataInput = dataInput1, + stratifiedAnalysis = TRUE, + directionUpper = TRUE, + stage = 2, + nPlanned = 30, + allocationRatioPlanned = 1, + intersectionTest = "SpiessensDebois" + ) + + ## Comparison of the results of AnalysisResultsEnrichmentFisher object 'x3' with expected results + expect_equal(x3$thetaH1[1, ], 1.6607445, tolerance = 1e-07, label = paste0("c(", paste0(x3$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(x3$thetaH1[2, ], 1.5814324, tolerance = 1e-07, label = paste0("c(", paste0(x3$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(x3$conditionalRejectionProbabilities[1, ], c(0.058300881, 0.080849353, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(x3$conditionalRejectionProbabilities[2, ], c(0.073230444, 0.10089716, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(x3$conditionalPower[1, ], c(NA_real_, NA_real_, 0.49594042), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(x3$conditionalPower[2, ], c(NA_real_, NA_real_, 0.49151717), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalLowerBounds[1, ], c(0.77887293, 0.87495539, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalLowerBounds[2, ], c(0.89732572, 0.9655589, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalUpperBounds[1, ], c(3.8248388, 3.1694642, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalUpperBounds[2, ], c(2.9541783, 2.6004037, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(x3$repeatedPValues[1, ], c(0.086600177, 0.047636937, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(x3$repeatedPValues[2, ], c(0.070085432, 0.040357555, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues[2, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x3), NA))) + expect_output(print(x3)$show()) + invisible(capture.output(expect_error(summary(x3), NA))) + expect_output(summary(x3)$show()) + x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) + expect_equal(x3CodeBased$thetaH1, x3$thetaH1, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) + expect_type(names(x3), "character") + df <- as.data.frame(x3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } }) test_that("'getAnalysisResults': enrichment survival, one sub-population, stratified data input, select S1 at first, gMax = 2", { - - .skipTestIfDisabled() - - # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} - # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} - # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} - # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentSurvival} - # @refFS[Formula]{fs:computeRCIsEnrichment} - # @refFS[Formula]{fs:conditionalPowerEnrichment} - # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} - # @refFS[Formula]{fs:stratifiedTestEnrichmentSurvival} - # @refFS[Formula]{fs:testStatisticEnrichmentSurvival} - S1 <- getDataset( - overallExpectedEvents = c(13.4, 35.4, 43.7), - overallEvents = c(16, 38, 47), - overallVarianceEvents = c(2.8, 4.7, 3.4), - overallAllocationRatios = c(1, 1, 1) - ) - - R <- getDataset( - overallExpectedEvents = c(23.3, NA, NA), - overallEvents = c(27, NA, NA), - overallVarianceEvents = c(3.9, NA, NA), - overallAllocationRatios = c(1, NA, NA) - ) - - dataInput2 <- getDataset(S1 = S1, R = R) - - ## Comparison of the results of DatasetEnrichmentSurvival object 'dataInput2' with expected results - expect_equal(dataInput2$events, c(16, 27, 22, NA_real_, 9, NA_real_), label = paste0("c(", paste0(dataInput2$events, collapse = ", "), ")")) - expect_equal(dataInput2$allocationRatios, c(1, 1, 1, NA_real_, 1, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(dataInput2$allocationRatios, collapse = ", "), ")")) - expect_equal(dataInput2$expectedEvents, c(13.4, 23.3, 22, NA_real_, 8.3, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(dataInput2$expectedEvents, collapse = ", "), ")")) - expect_equal(dataInput2$varianceEvents, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(dataInput2$varianceEvents, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dataInput2), NA))) - expect_output(print(dataInput2)$show()) - invisible(capture.output(expect_error(summary(dataInput2), NA))) - expect_output(summary(dataInput2)$show()) - dataInput2CodeBased <- eval(parse(text = getObjectRCode(dataInput2, stringWrapParagraphWidth = NULL))) - expect_equal(dataInput2CodeBased$events, dataInput2$events, tolerance = 1e-07) - expect_equal(dataInput2CodeBased$allocationRatios, dataInput2$allocationRatios, tolerance = 1e-07) - expect_equal(dataInput2CodeBased$expectedEvents, dataInput2$expectedEvents, tolerance = 1e-07) - expect_equal(dataInput2CodeBased$varianceEvents, dataInput2$varianceEvents, tolerance = 1e-07) - expect_type(names(dataInput2), "character") - df <- as.data.frame(dataInput2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dataInput2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - design1 <- getDesignInverseNormal( - kMax = 3, typeOfDesign = "asP", - typeBetaSpending = "bsKD", gammaB = 1.3, alpha = 0.025, - informationRates = c(0.4, 0.7, 1), bindingFutility = FALSE, beta = 0.1 - ) - - x4 <- getAnalysisResults( - design = design1, - dataInput = dataInput2, - stratifiedAnalysis = TRUE, - directionUpper = TRUE, - stage = 2, - nPlanned = 30, - thetaH1 = 2.5, - allocationRatioPlanned = 1, - intersectionTest = "SpiessensDebois" - ) - - - ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x4' with expected results - expect_equal(x4$conditionalRejectionProbabilities[1, ], c(0.066531397, 0.014937437, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(x4$conditionalRejectionProbabilities[2, ], c(0.21112053, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(x4$conditionalPower[1, ], c(NA_real_, NA_real_, 0.63217527), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(x4$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(x4$repeatedConfidenceIntervalLowerBounds[1, ], c(0.63930031, 0.68758378, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(x4$repeatedConfidenceIntervalLowerBounds[2, ], c(0.99553933, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(x4$repeatedConfidenceIntervalUpperBounds[1, ], c(7.3977709, 3.5674239, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(x4$repeatedConfidenceIntervalUpperBounds[2, ], c(4.4332679, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(x4$repeatedPValues[1, ], c(0.11491566, 0.11491566, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(x4$repeatedPValues[2, ], c(0.026005739, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedPValues[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x4), NA))) - expect_output(print(x4)$show()) - invisible(capture.output(expect_error(summary(x4), NA))) - expect_output(summary(x4)$show()) - x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) - expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-07) - expect_type(names(x4), "character") - df <- as.data.frame(x4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } + .skipTestIfDisabled() + + # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} + # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} + # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} + # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentSurvival} + # @refFS[Formula]{fs:computeRCIsEnrichment} + # @refFS[Formula]{fs:conditionalPowerEnrichment} + # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} + # @refFS[Formula]{fs:stratifiedTestEnrichmentSurvival} + # @refFS[Formula]{fs:testStatisticEnrichmentSurvival} + S1 <- getDataset( + overallExpectedEvents = c(13.4, 35.4, 43.7), + overallEvents = c(16, 38, 47), + overallVarianceEvents = c(2.8, 4.7, 3.4), + overallAllocationRatios = c(1, 1, 1) + ) + + R <- getDataset( + overallExpectedEvents = c(23.3, NA, NA), + overallEvents = c(27, NA, NA), + overallVarianceEvents = c(3.9, NA, NA), + overallAllocationRatios = c(1, NA, NA) + ) + + dataInput2 <- getDataset(S1 = S1, R = R) + + ## Comparison of the results of DatasetEnrichmentSurvival object 'dataInput2' with expected results + expect_equal(dataInput2$events, c(16, 27, 22, NA_real_, 9, NA_real_), label = paste0("c(", paste0(dataInput2$events, collapse = ", "), ")")) + expect_equal(dataInput2$allocationRatios, c(1, 1, 1, NA_real_, 1, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(dataInput2$allocationRatios, collapse = ", "), ")")) + expect_equal(dataInput2$expectedEvents, c(13.4, 23.3, 22, NA_real_, 8.3, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(dataInput2$expectedEvents, collapse = ", "), ")")) + expect_equal(dataInput2$varianceEvents, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(dataInput2$varianceEvents, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dataInput2), NA))) + expect_output(print(dataInput2)$show()) + invisible(capture.output(expect_error(summary(dataInput2), NA))) + expect_output(summary(dataInput2)$show()) + dataInput2CodeBased <- eval(parse(text = getObjectRCode(dataInput2, stringWrapParagraphWidth = NULL))) + expect_equal(dataInput2CodeBased$events, dataInput2$events, tolerance = 1e-07) + expect_equal(dataInput2CodeBased$allocationRatios, dataInput2$allocationRatios, tolerance = 1e-07) + expect_equal(dataInput2CodeBased$expectedEvents, dataInput2$expectedEvents, tolerance = 1e-07) + expect_equal(dataInput2CodeBased$varianceEvents, dataInput2$varianceEvents, tolerance = 1e-07) + expect_type(names(dataInput2), "character") + df <- as.data.frame(dataInput2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dataInput2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + design1 <- getDesignInverseNormal( + kMax = 3, typeOfDesign = "asP", + typeBetaSpending = "bsKD", gammaB = 1.3, alpha = 0.025, + informationRates = c(0.4, 0.7, 1), bindingFutility = FALSE, beta = 0.1 + ) + + x4 <- getAnalysisResults( + design = design1, + dataInput = dataInput2, + stratifiedAnalysis = TRUE, + directionUpper = TRUE, + stage = 2, + nPlanned = 30, + thetaH1 = 2.5, + allocationRatioPlanned = 1, + intersectionTest = "SpiessensDebois" + ) + + + ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x4' with expected results + expect_equal(x4$conditionalRejectionProbabilities[1, ], c(0.066531397, 0.014937437, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(x4$conditionalRejectionProbabilities[2, ], c(0.21112053, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(x4$conditionalPower[1, ], c(NA_real_, NA_real_, 0.63217527), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(x4$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(x4$repeatedConfidenceIntervalLowerBounds[1, ], c(0.63930031, 0.68758378, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(x4$repeatedConfidenceIntervalLowerBounds[2, ], c(0.99553933, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(x4$repeatedConfidenceIntervalUpperBounds[1, ], c(7.3977709, 3.5674239, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(x4$repeatedConfidenceIntervalUpperBounds[2, ], c(4.4332679, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(x4$repeatedPValues[1, ], c(0.11491566, 0.11491566, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(x4$repeatedPValues[2, ], c(0.026005739, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedPValues[2, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x4), NA))) + expect_output(print(x4)$show()) + invisible(capture.output(expect_error(summary(x4), NA))) + expect_output(summary(x4)$show()) + x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) + expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-07) + expect_type(names(x4), "character") + df <- as.data.frame(x4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } }) test_that("'getAnalysisResults': enrichment survival, two sub-populations, non-stratified analysis, select S1 and S2 at first IA, select S1 at second, gMax = 3", { - - .skipTestIfDisabled() - - # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} - # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} - # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} - # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentRates} - # @refFS[Formula]{fs:computeRCIsEnrichment} - # @refFS[Formula]{fs:conditionalPowerEnrichment} - # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} - # @refFS[Formula]{fs:stratifiedTestEnrichmentRates} - # @refFS[Formula]{fs:testStatisticEnrichmentRates} - design1 <- getDesignInverseNormal( - kMax = 3, typeOfDesign = "asP", typeBetaSpending = "bsKD", gammaB = 1.3, alpha = 0.02, - informationRates = c(0.4, 0.7, 1), bindingFutility = FALSE, beta = 0.1 - ) - - F <- getDataset( - events = c(66, NA, NA), - logRanks = -c(2.18, NA, NA) - ) - - S1 <- getDataset( - events = c(37, 13, 26), - logRanks = -c(1.66, 1.239, 0.785) - ) - - S2 <- getDataset( - events = c(31, 18, NA), - logRanks = -c(1.98, 1.064, NA) - ) - - dataInput3 <- getDataset(S1 = S1, S2 = S2, F = F) - - ## Comparison of the results of DatasetSurvival object 'dataInput3' with expected results - expect_equal(dataInput3$events, c(37, 31, 66, 13, 18, NA_real_, 26, NA_real_, NA_real_), label = paste0("c(", paste0(dataInput3$events, collapse = ", "), ")")) - expect_equal(dataInput3$allocationRatios, c(1, 1, 1, 1, 1, NA_real_, 1, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(dataInput3$allocationRatios, collapse = ", "), ")")) - expect_equal(dataInput3$logRanks, c(-1.66, -1.98, -2.18, -1.239, -1.064, NA_real_, -0.785, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(dataInput3$logRanks, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dataInput3), NA))) - expect_output(print(dataInput3)$show()) - invisible(capture.output(expect_error(summary(dataInput3), NA))) - expect_output(summary(dataInput3)$show()) - dataInput3CodeBased <- eval(parse(text = getObjectRCode(dataInput3, stringWrapParagraphWidth = NULL))) - expect_equal(dataInput3CodeBased$events, dataInput3$events, tolerance = 1e-07) - expect_equal(dataInput3CodeBased$allocationRatios, dataInput3$allocationRatios, tolerance = 1e-07) - expect_equal(dataInput3CodeBased$logRanks, dataInput3$logRanks, tolerance = 1e-07) - expect_type(names(dataInput3), "character") - df <- as.data.frame(dataInput3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dataInput3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x1 <- getAnalysisResults( - design = design1, - dataInput = dataInput3, - directionUpper = FALSE, - stage = 2, - nPlanned = 30, - allocationRatioPlanned = 1, - intersectionTest = "Sidak" - ) - - - ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x1' with expected results - expect_equal(x1$thetaH1[1, ], 0.55845203, tolerance = 1e-07, label = paste0("c(", paste0(x1$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(x1$thetaH1[2, ], 0.53035001, tolerance = 1e-07, label = paste0("c(", paste0(x1$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(x1$thetaH1[3, ], NA_real_, label = paste0("c(", paste0(x1$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(x1$conditionalRejectionProbabilities[1, ], c(0.063444981, 0.051842822, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(x1$conditionalRejectionProbabilities[2, ], c(0.065210901, 0.051842822, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(x1$conditionalRejectionProbabilities[3, ], c(0.070888966, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(x1$conditionalPower[1, ], c(NA_real_, NA_real_, 0.48733039), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(x1$conditionalPower[2, ], c(NA_real_, NA_real_, 0.54365075), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(x1$conditionalPower[3, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalLowerBounds[1, ], c(0.23870487, 0.2370187, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalLowerBounds[2, ], c(0.1863782, 0.22932092, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalLowerBounds[3, ], c(0.30101352, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalUpperBounds[1, ], c(1.406238, 1.2861572, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalUpperBounds[2, ], c(1.2936975, 1.2386982, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalUpperBounds[3, ], c(1.1356925, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(x1$repeatedPValues[1, ], c(0.09262834, 0.074349301, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(x1$repeatedPValues[2, ], c(0.090100155, 0.074349301, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(x1$repeatedPValues[3, ], c(0.082670093, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x1), NA))) - expect_output(print(x1)$show()) - invisible(capture.output(expect_error(summary(x1), NA))) - expect_output(summary(x1)$show()) - x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) - expect_equal(x1CodeBased$thetaH1, x1$thetaH1, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) - expect_type(names(x1), "character") - df <- as.data.frame(x1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } + .skipTestIfDisabled() + + # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} + # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} + # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} + # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentRates} + # @refFS[Formula]{fs:computeRCIsEnrichment} + # @refFS[Formula]{fs:conditionalPowerEnrichment} + # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} + # @refFS[Formula]{fs:stratifiedTestEnrichmentRates} + # @refFS[Formula]{fs:testStatisticEnrichmentRates} + design1 <- getDesignInverseNormal( + kMax = 3, typeOfDesign = "asP", typeBetaSpending = "bsKD", gammaB = 1.3, alpha = 0.02, + informationRates = c(0.4, 0.7, 1), bindingFutility = FALSE, beta = 0.1 + ) + + F <- getDataset( + events = c(66, NA, NA), + logRanks = -c(2.18, NA, NA) + ) + + S1 <- getDataset( + events = c(37, 13, 26), + logRanks = -c(1.66, 1.239, 0.785) + ) + + S2 <- getDataset( + events = c(31, 18, NA), + logRanks = -c(1.98, 1.064, NA) + ) + + dataInput3 <- getDataset(S1 = S1, S2 = S2, F = F) + + ## Comparison of the results of DatasetSurvival object 'dataInput3' with expected results + expect_equal(dataInput3$events, c(37, 31, 66, 13, 18, NA_real_, 26, NA_real_, NA_real_), label = paste0("c(", paste0(dataInput3$events, collapse = ", "), ")")) + expect_equal(dataInput3$allocationRatios, c(1, 1, 1, 1, 1, NA_real_, 1, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(dataInput3$allocationRatios, collapse = ", "), ")")) + expect_equal(dataInput3$logRanks, c(-1.66, -1.98, -2.18, -1.239, -1.064, NA_real_, -0.785, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(dataInput3$logRanks, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dataInput3), NA))) + expect_output(print(dataInput3)$show()) + invisible(capture.output(expect_error(summary(dataInput3), NA))) + expect_output(summary(dataInput3)$show()) + dataInput3CodeBased <- eval(parse(text = getObjectRCode(dataInput3, stringWrapParagraphWidth = NULL))) + expect_equal(dataInput3CodeBased$events, dataInput3$events, tolerance = 1e-07) + expect_equal(dataInput3CodeBased$allocationRatios, dataInput3$allocationRatios, tolerance = 1e-07) + expect_equal(dataInput3CodeBased$logRanks, dataInput3$logRanks, tolerance = 1e-07) + expect_type(names(dataInput3), "character") + df <- as.data.frame(dataInput3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dataInput3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x1 <- getAnalysisResults( + design = design1, + dataInput = dataInput3, + directionUpper = FALSE, + stage = 2, + nPlanned = 30, + allocationRatioPlanned = 1, + intersectionTest = "Sidak" + ) + + + ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x1' with expected results + expect_equal(x1$thetaH1[1, ], 0.55845203, tolerance = 1e-07, label = paste0("c(", paste0(x1$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(x1$thetaH1[2, ], 0.53035001, tolerance = 1e-07, label = paste0("c(", paste0(x1$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(x1$thetaH1[3, ], NA_real_, label = paste0("c(", paste0(x1$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(x1$conditionalRejectionProbabilities[1, ], c(0.063444981, 0.051842822, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(x1$conditionalRejectionProbabilities[2, ], c(0.065210901, 0.051842822, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(x1$conditionalRejectionProbabilities[3, ], c(0.070888966, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(x1$conditionalPower[1, ], c(NA_real_, NA_real_, 0.48733039), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(x1$conditionalPower[2, ], c(NA_real_, NA_real_, 0.54365075), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(x1$conditionalPower[3, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalLowerBounds[1, ], c(0.23870487, 0.2370187, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalLowerBounds[2, ], c(0.1863782, 0.22932092, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalLowerBounds[3, ], c(0.30101352, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalUpperBounds[1, ], c(1.406238, 1.2861572, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalUpperBounds[2, ], c(1.2936975, 1.2386982, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalUpperBounds[3, ], c(1.1356925, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(x1$repeatedPValues[1, ], c(0.09262834, 0.074349301, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(x1$repeatedPValues[2, ], c(0.090100155, 0.074349301, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(x1$repeatedPValues[3, ], c(0.082670093, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x1), NA))) + expect_output(print(x1)$show()) + invisible(capture.output(expect_error(summary(x1), NA))) + expect_output(summary(x1)$show()) + x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) + expect_equal(x1CodeBased$thetaH1, x1$thetaH1, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) + expect_type(names(x1), "character") + df <- as.data.frame(x1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } }) test_that("'getAnalysisResults': enrichment survival, two sub-populations, stratified analysis, select S1 and S2 at first IA, select S1 at second, gMax = 3", { - - .skipTestIfDisabled() - - # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} - # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} - # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} - # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentRates} - # @refFS[Formula]{fs:computeRCIsEnrichment} - # @refFS[Formula]{fs:conditionalPowerEnrichment} - # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} - # @refFS[Formula]{fs:stratifiedTestEnrichmentRates} - # @refFS[Formula]{fs:testStatisticEnrichmentRates} - S1 <- getDataset( - overallExpectedEvents = c(13.4, 35.4, 43.7), - overallEvents = c(16, 37, 47), - overallVarianceEvents = c(2.8, 4.7, 3.4), - overallAllocationRatios = c(1, 1, 1) - ) - - S2 <- getDataset( - overallExpectedEvents = c(11.5, 31.1, NA), - overallEvents = c(15, 33, NA), - overallVarianceEvents = c(2.2, 4.4, NA), - overallAllocationRatios = c(1, 1, NA) - ) - - S12 <- getDataset( - overallExpectedEvents = c(10.1, 29.6, 39.1), - overallEvents = c(11, 31, 42), - overallVarianceEvents = c(2.8, 4.7, 3.4), - overallAllocationRatios = c(1, 1, 1) - ) - - R <- getDataset( - overallExpectedEvents = c(23.3, NA, NA), - overallEvents = c(25, NA, NA), - overallVarianceEvents = c(3.9, NA, NA), - overallAllocationRatios = c(1, NA, NA) - ) - - dataInput4 <- getDataset(S1 = S1, S2 = S2, S12 = S12, R = R) - - ## Comparison of the results of DatasetEnrichmentSurvival object 'dataInput4' with expected results - expect_equal(dataInput4$events, c(16, 15, 11, 25, 21, 18, 20, NA_real_, 10, NA_real_, 11, NA_real_), label = paste0("c(", paste0(dataInput4$events, collapse = ", "), ")")) - expect_equal(dataInput4$allocationRatios, c(1, 1, 1, 1, 1, 1, 1, NA_real_, 1, NA_real_, 1, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(dataInput4$allocationRatios, collapse = ", "), ")")) - expect_equal(dataInput4$expectedEvents, c(13.4, 11.5, 10.1, 23.3, 22, 19.6, 19.5, NA_real_, 8.3, NA_real_, 9.5, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(dataInput4$expectedEvents, collapse = ", "), ")")) - expect_equal(dataInput4$varianceEvents, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(dataInput4$varianceEvents, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dataInput4), NA))) - expect_output(print(dataInput4)$show()) - invisible(capture.output(expect_error(summary(dataInput4), NA))) - expect_output(summary(dataInput4)$show()) - dataInput4CodeBased <- eval(parse(text = getObjectRCode(dataInput4, stringWrapParagraphWidth = NULL))) - expect_equal(dataInput4CodeBased$events, dataInput4$events, tolerance = 1e-07) - expect_equal(dataInput4CodeBased$allocationRatios, dataInput4$allocationRatios, tolerance = 1e-07) - expect_equal(dataInput4CodeBased$expectedEvents, dataInput4$expectedEvents, tolerance = 1e-07) - expect_equal(dataInput4CodeBased$varianceEvents, dataInput4$varianceEvents, tolerance = 1e-07) - expect_type(names(dataInput4), "character") - df <- as.data.frame(dataInput4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dataInput4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - design1 <- getDesignInverseNormal( - kMax = 3, typeOfDesign = "asP", typeBetaSpending = "bsKD", gammaB = 1.3, alpha = 0.02, - informationRates = c(0.4, 0.7, 1), bindingFutility = FALSE, beta = 0.1 - ) - - x2 <- getAnalysisResults( - design = design1, - dataInput = dataInput4, - stratifiedAnalysis = TRUE, - directionUpper = TRUE, - stage = 2, - nPlanned = 30, - thetaH1 = 2, - allocationRatioPlanned = 1, - intersectionTest = "Sidak" - ) - - ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x2' with expected results - expect_equal(x2$conditionalRejectionProbabilities[1, ], c(0.043010929, 0.0010677592, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(x2$conditionalRejectionProbabilities[2, ], c(0.063395248, 0.0010677592, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(x2$conditionalRejectionProbabilities[3, ], c(0.15397803, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(x2$conditionalPower[1, ], c(NA_real_, NA_real_, 0.12050895), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(x2$conditionalPower[2, ], c(NA_real_, NA_real_, 0.12050895), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(x2$conditionalPower[3, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalLowerBounds[1, ], c(0.62578554, 0.64439022, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalLowerBounds[2, ], c(0.75127376, 0.66639106, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalLowerBounds[3, ], c(0.96321381, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalUpperBounds[1, ], c(4.9893102, 2.8192192, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalUpperBounds[2, ], c(6.2314391, 3.0969281, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalUpperBounds[3, ], c(3.5981376, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(x2$repeatedPValues[1, ], c(0.13298203, 0.13298203, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(x2$repeatedPValues[2, ], c(0.092701773, 0.092701773, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(x2$repeatedPValues[3, ], c(0.031299575, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x2), NA))) - expect_output(print(x2)$show()) - invisible(capture.output(expect_error(summary(x2), NA))) - expect_output(summary(x2)$show()) - x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) - expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) - expect_type(names(x2), "character") - df <- as.data.frame(x2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } + .skipTestIfDisabled() + + # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} + # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} + # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} + # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentRates} + # @refFS[Formula]{fs:computeRCIsEnrichment} + # @refFS[Formula]{fs:conditionalPowerEnrichment} + # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} + # @refFS[Formula]{fs:stratifiedTestEnrichmentRates} + # @refFS[Formula]{fs:testStatisticEnrichmentRates} + S1 <- getDataset( + overallExpectedEvents = c(13.4, 35.4, 43.7), + overallEvents = c(16, 37, 47), + overallVarianceEvents = c(2.8, 4.7, 3.4), + overallAllocationRatios = c(1, 1, 1) + ) + + S2 <- getDataset( + overallExpectedEvents = c(11.5, 31.1, NA), + overallEvents = c(15, 33, NA), + overallVarianceEvents = c(2.2, 4.4, NA), + overallAllocationRatios = c(1, 1, NA) + ) + + S12 <- getDataset( + overallExpectedEvents = c(10.1, 29.6, 39.1), + overallEvents = c(11, 31, 42), + overallVarianceEvents = c(2.8, 4.7, 3.4), + overallAllocationRatios = c(1, 1, 1) + ) + + R <- getDataset( + overallExpectedEvents = c(23.3, NA, NA), + overallEvents = c(25, NA, NA), + overallVarianceEvents = c(3.9, NA, NA), + overallAllocationRatios = c(1, NA, NA) + ) + + dataInput4 <- getDataset(S1 = S1, S2 = S2, S12 = S12, R = R) + + ## Comparison of the results of DatasetEnrichmentSurvival object 'dataInput4' with expected results + expect_equal(dataInput4$events, c(16, 15, 11, 25, 21, 18, 20, NA_real_, 10, NA_real_, 11, NA_real_), label = paste0("c(", paste0(dataInput4$events, collapse = ", "), ")")) + expect_equal(dataInput4$allocationRatios, c(1, 1, 1, 1, 1, 1, 1, NA_real_, 1, NA_real_, 1, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(dataInput4$allocationRatios, collapse = ", "), ")")) + expect_equal(dataInput4$expectedEvents, c(13.4, 11.5, 10.1, 23.3, 22, 19.6, 19.5, NA_real_, 8.3, NA_real_, 9.5, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(dataInput4$expectedEvents, collapse = ", "), ")")) + expect_equal(dataInput4$varianceEvents, c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(dataInput4$varianceEvents, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dataInput4), NA))) + expect_output(print(dataInput4)$show()) + invisible(capture.output(expect_error(summary(dataInput4), NA))) + expect_output(summary(dataInput4)$show()) + dataInput4CodeBased <- eval(parse(text = getObjectRCode(dataInput4, stringWrapParagraphWidth = NULL))) + expect_equal(dataInput4CodeBased$events, dataInput4$events, tolerance = 1e-07) + expect_equal(dataInput4CodeBased$allocationRatios, dataInput4$allocationRatios, tolerance = 1e-07) + expect_equal(dataInput4CodeBased$expectedEvents, dataInput4$expectedEvents, tolerance = 1e-07) + expect_equal(dataInput4CodeBased$varianceEvents, dataInput4$varianceEvents, tolerance = 1e-07) + expect_type(names(dataInput4), "character") + df <- as.data.frame(dataInput4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dataInput4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + design1 <- getDesignInverseNormal( + kMax = 3, typeOfDesign = "asP", typeBetaSpending = "bsKD", gammaB = 1.3, alpha = 0.02, + informationRates = c(0.4, 0.7, 1), bindingFutility = FALSE, beta = 0.1 + ) + + x2 <- getAnalysisResults( + design = design1, + dataInput = dataInput4, + stratifiedAnalysis = TRUE, + directionUpper = TRUE, + stage = 2, + nPlanned = 30, + thetaH1 = 2, + allocationRatioPlanned = 1, + intersectionTest = "Sidak" + ) + + ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x2' with expected results + expect_equal(x2$conditionalRejectionProbabilities[1, ], c(0.043010929, 0.0010677592, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(x2$conditionalRejectionProbabilities[2, ], c(0.063395248, 0.0010677592, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(x2$conditionalRejectionProbabilities[3, ], c(0.15397803, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(x2$conditionalPower[1, ], c(NA_real_, NA_real_, 0.12050895), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(x2$conditionalPower[2, ], c(NA_real_, NA_real_, 0.12050895), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(x2$conditionalPower[3, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalLowerBounds[1, ], c(0.62578554, 0.64439022, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalLowerBounds[2, ], c(0.75127376, 0.66639106, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalLowerBounds[3, ], c(0.96321381, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalUpperBounds[1, ], c(4.9893102, 2.8192192, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalUpperBounds[2, ], c(6.2314391, 3.0969281, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalUpperBounds[3, ], c(3.5981376, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(x2$repeatedPValues[1, ], c(0.13298203, 0.13298203, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(x2$repeatedPValues[2, ], c(0.092701773, 0.092701773, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(x2$repeatedPValues[3, ], c(0.031299575, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x2), NA))) + expect_output(print(x2)$show()) + invisible(capture.output(expect_error(summary(x2), NA))) + expect_output(summary(x2)$show()) + x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) + expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) + expect_type(names(x2), "character") + df <- as.data.frame(x2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } }) - diff --git a/tests/testthat/test-f_analysis_input_validation.R b/tests/testthat/test-f_analysis_input_validation.R index 0e874f94..b8c28634 100644 --- a/tests/testthat/test-f_analysis_input_validation.R +++ b/tests/testthat/test-f_analysis_input_validation.R @@ -1,114 +1,115 @@ -## | -## | *Unit tests* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | RPACT package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File name: test-f_analysis_input_validation.R -## | Creation date: 08 November 2023, 08:56:03 -## | File version: $Revision: 7662 $ -## | Last changed: $Date: 2024-02-23 12:42:26 +0100 (Fr, 23 Feb 2024) $ -## | Last changed by: $Author: pahlke $ -## | - -test_plan_section("Testing the Correct Input Validation of All Analysis Functions") - - -test_that("Errors and warnings for calculation of analysis results with dataset of means", { - .skipTestIfDisabled() - - design1 <- getDesignInverseNormal( - kMax = 4, alpha = 0.02, futilityBounds = c(-0.5, 0, 0.5), - bindingFutility = FALSE, typeOfDesign = "asKD", gammaA = 1.2, informationRates = c(0.15, 0.4, 0.7, 1) - ) - - design3 <- getDesignConditionalDunnett(alpha = 0.02, informationAtInterim = 0.4, secondStageConditioning = TRUE) - - dataExample1 <- getDataset( - n = c(13, 25), - means = c(24.2, 22.2), - stDevs = c(24.4, 22.1) - ) - - dataExample2 <- getDataset( - n1 = c(13, 25), - n2 = c(15, 27), - means1 = c(24.2, 22.2), - means2 = c(18.8, 27.7), - stDevs1 = c(24.4, 22.1), - stDevs2 = c(21.2, 23.7) - ) - - dataExample4 <- getDataset( - n1 = c(13, 25), - n2 = c(15, NA), - n3 = c(14, 27), - n4 = c(12, 29), - means1 = c(24.2, 22.2), - means2 = c(18.8, NA), - means3 = c(26.7, 27.7), - means4 = c(9.2, 12.2), - stDevs1 = c(24.4, 22.1), - stDevs2 = c(21.2, NA), - stDevs3 = c(25.6, 23.2), - stDevs4 = c(21.5, 22.7) - ) - - expect_error(getAnalysisResults( - design = design1, dataInput = dataExample4, - intersectionTest = "", varianceOption = "notPooled", nPlanned = c(20, 20) - )) - expect_error(getAnalysisResults( - design = design1, dataInput = dataExample4, - intersectionTest = "Simes", varianceOption = "X", nPlanned = c(20, 20) - )) - expect_error(getAnalysisResults( - design = design1, dataInput = dataExample4, - intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = c(20, 20, 30) - )) - expect_error(getAnalysisResults( - design = design1, dataInput = dataExample4, - intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = 20 - )) - expect_error(getAnalysisResults( - design = design1, dataInput = dataExample4, - intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = c() - )) - expect_error(getAnalysisResults( - design = design1, dataInput = dataExample4, - intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = numeric(0) - )) - - expect_error(getAnalysisResults( - design = design3, dataInput = dataExample4, - intersectionTest = "Dunnett", varianceOption = "pairwisePooled" - ), - paste0( - "Illegal argument: variance option ('pairwisePooled') must be 'overallPooled' ", - "because conditional Dunnett test was specified as design" - ), - fixed = TRUE - ) - - expect_error(getAnalysisResults( - design = design1, dataInput = dataExample4, - intersectionTest = "Dunnett", varianceOption = "pairwisePooled", nPlanned = c(20, 20) - ), - "Dunnett t test can only be performed with overall variance estimation", - fixed = TRUE - ) - - expect_error(getConditionalPower(getStageResults(design1, dataInput = dataExample2), - nPlanned = c(20, 20), allocationRatioPlanned = -1 - )) -}) - +## | +## | *Unit tests* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | RPACT package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File name: test-f_analysis_input_validation.R +## | Creation date: 08 November 2023, 08:56:03 +## | File version: $Revision: 7662 $ +## | Last changed: $Date: 2024-02-23 12:42:26 +0100 (Fr, 23 Feb 2024) $ +## | Last changed by: $Author: pahlke $ +## | + +test_plan_section("Testing the Correct Input Validation of All Analysis Functions") + + +test_that("Errors and warnings for calculation of analysis results with dataset of means", { + .skipTestIfDisabled() + + design1 <- getDesignInverseNormal( + kMax = 4, alpha = 0.02, futilityBounds = c(-0.5, 0, 0.5), + bindingFutility = FALSE, typeOfDesign = "asKD", gammaA = 1.2, informationRates = c(0.15, 0.4, 0.7, 1) + ) + + design3 <- getDesignConditionalDunnett(alpha = 0.02, informationAtInterim = 0.4, secondStageConditioning = TRUE) + + dataExample1 <- getDataset( + n = c(13, 25), + means = c(24.2, 22.2), + stDevs = c(24.4, 22.1) + ) + + dataExample2 <- getDataset( + n1 = c(13, 25), + n2 = c(15, 27), + means1 = c(24.2, 22.2), + means2 = c(18.8, 27.7), + stDevs1 = c(24.4, 22.1), + stDevs2 = c(21.2, 23.7) + ) + + dataExample4 <- getDataset( + n1 = c(13, 25), + n2 = c(15, NA), + n3 = c(14, 27), + n4 = c(12, 29), + means1 = c(24.2, 22.2), + means2 = c(18.8, NA), + means3 = c(26.7, 27.7), + means4 = c(9.2, 12.2), + stDevs1 = c(24.4, 22.1), + stDevs2 = c(21.2, NA), + stDevs3 = c(25.6, 23.2), + stDevs4 = c(21.5, 22.7) + ) + + expect_error(getAnalysisResults( + design = design1, dataInput = dataExample4, + intersectionTest = "", varianceOption = "notPooled", nPlanned = c(20, 20) + )) + expect_error(getAnalysisResults( + design = design1, dataInput = dataExample4, + intersectionTest = "Simes", varianceOption = "X", nPlanned = c(20, 20) + )) + expect_error(getAnalysisResults( + design = design1, dataInput = dataExample4, + intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = c(20, 20, 30) + )) + expect_error(getAnalysisResults( + design = design1, dataInput = dataExample4, + intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = 20 + )) + expect_error(getAnalysisResults( + design = design1, dataInput = dataExample4, + intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = c() + )) + expect_error(getAnalysisResults( + design = design1, dataInput = dataExample4, + intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = numeric(0) + )) + + expect_error(getAnalysisResults( + design = design3, dataInput = dataExample4, + intersectionTest = "Dunnett", varianceOption = "pairwisePooled" + ), + paste0( + "Illegal argument: variance option ('pairwisePooled') must be 'overallPooled' ", + "because conditional Dunnett test was specified as design" + ), + fixed = TRUE + ) + + expect_error(getAnalysisResults( + design = design1, dataInput = dataExample4, + intersectionTest = "Dunnett", varianceOption = "pairwisePooled", nPlanned = c(20, 20) + ), + "Dunnett t test can only be performed with overall variance estimation", + fixed = TRUE + ) + + expect_error(getConditionalPower(getStageResults(design1, dataInput = dataExample2), + nPlanned = c(20, 20), allocationRatioPlanned = -1 + )) + +}) + diff --git a/tests/testthat/test-f_analysis_multiarm_means.R b/tests/testthat/test-f_analysis_multiarm_means.R index 50fd1931..38557ee7 100644 --- a/tests/testthat/test-f_analysis_multiarm_means.R +++ b/tests/testthat/test-f_analysis_multiarm_means.R @@ -1,5486 +1,5648 @@ -## | +## | ## | *Unit tests* -## | +## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | +## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | +## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org -## | +## | ## | Contact us for information about our services: info@rpact.com -## | +## | ## | File name: test-f_analysis_multiarm_means.R ## | Creation date: 08 November 2023, 08:56:03 -## | File version: $Revision: 7662 $ -## | Last changed: $Date: 2024-02-23 12:42:26 +0100 (Fr, 23 Feb 2024) $ +## | File version: $Revision: 7682 $ +## | Last changed: $Date: 2024-03-05 07:53:40 +0100 (Di, 05 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ -## | +## | test_plan_section("Testing the Analysis Means Functionality for Three or More Treatments") test_that("'getAnalysisResultsMultiArm' with dataset of means", { - - design1 <- getDesignInverseNormal( - kMax = 4, alpha = 0.02, futilityBounds = c(-0.5, 0, 0.5), - bindingFutility = FALSE, typeOfDesign = "asKD", gammaA = 1.2, informationRates = c(0.15, 0.4, 0.7, 1) - ) - - design2 <- getDesignFisher( - kMax = 4, alpha = 0.02, alpha0Vec = c(0.7, 0.5, 0.3), method = "equalAlpha", - bindingFutility = TRUE, informationRates = c(0.15, 0.4, 0.7, 1) - ) - - design3 <- getDesignConditionalDunnett(alpha = 0.02, informationAtInterim = 0.4, secondStageConditioning = TRUE) - - # directionUpper = TRUE - dataExample1 <- getDataset( - n1 = c(13, 25), - n2 = c(15, NA), - n3 = c(14, 27), - n4 = c(12, 29), - means1 = c(24.2, 22.2), - means2 = c(18.8, NA), - means3 = c(26.7, 27.7), - means4 = c(9.2, 12.2), - stDevs1 = c(24.4, 22.1), - stDevs2 = c(21.2, NA), - stDevs3 = c(25.6, 23.2), - stDevs4 = c(21.5, 22.7) - ) - - # directionUpper = FALSE - dataExample2 <- getDataset( - n1 = c(13, 25), - n2 = c(15, NA), - n3 = c(14, 27), - n4 = c(12, 29), - means1 = -c(24.2, 22.2), - means2 = -c(18.8, NA), - means3 = -c(26.7, 27.7), - means4 = -c(9.2, 12.2), - stDevs1 = c(24.4, 22.1), - stDevs2 = c(21.2, NA), - stDevs3 = c(25.6, 23.2), - stDevs4 = c(21.5, 22.7) - ) - - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results1 <- getAnalysisResults(design = design1, dataInput = dataExample1, - intersectionTest = "Bonferroni", varianceOption = "notPooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results1' with expected results - expect_equal(results1$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results1$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results1$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results1$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results1$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results1$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results1$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results1$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results1$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results1$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results1$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results1$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results1$conditionalRejectionProbabilities[1, ], c(0.043739576, 0.16022367, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results1$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results1$conditionalRejectionProbabilities[2, ], c(0.03844608, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results1$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results1$conditionalRejectionProbabilities[3, ], c(0.048616927, 0.34001465, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results1$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results1$conditionalPower[1, ], c(NA_real_, NA_real_, 0.45838936, 0.70196346), tolerance = 1e-06, label = paste0("c(", paste0(results1$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results1$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results1$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results1$conditionalPower[3, ], c(NA_real_, NA_real_, 0.827255, 0.9465652), tolerance = 1e-06, label = paste0("c(", paste0(results1$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results1$repeatedConfidenceIntervalLowerBounds[1, ], c(-14.395028, -4.0669228, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results1$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results1$repeatedConfidenceIntervalLowerBounds[2, ], c(-16.891548, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results1$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results1$repeatedConfidenceIntervalLowerBounds[3, ], c(-12.071338, 0.24153969, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results1$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results1$repeatedConfidenceIntervalUpperBounds[1, ], c(44.395028, 27.895908, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results1$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results1$repeatedConfidenceIntervalUpperBounds[2, ], c(36.091548, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results1$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results1$repeatedConfidenceIntervalUpperBounds[3, ], c(47.071339, 32.285152, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results1$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results1$repeatedPValues[1, ], c(0.5, 0.072888275, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results1$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results1$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results1$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results1$repeatedPValues[3, ], c(0.5, 0.017155659, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results1$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results1), NA))) - expect_output(print(results1)$show()) - invisible(capture.output(expect_error(summary(results1), NA))) - expect_output(summary(results1)$show()) - results1CodeBased <- eval(parse(text = getObjectRCode(results1, stringWrapParagraphWidth = NULL))) - expect_equal(results1CodeBased$thetaH1, results1$thetaH1, tolerance = 1e-06) - expect_equal(results1CodeBased$assumedStDevs, results1$assumedStDevs, tolerance = 1e-06) - expect_equal(results1CodeBased$conditionalRejectionProbabilities, results1$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results1CodeBased$conditionalPower, results1$conditionalPower, tolerance = 1e-06) - expect_equal(results1CodeBased$repeatedConfidenceIntervalLowerBounds, results1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results1CodeBased$repeatedConfidenceIntervalUpperBounds, results1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results1CodeBased$repeatedPValues, results1$repeatedPValues, tolerance = 1e-06) - expect_type(names(results1), "character") - df <- as.data.frame(results1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - .skipTestIfDisabled() - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results2 <- getAnalysisResults(design = design1, dataInput = dataExample1, - intersectionTest = "Bonferroni", varianceOption = "notPooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results2' with expected results - expect_equal(results2$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results2$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results2$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results2$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results2$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results2$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results2$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results2$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results2$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results2$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results2$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results2$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results2$conditionalRejectionProbabilities[1, ], c(0.040100206, 0.14400686, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results2$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results2$conditionalRejectionProbabilities[2, ], c(0.037171319, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results2$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results2$conditionalRejectionProbabilities[3, ], c(0.042866371, 0.28890175, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results2$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results2$conditionalPower[1, ], c(NA_real_, NA_real_, 0.42767622, 0.67947129), tolerance = 1e-06, label = paste0("c(", paste0(results2$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results2$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results2$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results2$conditionalPower[3, ], c(NA_real_, NA_real_, 0.78417464, 0.93070164), tolerance = 1e-06, label = paste0("c(", paste0(results2$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results2$repeatedConfidenceIntervalLowerBounds[1, ], c(-18.433726, -4.7641755, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results2$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results2$repeatedConfidenceIntervalLowerBounds[2, ], c(-20.426743, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results2$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results2$repeatedConfidenceIntervalLowerBounds[3, ], c(-15.938808, -0.40329832, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results2$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results2$repeatedConfidenceIntervalUpperBounds[1, ], c(48.433726, 28.584393, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results2$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results2$repeatedConfidenceIntervalUpperBounds[2, ], c(39.626743, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results2$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results2$repeatedConfidenceIntervalUpperBounds[3, ], c(50.938808, 32.927366, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results2$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results2$repeatedPValues[1, ], c(0.5, 0.085188742, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results2$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results2$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results2$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results2$repeatedPValues[3, ], c(0.5, 0.025112148, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results2$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results2), NA))) - expect_output(print(results2)$show()) - invisible(capture.output(expect_error(summary(results2), NA))) - expect_output(summary(results2)$show()) - results2CodeBased <- eval(parse(text = getObjectRCode(results2, stringWrapParagraphWidth = NULL))) - expect_equal(results2CodeBased$thetaH1, results2$thetaH1, tolerance = 1e-06) - expect_equal(results2CodeBased$assumedStDevs, results2$assumedStDevs, tolerance = 1e-06) - expect_equal(results2CodeBased$conditionalRejectionProbabilities, results2$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results2CodeBased$conditionalPower, results2$conditionalPower, tolerance = 1e-06) - expect_equal(results2CodeBased$repeatedConfidenceIntervalLowerBounds, results2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results2CodeBased$repeatedConfidenceIntervalUpperBounds, results2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results2CodeBased$repeatedPValues, results2$repeatedPValues, tolerance = 1e-06) - expect_type(names(results2), "character") - df <- as.data.frame(results2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results3 <- getAnalysisResults(design = design1, dataInput = dataExample1, - intersectionTest = "Bonferroni", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results3' with expected results - expect_equal(results3$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results3$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results3$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results3$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results3$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results3$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results3$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results3$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results3$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results3$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results3$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results3$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results3$conditionalRejectionProbabilities[1, ], c(0.042394596, 0.15198143, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results3$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results3$conditionalRejectionProbabilities[2, ], c(0.034321105, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results3$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results3$conditionalRejectionProbabilities[3, ], c(0.049947129, 0.35588618, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results3$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results3$conditionalPower[1, ], c(NA_real_, NA_real_, 0.44302928, 0.69082025), tolerance = 1e-06, label = paste0("c(", paste0(results3$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results3$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results3$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results3$conditionalPower[3, ], c(NA_real_, NA_real_, 0.83889182, 0.95069292), tolerance = 1e-06, label = paste0("c(", paste0(results3$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results3$repeatedConfidenceIntervalLowerBounds[1, ], c(-14.802158, -4.2854677, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results3$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results3$repeatedConfidenceIntervalLowerBounds[2, ], c(-19.232721, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results3$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results3$repeatedConfidenceIntervalLowerBounds[3, ], c(-11.786808, 0.41764226, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results3$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results3$repeatedConfidenceIntervalUpperBounds[1, ], c(44.802158, 28.113845, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results3$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results3$repeatedConfidenceIntervalUpperBounds[2, ], c(38.432721, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results3$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results3$repeatedConfidenceIntervalUpperBounds[3, ], c(46.786808, 32.10754, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results3$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results3$repeatedPValues[1, ], c(0.5, 0.078823932, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results3$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results3$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results3$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results3$repeatedPValues[3, ], c(0.5, 0.015272156, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results3$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results3), NA))) - expect_output(print(results3)$show()) - invisible(capture.output(expect_error(summary(results3), NA))) - expect_output(summary(results3)$show()) - results3CodeBased <- eval(parse(text = getObjectRCode(results3, stringWrapParagraphWidth = NULL))) - expect_equal(results3CodeBased$thetaH1, results3$thetaH1, tolerance = 1e-06) - expect_equal(results3CodeBased$assumedStDevs, results3$assumedStDevs, tolerance = 1e-06) - expect_equal(results3CodeBased$conditionalRejectionProbabilities, results3$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results3CodeBased$conditionalPower, results3$conditionalPower, tolerance = 1e-06) - expect_equal(results3CodeBased$repeatedConfidenceIntervalLowerBounds, results3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results3CodeBased$repeatedConfidenceIntervalUpperBounds, results3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results3CodeBased$repeatedPValues, results3$repeatedPValues, tolerance = 1e-06) - expect_type(names(results3), "character") - df <- as.data.frame(results3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results4 <- getAnalysisResults(design = design1, dataInput = dataExample1, - intersectionTest = "Bonferroni", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results4' with expected results - expect_equal(results4$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results4$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results4$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results4$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results4$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results4$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results4$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results4$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results4$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results4$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results4$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results4$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results4$conditionalRejectionProbabilities[1, ], c(0.040740209, 0.14372404, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results4$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results4$conditionalRejectionProbabilities[2, ], c(0.033856262, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results4$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results4$conditionalRejectionProbabilities[3, ], c(0.046882975, 0.32321322, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results4$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results4$conditionalPower[1, ], c(NA_real_, NA_real_, 0.42712247, 0.6790579), tolerance = 1e-06, label = paste0("c(", paste0(results4$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results4$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results4$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results4$conditionalPower[3, ], c(NA_real_, NA_real_, 0.81409137, 0.94181531), tolerance = 1e-06, label = paste0("c(", paste0(results4$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results4$repeatedConfidenceIntervalLowerBounds[1, ], c(-16.567569, -4.662798, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results4$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results4$repeatedConfidenceIntervalLowerBounds[2, ], c(-20.940706, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results4$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results4$repeatedConfidenceIntervalLowerBounds[3, ], c(-13.521691, 0.049006969, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results4$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results4$repeatedConfidenceIntervalUpperBounds[1, ], c(46.567569, 28.528695, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results4$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results4$repeatedConfidenceIntervalUpperBounds[2, ], c(40.140706, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results4$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results4$repeatedConfidenceIntervalUpperBounds[3, ], c(48.521691, 32.491814, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results4$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results4$repeatedPValues[1, ], c(0.5, 0.08542716, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results4$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results4$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results4$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results4$repeatedPValues[3, ], c(0.5, 0.019420631, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results4$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results4), NA))) - expect_output(print(results4)$show()) - invisible(capture.output(expect_error(summary(results4), NA))) - expect_output(summary(results4)$show()) - results4CodeBased <- eval(parse(text = getObjectRCode(results4, stringWrapParagraphWidth = NULL))) - expect_equal(results4CodeBased$thetaH1, results4$thetaH1, tolerance = 1e-06) - expect_equal(results4CodeBased$assumedStDevs, results4$assumedStDevs, tolerance = 1e-06) - expect_equal(results4CodeBased$conditionalRejectionProbabilities, results4$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results4CodeBased$conditionalPower, results4$conditionalPower, tolerance = 1e-06) - expect_equal(results4CodeBased$repeatedConfidenceIntervalLowerBounds, results4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results4CodeBased$repeatedConfidenceIntervalUpperBounds, results4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results4CodeBased$repeatedPValues, results4$repeatedPValues, tolerance = 1e-06) - expect_type(names(results4), "character") - df <- as.data.frame(results4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results5 <- getAnalysisResults(design = design1, dataInput = dataExample1, - intersectionTest = "Bonferroni", varianceOption = "pairwisePooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results5' with expected results - expect_equal(results5$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results5$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results5$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results5$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results5$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results5$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results5$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results5$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results5$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results5$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results5$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results5$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results5$conditionalRejectionProbabilities[1, ], c(0.043219831, 0.15803856, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results5$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results5$conditionalRejectionProbabilities[2, ], c(0.038533075, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results5$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results5$conditionalRejectionProbabilities[3, ], c(0.046782116, 0.33290332, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results5$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results5$conditionalPower[1, ], c(NA_real_, NA_real_, 0.45436587, 0.6990644), tolerance = 1e-06, label = paste0("c(", paste0(results5$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results5$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results5$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results5$conditionalPower[3, ], c(NA_real_, NA_real_, 0.8217936, 0.94460493), tolerance = 1e-06, label = paste0("c(", paste0(results5$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results5$repeatedConfidenceIntervalLowerBounds[1, ], c(-14.549821, -4.1213996, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results5$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results5$repeatedConfidenceIntervalLowerBounds[2, ], c(-16.848567, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results5$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results5$repeatedConfidenceIntervalLowerBounds[3, ], c(-12.483405, 0.16013976, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results5$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results5$repeatedConfidenceIntervalUpperBounds[1, ], c(44.549821, 27.945069, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results5$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results5$repeatedConfidenceIntervalUpperBounds[2, ], c(36.048567, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results5$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results5$repeatedConfidenceIntervalUpperBounds[3, ], c(47.483405, 32.356999, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results5$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results5$repeatedPValues[1, ], c(0.5, 0.07440366, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results5$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results5$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results5$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results5$repeatedPValues[3, ], c(0.5, 0.018077861, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results5$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results5), NA))) - expect_output(print(results5)$show()) - invisible(capture.output(expect_error(summary(results5), NA))) - expect_output(summary(results5)$show()) - results5CodeBased <- eval(parse(text = getObjectRCode(results5, stringWrapParagraphWidth = NULL))) - expect_equal(results5CodeBased$thetaH1, results5$thetaH1, tolerance = 1e-06) - expect_equal(results5CodeBased$assumedStDevs, results5$assumedStDevs, tolerance = 1e-06) - expect_equal(results5CodeBased$conditionalRejectionProbabilities, results5$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results5CodeBased$conditionalPower, results5$conditionalPower, tolerance = 1e-06) - expect_equal(results5CodeBased$repeatedConfidenceIntervalLowerBounds, results5$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results5CodeBased$repeatedConfidenceIntervalUpperBounds, results5$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results5CodeBased$repeatedPValues, results5$repeatedPValues, tolerance = 1e-06) - expect_type(names(results5), "character") - df <- as.data.frame(results5) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results5) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results6 <- getAnalysisResults(design = design1, dataInput = dataExample1, - intersectionTest = "Bonferroni", varianceOption = "pairwisePooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results6' with expected results - expect_equal(results6$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results6$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results6$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results6$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results6$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results6$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results6$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results6$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results6$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results6$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results6$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results6$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results6$conditionalRejectionProbabilities[1, ], c(0.039664178, 0.14221619, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results6$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results6$conditionalRejectionProbabilities[2, ], c(0.037322005, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results6$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results6$conditionalRejectionProbabilities[3, ], c(0.041377736, 0.28315003, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results6$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results6$conditionalPower[1, ], c(NA_real_, NA_real_, 0.42415922, 0.67684078), tolerance = 1e-06, label = paste0("c(", paste0(results6$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results6$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results6$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results6$conditionalPower[3, ], c(NA_real_, NA_real_, 0.77871789, 0.92862656), tolerance = 1e-06, label = paste0("c(", paste0(results6$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results6$repeatedConfidenceIntervalLowerBounds[1, ], c(-18.601467, -4.8144337, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results6$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results6$repeatedConfidenceIntervalLowerBounds[2, ], c(-20.153637, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results6$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results6$repeatedConfidenceIntervalLowerBounds[3, ], c(-16.403927, -0.48327212, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results6$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results6$repeatedConfidenceIntervalUpperBounds[1, ], c(48.601467, 28.627869, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results6$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results6$repeatedConfidenceIntervalUpperBounds[2, ], c(39.353637, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results6$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results6$repeatedConfidenceIntervalUpperBounds[3, ], c(51.403927, 32.999307, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results6$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results6$repeatedPValues[1, ], c(0.5, 0.086711756, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results6$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results6$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results6$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results6$repeatedPValues[3, ], c(0.5, 0.026234621, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results6$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results6), NA))) - expect_output(print(results6)$show()) - invisible(capture.output(expect_error(summary(results6), NA))) - expect_output(summary(results6)$show()) - results6CodeBased <- eval(parse(text = getObjectRCode(results6, stringWrapParagraphWidth = NULL))) - expect_equal(results6CodeBased$thetaH1, results6$thetaH1, tolerance = 1e-06) - expect_equal(results6CodeBased$assumedStDevs, results6$assumedStDevs, tolerance = 1e-06) - expect_equal(results6CodeBased$conditionalRejectionProbabilities, results6$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results6CodeBased$conditionalPower, results6$conditionalPower, tolerance = 1e-06) - expect_equal(results6CodeBased$repeatedConfidenceIntervalLowerBounds, results6$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results6CodeBased$repeatedConfidenceIntervalUpperBounds, results6$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results6CodeBased$repeatedPValues, results6$repeatedPValues, tolerance = 1e-06) - expect_type(names(results6), "character") - df <- as.data.frame(results6) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results6) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results7 <- getAnalysisResults(design = design1, dataInput = dataExample1, - intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results7' with expected results - expect_equal(results7$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results7$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results7$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results7$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results7$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results7$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results7$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results7$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results7$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results7$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results7$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results7$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results7$conditionalRejectionProbabilities[1, ], c(0.043739576, 0.16022367, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results7$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results7$conditionalRejectionProbabilities[2, ], c(0.03844608, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results7$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results7$conditionalRejectionProbabilities[3, ], c(0.052717287, 0.35672949, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results7$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results7$conditionalPower[1, ], c(NA_real_, NA_real_, 0.45838936, 0.70196346), tolerance = 1e-06, label = paste0("c(", paste0(results7$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results7$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results7$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results7$conditionalPower[3, ], c(NA_real_, NA_real_, 0.83948961, 0.95090316), tolerance = 1e-06, label = paste0("c(", paste0(results7$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results7$repeatedConfidenceIntervalLowerBounds[1, ], c(-14.395028, -4.0669228, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results7$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results7$repeatedConfidenceIntervalLowerBounds[2, ], c(-16.891548, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results7$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results7$repeatedConfidenceIntervalLowerBounds[3, ], c(-12.071338, 0.24153969, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results7$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results7$repeatedConfidenceIntervalUpperBounds[1, ], c(44.395028, 27.895908, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results7$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results7$repeatedConfidenceIntervalUpperBounds[2, ], c(36.091548, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results7$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results7$repeatedConfidenceIntervalUpperBounds[3, ], c(47.071339, 32.285152, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results7$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results7$repeatedPValues[1, ], c(0.5, 0.072888275, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results7$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results7$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results7$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results7$repeatedPValues[3, ], c(0.5, 0.015177743, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results7$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results7), NA))) - expect_output(print(results7)$show()) - invisible(capture.output(expect_error(summary(results7), NA))) - expect_output(summary(results7)$show()) - results7CodeBased <- eval(parse(text = getObjectRCode(results7, stringWrapParagraphWidth = NULL))) - expect_equal(results7CodeBased$thetaH1, results7$thetaH1, tolerance = 1e-06) - expect_equal(results7CodeBased$assumedStDevs, results7$assumedStDevs, tolerance = 1e-06) - expect_equal(results7CodeBased$conditionalRejectionProbabilities, results7$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results7CodeBased$conditionalPower, results7$conditionalPower, tolerance = 1e-06) - expect_equal(results7CodeBased$repeatedConfidenceIntervalLowerBounds, results7$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results7CodeBased$repeatedConfidenceIntervalUpperBounds, results7$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results7CodeBased$repeatedPValues, results7$repeatedPValues, tolerance = 1e-06) - expect_type(names(results7), "character") - df <- as.data.frame(results7) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results7) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results8 <- getAnalysisResults(design = design1, dataInput = dataExample1, - intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results8' with expected results - expect_equal(results8$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results8$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results8$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results8$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results8$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results8$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results8$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results8$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results8$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results8$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results8$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results8$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results8$conditionalRejectionProbabilities[1, ], c(0.040100206, 0.14400686, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results8$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results8$conditionalRejectionProbabilities[2, ], c(0.037171319, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results8$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results8$conditionalRejectionProbabilities[3, ], c(0.048708233, 0.3133215, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results8$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results8$conditionalPower[1, ], c(NA_real_, NA_real_, 0.42767622, 0.67947129), tolerance = 1e-06, label = paste0("c(", paste0(results8$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results8$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results8$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results8$conditionalPower[3, ], c(NA_real_, NA_real_, 0.80590445, 0.93881804), tolerance = 1e-06, label = paste0("c(", paste0(results8$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results8$repeatedConfidenceIntervalLowerBounds[1, ], c(-18.433726, -4.7641755, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results8$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results8$repeatedConfidenceIntervalLowerBounds[2, ], c(-20.426743, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results8$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results8$repeatedConfidenceIntervalLowerBounds[3, ], c(-15.938808, -0.40329832, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results8$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results8$repeatedConfidenceIntervalUpperBounds[1, ], c(48.433726, 28.584393, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results8$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results8$repeatedConfidenceIntervalUpperBounds[2, ], c(39.626743, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results8$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results8$repeatedConfidenceIntervalUpperBounds[3, ], c(50.938808, 32.927366, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results8$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results8$repeatedPValues[1, ], c(0.5, 0.085188742, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results8$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results8$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results8$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results8$repeatedPValues[3, ], c(0.5, 0.020901685, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results8$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results8), NA))) - expect_output(print(results8)$show()) - invisible(capture.output(expect_error(summary(results8), NA))) - expect_output(summary(results8)$show()) - results8CodeBased <- eval(parse(text = getObjectRCode(results8, stringWrapParagraphWidth = NULL))) - expect_equal(results8CodeBased$thetaH1, results8$thetaH1, tolerance = 1e-06) - expect_equal(results8CodeBased$assumedStDevs, results8$assumedStDevs, tolerance = 1e-06) - expect_equal(results8CodeBased$conditionalRejectionProbabilities, results8$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results8CodeBased$conditionalPower, results8$conditionalPower, tolerance = 1e-06) - expect_equal(results8CodeBased$repeatedConfidenceIntervalLowerBounds, results8$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results8CodeBased$repeatedConfidenceIntervalUpperBounds, results8$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results8CodeBased$repeatedPValues, results8$repeatedPValues, tolerance = 1e-06) - expect_type(names(results8), "character") - df <- as.data.frame(results8) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results8) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results9 <- getAnalysisResults(design = design1, dataInput = dataExample1, - intersectionTest = "Simes", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results9' with expected results - expect_equal(results9$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results9$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results9$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results9$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results9$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results9$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results9$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results9$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results9$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results9$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results9$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results9$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results9$conditionalRejectionProbabilities[1, ], c(0.042394596, 0.15198143, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results9$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results9$conditionalRejectionProbabilities[2, ], c(0.034321105, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results9$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results9$conditionalRejectionProbabilities[3, ], c(0.051237296, 0.36121246, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results9$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results9$conditionalPower[1, ], c(NA_real_, NA_real_, 0.44302928, 0.69082025), tolerance = 1e-06, label = paste0("c(", paste0(results9$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results9$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results9$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results9$conditionalPower[3, ], c(NA_real_, NA_real_, 0.84263383, 0.95200602), tolerance = 1e-06, label = paste0("c(", paste0(results9$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results9$repeatedConfidenceIntervalLowerBounds[1, ], c(-14.802158, -4.2854677, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results9$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results9$repeatedConfidenceIntervalLowerBounds[2, ], c(-19.232721, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results9$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results9$repeatedConfidenceIntervalLowerBounds[3, ], c(-11.786808, 0.41764226, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results9$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results9$repeatedConfidenceIntervalUpperBounds[1, ], c(44.802158, 28.113845, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results9$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results9$repeatedConfidenceIntervalUpperBounds[2, ], c(38.432721, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results9$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results9$repeatedConfidenceIntervalUpperBounds[3, ], c(46.786808, 32.10754, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results9$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results9$repeatedPValues[1, ], c(0.5, 0.078823932, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results9$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results9$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results9$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results9$repeatedPValues[3, ], c(0.5, 0.014689462, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results9$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results9), NA))) - expect_output(print(results9)$show()) - invisible(capture.output(expect_error(summary(results9), NA))) - expect_output(summary(results9)$show()) - results9CodeBased <- eval(parse(text = getObjectRCode(results9, stringWrapParagraphWidth = NULL))) - expect_equal(results9CodeBased$thetaH1, results9$thetaH1, tolerance = 1e-06) - expect_equal(results9CodeBased$assumedStDevs, results9$assumedStDevs, tolerance = 1e-06) - expect_equal(results9CodeBased$conditionalRejectionProbabilities, results9$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results9CodeBased$conditionalPower, results9$conditionalPower, tolerance = 1e-06) - expect_equal(results9CodeBased$repeatedConfidenceIntervalLowerBounds, results9$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results9CodeBased$repeatedConfidenceIntervalUpperBounds, results9$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results9CodeBased$repeatedPValues, results9$repeatedPValues, tolerance = 1e-06) - expect_type(names(results9), "character") - df <- as.data.frame(results9) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results9) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results10 <- getAnalysisResults(design = design1, dataInput = dataExample1, - intersectionTest = "Simes", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results10' with expected results - expect_equal(results10$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results10$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results10$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results10$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results10$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results10$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results10$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results10$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results10$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results10$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results10$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results10$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results10$conditionalRejectionProbabilities[1, ], c(0.040740209, 0.14372404, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results10$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results10$conditionalRejectionProbabilities[2, ], c(0.033856262, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results10$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results10$conditionalRejectionProbabilities[3, ], c(0.049414261, 0.33374326, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results10$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results10$conditionalPower[1, ], c(NA_real_, NA_real_, 0.42712247, 0.6790579), tolerance = 1e-06, label = paste0("c(", paste0(results10$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results10$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results10$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results10$conditionalPower[3, ], c(NA_real_, NA_real_, 0.82244694, 0.94484021), tolerance = 1e-06, label = paste0("c(", paste0(results10$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results10$repeatedConfidenceIntervalLowerBounds[1, ], c(-16.567569, -4.662798, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results10$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results10$repeatedConfidenceIntervalLowerBounds[2, ], c(-20.940706, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results10$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results10$repeatedConfidenceIntervalLowerBounds[3, ], c(-13.521691, 0.049006969, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results10$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results10$repeatedConfidenceIntervalUpperBounds[1, ], c(46.567569, 28.528695, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results10$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results10$repeatedConfidenceIntervalUpperBounds[2, ], c(40.140706, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results10$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results10$repeatedConfidenceIntervalUpperBounds[3, ], c(48.521691, 32.491814, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results10$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results10$repeatedPValues[1, ], c(0.5, 0.08542716, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results10$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results10$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results10$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results10$repeatedPValues[3, ], c(0.5, 0.017966281, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results10$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results10), NA))) - expect_output(print(results10)$show()) - invisible(capture.output(expect_error(summary(results10), NA))) - expect_output(summary(results10)$show()) - results10CodeBased <- eval(parse(text = getObjectRCode(results10, stringWrapParagraphWidth = NULL))) - expect_equal(results10CodeBased$thetaH1, results10$thetaH1, tolerance = 1e-06) - expect_equal(results10CodeBased$assumedStDevs, results10$assumedStDevs, tolerance = 1e-06) - expect_equal(results10CodeBased$conditionalRejectionProbabilities, results10$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results10CodeBased$conditionalPower, results10$conditionalPower, tolerance = 1e-06) - expect_equal(results10CodeBased$repeatedConfidenceIntervalLowerBounds, results10$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results10CodeBased$repeatedConfidenceIntervalUpperBounds, results10$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results10CodeBased$repeatedPValues, results10$repeatedPValues, tolerance = 1e-06) - expect_type(names(results10), "character") - df <- as.data.frame(results10) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results10) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results11 <- getAnalysisResults(design = design1, dataInput = dataExample1, - intersectionTest = "Simes", varianceOption = "pairwisePooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results11' with expected results - expect_equal(results11$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results11$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results11$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results11$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results11$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results11$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results11$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results11$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results11$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results11$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results11$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results11$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results11$conditionalRejectionProbabilities[1, ], c(0.043219831, 0.15803856, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results11$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results11$conditionalRejectionProbabilities[2, ], c(0.038533075, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results11$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results11$conditionalRejectionProbabilities[3, ], c(0.052145589, 0.35513472, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results11$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results11$conditionalPower[1, ], c(NA_real_, NA_real_, 0.45436587, 0.6990644), tolerance = 1e-06, label = paste0("c(", paste0(results11$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results11$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results11$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results11$conditionalPower[3, ], c(NA_real_, NA_real_, 0.83835744, 0.95050484), tolerance = 1e-06, label = paste0("c(", paste0(results11$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results11$repeatedConfidenceIntervalLowerBounds[1, ], c(-14.549821, -4.1213996, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results11$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results11$repeatedConfidenceIntervalLowerBounds[2, ], c(-16.848567, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results11$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results11$repeatedConfidenceIntervalLowerBounds[3, ], c(-12.483405, 0.16013976, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results11$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results11$repeatedConfidenceIntervalUpperBounds[1, ], c(44.549821, 27.945069, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results11$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results11$repeatedConfidenceIntervalUpperBounds[2, ], c(36.048567, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results11$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results11$repeatedConfidenceIntervalUpperBounds[3, ], c(47.483405, 32.356999, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results11$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results11$repeatedPValues[1, ], c(0.5, 0.07440366, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results11$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results11$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results11$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results11$repeatedPValues[3, ], c(0.5, 0.015356079, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results11$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results11), NA))) - expect_output(print(results11)$show()) - invisible(capture.output(expect_error(summary(results11), NA))) - expect_output(summary(results11)$show()) - results11CodeBased <- eval(parse(text = getObjectRCode(results11, stringWrapParagraphWidth = NULL))) - expect_equal(results11CodeBased$thetaH1, results11$thetaH1, tolerance = 1e-06) - expect_equal(results11CodeBased$assumedStDevs, results11$assumedStDevs, tolerance = 1e-06) - expect_equal(results11CodeBased$conditionalRejectionProbabilities, results11$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results11CodeBased$conditionalPower, results11$conditionalPower, tolerance = 1e-06) - expect_equal(results11CodeBased$repeatedConfidenceIntervalLowerBounds, results11$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results11CodeBased$repeatedConfidenceIntervalUpperBounds, results11$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results11CodeBased$repeatedPValues, results11$repeatedPValues, tolerance = 1e-06) - expect_type(names(results11), "character") - df <- as.data.frame(results11) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results11) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results12 <- getAnalysisResults(design = design1, dataInput = dataExample1, - intersectionTest = "Simes", varianceOption = "pairwisePooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results12' with expected results - expect_equal(results12$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results12$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results12$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results12$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results12$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results12$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results12$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results12$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results12$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results12$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results12$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results12$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results12$conditionalRejectionProbabilities[1, ], c(0.039664178, 0.14221619, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results12$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results12$conditionalRejectionProbabilities[2, ], c(0.037322005, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results12$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results12$conditionalRejectionProbabilities[3, ], c(0.048226966, 0.31219358, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results12$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results12$conditionalPower[1, ], c(NA_real_, NA_real_, 0.42415922, 0.67684078), tolerance = 1e-06, label = paste0("c(", paste0(results12$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results12$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results12$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results12$conditionalPower[3, ], c(NA_real_, NA_real_, 0.80494934, 0.93846621), tolerance = 1e-06, label = paste0("c(", paste0(results12$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results12$repeatedConfidenceIntervalLowerBounds[1, ], c(-18.601467, -4.8144337, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results12$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results12$repeatedConfidenceIntervalLowerBounds[2, ], c(-20.153637, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results12$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results12$repeatedConfidenceIntervalLowerBounds[3, ], c(-16.403927, -0.48327212, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results12$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results12$repeatedConfidenceIntervalUpperBounds[1, ], c(48.601467, 28.627869, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results12$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results12$repeatedConfidenceIntervalUpperBounds[2, ], c(39.353637, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results12$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results12$repeatedConfidenceIntervalUpperBounds[3, ], c(51.403927, 32.999307, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results12$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results12$repeatedPValues[1, ], c(0.5, 0.086711756, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results12$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results12$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results12$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results12$repeatedPValues[3, ], c(0.5, 0.021078114, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results12$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results12), NA))) - expect_output(print(results12)$show()) - invisible(capture.output(expect_error(summary(results12), NA))) - expect_output(summary(results12)$show()) - results12CodeBased <- eval(parse(text = getObjectRCode(results12, stringWrapParagraphWidth = NULL))) - expect_equal(results12CodeBased$thetaH1, results12$thetaH1, tolerance = 1e-06) - expect_equal(results12CodeBased$assumedStDevs, results12$assumedStDevs, tolerance = 1e-06) - expect_equal(results12CodeBased$conditionalRejectionProbabilities, results12$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results12CodeBased$conditionalPower, results12$conditionalPower, tolerance = 1e-06) - expect_equal(results12CodeBased$repeatedConfidenceIntervalLowerBounds, results12$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results12CodeBased$repeatedConfidenceIntervalUpperBounds, results12$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results12CodeBased$repeatedPValues, results12$repeatedPValues, tolerance = 1e-06) - expect_type(names(results12), "character") - df <- as.data.frame(results12) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results12) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results13 <- getAnalysisResults(design = design1, dataInput = dataExample1, - intersectionTest = "Sidak", varianceOption = "notPooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results13' with expected results - expect_equal(results13$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results13$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results13$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results13$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results13$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results13$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results13$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results13$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results13$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results13$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results13$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results13$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results13$conditionalRejectionProbabilities[1, ], c(0.044513617, 0.16250147, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results13$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results13$conditionalRejectionProbabilities[2, ], c(0.03844608, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results13$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results13$conditionalRejectionProbabilities[3, ], c(0.049538053, 0.34419132, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results13$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results13$conditionalPower[1, ], c(NA_real_, NA_real_, 0.46254707, 0.70494473), tolerance = 1e-06, label = paste0("c(", paste0(results13$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results13$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results13$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results13$conditionalPower[3, ], c(NA_real_, NA_real_, 0.83038985, 0.94768376), tolerance = 1e-06, label = paste0("c(", paste0(results13$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results13$repeatedConfidenceIntervalLowerBounds[1, ], c(-14.393216, -4.0328452, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results13$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results13$repeatedConfidenceIntervalLowerBounds[2, ], c(-16.889915, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results13$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results13$repeatedConfidenceIntervalLowerBounds[3, ], c(-12.069516, 0.29402607, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results13$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results13$repeatedConfidenceIntervalUpperBounds[1, ], c(44.393216, 27.725836, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results13$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results13$repeatedConfidenceIntervalUpperBounds[2, ], c(36.089915, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results13$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results13$repeatedConfidenceIntervalUpperBounds[3, ], c(47.069516, 32.182569, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results13$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results13$repeatedPValues[1, ], c(0.5, 0.071351909, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results13$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results13$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results13$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results13$repeatedPValues[3, ], c(0.5, 0.016637815, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results13$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results13), NA))) - expect_output(print(results13)$show()) - invisible(capture.output(expect_error(summary(results13), NA))) - expect_output(summary(results13)$show()) - results13CodeBased <- eval(parse(text = getObjectRCode(results13, stringWrapParagraphWidth = NULL))) - expect_equal(results13CodeBased$thetaH1, results13$thetaH1, tolerance = 1e-06) - expect_equal(results13CodeBased$assumedStDevs, results13$assumedStDevs, tolerance = 1e-06) - expect_equal(results13CodeBased$conditionalRejectionProbabilities, results13$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results13CodeBased$conditionalPower, results13$conditionalPower, tolerance = 1e-06) - expect_equal(results13CodeBased$repeatedConfidenceIntervalLowerBounds, results13$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results13CodeBased$repeatedConfidenceIntervalUpperBounds, results13$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results13CodeBased$repeatedPValues, results13$repeatedPValues, tolerance = 1e-06) - expect_type(names(results13), "character") - df <- as.data.frame(results13) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results13) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results14 <- getAnalysisResults(design = design1, dataInput = dataExample1, - intersectionTest = "Sidak", varianceOption = "notPooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results14' with expected results - expect_equal(results14$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results14$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results14$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results14$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results14$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results14$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results14$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results14$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results14$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results14$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results14$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results14$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results14$conditionalRejectionProbabilities[1, ], c(0.040941914, 0.14648989, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results14$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results14$conditionalRejectionProbabilities[2, ], c(0.037171319, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results14$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results14$conditionalRejectionProbabilities[3, ], c(0.043912863, 0.29382832, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results14$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results14$conditionalPower[1, ], c(NA_real_, NA_real_, 0.4325103, 0.68306799), tolerance = 1e-06, label = paste0("c(", paste0(results14$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results14$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results14$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results14$conditionalPower[3, ], c(NA_real_, NA_real_, 0.78874215, 0.93242714), tolerance = 1e-06, label = paste0("c(", paste0(results14$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results14$repeatedConfidenceIntervalLowerBounds[1, ], c(-18.431163, -4.7231897, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results14$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results14$repeatedConfidenceIntervalLowerBounds[2, ], c(-20.424453, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results14$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results14$repeatedConfidenceIntervalLowerBounds[3, ], c(-15.936268, -0.34247232, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results14$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results14$repeatedConfidenceIntervalUpperBounds[1, ], c(48.431163, 28.407231, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results14$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results14$repeatedConfidenceIntervalUpperBounds[2, ], c(39.624453, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results14$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results14$repeatedConfidenceIntervalUpperBounds[3, ], c(50.936268, 32.815818, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results14$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results14$repeatedPValues[1, ], c(0.5, 0.083136439, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results14$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results14$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results14$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results14$repeatedPValues[3, ], c(0.5, 0.024192808, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results14$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results14), NA))) - expect_output(print(results14)$show()) - invisible(capture.output(expect_error(summary(results14), NA))) - expect_output(summary(results14)$show()) - results14CodeBased <- eval(parse(text = getObjectRCode(results14, stringWrapParagraphWidth = NULL))) - expect_equal(results14CodeBased$thetaH1, results14$thetaH1, tolerance = 1e-06) - expect_equal(results14CodeBased$assumedStDevs, results14$assumedStDevs, tolerance = 1e-06) - expect_equal(results14CodeBased$conditionalRejectionProbabilities, results14$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results14CodeBased$conditionalPower, results14$conditionalPower, tolerance = 1e-06) - expect_equal(results14CodeBased$repeatedConfidenceIntervalLowerBounds, results14$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results14CodeBased$repeatedConfidenceIntervalUpperBounds, results14$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results14CodeBased$repeatedPValues, results14$repeatedPValues, tolerance = 1e-06) - expect_type(names(results14), "character") - df <- as.data.frame(results14) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results14) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results15 <- getAnalysisResults(design = design1, dataInput = dataExample1, - intersectionTest = "Sidak", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results15' with expected results - expect_equal(results15$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results15$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results15$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results15$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results15$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results15$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results15$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results15$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results15$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results15$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results15$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results15$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results15$conditionalRejectionProbabilities[1, ], c(0.043192758, 0.15430882, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results15$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results15$conditionalRejectionProbabilities[2, ], c(0.034321105, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results15$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results15$conditionalRejectionProbabilities[3, ], c(0.050842102, 0.35990794, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results15$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results15$conditionalPower[1, ], c(NA_real_, NA_real_, 0.44741759, 0.6940249), tolerance = 1e-06, label = paste0("c(", paste0(results15$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results15$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results15$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results15$conditionalPower[3, ], c(NA_real_, NA_real_, 0.84172467, 0.95168763), tolerance = 1e-06, label = paste0("c(", paste0(results15$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results15$repeatedConfidenceIntervalLowerBounds[1, ], c(-14.800321, -4.2506387, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results15$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results15$repeatedConfidenceIntervalLowerBounds[2, ], c(-19.230944, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results15$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results15$repeatedConfidenceIntervalLowerBounds[3, ], c(-11.785003, 0.46968016, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results15$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results15$repeatedConfidenceIntervalUpperBounds[1, ], c(44.800321, 27.943326, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results15$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results15$repeatedConfidenceIntervalUpperBounds[2, ], c(38.430944, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results15$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results15$repeatedConfidenceIntervalUpperBounds[3, ], c(46.785003, 32.005071, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results15$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results15$repeatedPValues[1, ], c(0.5, 0.077086341, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results15$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results15$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results15$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results15$repeatedPValues[3, ], c(0.5, 0.014829652, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results15$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results15), NA))) - expect_output(print(results15)$show()) - invisible(capture.output(expect_error(summary(results15), NA))) - expect_output(summary(results15)$show()) - results15CodeBased <- eval(parse(text = getObjectRCode(results15, stringWrapParagraphWidth = NULL))) - expect_equal(results15CodeBased$thetaH1, results15$thetaH1, tolerance = 1e-06) - expect_equal(results15CodeBased$assumedStDevs, results15$assumedStDevs, tolerance = 1e-06) - expect_equal(results15CodeBased$conditionalRejectionProbabilities, results15$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results15CodeBased$conditionalPower, results15$conditionalPower, tolerance = 1e-06) - expect_equal(results15CodeBased$repeatedConfidenceIntervalLowerBounds, results15$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results15CodeBased$repeatedConfidenceIntervalUpperBounds, results15$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results15CodeBased$repeatedPValues, results15$repeatedPValues, tolerance = 1e-06) - expect_type(names(results15), "character") - df <- as.data.frame(results15) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results15) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results16 <- getAnalysisResults(design = design1, dataInput = dataExample1, - intersectionTest = "Sidak", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results16' with expected results - expect_equal(results16$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results16$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results16$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results16$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results16$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results16$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results16$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results16$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results16$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results16$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results16$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results16$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results16$conditionalRejectionProbabilities[1, ], c(0.041569453, 0.14613212, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results16$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results16$conditionalRejectionProbabilities[2, ], c(0.033856262, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results16$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results16$conditionalRejectionProbabilities[3, ], c(0.047839714, 0.32760313, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results16$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results16$conditionalPower[1, ], c(NA_real_, NA_real_, 0.43181681, 0.68255335), tolerance = 1e-06, label = paste0("c(", paste0(results16$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results16$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results16$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results16$conditionalPower[3, ], c(NA_real_, NA_real_, 0.81761872, 0.94309649), tolerance = 1e-06, label = paste0("c(", paste0(results16$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results16$repeatedConfidenceIntervalLowerBounds[1, ], c(-16.565416, -4.6248784, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results16$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results16$repeatedConfidenceIntervalLowerBounds[2, ], c(-20.938622, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results16$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results16$repeatedConfidenceIntervalLowerBounds[3, ], c(-13.519575, 0.10461531, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results16$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results16$repeatedConfidenceIntervalUpperBounds[1, ], c(46.565416, 28.357046, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results16$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results16$repeatedConfidenceIntervalUpperBounds[2, ], c(40.138622, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results16$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results16$repeatedConfidenceIntervalUpperBounds[3, ], c(48.519575, 32.386196, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results16$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results16$repeatedPValues[1, ], c(0.5, 0.083428262, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results16$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results16$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results16$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results16$repeatedPValues[3, ], c(0.5, 0.018799791, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results16$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results16), NA))) - expect_output(print(results16)$show()) - invisible(capture.output(expect_error(summary(results16), NA))) - expect_output(summary(results16)$show()) - results16CodeBased <- eval(parse(text = getObjectRCode(results16, stringWrapParagraphWidth = NULL))) - expect_equal(results16CodeBased$thetaH1, results16$thetaH1, tolerance = 1e-06) - expect_equal(results16CodeBased$assumedStDevs, results16$assumedStDevs, tolerance = 1e-06) - expect_equal(results16CodeBased$conditionalRejectionProbabilities, results16$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results16CodeBased$conditionalPower, results16$conditionalPower, tolerance = 1e-06) - expect_equal(results16CodeBased$repeatedConfidenceIntervalLowerBounds, results16$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results16CodeBased$repeatedConfidenceIntervalUpperBounds, results16$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results16CodeBased$repeatedPValues, results16$repeatedPValues, tolerance = 1e-06) - expect_type(names(results16), "character") - df <- as.data.frame(results16) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results16) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results17 <- getAnalysisResults(design = design1, dataInput = dataExample1, - intersectionTest = "Sidak", varianceOption = "pairwisePooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results17' with expected results - expect_equal(results17$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results17$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results17$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results17$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results17$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results17$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results17$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results17$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results17$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results17$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results17$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results17$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results17$conditionalRejectionProbabilities[1, ], c(0.044003076, 0.16034604, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results17$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results17$conditionalRejectionProbabilities[2, ], c(0.038533075, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results17$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results17$conditionalRejectionProbabilities[3, ], c(0.047740982, 0.33733332, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results17$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results17$conditionalPower[1, ], c(NA_real_, NA_real_, 0.45861366, 0.70212467), tolerance = 1e-06, label = paste0("c(", paste0(results17$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results17$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results17$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results17$conditionalPower[3, ], c(NA_real_, NA_real_, 0.82521432, 0.94583446), tolerance = 1e-06, label = paste0("c(", paste0(results17$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results17$repeatedConfidenceIntervalLowerBounds[1, ], c(-14.548, -4.0869288, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results17$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results17$repeatedConfidenceIntervalLowerBounds[2, ], c(-16.846937, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results17$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results17$repeatedConfidenceIntervalLowerBounds[3, ], c(-12.481557, 0.21501802, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results17$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results17$repeatedConfidenceIntervalUpperBounds[1, ], c(44.548, 27.773536, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results17$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results17$repeatedConfidenceIntervalUpperBounds[2, ], c(36.046937, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results17$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results17$repeatedConfidenceIntervalUpperBounds[3, ], c(47.481556, 32.250037, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results17$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results17$repeatedPValues[1, ], c(0.5, 0.072804352, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results17$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results17$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results17$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results17$repeatedPValues[3, ], c(0.5, 0.017498028, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results17$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results17), NA))) - expect_output(print(results17)$show()) - invisible(capture.output(expect_error(summary(results17), NA))) - expect_output(summary(results17)$show()) - results17CodeBased <- eval(parse(text = getObjectRCode(results17, stringWrapParagraphWidth = NULL))) - expect_equal(results17CodeBased$thetaH1, results17$thetaH1, tolerance = 1e-06) - expect_equal(results17CodeBased$assumedStDevs, results17$assumedStDevs, tolerance = 1e-06) - expect_equal(results17CodeBased$conditionalRejectionProbabilities, results17$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results17CodeBased$conditionalPower, results17$conditionalPower, tolerance = 1e-06) - expect_equal(results17CodeBased$repeatedConfidenceIntervalLowerBounds, results17$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results17CodeBased$repeatedConfidenceIntervalUpperBounds, results17$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results17CodeBased$repeatedPValues, results17$repeatedPValues, tolerance = 1e-06) - expect_type(names(results17), "character") - df <- as.data.frame(results17) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results17) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results18 <- getAnalysisResults(design = design1, dataInput = dataExample1, - intersectionTest = "Sidak", varianceOption = "pairwisePooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results18' with expected results - expect_equal(results18$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results18$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results18$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results18$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results18$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results18$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results18$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results18$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results18$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results18$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results18$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results18$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results18$conditionalRejectionProbabilities[1, ], c(0.040514523, 0.14472681, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results18$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results18$conditionalRejectionProbabilities[2, ], c(0.037322005, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results18$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results18$conditionalRejectionProbabilities[3, ], c(0.042460333, 0.28832504, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results18$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results18$conditionalPower[1, ], c(NA_real_, NA_real_, 0.42908294, 0.68052019), tolerance = 1e-06, label = paste0("c(", paste0(results18$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results18$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results18$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results18$conditionalPower[3, ], c(NA_real_, NA_real_, 0.78363361, 0.93049656), tolerance = 1e-06, label = paste0("c(", paste0(results18$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results18$repeatedConfidenceIntervalLowerBounds[1, ], c(-18.598892, -4.7729883, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results18$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results18$repeatedConfidenceIntervalLowerBounds[2, ], c(-20.151395, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results18$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results18$repeatedConfidenceIntervalLowerBounds[3, ], c(-16.401351, -0.41981706, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results18$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results18$repeatedConfidenceIntervalUpperBounds[1, ], c(48.598892, 28.449073, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results18$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results18$repeatedConfidenceIntervalUpperBounds[2, ], c(39.351395, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results18$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results18$repeatedConfidenceIntervalUpperBounds[3, ], c(51.401351, 32.883177, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results18$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results18$repeatedPValues[1, ], c(0.5, 0.084586974, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results18$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results18$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results18$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results18$repeatedPValues[3, ], c(0.5, 0.025221821, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results18$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results18), NA))) - expect_output(print(results18)$show()) - invisible(capture.output(expect_error(summary(results18), NA))) - expect_output(summary(results18)$show()) - results18CodeBased <- eval(parse(text = getObjectRCode(results18, stringWrapParagraphWidth = NULL))) - expect_equal(results18CodeBased$thetaH1, results18$thetaH1, tolerance = 1e-06) - expect_equal(results18CodeBased$assumedStDevs, results18$assumedStDevs, tolerance = 1e-06) - expect_equal(results18CodeBased$conditionalRejectionProbabilities, results18$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results18CodeBased$conditionalPower, results18$conditionalPower, tolerance = 1e-06) - expect_equal(results18CodeBased$repeatedConfidenceIntervalLowerBounds, results18$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results18CodeBased$repeatedConfidenceIntervalUpperBounds, results18$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results18CodeBased$repeatedPValues, results18$repeatedPValues, tolerance = 1e-06) - expect_type(names(results18), "character") - df <- as.data.frame(results18) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results18) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results19 <- getAnalysisResults(design = design1, dataInput = dataExample1, - intersectionTest = "Dunnett", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results19' with expected results - expect_equal(results19$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results19$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results19$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results19$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results19$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results19$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results19$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results19$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results19$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results19$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results19$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results19$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results19$conditionalRejectionProbabilities[1, ], c(0.046821821, 0.16471602, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results19$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results19$conditionalRejectionProbabilities[2, ], c(0.034321105, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results19$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results19$conditionalRejectionProbabilities[3, ], c(0.056787656, 0.38875311, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results19$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results19$conditionalPower[1, ], c(NA_real_, NA_real_, 0.46655424, 0.70780427), tolerance = 1e-06, label = paste0("c(", paste0(results19$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results19$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results19$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results19$conditionalPower[3, ], c(NA_real_, NA_real_, 0.8607721, 0.95827226), tolerance = 1e-06, label = paste0("c(", paste0(results19$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results19$repeatedConfidenceIntervalLowerBounds[1, ], c(-14.645333, -3.927683, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results19$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results19$repeatedConfidenceIntervalLowerBounds[2, ], c(-19.080998, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results19$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results19$repeatedConfidenceIntervalLowerBounds[3, ], c(-11.632695, 0.82950364, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results19$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results19$repeatedConfidenceIntervalUpperBounds[1, ], c(44.645334, 27.415422, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results19$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results19$repeatedConfidenceIntervalUpperBounds[2, ], c(38.280999, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results19$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results19$repeatedConfidenceIntervalUpperBounds[3, ], c(46.632695, 31.563129, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results19$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results19$repeatedPValues[1, ], c(0.5, 0.069897558, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results19$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results19$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results19$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results19$repeatedPValues[3, ], c(0.5, 0.012021087, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results19$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results19), NA))) - expect_output(print(results19)$show()) - invisible(capture.output(expect_error(summary(results19), NA))) - expect_output(summary(results19)$show()) - results19CodeBased <- eval(parse(text = getObjectRCode(results19, stringWrapParagraphWidth = NULL))) - expect_equal(results19CodeBased$thetaH1, results19$thetaH1, tolerance = 1e-06) - expect_equal(results19CodeBased$assumedStDevs, results19$assumedStDevs, tolerance = 1e-06) - expect_equal(results19CodeBased$conditionalRejectionProbabilities, results19$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results19CodeBased$conditionalPower, results19$conditionalPower, tolerance = 1e-06) - expect_equal(results19CodeBased$repeatedConfidenceIntervalLowerBounds, results19$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results19CodeBased$repeatedConfidenceIntervalUpperBounds, results19$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results19CodeBased$repeatedPValues, results19$repeatedPValues, tolerance = 1e-06) - expect_type(names(results19), "character") - df <- as.data.frame(results19) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results19) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results20 <- getAnalysisResults(design = design1, dataInput = dataExample1, - intersectionTest = "Dunnett", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results20' with expected results - expect_equal(results20$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results20$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results20$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results20$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results20$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results20$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results20$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results20$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results20$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results20$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results20$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results20$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results20$conditionalRejectionProbabilities[1, ], c(0.045317687, 0.15683192, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results20$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results20$conditionalRejectionProbabilities[2, ], c(0.033856262, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results20$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results20$conditionalRejectionProbabilities[3, ], c(0.054085103, 0.3588303, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results20$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results20$conditionalPower[1, ], c(NA_real_, NA_real_, 0.45212919, 0.69744676), tolerance = 1e-06, label = paste0("c(", paste0(results20$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results20$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results20$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results20$conditionalPower[3, ], c(NA_real_, NA_real_, 0.84097006, 0.95142305), tolerance = 1e-06, label = paste0("c(", paste0(results20$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results20$repeatedConfidenceIntervalLowerBounds[1, ], c(-16.335113, -4.2557288, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results20$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results20$repeatedConfidenceIntervalLowerBounds[2, ], c(-20.71581, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results20$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results20$repeatedConfidenceIntervalLowerBounds[3, ], c(-13.293254, 0.50940978, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results20$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results20$repeatedConfidenceIntervalUpperBounds[1, ], c(46.335113, 27.786662, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results20$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results20$repeatedConfidenceIntervalUpperBounds[2, ], c(39.91581, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results20$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results20$repeatedConfidenceIntervalUpperBounds[3, ], c(48.293254, 31.900882, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results20$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results20$repeatedPValues[1, ], c(0.5, 0.075258151, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results20$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results20$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results20$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results20$repeatedPValues[3, ], c(0.5, 0.014946954, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results20$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results20), NA))) - expect_output(print(results20)$show()) - invisible(capture.output(expect_error(summary(results20), NA))) - expect_output(summary(results20)$show()) - results20CodeBased <- eval(parse(text = getObjectRCode(results20, stringWrapParagraphWidth = NULL))) - expect_equal(results20CodeBased$thetaH1, results20$thetaH1, tolerance = 1e-06) - expect_equal(results20CodeBased$assumedStDevs, results20$assumedStDevs, tolerance = 1e-06) - expect_equal(results20CodeBased$conditionalRejectionProbabilities, results20$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results20CodeBased$conditionalPower, results20$conditionalPower, tolerance = 1e-06) - expect_equal(results20CodeBased$repeatedConfidenceIntervalLowerBounds, results20$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results20CodeBased$repeatedConfidenceIntervalUpperBounds, results20$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results20CodeBased$repeatedPValues, results20$repeatedPValues, tolerance = 1e-06) - expect_type(names(results20), "character") - df <- as.data.frame(results20) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results20) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results21 <- getAnalysisResults(design = design2, dataInput = dataExample1, - intersectionTest = "Bonferroni", varianceOption = "notPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results21' with expected results - expect_equal(results21$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results21$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results21$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results21$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results21$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results21$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results21$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results21$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results21$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results21$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results21$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results21$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results21$conditionalRejectionProbabilities[1, ], c(0.024608533, 0.053964296, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results21$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results21$conditionalRejectionProbabilities[2, ], c(0.021871903, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results21$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results21$conditionalRejectionProbabilities[3, ], c(0.027261939, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results21$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results21$repeatedConfidenceIntervalLowerBounds[1, ], c(-10.256183, -4.0576303, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results21$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results21$repeatedConfidenceIntervalLowerBounds[2, ], c(-13.161515, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results21$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results21$repeatedConfidenceIntervalLowerBounds[3, ], c(-7.9076686, 0.4326836, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results21$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results21$repeatedConfidenceIntervalUpperBounds[1, ], c(40.256183, 26.806923, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results21$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results21$repeatedConfidenceIntervalUpperBounds[2, ], c(32.361515, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results21$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results21$repeatedConfidenceIntervalUpperBounds[3, ], c(42.907669, 31.664999, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results21$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results21$repeatedPValues[1, ], c(0.17463845, 0.062131804, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results21$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results21$repeatedPValues[2, ], c(0.20337355, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results21$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results21$repeatedPValues[3, ], c(0.1527221, 0.015597359, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results21$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results21$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.277, 0.453), tolerance = 1e-06, label = paste0("c(", paste0(results21$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results21$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results21$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results21$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results21$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results21), NA))) - expect_output(print(results21)$show()) - invisible(capture.output(expect_error(summary(results21), NA))) - expect_output(summary(results21)$show()) - results21CodeBased <- eval(parse(text = getObjectRCode(results21, stringWrapParagraphWidth = NULL))) - expect_equal(results21CodeBased$thetaH1, results21$thetaH1, tolerance = 1e-06) - expect_equal(results21CodeBased$assumedStDevs, results21$assumedStDevs, tolerance = 1e-06) - expect_equal(results21CodeBased$conditionalRejectionProbabilities, results21$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results21CodeBased$repeatedConfidenceIntervalLowerBounds, results21$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results21CodeBased$repeatedConfidenceIntervalUpperBounds, results21$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results21CodeBased$repeatedPValues, results21$repeatedPValues, tolerance = 1e-06) - expect_equal(results21CodeBased$conditionalPowerSimulated, results21$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results21), "character") - df <- as.data.frame(results21) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results21) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results22 <- getAnalysisResults(design = design2, dataInput = dataExample1, - intersectionTest = "Bonferroni", varianceOption = "notPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results22' with expected results - expect_equal(results22$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results22$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results22$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results22$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results22$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results22$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results22$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results22$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results22$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results22$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results22$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results22$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results22$conditionalRejectionProbabilities[1, ], c(0.022711489, 0.047669561, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results22$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results22$conditionalRejectionProbabilities[2, ], c(0.021234311, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results22$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results22$conditionalRejectionProbabilities[3, ], c(0.024147032, 0.14148061, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results22$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results22$repeatedConfidenceIntervalLowerBounds[1, ], c(-12.830851, -4.722817, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results22$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results22$repeatedConfidenceIntervalLowerBounds[2, ], c(-15.416779, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results22$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results22$repeatedConfidenceIntervalLowerBounds[3, ], c(-10.376075, -0.16648466, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results22$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results22$repeatedConfidenceIntervalUpperBounds[1, ], c(42.830851, 27.447651, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results22$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results22$repeatedConfidenceIntervalUpperBounds[2, ], c(34.616779, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results22$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results22$repeatedConfidenceIntervalUpperBounds[3, ], c(45.376075, 32.257244, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results22$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results22$repeatedPValues[1, ], c(0.19376148, 0.070634747, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results22$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results22$repeatedPValues[2, ], c(0.2112175, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results22$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results22$repeatedPValues[3, ], c(0.17899101, 0.021776202, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results22$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results22$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.257, 0.434), tolerance = 1e-06, label = paste0("c(", paste0(results22$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results22$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results22$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results22$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 0.656, 0.797), tolerance = 1e-06, label = paste0("c(", paste0(results22$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results22), NA))) - expect_output(print(results22)$show()) - invisible(capture.output(expect_error(summary(results22), NA))) - expect_output(summary(results22)$show()) - results22CodeBased <- eval(parse(text = getObjectRCode(results22, stringWrapParagraphWidth = NULL))) - expect_equal(results22CodeBased$thetaH1, results22$thetaH1, tolerance = 1e-06) - expect_equal(results22CodeBased$assumedStDevs, results22$assumedStDevs, tolerance = 1e-06) - expect_equal(results22CodeBased$conditionalRejectionProbabilities, results22$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results22CodeBased$repeatedConfidenceIntervalLowerBounds, results22$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results22CodeBased$repeatedConfidenceIntervalUpperBounds, results22$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results22CodeBased$repeatedPValues, results22$repeatedPValues, tolerance = 1e-06) - expect_equal(results22CodeBased$conditionalPowerSimulated, results22$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results22), "character") - df <- as.data.frame(results22) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results22) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results23 <- getAnalysisResults(design = design2, dataInput = dataExample1, - intersectionTest = "Bonferroni", varianceOption = "overallPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results23' with expected results - expect_equal(results23$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results23$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results23$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results23$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results23$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results23$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results23$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results23$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results23$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results23$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results23$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results23$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results23$conditionalRejectionProbabilities[1, ], c(0.02389937, 0.050606752, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results23$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results23$conditionalRejectionProbabilities[2, ], c(0.019837849, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results23$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results23$conditionalRejectionProbabilities[3, ], c(0.028008383, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results23$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results23$repeatedConfidenceIntervalLowerBounds[1, ], c(-10.605988, -4.2731734, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results23$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results23$repeatedConfidenceIntervalLowerBounds[2, ], c(-15.173049, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results23$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results23$repeatedConfidenceIntervalLowerBounds[3, ], c(-7.6631999, 0.60791563, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results23$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results23$repeatedConfidenceIntervalUpperBounds[1, ], c(40.605988, 27.021858, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results23$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results23$repeatedConfidenceIntervalUpperBounds[2, ], c(34.373049, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results23$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results23$repeatedConfidenceIntervalUpperBounds[3, ], c(42.6632, 31.486561, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results23$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results23$repeatedPValues[1, ], c(0.18140284, 0.066412839, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results23$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results23$repeatedPValues[2, ], c(0.23027951, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results23$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results23$repeatedPValues[3, ], c(0.14737581, 0.014014262, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results23$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results23$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.268, 0.445), tolerance = 1e-06, label = paste0("c(", paste0(results23$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results23$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results23$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results23$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results23$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results23), NA))) - expect_output(print(results23)$show()) - invisible(capture.output(expect_error(summary(results23), NA))) - expect_output(summary(results23)$show()) - results23CodeBased <- eval(parse(text = getObjectRCode(results23, stringWrapParagraphWidth = NULL))) - expect_equal(results23CodeBased$thetaH1, results23$thetaH1, tolerance = 1e-06) - expect_equal(results23CodeBased$assumedStDevs, results23$assumedStDevs, tolerance = 1e-06) - expect_equal(results23CodeBased$conditionalRejectionProbabilities, results23$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results23CodeBased$repeatedConfidenceIntervalLowerBounds, results23$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results23CodeBased$repeatedConfidenceIntervalUpperBounds, results23$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results23CodeBased$repeatedPValues, results23$repeatedPValues, tolerance = 1e-06) - expect_equal(results23CodeBased$conditionalPowerSimulated, results23$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results23), "character") - df <- as.data.frame(results23) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results23) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results24 <- getAnalysisResults(design = design2, dataInput = dataExample1, - intersectionTest = "Bonferroni", varianceOption = "overallPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results24' with expected results - expect_equal(results24$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results24$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results24$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results24$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results24$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results24$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results24$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results24$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results24$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results24$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results24$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results24$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results24$conditionalRejectionProbabilities[1, ], c(0.023040094, 0.047419024, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results24$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results24$conditionalRejectionProbabilities[2, ], c(0.019613852, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results24$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results24$conditionalRejectionProbabilities[3, ], c(0.026303733, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results24$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results24$repeatedConfidenceIntervalLowerBounds[1, ], c(-11.74771, -4.6401767, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results24$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results24$repeatedConfidenceIntervalLowerBounds[2, ], c(-16.277631, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results24$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results24$repeatedConfidenceIntervalLowerBounds[3, ], c(-8.7851784, 0.25415362, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results24$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results24$repeatedConfidenceIntervalUpperBounds[1, ], c(41.74771, 27.425347, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results24$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results24$repeatedConfidenceIntervalUpperBounds[2, ], c(35.477631, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results24$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results24$repeatedConfidenceIntervalUpperBounds[3, ], c(43.785178, 31.856528, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results24$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results24$repeatedPValues[1, ], c(0.19020524, 0.071018123, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results24$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results24$repeatedPValues[2, ], c(0.23360401, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results24$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results24$repeatedPValues[3, ], c(0.16007682, 0.01742078, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results24$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results24$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.256, 0.433), tolerance = 1e-06, label = paste0("c(", paste0(results24$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results24$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results24$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results24$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results24$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results24), NA))) - expect_output(print(results24)$show()) - invisible(capture.output(expect_error(summary(results24), NA))) - expect_output(summary(results24)$show()) - results24CodeBased <- eval(parse(text = getObjectRCode(results24, stringWrapParagraphWidth = NULL))) - expect_equal(results24CodeBased$thetaH1, results24$thetaH1, tolerance = 1e-06) - expect_equal(results24CodeBased$assumedStDevs, results24$assumedStDevs, tolerance = 1e-06) - expect_equal(results24CodeBased$conditionalRejectionProbabilities, results24$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results24CodeBased$repeatedConfidenceIntervalLowerBounds, results24$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results24CodeBased$repeatedConfidenceIntervalUpperBounds, results24$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results24CodeBased$repeatedPValues, results24$repeatedPValues, tolerance = 1e-06) - expect_equal(results24CodeBased$conditionalPowerSimulated, results24$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results24), "character") - df <- as.data.frame(results24) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results24) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results25 <- getAnalysisResults(design = design2, dataInput = dataExample1, - intersectionTest = "Bonferroni", varianceOption = "pairwisePooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results25' with expected results - expect_equal(results25$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results25$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results25$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results25$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results25$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results25$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results25$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results25$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results25$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results25$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results25$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results25$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results25$conditionalRejectionProbabilities[1, ], c(0.024333354, 0.053095357, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results25$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results25$conditionalRejectionProbabilities[2, ], c(0.021915713, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results25$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results25$conditionalRejectionProbabilities[3, ], c(0.026248507, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results25$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results25$repeatedConfidenceIntervalLowerBounds[1, ], c(-10.389181, -4.1091853, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results25$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results25$repeatedConfidenceIntervalLowerBounds[2, ], c(-13.124586, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results25$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results25$repeatedConfidenceIntervalLowerBounds[3, ], c(-8.2617152, 0.37246523, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results25$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results25$repeatedConfidenceIntervalUpperBounds[1, ], c(40.389181, 26.847363, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results25$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results25$repeatedConfidenceIntervalUpperBounds[2, ], c(32.324586, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results25$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results25$repeatedConfidenceIntervalUpperBounds[3, ], c(43.261715, 31.705217, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results25$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results25$repeatedPValues[1, ], c(0.17721241, 0.063189426, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results25$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results25$repeatedPValues[2, ], c(0.20285189, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results25$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results25$repeatedPValues[3, ], c(0.16051933, 0.01616384, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results25$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results25$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.274, 0.453), tolerance = 1e-06, label = paste0("c(", paste0(results25$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results25$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results25$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results25$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results25$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results25), NA))) - expect_output(print(results25)$show()) - invisible(capture.output(expect_error(summary(results25), NA))) - expect_output(summary(results25)$show()) - results25CodeBased <- eval(parse(text = getObjectRCode(results25, stringWrapParagraphWidth = NULL))) - expect_equal(results25CodeBased$thetaH1, results25$thetaH1, tolerance = 1e-06) - expect_equal(results25CodeBased$assumedStDevs, results25$assumedStDevs, tolerance = 1e-06) - expect_equal(results25CodeBased$conditionalRejectionProbabilities, results25$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results25CodeBased$repeatedConfidenceIntervalLowerBounds, results25$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results25CodeBased$repeatedConfidenceIntervalUpperBounds, results25$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results25CodeBased$repeatedPValues, results25$repeatedPValues, tolerance = 1e-06) - expect_equal(results25CodeBased$conditionalPowerSimulated, results25$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results25), "character") - df <- as.data.frame(results25) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results25) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results26 <- getAnalysisResults(design = design2, dataInput = dataExample1, - intersectionTest = "Bonferroni", varianceOption = "pairwisePooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results26' with expected results - expect_equal(results26$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results26$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results26$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results26$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results26$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results26$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results26$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results26$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results26$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results26$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results26$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results26$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results26$conditionalRejectionProbabilities[1, ], c(0.02248882, 0.047009108, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results26$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results26$conditionalRejectionProbabilities[2, ], c(0.021309255, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results26$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results26$conditionalRejectionProbabilities[3, ], c(0.023369532, 0.13794488, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results26$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results26$repeatedConfidenceIntervalLowerBounds[1, ], c(-12.972232, -4.7692163, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results26$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results26$repeatedConfidenceIntervalLowerBounds[2, ], c(-15.236237, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results26$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results26$repeatedConfidenceIntervalLowerBounds[3, ], c(-10.763995, -0.22335705, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results26$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results26$repeatedConfidenceIntervalUpperBounds[1, ], c(42.972232, 27.481288, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results26$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results26$repeatedConfidenceIntervalUpperBounds[2, ], c(34.436237, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results26$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results26$repeatedConfidenceIntervalUpperBounds[3, ], c(45.763994, 32.295837, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results26$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results26$repeatedPValues[1, ], c(0.19623626, 0.071653269, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results26$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results26$repeatedPValues[2, ], c(0.21026955, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results26$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results26$repeatedPValues[3, ], c(0.18674722, 0.022408487, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results26$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results26$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.256, 0.431), tolerance = 1e-06, label = paste0("c(", paste0(results26$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results26$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results26$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results26$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 0.652, 0.795), tolerance = 1e-06, label = paste0("c(", paste0(results26$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results26), NA))) - expect_output(print(results26)$show()) - invisible(capture.output(expect_error(summary(results26), NA))) - expect_output(summary(results26)$show()) - results26CodeBased <- eval(parse(text = getObjectRCode(results26, stringWrapParagraphWidth = NULL))) - expect_equal(results26CodeBased$thetaH1, results26$thetaH1, tolerance = 1e-06) - expect_equal(results26CodeBased$assumedStDevs, results26$assumedStDevs, tolerance = 1e-06) - expect_equal(results26CodeBased$conditionalRejectionProbabilities, results26$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results26CodeBased$repeatedConfidenceIntervalLowerBounds, results26$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results26CodeBased$repeatedConfidenceIntervalUpperBounds, results26$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results26CodeBased$repeatedPValues, results26$repeatedPValues, tolerance = 1e-06) - expect_equal(results26CodeBased$conditionalPowerSimulated, results26$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results26), "character") - df <- as.data.frame(results26) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results26) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results27 <- getAnalysisResults(design = design2, dataInput = dataExample1, - intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results27' with expected results - expect_equal(results27$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results27$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results27$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results27$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results27$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results27$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results27$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results27$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results27$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results27$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results27$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results27$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results27$conditionalRejectionProbabilities[1, ], c(0.024608533, 0.053964296, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results27$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results27$conditionalRejectionProbabilities[2, ], c(0.021871903, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results27$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results27$conditionalRejectionProbabilities[3, ], c(0.029595078, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results27$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results27$repeatedConfidenceIntervalLowerBounds[1, ], c(-10.256183, -4.0576303, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results27$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results27$repeatedConfidenceIntervalLowerBounds[2, ], c(-13.161515, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results27$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results27$repeatedConfidenceIntervalLowerBounds[3, ], c(-7.9076686, 0.4326836, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results27$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results27$repeatedConfidenceIntervalUpperBounds[1, ], c(40.256183, 26.806923, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results27$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results27$repeatedConfidenceIntervalUpperBounds[2, ], c(32.361515, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results27$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results27$repeatedConfidenceIntervalUpperBounds[3, ], c(42.907669, 31.664999, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results27$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results27$repeatedPValues[1, ], c(0.17463845, 0.062131804, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results27$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results27$repeatedPValues[2, ], c(0.20337355, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results27$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results27$repeatedPValues[3, ], c(0.13700176, 0.014275569, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results27$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results27$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.277, 0.453), tolerance = 1e-06, label = paste0("c(", paste0(results27$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results27$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results27$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results27$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results27$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results27), NA))) - expect_output(print(results27)$show()) - invisible(capture.output(expect_error(summary(results27), NA))) - expect_output(summary(results27)$show()) - results27CodeBased <- eval(parse(text = getObjectRCode(results27, stringWrapParagraphWidth = NULL))) - expect_equal(results27CodeBased$thetaH1, results27$thetaH1, tolerance = 1e-06) - expect_equal(results27CodeBased$assumedStDevs, results27$assumedStDevs, tolerance = 1e-06) - expect_equal(results27CodeBased$conditionalRejectionProbabilities, results27$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results27CodeBased$repeatedConfidenceIntervalLowerBounds, results27$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results27CodeBased$repeatedConfidenceIntervalUpperBounds, results27$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results27CodeBased$repeatedPValues, results27$repeatedPValues, tolerance = 1e-06) - expect_equal(results27CodeBased$conditionalPowerSimulated, results27$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results27), "character") - df <- as.data.frame(results27) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results27) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results28 <- getAnalysisResults(design = design2, dataInput = dataExample1, - intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results28' with expected results - expect_equal(results28$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results28$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results28$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results28$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results28$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results28$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results28$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results28$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results28$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results28$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results28$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results28$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results28$conditionalRejectionProbabilities[1, ], c(0.022711489, 0.047669561, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results28$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results28$conditionalRejectionProbabilities[2, ], c(0.021234311, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results28$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results28$conditionalRejectionProbabilities[3, ], c(0.027312859, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results28$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results28$repeatedConfidenceIntervalLowerBounds[1, ], c(-12.830851, -4.722817, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results28$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results28$repeatedConfidenceIntervalLowerBounds[2, ], c(-15.416779, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results28$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results28$repeatedConfidenceIntervalLowerBounds[3, ], c(-10.376075, -0.16648466, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results28$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results28$repeatedConfidenceIntervalUpperBounds[1, ], c(42.830851, 27.447651, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results28$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results28$repeatedConfidenceIntervalUpperBounds[2, ], c(34.616779, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results28$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results28$repeatedConfidenceIntervalUpperBounds[3, ], c(45.376075, 32.257244, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results28$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results28$repeatedPValues[1, ], c(0.19376148, 0.070634747, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results28$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results28$repeatedPValues[2, ], c(0.2112175, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results28$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results28$repeatedPValues[3, ], c(0.15234731, 0.019097336, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results28$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results28$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.257, 0.434), tolerance = 1e-06, label = paste0("c(", paste0(results28$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results28$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results28$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results28$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results28$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results28), NA))) - expect_output(print(results28)$show()) - invisible(capture.output(expect_error(summary(results28), NA))) - expect_output(summary(results28)$show()) - results28CodeBased <- eval(parse(text = getObjectRCode(results28, stringWrapParagraphWidth = NULL))) - expect_equal(results28CodeBased$thetaH1, results28$thetaH1, tolerance = 1e-06) - expect_equal(results28CodeBased$assumedStDevs, results28$assumedStDevs, tolerance = 1e-06) - expect_equal(results28CodeBased$conditionalRejectionProbabilities, results28$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results28CodeBased$repeatedConfidenceIntervalLowerBounds, results28$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results28CodeBased$repeatedConfidenceIntervalUpperBounds, results28$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results28CodeBased$repeatedPValues, results28$repeatedPValues, tolerance = 1e-06) - expect_equal(results28CodeBased$conditionalPowerSimulated, results28$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results28), "character") - df <- as.data.frame(results28) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results28) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results29 <- getAnalysisResults(design = design2, dataInput = dataExample1, - intersectionTest = "Simes", varianceOption = "overallPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results29' with expected results - expect_equal(results29$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results29$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results29$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results29$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results29$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results29$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results29$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results29$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results29$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results29$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results29$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results29$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results29$conditionalRejectionProbabilities[1, ], c(0.02389937, 0.050606752, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results29$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results29$conditionalRejectionProbabilities[2, ], c(0.019837849, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results29$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results29$conditionalRejectionProbabilities[3, ], c(0.028741907, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results29$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results29$repeatedConfidenceIntervalLowerBounds[1, ], c(-10.605988, -4.2731734, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results29$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results29$repeatedConfidenceIntervalLowerBounds[2, ], c(-15.173049, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results29$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results29$repeatedConfidenceIntervalLowerBounds[3, ], c(-7.6631999, 0.60791563, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results29$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results29$repeatedConfidenceIntervalUpperBounds[1, ], c(40.605988, 27.021858, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results29$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results29$repeatedConfidenceIntervalUpperBounds[2, ], c(34.373049, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results29$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results29$repeatedConfidenceIntervalUpperBounds[3, ], c(42.6632, 31.486561, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results29$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results29$repeatedPValues[1, ], c(0.18140284, 0.066412839, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results29$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results29$repeatedPValues[2, ], c(0.23027951, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results29$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results29$repeatedPValues[3, ], c(0.14242148, 0.013628025, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results29$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results29$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.268, 0.445), tolerance = 1e-06, label = paste0("c(", paste0(results29$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results29$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results29$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results29$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results29$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results29), NA))) - expect_output(print(results29)$show()) - invisible(capture.output(expect_error(summary(results29), NA))) - expect_output(summary(results29)$show()) - results29CodeBased <- eval(parse(text = getObjectRCode(results29, stringWrapParagraphWidth = NULL))) - expect_equal(results29CodeBased$thetaH1, results29$thetaH1, tolerance = 1e-06) - expect_equal(results29CodeBased$assumedStDevs, results29$assumedStDevs, tolerance = 1e-06) - expect_equal(results29CodeBased$conditionalRejectionProbabilities, results29$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results29CodeBased$repeatedConfidenceIntervalLowerBounds, results29$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results29CodeBased$repeatedConfidenceIntervalUpperBounds, results29$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results29CodeBased$repeatedPValues, results29$repeatedPValues, tolerance = 1e-06) - expect_equal(results29CodeBased$conditionalPowerSimulated, results29$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results29), "character") - df <- as.data.frame(results29) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results29) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results30 <- getAnalysisResults(design = design2, dataInput = dataExample1, - intersectionTest = "Simes", varianceOption = "overallPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results30' with expected results - expect_equal(results30$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results30$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results30$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results30$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results30$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results30$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results30$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results30$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results30$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results30$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results30$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results30$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results30$conditionalRejectionProbabilities[1, ], c(0.023040094, 0.047419024, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results30$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results30$conditionalRejectionProbabilities[2, ], c(0.019613852, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results30$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results30$conditionalRejectionProbabilities[3, ], c(0.027708171, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results30$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results30$repeatedConfidenceIntervalLowerBounds[1, ], c(-11.74771, -4.6401767, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results30$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results30$repeatedConfidenceIntervalLowerBounds[2, ], c(-16.277631, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results30$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results30$repeatedConfidenceIntervalLowerBounds[3, ], c(-8.7851784, 0.25415362, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results30$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results30$repeatedConfidenceIntervalUpperBounds[1, ], c(41.74771, 27.425347, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results30$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results30$repeatedConfidenceIntervalUpperBounds[2, ], c(35.477631, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results30$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results30$repeatedConfidenceIntervalUpperBounds[3, ], c(43.785178, 31.856528, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results30$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results30$repeatedPValues[1, ], c(0.19020524, 0.071018123, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results30$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results30$repeatedPValues[2, ], c(0.23360401, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results30$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results30$repeatedPValues[3, ], c(0.1494882, 0.016474737, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results30$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results30$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.256, 0.433), tolerance = 1e-06, label = paste0("c(", paste0(results30$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results30$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results30$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results30$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results30$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results30), NA))) - expect_output(print(results30)$show()) - invisible(capture.output(expect_error(summary(results30), NA))) - expect_output(summary(results30)$show()) - results30CodeBased <- eval(parse(text = getObjectRCode(results30, stringWrapParagraphWidth = NULL))) - expect_equal(results30CodeBased$thetaH1, results30$thetaH1, tolerance = 1e-06) - expect_equal(results30CodeBased$assumedStDevs, results30$assumedStDevs, tolerance = 1e-06) - expect_equal(results30CodeBased$conditionalRejectionProbabilities, results30$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results30CodeBased$repeatedConfidenceIntervalLowerBounds, results30$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results30CodeBased$repeatedConfidenceIntervalUpperBounds, results30$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results30CodeBased$repeatedPValues, results30$repeatedPValues, tolerance = 1e-06) - expect_equal(results30CodeBased$conditionalPowerSimulated, results30$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results30), "character") - df <- as.data.frame(results30) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results30) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results31 <- getAnalysisResults(design = design2, dataInput = dataExample1, - intersectionTest = "Simes", varianceOption = "pairwisePooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results31' with expected results - expect_equal(results31$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results31$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results31$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results31$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results31$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results31$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results31$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results31$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results31$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results31$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results31$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results31$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results31$conditionalRejectionProbabilities[1, ], c(0.024333354, 0.053095357, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results31$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results31$conditionalRejectionProbabilities[2, ], c(0.021915713, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results31$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results31$conditionalRejectionProbabilities[3, ], c(0.029264016, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results31$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results31$repeatedConfidenceIntervalLowerBounds[1, ], c(-10.389181, -4.1091853, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results31$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results31$repeatedConfidenceIntervalLowerBounds[2, ], c(-13.124586, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results31$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results31$repeatedConfidenceIntervalLowerBounds[3, ], c(-8.2617152, 0.37246523, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results31$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results31$repeatedConfidenceIntervalUpperBounds[1, ], c(40.389181, 26.847363, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results31$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results31$repeatedConfidenceIntervalUpperBounds[2, ], c(32.324586, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results31$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results31$repeatedConfidenceIntervalUpperBounds[3, ], c(43.261715, 31.705217, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results31$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results31$repeatedPValues[1, ], c(0.17721241, 0.063189426, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results31$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results31$repeatedPValues[2, ], c(0.20285189, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results31$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results31$repeatedPValues[3, ], c(0.13906265, 0.014376658, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results31$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results31$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.274, 0.453), tolerance = 1e-06, label = paste0("c(", paste0(results31$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results31$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results31$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results31$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results31$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results31), NA))) - expect_output(print(results31)$show()) - invisible(capture.output(expect_error(summary(results31), NA))) - expect_output(summary(results31)$show()) - results31CodeBased <- eval(parse(text = getObjectRCode(results31, stringWrapParagraphWidth = NULL))) - expect_equal(results31CodeBased$thetaH1, results31$thetaH1, tolerance = 1e-06) - expect_equal(results31CodeBased$assumedStDevs, results31$assumedStDevs, tolerance = 1e-06) - expect_equal(results31CodeBased$conditionalRejectionProbabilities, results31$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results31CodeBased$repeatedConfidenceIntervalLowerBounds, results31$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results31CodeBased$repeatedConfidenceIntervalUpperBounds, results31$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results31CodeBased$repeatedPValues, results31$repeatedPValues, tolerance = 1e-06) - expect_equal(results31CodeBased$conditionalPowerSimulated, results31$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results31), "character") - df <- as.data.frame(results31) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results31) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results32 <- getAnalysisResults(design = design2, dataInput = dataExample1, - intersectionTest = "Simes", varianceOption = "pairwisePooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results32' with expected results - expect_equal(results32$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results32$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results32$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results32$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results32$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results32$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results32$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results32$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results32$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results32$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results32$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results32$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results32$conditionalRejectionProbabilities[1, ], c(0.02248882, 0.047009108, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results32$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results32$conditionalRejectionProbabilities[2, ], c(0.021309255, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results32$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results32$conditionalRejectionProbabilities[3, ], c(0.027044989, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results32$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results32$repeatedConfidenceIntervalLowerBounds[1, ], c(-12.972232, -4.7692163, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results32$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results32$repeatedConfidenceIntervalLowerBounds[2, ], c(-15.236237, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results32$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results32$repeatedConfidenceIntervalLowerBounds[3, ], c(-10.763995, -0.22335705, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results32$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results32$repeatedConfidenceIntervalUpperBounds[1, ], c(42.972232, 27.481288, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results32$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results32$repeatedConfidenceIntervalUpperBounds[2, ], c(34.436237, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results32$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results32$repeatedConfidenceIntervalUpperBounds[3, ], c(45.763994, 32.295837, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results32$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results32$repeatedPValues[1, ], c(0.19623626, 0.071653269, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results32$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results32$repeatedPValues[2, ], c(0.21026955, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results32$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results32$repeatedPValues[3, ], c(0.15433667, 0.019180306, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results32$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results32$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.256, 0.431), tolerance = 1e-06, label = paste0("c(", paste0(results32$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results32$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results32$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results32$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results32$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results32), NA))) - expect_output(print(results32)$show()) - invisible(capture.output(expect_error(summary(results32), NA))) - expect_output(summary(results32)$show()) - results32CodeBased <- eval(parse(text = getObjectRCode(results32, stringWrapParagraphWidth = NULL))) - expect_equal(results32CodeBased$thetaH1, results32$thetaH1, tolerance = 1e-06) - expect_equal(results32CodeBased$assumedStDevs, results32$assumedStDevs, tolerance = 1e-06) - expect_equal(results32CodeBased$conditionalRejectionProbabilities, results32$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results32CodeBased$repeatedConfidenceIntervalLowerBounds, results32$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results32CodeBased$repeatedConfidenceIntervalUpperBounds, results32$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results32CodeBased$repeatedPValues, results32$repeatedPValues, tolerance = 1e-06) - expect_equal(results32CodeBased$conditionalPowerSimulated, results32$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results32), "character") - df <- as.data.frame(results32) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results32) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results33 <- getAnalysisResults(design = design2, dataInput = dataExample1, - intersectionTest = "Sidak", varianceOption = "notPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results33' with expected results - expect_equal(results33$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results33$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results33$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results33$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results33$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results33$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results33$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results33$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results33$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results33$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results33$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results33$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results33$conditionalRejectionProbabilities[1, ], c(0.025021019, 0.054834069, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results33$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results33$conditionalRejectionProbabilities[2, ], c(0.021871903, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results33$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results33$conditionalRejectionProbabilities[3, ], c(0.027777772, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results33$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results33$repeatedConfidenceIntervalLowerBounds[1, ], c(-10.247199, -4.0258193, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results33$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results33$repeatedConfidenceIntervalLowerBounds[2, ], c(-13.153418, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results33$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results33$repeatedConfidenceIntervalLowerBounds[3, ], c(-7.8986307, 0.47811558, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results33$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results33$repeatedConfidenceIntervalUpperBounds[1, ], c(40.247199, 26.680539, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results33$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results33$repeatedConfidenceIntervalUpperBounds[2, ], c(32.353418, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results33$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results33$repeatedConfidenceIntervalUpperBounds[3, ], c(42.898631, 31.584065, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results33$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results33$repeatedPValues[1, ], c(0.17089623, 0.061105652, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results33$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results33$repeatedPValues[2, ], c(0.20337355, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results33$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results33$repeatedPValues[3, ], c(0.14899419, 0.015246407, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results33$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results33$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.283, 0.454), tolerance = 1e-06, label = paste0("c(", paste0(results33$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results33$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results33$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results33$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results33$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results33), NA))) - expect_output(print(results33)$show()) - invisible(capture.output(expect_error(summary(results33), NA))) - expect_output(summary(results33)$show()) - results33CodeBased <- eval(parse(text = getObjectRCode(results33, stringWrapParagraphWidth = NULL))) - expect_equal(results33CodeBased$thetaH1, results33$thetaH1, tolerance = 1e-06) - expect_equal(results33CodeBased$assumedStDevs, results33$assumedStDevs, tolerance = 1e-06) - expect_equal(results33CodeBased$conditionalRejectionProbabilities, results33$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results33CodeBased$repeatedConfidenceIntervalLowerBounds, results33$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results33CodeBased$repeatedConfidenceIntervalUpperBounds, results33$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results33CodeBased$repeatedPValues, results33$repeatedPValues, tolerance = 1e-06) - expect_equal(results33CodeBased$conditionalPowerSimulated, results33$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results33), "character") - df <- as.data.frame(results33) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results33) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results34 <- getAnalysisResults(design = design2, dataInput = dataExample1, - intersectionTest = "Sidak", varianceOption = "notPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results34' with expected results - expect_equal(results34$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results34$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results34$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results34$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results34$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results34$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results34$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results34$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results34$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results34$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results34$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results34$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results34$conditionalRejectionProbabilities[1, ], c(0.023144095, 0.048545015, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results34$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results34$conditionalRejectionProbabilities[2, ], c(0.021234311, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results34$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results34$conditionalRejectionProbabilities[3, ], c(0.0247006, 0.1449328, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results34$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results34$repeatedConfidenceIntervalLowerBounds[1, ], c(-12.8192, -4.6852584, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results34$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results34$repeatedConfidenceIntervalLowerBounds[2, ], c(-15.40635, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results34$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results34$repeatedConfidenceIntervalLowerBounds[3, ], c(-10.364486, -0.1144866, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results34$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results34$repeatedConfidenceIntervalUpperBounds[1, ], c(42.8192, 27.314543, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results34$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results34$repeatedConfidenceIntervalUpperBounds[2, ], c(34.60635, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results34$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results34$repeatedConfidenceIntervalUpperBounds[3, ], c(45.364486, 32.169333, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results34$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results34$repeatedPValues[1, ], c(0.18910184, 0.069324401, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results34$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results34$repeatedPValues[2, ], c(0.2112175, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results34$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results34$repeatedPValues[3, ], c(0.17379158, 0.021189694, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results34$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results34$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.26, 0.437), tolerance = 1e-06, label = paste0("c(", paste0(results34$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results34$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results34$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results34$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 0.66, 0.799), tolerance = 1e-06, label = paste0("c(", paste0(results34$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results34), NA))) - expect_output(print(results34)$show()) - invisible(capture.output(expect_error(summary(results34), NA))) - expect_output(summary(results34)$show()) - results34CodeBased <- eval(parse(text = getObjectRCode(results34, stringWrapParagraphWidth = NULL))) - expect_equal(results34CodeBased$thetaH1, results34$thetaH1, tolerance = 1e-06) - expect_equal(results34CodeBased$assumedStDevs, results34$assumedStDevs, tolerance = 1e-06) - expect_equal(results34CodeBased$conditionalRejectionProbabilities, results34$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results34CodeBased$repeatedConfidenceIntervalLowerBounds, results34$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results34CodeBased$repeatedConfidenceIntervalUpperBounds, results34$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results34CodeBased$repeatedPValues, results34$repeatedPValues, tolerance = 1e-06) - expect_equal(results34CodeBased$conditionalPowerSimulated, results34$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results34), "character") - df <- as.data.frame(results34) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results34) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results35 <- getAnalysisResults(design = design2, dataInput = dataExample1, - intersectionTest = "Sidak", varianceOption = "overallPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results35' with expected results - expect_equal(results35$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results35$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results35$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results35$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results35$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results35$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results35$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results35$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results35$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results35$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results35$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results35$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results35$conditionalRejectionProbabilities[1, ], c(0.024319059, 0.051462476, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results35$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results35$conditionalRejectionProbabilities[2, ], c(0.019837849, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results35$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results35$conditionalRejectionProbabilities[3, ], c(0.028516214, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results35$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results35$repeatedConfidenceIntervalLowerBounds[1, ], c(-10.59688, -4.2407133, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results35$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results35$repeatedConfidenceIntervalLowerBounds[2, ], c(-15.164237, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results35$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results35$repeatedConfidenceIntervalLowerBounds[3, ], c(-7.6542489, 0.6529301, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results35$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results35$repeatedConfidenceIntervalUpperBounds[1, ], c(40.59688, 26.894985, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results35$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results35$repeatedConfidenceIntervalUpperBounds[2, ], c(34.364237, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results35$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results35$repeatedConfidenceIntervalUpperBounds[3, ], c(42.654249, 31.405859, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results35$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results35$repeatedPValues[1, ], c(0.17734783, 0.06527034, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results35$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results35$repeatedPValues[2, ], c(0.23027951, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results35$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results35$repeatedPValues[3, ], c(0.14391589, 0.013711948, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results35$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results35$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.271, 0.447), tolerance = 1e-06, label = paste0("c(", paste0(results35$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results35$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results35$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results35$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results35$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results35), NA))) - expect_output(print(results35)$show()) - invisible(capture.output(expect_error(summary(results35), NA))) - expect_output(summary(results35)$show()) - results35CodeBased <- eval(parse(text = getObjectRCode(results35, stringWrapParagraphWidth = NULL))) - expect_equal(results35CodeBased$thetaH1, results35$thetaH1, tolerance = 1e-06) - expect_equal(results35CodeBased$assumedStDevs, results35$assumedStDevs, tolerance = 1e-06) - expect_equal(results35CodeBased$conditionalRejectionProbabilities, results35$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results35CodeBased$repeatedConfidenceIntervalLowerBounds, results35$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results35CodeBased$repeatedConfidenceIntervalUpperBounds, results35$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results35CodeBased$repeatedPValues, results35$repeatedPValues, tolerance = 1e-06) - expect_equal(results35CodeBased$conditionalPowerSimulated, results35$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results35), "character") - df <- as.data.frame(results35) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results35) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results36 <- getAnalysisResults(design = design2, dataInput = dataExample1, - intersectionTest = "Sidak", varianceOption = "overallPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results36' with expected results - expect_equal(results36$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results36$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results36$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results36$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results36$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results36$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results36$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results36$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results36$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results36$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results36$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results36$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results36$conditionalRejectionProbabilities[1, ], c(0.023469013, 0.048270226, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results36$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results36$conditionalRejectionProbabilities[2, ], c(0.019613852, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results36$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results36$conditionalRejectionProbabilities[3, ], c(0.026830382, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results36$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results36$repeatedConfidenceIntervalLowerBounds[1, ], c(-11.737451, -4.6050352, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results36$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results36$repeatedConfidenceIntervalLowerBounds[2, ], c(-16.267707, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results36$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results36$repeatedConfidenceIntervalLowerBounds[3, ], c(-8.7750975, 0.30217392, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results36$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results36$repeatedConfidenceIntervalUpperBounds[1, ], c(41.737451, 27.295819, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results36$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results36$repeatedConfidenceIntervalUpperBounds[2, ], c(35.467707, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results36$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results36$repeatedConfidenceIntervalUpperBounds[3, ], c(43.775098, 31.772829, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results36$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results36$repeatedPValues[1, ], c(0.18572393, 0.069730666, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results36$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results36$repeatedPValues[2, ], c(0.23360401, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results36$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results36$repeatedPValues[3, ], c(0.15596268, 0.017006886, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results36$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results36$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.26, 0.436), tolerance = 1e-06, label = paste0("c(", paste0(results36$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results36$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results36$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results36$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results36$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results36), NA))) - expect_output(print(results36)$show()) - invisible(capture.output(expect_error(summary(results36), NA))) - expect_output(summary(results36)$show()) - results36CodeBased <- eval(parse(text = getObjectRCode(results36, stringWrapParagraphWidth = NULL))) - expect_equal(results36CodeBased$thetaH1, results36$thetaH1, tolerance = 1e-06) - expect_equal(results36CodeBased$assumedStDevs, results36$assumedStDevs, tolerance = 1e-06) - expect_equal(results36CodeBased$conditionalRejectionProbabilities, results36$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results36CodeBased$repeatedConfidenceIntervalLowerBounds, results36$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results36CodeBased$repeatedConfidenceIntervalUpperBounds, results36$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results36CodeBased$repeatedPValues, results36$repeatedPValues, tolerance = 1e-06) - expect_equal(results36CodeBased$conditionalPowerSimulated, results36$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results36), "character") - df <- as.data.frame(results36) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results36) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results37 <- getAnalysisResults(design = design2, dataInput = dataExample1, - intersectionTest = "Sidak", varianceOption = "pairwisePooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results37' with expected results - expect_equal(results37$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results37$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results37$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results37$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results37$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results37$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results37$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results37$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results37$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results37$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results37$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results37$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results37$conditionalRejectionProbabilities[1, ], c(0.024748593, 0.053966892, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results37$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results37$conditionalRejectionProbabilities[2, ], c(0.021915713, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results37$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results37$conditionalRejectionProbabilities[3, ], c(0.0267758, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results37$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results37$repeatedConfidenceIntervalLowerBounds[1, ], c(-10.38015, -4.0770639, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results37$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results37$repeatedConfidenceIntervalLowerBounds[2, ], c(-13.116502, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results37$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results37$repeatedConfidenceIntervalLowerBounds[3, ], c(-8.2525514, 0.41959343, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results37$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results37$repeatedConfidenceIntervalUpperBounds[1, ], c(40.38015, 26.720108, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results37$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results37$repeatedConfidenceIntervalUpperBounds[2, ], c(32.316502, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results37$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results37$repeatedConfidenceIntervalUpperBounds[3, ], c(43.252551, 31.62149, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results37$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results37$repeatedPValues[1, ], c(0.17335289, 0.062127989, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results37$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results37$repeatedPValues[2, ], c(0.20285189, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results37$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results37$repeatedPValues[3, ], c(0.15638134, 0.015781417, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results37$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results37$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.277, 0.453), tolerance = 1e-06, label = paste0("c(", paste0(results37$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results37$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results37$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results37$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results37$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results37), NA))) - expect_output(print(results37)$show()) - invisible(capture.output(expect_error(summary(results37), NA))) - expect_output(summary(results37)$show()) - results37CodeBased <- eval(parse(text = getObjectRCode(results37, stringWrapParagraphWidth = NULL))) - expect_equal(results37CodeBased$thetaH1, results37$thetaH1, tolerance = 1e-06) - expect_equal(results37CodeBased$assumedStDevs, results37$assumedStDevs, tolerance = 1e-06) - expect_equal(results37CodeBased$conditionalRejectionProbabilities, results37$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results37CodeBased$repeatedConfidenceIntervalLowerBounds, results37$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results37CodeBased$repeatedConfidenceIntervalUpperBounds, results37$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results37CodeBased$repeatedPValues, results37$repeatedPValues, tolerance = 1e-06) - expect_equal(results37CodeBased$conditionalPowerSimulated, results37$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results37), "character") - df <- as.data.frame(results37) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results37) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results38 <- getAnalysisResults(design = design2, dataInput = dataExample1, - intersectionTest = "Sidak", varianceOption = "pairwisePooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results38' with expected results - expect_equal(results38$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results38$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results38$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results38$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results38$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results38$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results38$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results38$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results38$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results38$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results38$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results38$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results38$conditionalRejectionProbabilities[1, ], c(0.022923976, 0.04788638, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results38$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results38$conditionalRejectionProbabilities[2, ], c(0.021309255, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results38$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results38$conditionalRejectionProbabilities[3, ], c(0.023933809, 0.14146912, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results38$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results38$repeatedConfidenceIntervalLowerBounds[1, ], c(-12.960526, -4.7313117, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results38$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results38$repeatedConfidenceIntervalLowerBounds[2, ], c(-15.225975, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results38$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results38$repeatedConfidenceIntervalLowerBounds[3, ], c(-10.752245, -0.16953037, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results38$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results38$repeatedConfidenceIntervalUpperBounds[1, ], c(42.960526, 27.347242, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results38$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results38$repeatedConfidenceIntervalUpperBounds[2, ], c(34.425975, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results38$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results38$repeatedConfidenceIntervalUpperBounds[3, ], c(45.752245, 32.205007, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results38$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results38$repeatedPValues[1, ], c(0.19144883, 0.07030573, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results38$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results38$repeatedPValues[2, ], c(0.21026955, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results38$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results38$repeatedPValues[3, ], c(0.18106429, 0.021778109, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results38$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results38$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.259, 0.434), tolerance = 1e-06, label = paste0("c(", paste0(results38$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results38$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results38$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results38$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 0.656, 0.797), tolerance = 1e-06, label = paste0("c(", paste0(results38$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results38), NA))) - expect_output(print(results38)$show()) - invisible(capture.output(expect_error(summary(results38), NA))) - expect_output(summary(results38)$show()) - results38CodeBased <- eval(parse(text = getObjectRCode(results38, stringWrapParagraphWidth = NULL))) - expect_equal(results38CodeBased$thetaH1, results38$thetaH1, tolerance = 1e-06) - expect_equal(results38CodeBased$assumedStDevs, results38$assumedStDevs, tolerance = 1e-06) - expect_equal(results38CodeBased$conditionalRejectionProbabilities, results38$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results38CodeBased$repeatedConfidenceIntervalLowerBounds, results38$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results38CodeBased$repeatedConfidenceIntervalUpperBounds, results38$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results38CodeBased$repeatedPValues, results38$repeatedPValues, tolerance = 1e-06) - expect_equal(results38CodeBased$conditionalPowerSimulated, results38$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results38), "character") - df <- as.data.frame(results38) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results38) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results39 <- getAnalysisResults(design = design2, dataInput = dataExample1, - intersectionTest = "Dunnett", varianceOption = "overallPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results39' with expected results - expect_equal(results39$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results39$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results39$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results39$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results39$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results39$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results39$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results39$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results39$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results39$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results39$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results39$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results39$conditionalRejectionProbabilities[1, ], c(0.026270241, 0.055429536, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results39$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results39$conditionalRejectionProbabilities[2, ], c(0.019837849, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results39$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results39$conditionalRejectionProbabilities[3, ], c(0.032007473, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results39$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results39$repeatedConfidenceIntervalLowerBounds[1, ], c(-10.308137, -3.9366921, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results39$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results39$repeatedConfidenceIntervalLowerBounds[2, ], c(-14.884887, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results39$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results39$repeatedConfidenceIntervalLowerBounds[3, ], c(-7.3704995, 0.96851041, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results39$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results39$repeatedConfidenceIntervalUpperBounds[1, ], c(40.308137, 26.527814, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results39$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results39$repeatedConfidenceIntervalUpperBounds[2, ], c(34.084887, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results39$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results39$repeatedConfidenceIntervalUpperBounds[3, ], c(42.370499, 31.063081, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results39$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results39$repeatedPValues[1, ], c(0.1603448, 0.060420915, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results39$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results39$repeatedPValues[2, ], c(0.23027951, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results39$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results39$repeatedPValues[3, ], c(0.12340907, 0.011635803, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results39$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results39$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.286, 0.457), tolerance = 1e-06, label = paste0("c(", paste0(results39$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results39$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results39$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results39$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results39$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results39), NA))) - expect_output(print(results39)$show()) - invisible(capture.output(expect_error(summary(results39), NA))) - expect_output(summary(results39)$show()) - results39CodeBased <- eval(parse(text = getObjectRCode(results39, stringWrapParagraphWidth = NULL))) - expect_equal(results39CodeBased$thetaH1, results39$thetaH1, tolerance = 1e-06) - expect_equal(results39CodeBased$assumedStDevs, results39$assumedStDevs, tolerance = 1e-06) - expect_equal(results39CodeBased$conditionalRejectionProbabilities, results39$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results39CodeBased$repeatedConfidenceIntervalLowerBounds, results39$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results39CodeBased$repeatedConfidenceIntervalUpperBounds, results39$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results39CodeBased$repeatedPValues, results39$repeatedPValues, tolerance = 1e-06) - expect_equal(results39CodeBased$conditionalPowerSimulated, results39$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results39), "character") - df <- as.data.frame(results39) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results39) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results40 <- getAnalysisResults(design = design2, dataInput = dataExample1, - intersectionTest = "Dunnett", varianceOption = "overallPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results40' with expected results - expect_equal(results40$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results40$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results40$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results40$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results40$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results40$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results40$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results40$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results40$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results40$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results40$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results40$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results40$conditionalRejectionProbabilities[1, ], c(0.025452912, 0.052195908, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results40$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results40$conditionalRejectionProbabilities[2, ], c(0.019613852, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results40$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results40$conditionalRejectionProbabilities[3, ], c(0.030394861, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results40$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results40$repeatedConfidenceIntervalLowerBounds[1, ], c(-11.358826, -4.2590391, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results40$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results40$repeatedConfidenceIntervalLowerBounds[2, ], c(-15.901398, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results40$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results40$repeatedConfidenceIntervalLowerBounds[3, ], c(-8.4030195, 0.65705914, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results40$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results40$repeatedConfidenceIntervalUpperBounds[1, ], c(41.358826, 26.891429, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results40$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results40$repeatedConfidenceIntervalUpperBounds[2, ], c(35.101397, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results40$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results40$repeatedConfidenceIntervalUpperBounds[3, ], c(43.40302, 31.392896, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results40$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results40$repeatedPValues[1, ], c(0.16712065, 0.064319528, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results40$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results40$repeatedPValues[2, ], c(0.23360401, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results40$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results40$repeatedPValues[3, ], c(0.13222768, 0.014210719, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results40$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results40$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.272, 0.449), tolerance = 1e-06, label = paste0("c(", paste0(results40$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results40$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results40$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results40$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results40$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results40), NA))) - expect_output(print(results40)$show()) - invisible(capture.output(expect_error(summary(results40), NA))) - expect_output(summary(results40)$show()) - results40CodeBased <- eval(parse(text = getObjectRCode(results40, stringWrapParagraphWidth = NULL))) - expect_equal(results40CodeBased$thetaH1, results40$thetaH1, tolerance = 1e-06) - expect_equal(results40CodeBased$assumedStDevs, results40$assumedStDevs, tolerance = 1e-06) - expect_equal(results40CodeBased$conditionalRejectionProbabilities, results40$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results40CodeBased$repeatedConfidenceIntervalLowerBounds, results40$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results40CodeBased$repeatedConfidenceIntervalUpperBounds, results40$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results40CodeBased$repeatedPValues, results40$repeatedPValues, tolerance = 1e-06) - expect_equal(results40CodeBased$conditionalPowerSimulated, results40$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results40), "character") - df <- as.data.frame(results40) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results40) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results41 <- getAnalysisResults(design = design3, dataInput = dataExample1, - intersectionTest = "Dunnett", varianceOption = "overallPooled", normalApproximation = TRUE, directionUpper = TRUE) - - ## Comparison of the results of AnalysisResultsConditionalDunnett object 'results41' with expected results - expect_equal(results41$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results41$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results41$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results41$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results41$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results41$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results41$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results41$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results41$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results41$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results41$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results41$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results41$conditionalRejectionProbabilities[1, ], c(NA_real_, 0.061352937), tolerance = 1e-06, label = paste0("c(", paste0(results41$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results41$conditionalRejectionProbabilities[2, ], c(NA_real_, 0.03744742), tolerance = 1e-06, label = paste0("c(", paste0(results41$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results41$conditionalRejectionProbabilities[3, ], c(NA_real_, 0.086511764), tolerance = 1e-06, label = paste0("c(", paste0(results41$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results41$conditionalPower[1, ], c(NA_real_, NA_real_), label = paste0("c(", paste0(results41$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results41$conditionalPower[2, ], c(NA_real_, NA_real_), label = paste0("c(", paste0(results41$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results41$conditionalPower[3, ], c(NA_real_, NA_real_), label = paste0("c(", paste0(results41$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results41$repeatedConfidenceIntervalLowerBounds[1, ], c(NA_real_, -0.72441408), tolerance = 1e-06, label = paste0("c(", paste0(results41$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results41$repeatedConfidenceIntervalLowerBounds[2, ], c(NA_real_, NA_real_), label = paste0("c(", paste0(results41$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results41$repeatedConfidenceIntervalLowerBounds[3, ], c(NA_real_, 3.9389155), tolerance = 1e-06, label = paste0("c(", paste0(results41$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results41$repeatedConfidenceIntervalUpperBounds[1, ], c(NA_real_, 22.538727), tolerance = 1e-06, label = paste0("c(", paste0(results41$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results41$repeatedConfidenceIntervalUpperBounds[2, ], c(NA_real_, NA_real_), label = paste0("c(", paste0(results41$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results41$repeatedConfidenceIntervalUpperBounds[3, ], c(NA_real_, 26.753532), tolerance = 1e-06, label = paste0("c(", paste0(results41$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results41$repeatedPValues[1, ], c(NA_real_, 0.017445576), tolerance = 1e-06, label = paste0("c(", paste0(results41$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results41$repeatedPValues[2, ], c(NA_real_, NA_real_), label = paste0("c(", paste0(results41$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results41$repeatedPValues[3, ], c(NA_real_, 0.0019493527), tolerance = 1e-06, label = paste0("c(", paste0(results41$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results41), NA))) - expect_output(print(results41)$show()) - invisible(capture.output(expect_error(summary(results41), NA))) - expect_output(summary(results41)$show()) - results41CodeBased <- eval(parse(text = getObjectRCode(results41, stringWrapParagraphWidth = NULL))) - expect_equal(results41CodeBased$thetaH1, results41$thetaH1, tolerance = 1e-06) - expect_equal(results41CodeBased$assumedStDevs, results41$assumedStDevs, tolerance = 1e-06) - expect_equal(results41CodeBased$conditionalRejectionProbabilities, results41$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results41CodeBased$conditionalPower, results41$conditionalPower, tolerance = 1e-06) - expect_equal(results41CodeBased$repeatedConfidenceIntervalLowerBounds, results41$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results41CodeBased$repeatedConfidenceIntervalUpperBounds, results41$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results41CodeBased$repeatedPValues, results41$repeatedPValues, tolerance = 1e-06) - expect_type(names(results41), "character") - df <- as.data.frame(results41) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results41) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results42 <- getAnalysisResults(design = design1, dataInput = dataExample2, - intersectionTest = "Bonferroni", varianceOption = "notPooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results42' with expected results - expect_equal(results42$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results42$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results42$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results42$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results42$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results42$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results42$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results42$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results42$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results42$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results42$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results42$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results42$conditionalRejectionProbabilities[1, ], c(0.043739576, 0.16022367, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results42$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results42$conditionalRejectionProbabilities[2, ], c(0.03844608, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results42$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results42$conditionalRejectionProbabilities[3, ], c(0.048616927, 0.34001465, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results42$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results42$conditionalPower[1, ], c(NA_real_, NA_real_, 0.45838936, 0.70196346), tolerance = 1e-06, label = paste0("c(", paste0(results42$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results42$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results42$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results42$conditionalPower[3, ], c(NA_real_, NA_real_, 0.827255, 0.9465652), tolerance = 1e-06, label = paste0("c(", paste0(results42$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results42$repeatedConfidenceIntervalLowerBounds[1, ], c(-44.395028, -27.895908, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results42$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results42$repeatedConfidenceIntervalLowerBounds[2, ], c(-36.091548, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results42$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results42$repeatedConfidenceIntervalLowerBounds[3, ], c(-47.071339, -32.285152, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results42$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results42$repeatedConfidenceIntervalUpperBounds[1, ], c(14.395028, 4.0669228, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results42$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results42$repeatedConfidenceIntervalUpperBounds[2, ], c(16.891548, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results42$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results42$repeatedConfidenceIntervalUpperBounds[3, ], c(12.071338, -0.24153969, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results42$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results42$repeatedPValues[1, ], c(0.5, 0.072888275, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results42$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results42$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results42$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results42$repeatedPValues[3, ], c(0.5, 0.017155659, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results42$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results42), NA))) - expect_output(print(results42)$show()) - invisible(capture.output(expect_error(summary(results42), NA))) - expect_output(summary(results42)$show()) - results42CodeBased <- eval(parse(text = getObjectRCode(results42, stringWrapParagraphWidth = NULL))) - expect_equal(results42CodeBased$thetaH1, results42$thetaH1, tolerance = 1e-06) - expect_equal(results42CodeBased$assumedStDevs, results42$assumedStDevs, tolerance = 1e-06) - expect_equal(results42CodeBased$conditionalRejectionProbabilities, results42$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results42CodeBased$conditionalPower, results42$conditionalPower, tolerance = 1e-06) - expect_equal(results42CodeBased$repeatedConfidenceIntervalLowerBounds, results42$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results42CodeBased$repeatedConfidenceIntervalUpperBounds, results42$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results42CodeBased$repeatedPValues, results42$repeatedPValues, tolerance = 1e-06) - expect_type(names(results42), "character") - df <- as.data.frame(results42) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results42) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results43 <- getAnalysisResults(design = design1, dataInput = dataExample2, - intersectionTest = "Bonferroni", varianceOption = "notPooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results43' with expected results - expect_equal(results43$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results43$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results43$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results43$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results43$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results43$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results43$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results43$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results43$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results43$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results43$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results43$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results43$conditionalRejectionProbabilities[1, ], c(0.040100206, 0.14400686, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results43$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results43$conditionalRejectionProbabilities[2, ], c(0.037171319, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results43$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results43$conditionalRejectionProbabilities[3, ], c(0.042866371, 0.28890175, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results43$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results43$conditionalPower[1, ], c(NA_real_, NA_real_, 0.42767622, 0.67947129), tolerance = 1e-06, label = paste0("c(", paste0(results43$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results43$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results43$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results43$conditionalPower[3, ], c(NA_real_, NA_real_, 0.78417464, 0.93070164), tolerance = 1e-06, label = paste0("c(", paste0(results43$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results43$repeatedConfidenceIntervalLowerBounds[1, ], c(-48.433726, -28.584393, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results43$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results43$repeatedConfidenceIntervalLowerBounds[2, ], c(-39.626743, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results43$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results43$repeatedConfidenceIntervalLowerBounds[3, ], c(-50.938808, -32.927366, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results43$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results43$repeatedConfidenceIntervalUpperBounds[1, ], c(18.433726, 4.7641755, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results43$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results43$repeatedConfidenceIntervalUpperBounds[2, ], c(20.426743, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results43$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results43$repeatedConfidenceIntervalUpperBounds[3, ], c(15.938808, 0.40329832, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results43$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results43$repeatedPValues[1, ], c(0.5, 0.085188742, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results43$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results43$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results43$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results43$repeatedPValues[3, ], c(0.5, 0.025112148, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results43$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results43), NA))) - expect_output(print(results43)$show()) - invisible(capture.output(expect_error(summary(results43), NA))) - expect_output(summary(results43)$show()) - results43CodeBased <- eval(parse(text = getObjectRCode(results43, stringWrapParagraphWidth = NULL))) - expect_equal(results43CodeBased$thetaH1, results43$thetaH1, tolerance = 1e-06) - expect_equal(results43CodeBased$assumedStDevs, results43$assumedStDevs, tolerance = 1e-06) - expect_equal(results43CodeBased$conditionalRejectionProbabilities, results43$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results43CodeBased$conditionalPower, results43$conditionalPower, tolerance = 1e-06) - expect_equal(results43CodeBased$repeatedConfidenceIntervalLowerBounds, results43$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results43CodeBased$repeatedConfidenceIntervalUpperBounds, results43$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results43CodeBased$repeatedPValues, results43$repeatedPValues, tolerance = 1e-06) - expect_type(names(results43), "character") - df <- as.data.frame(results43) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results43) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results44 <- getAnalysisResults(design = design1, dataInput = dataExample2, - intersectionTest = "Bonferroni", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results44' with expected results - expect_equal(results44$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results44$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results44$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results44$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results44$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results44$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results44$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results44$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results44$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results44$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results44$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results44$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results44$conditionalRejectionProbabilities[1, ], c(0.042394596, 0.15198143, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results44$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results44$conditionalRejectionProbabilities[2, ], c(0.034321105, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results44$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results44$conditionalRejectionProbabilities[3, ], c(0.049947129, 0.35588618, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results44$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results44$conditionalPower[1, ], c(NA_real_, NA_real_, 0.44302928, 0.69082025), tolerance = 1e-06, label = paste0("c(", paste0(results44$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results44$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results44$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results44$conditionalPower[3, ], c(NA_real_, NA_real_, 0.83889182, 0.95069292), tolerance = 1e-06, label = paste0("c(", paste0(results44$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results44$repeatedConfidenceIntervalLowerBounds[1, ], c(-44.802158, -28.113845, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results44$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results44$repeatedConfidenceIntervalLowerBounds[2, ], c(-38.432721, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results44$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results44$repeatedConfidenceIntervalLowerBounds[3, ], c(-46.786808, -32.10754, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results44$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results44$repeatedConfidenceIntervalUpperBounds[1, ], c(14.802158, 4.2854677, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results44$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results44$repeatedConfidenceIntervalUpperBounds[2, ], c(19.232721, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results44$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results44$repeatedConfidenceIntervalUpperBounds[3, ], c(11.786808, -0.41764226, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results44$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results44$repeatedPValues[1, ], c(0.5, 0.078823932, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results44$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results44$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results44$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results44$repeatedPValues[3, ], c(0.5, 0.015272156, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results44$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results44), NA))) - expect_output(print(results44)$show()) - invisible(capture.output(expect_error(summary(results44), NA))) - expect_output(summary(results44)$show()) - results44CodeBased <- eval(parse(text = getObjectRCode(results44, stringWrapParagraphWidth = NULL))) - expect_equal(results44CodeBased$thetaH1, results44$thetaH1, tolerance = 1e-06) - expect_equal(results44CodeBased$assumedStDevs, results44$assumedStDevs, tolerance = 1e-06) - expect_equal(results44CodeBased$conditionalRejectionProbabilities, results44$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results44CodeBased$conditionalPower, results44$conditionalPower, tolerance = 1e-06) - expect_equal(results44CodeBased$repeatedConfidenceIntervalLowerBounds, results44$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results44CodeBased$repeatedConfidenceIntervalUpperBounds, results44$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results44CodeBased$repeatedPValues, results44$repeatedPValues, tolerance = 1e-06) - expect_type(names(results44), "character") - df <- as.data.frame(results44) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results44) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results45 <- getAnalysisResults(design = design1, dataInput = dataExample2, - intersectionTest = "Bonferroni", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results45' with expected results - expect_equal(results45$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results45$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results45$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results45$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results45$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results45$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results45$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results45$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results45$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results45$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results45$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results45$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results45$conditionalRejectionProbabilities[1, ], c(0.040740209, 0.14372404, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results45$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results45$conditionalRejectionProbabilities[2, ], c(0.033856262, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results45$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results45$conditionalRejectionProbabilities[3, ], c(0.046882975, 0.32321322, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results45$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results45$conditionalPower[1, ], c(NA_real_, NA_real_, 0.42712247, 0.6790579), tolerance = 1e-06, label = paste0("c(", paste0(results45$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results45$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results45$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results45$conditionalPower[3, ], c(NA_real_, NA_real_, 0.81409137, 0.94181531), tolerance = 1e-06, label = paste0("c(", paste0(results45$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results45$repeatedConfidenceIntervalLowerBounds[1, ], c(-46.567569, -28.528695, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results45$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results45$repeatedConfidenceIntervalLowerBounds[2, ], c(-40.140706, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results45$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results45$repeatedConfidenceIntervalLowerBounds[3, ], c(-48.521691, -32.491814, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results45$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results45$repeatedConfidenceIntervalUpperBounds[1, ], c(16.567569, 4.662798, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results45$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results45$repeatedConfidenceIntervalUpperBounds[2, ], c(20.940706, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results45$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results45$repeatedConfidenceIntervalUpperBounds[3, ], c(13.521691, -0.049006969, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results45$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results45$repeatedPValues[1, ], c(0.5, 0.08542716, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results45$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results45$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results45$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results45$repeatedPValues[3, ], c(0.5, 0.019420631, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results45$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results45), NA))) - expect_output(print(results45)$show()) - invisible(capture.output(expect_error(summary(results45), NA))) - expect_output(summary(results45)$show()) - results45CodeBased <- eval(parse(text = getObjectRCode(results45, stringWrapParagraphWidth = NULL))) - expect_equal(results45CodeBased$thetaH1, results45$thetaH1, tolerance = 1e-06) - expect_equal(results45CodeBased$assumedStDevs, results45$assumedStDevs, tolerance = 1e-06) - expect_equal(results45CodeBased$conditionalRejectionProbabilities, results45$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results45CodeBased$conditionalPower, results45$conditionalPower, tolerance = 1e-06) - expect_equal(results45CodeBased$repeatedConfidenceIntervalLowerBounds, results45$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results45CodeBased$repeatedConfidenceIntervalUpperBounds, results45$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results45CodeBased$repeatedPValues, results45$repeatedPValues, tolerance = 1e-06) - expect_type(names(results45), "character") - df <- as.data.frame(results45) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results45) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results46 <- getAnalysisResults(design = design1, dataInput = dataExample2, - intersectionTest = "Bonferroni", varianceOption = "pairwisePooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results46' with expected results - expect_equal(results46$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results46$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results46$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results46$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results46$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results46$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results46$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results46$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results46$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results46$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results46$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results46$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results46$conditionalRejectionProbabilities[1, ], c(0.043219831, 0.15803856, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results46$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results46$conditionalRejectionProbabilities[2, ], c(0.038533075, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results46$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results46$conditionalRejectionProbabilities[3, ], c(0.046782116, 0.33290332, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results46$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results46$conditionalPower[1, ], c(NA_real_, NA_real_, 0.45436587, 0.6990644), tolerance = 1e-06, label = paste0("c(", paste0(results46$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results46$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results46$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results46$conditionalPower[3, ], c(NA_real_, NA_real_, 0.8217936, 0.94460493), tolerance = 1e-06, label = paste0("c(", paste0(results46$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results46$repeatedConfidenceIntervalLowerBounds[1, ], c(-44.549821, -27.945069, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results46$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results46$repeatedConfidenceIntervalLowerBounds[2, ], c(-36.048567, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results46$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results46$repeatedConfidenceIntervalLowerBounds[3, ], c(-47.483405, -32.356999, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results46$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results46$repeatedConfidenceIntervalUpperBounds[1, ], c(14.549821, 4.1213996, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results46$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results46$repeatedConfidenceIntervalUpperBounds[2, ], c(16.848567, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results46$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results46$repeatedConfidenceIntervalUpperBounds[3, ], c(12.483405, -0.16013976, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results46$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results46$repeatedPValues[1, ], c(0.5, 0.07440366, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results46$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results46$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results46$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results46$repeatedPValues[3, ], c(0.5, 0.018077861, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results46$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results46), NA))) - expect_output(print(results46)$show()) - invisible(capture.output(expect_error(summary(results46), NA))) - expect_output(summary(results46)$show()) - results46CodeBased <- eval(parse(text = getObjectRCode(results46, stringWrapParagraphWidth = NULL))) - expect_equal(results46CodeBased$thetaH1, results46$thetaH1, tolerance = 1e-06) - expect_equal(results46CodeBased$assumedStDevs, results46$assumedStDevs, tolerance = 1e-06) - expect_equal(results46CodeBased$conditionalRejectionProbabilities, results46$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results46CodeBased$conditionalPower, results46$conditionalPower, tolerance = 1e-06) - expect_equal(results46CodeBased$repeatedConfidenceIntervalLowerBounds, results46$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results46CodeBased$repeatedConfidenceIntervalUpperBounds, results46$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results46CodeBased$repeatedPValues, results46$repeatedPValues, tolerance = 1e-06) - expect_type(names(results46), "character") - df <- as.data.frame(results46) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results46) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results47 <- getAnalysisResults(design = design1, dataInput = dataExample2, - intersectionTest = "Bonferroni", varianceOption = "pairwisePooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results47' with expected results - expect_equal(results47$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results47$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results47$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results47$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results47$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results47$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results47$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results47$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results47$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results47$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results47$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results47$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results47$conditionalRejectionProbabilities[1, ], c(0.039664178, 0.14221619, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results47$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results47$conditionalRejectionProbabilities[2, ], c(0.037322005, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results47$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results47$conditionalRejectionProbabilities[3, ], c(0.041377736, 0.28315003, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results47$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results47$conditionalPower[1, ], c(NA_real_, NA_real_, 0.42415922, 0.67684078), tolerance = 1e-06, label = paste0("c(", paste0(results47$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results47$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results47$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results47$conditionalPower[3, ], c(NA_real_, NA_real_, 0.77871789, 0.92862656), tolerance = 1e-06, label = paste0("c(", paste0(results47$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results47$repeatedConfidenceIntervalLowerBounds[1, ], c(-48.601467, -28.627869, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results47$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results47$repeatedConfidenceIntervalLowerBounds[2, ], c(-39.353637, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results47$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results47$repeatedConfidenceIntervalLowerBounds[3, ], c(-51.403927, -32.999307, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results47$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results47$repeatedConfidenceIntervalUpperBounds[1, ], c(18.601467, 4.8144337, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results47$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results47$repeatedConfidenceIntervalUpperBounds[2, ], c(20.153637, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results47$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results47$repeatedConfidenceIntervalUpperBounds[3, ], c(16.403927, 0.48327212, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results47$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results47$repeatedPValues[1, ], c(0.5, 0.086711756, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results47$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results47$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results47$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results47$repeatedPValues[3, ], c(0.5, 0.026234621, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results47$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results47), NA))) - expect_output(print(results47)$show()) - invisible(capture.output(expect_error(summary(results47), NA))) - expect_output(summary(results47)$show()) - results47CodeBased <- eval(parse(text = getObjectRCode(results47, stringWrapParagraphWidth = NULL))) - expect_equal(results47CodeBased$thetaH1, results47$thetaH1, tolerance = 1e-06) - expect_equal(results47CodeBased$assumedStDevs, results47$assumedStDevs, tolerance = 1e-06) - expect_equal(results47CodeBased$conditionalRejectionProbabilities, results47$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results47CodeBased$conditionalPower, results47$conditionalPower, tolerance = 1e-06) - expect_equal(results47CodeBased$repeatedConfidenceIntervalLowerBounds, results47$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results47CodeBased$repeatedConfidenceIntervalUpperBounds, results47$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results47CodeBased$repeatedPValues, results47$repeatedPValues, tolerance = 1e-06) - expect_type(names(results47), "character") - df <- as.data.frame(results47) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results47) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results48 <- getAnalysisResults(design = design1, dataInput = dataExample2, - intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results48' with expected results - expect_equal(results48$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results48$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results48$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results48$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results48$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results48$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results48$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results48$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results48$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results48$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results48$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results48$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results48$conditionalRejectionProbabilities[1, ], c(0.043739576, 0.16022367, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results48$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results48$conditionalRejectionProbabilities[2, ], c(0.03844608, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results48$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results48$conditionalRejectionProbabilities[3, ], c(0.052717287, 0.35672949, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results48$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results48$conditionalPower[1, ], c(NA_real_, NA_real_, 0.45838936, 0.70196346), tolerance = 1e-06, label = paste0("c(", paste0(results48$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results48$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results48$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results48$conditionalPower[3, ], c(NA_real_, NA_real_, 0.83948961, 0.95090316), tolerance = 1e-06, label = paste0("c(", paste0(results48$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results48$repeatedConfidenceIntervalLowerBounds[1, ], c(-44.395028, -27.895908, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results48$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results48$repeatedConfidenceIntervalLowerBounds[2, ], c(-36.091548, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results48$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results48$repeatedConfidenceIntervalLowerBounds[3, ], c(-47.071339, -32.285152, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results48$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results48$repeatedConfidenceIntervalUpperBounds[1, ], c(14.395028, 4.0669228, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results48$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results48$repeatedConfidenceIntervalUpperBounds[2, ], c(16.891548, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results48$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results48$repeatedConfidenceIntervalUpperBounds[3, ], c(12.071338, -0.24153969, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results48$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results48$repeatedPValues[1, ], c(0.5, 0.072888275, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results48$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results48$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results48$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results48$repeatedPValues[3, ], c(0.5, 0.015177743, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results48$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results48), NA))) - expect_output(print(results48)$show()) - invisible(capture.output(expect_error(summary(results48), NA))) - expect_output(summary(results48)$show()) - results48CodeBased <- eval(parse(text = getObjectRCode(results48, stringWrapParagraphWidth = NULL))) - expect_equal(results48CodeBased$thetaH1, results48$thetaH1, tolerance = 1e-06) - expect_equal(results48CodeBased$assumedStDevs, results48$assumedStDevs, tolerance = 1e-06) - expect_equal(results48CodeBased$conditionalRejectionProbabilities, results48$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results48CodeBased$conditionalPower, results48$conditionalPower, tolerance = 1e-06) - expect_equal(results48CodeBased$repeatedConfidenceIntervalLowerBounds, results48$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results48CodeBased$repeatedConfidenceIntervalUpperBounds, results48$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results48CodeBased$repeatedPValues, results48$repeatedPValues, tolerance = 1e-06) - expect_type(names(results48), "character") - df <- as.data.frame(results48) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results48) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results49 <- getAnalysisResults(design = design1, dataInput = dataExample2, - intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results49' with expected results - expect_equal(results49$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results49$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results49$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results49$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results49$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results49$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results49$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results49$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results49$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results49$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results49$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results49$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results49$conditionalRejectionProbabilities[1, ], c(0.040100206, 0.14400686, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results49$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results49$conditionalRejectionProbabilities[2, ], c(0.037171319, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results49$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results49$conditionalRejectionProbabilities[3, ], c(0.048708233, 0.3133215, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results49$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results49$conditionalPower[1, ], c(NA_real_, NA_real_, 0.42767622, 0.67947129), tolerance = 1e-06, label = paste0("c(", paste0(results49$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results49$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results49$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results49$conditionalPower[3, ], c(NA_real_, NA_real_, 0.80590445, 0.93881804), tolerance = 1e-06, label = paste0("c(", paste0(results49$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results49$repeatedConfidenceIntervalLowerBounds[1, ], c(-48.433726, -28.584393, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results49$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results49$repeatedConfidenceIntervalLowerBounds[2, ], c(-39.626743, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results49$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results49$repeatedConfidenceIntervalLowerBounds[3, ], c(-50.938808, -32.927366, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results49$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results49$repeatedConfidenceIntervalUpperBounds[1, ], c(18.433726, 4.7641755, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results49$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results49$repeatedConfidenceIntervalUpperBounds[2, ], c(20.426743, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results49$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results49$repeatedConfidenceIntervalUpperBounds[3, ], c(15.938808, 0.40329832, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results49$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results49$repeatedPValues[1, ], c(0.5, 0.085188742, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results49$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results49$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results49$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results49$repeatedPValues[3, ], c(0.5, 0.020901685, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results49$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results49), NA))) - expect_output(print(results49)$show()) - invisible(capture.output(expect_error(summary(results49), NA))) - expect_output(summary(results49)$show()) - results49CodeBased <- eval(parse(text = getObjectRCode(results49, stringWrapParagraphWidth = NULL))) - expect_equal(results49CodeBased$thetaH1, results49$thetaH1, tolerance = 1e-06) - expect_equal(results49CodeBased$assumedStDevs, results49$assumedStDevs, tolerance = 1e-06) - expect_equal(results49CodeBased$conditionalRejectionProbabilities, results49$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results49CodeBased$conditionalPower, results49$conditionalPower, tolerance = 1e-06) - expect_equal(results49CodeBased$repeatedConfidenceIntervalLowerBounds, results49$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results49CodeBased$repeatedConfidenceIntervalUpperBounds, results49$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results49CodeBased$repeatedPValues, results49$repeatedPValues, tolerance = 1e-06) - expect_type(names(results49), "character") - df <- as.data.frame(results49) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results49) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results50 <- getAnalysisResults(design = design1, dataInput = dataExample2, - intersectionTest = "Simes", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results50' with expected results - expect_equal(results50$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results50$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results50$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results50$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results50$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results50$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results50$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results50$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results50$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results50$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results50$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results50$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results50$conditionalRejectionProbabilities[1, ], c(0.042394596, 0.15198143, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results50$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results50$conditionalRejectionProbabilities[2, ], c(0.034321105, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results50$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results50$conditionalRejectionProbabilities[3, ], c(0.051237296, 0.36121246, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results50$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results50$conditionalPower[1, ], c(NA_real_, NA_real_, 0.44302928, 0.69082025), tolerance = 1e-06, label = paste0("c(", paste0(results50$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results50$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results50$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results50$conditionalPower[3, ], c(NA_real_, NA_real_, 0.84263383, 0.95200602), tolerance = 1e-06, label = paste0("c(", paste0(results50$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results50$repeatedConfidenceIntervalLowerBounds[1, ], c(-44.802158, -28.113845, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results50$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results50$repeatedConfidenceIntervalLowerBounds[2, ], c(-38.432721, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results50$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results50$repeatedConfidenceIntervalLowerBounds[3, ], c(-46.786808, -32.10754, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results50$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results50$repeatedConfidenceIntervalUpperBounds[1, ], c(14.802158, 4.2854677, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results50$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results50$repeatedConfidenceIntervalUpperBounds[2, ], c(19.232721, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results50$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results50$repeatedConfidenceIntervalUpperBounds[3, ], c(11.786808, -0.41764226, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results50$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results50$repeatedPValues[1, ], c(0.5, 0.078823932, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results50$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results50$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results50$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results50$repeatedPValues[3, ], c(0.5, 0.014689462, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results50$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results50), NA))) - expect_output(print(results50)$show()) - invisible(capture.output(expect_error(summary(results50), NA))) - expect_output(summary(results50)$show()) - results50CodeBased <- eval(parse(text = getObjectRCode(results50, stringWrapParagraphWidth = NULL))) - expect_equal(results50CodeBased$thetaH1, results50$thetaH1, tolerance = 1e-06) - expect_equal(results50CodeBased$assumedStDevs, results50$assumedStDevs, tolerance = 1e-06) - expect_equal(results50CodeBased$conditionalRejectionProbabilities, results50$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results50CodeBased$conditionalPower, results50$conditionalPower, tolerance = 1e-06) - expect_equal(results50CodeBased$repeatedConfidenceIntervalLowerBounds, results50$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results50CodeBased$repeatedConfidenceIntervalUpperBounds, results50$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results50CodeBased$repeatedPValues, results50$repeatedPValues, tolerance = 1e-06) - expect_type(names(results50), "character") - df <- as.data.frame(results50) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results50) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results51 <- getAnalysisResults(design = design1, dataInput = dataExample2, - intersectionTest = "Simes", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results51' with expected results - expect_equal(results51$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results51$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results51$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results51$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results51$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results51$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results51$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results51$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results51$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results51$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results51$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results51$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results51$conditionalRejectionProbabilities[1, ], c(0.040740209, 0.14372404, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results51$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results51$conditionalRejectionProbabilities[2, ], c(0.033856262, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results51$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results51$conditionalRejectionProbabilities[3, ], c(0.049414261, 0.33374326, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results51$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results51$conditionalPower[1, ], c(NA_real_, NA_real_, 0.42712247, 0.6790579), tolerance = 1e-06, label = paste0("c(", paste0(results51$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results51$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results51$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results51$conditionalPower[3, ], c(NA_real_, NA_real_, 0.82244694, 0.94484021), tolerance = 1e-06, label = paste0("c(", paste0(results51$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results51$repeatedConfidenceIntervalLowerBounds[1, ], c(-46.567569, -28.528695, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results51$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results51$repeatedConfidenceIntervalLowerBounds[2, ], c(-40.140706, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results51$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results51$repeatedConfidenceIntervalLowerBounds[3, ], c(-48.521691, -32.491814, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results51$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results51$repeatedConfidenceIntervalUpperBounds[1, ], c(16.567569, 4.662798, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results51$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results51$repeatedConfidenceIntervalUpperBounds[2, ], c(20.940706, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results51$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results51$repeatedConfidenceIntervalUpperBounds[3, ], c(13.521691, -0.049006969, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results51$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results51$repeatedPValues[1, ], c(0.5, 0.08542716, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results51$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results51$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results51$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results51$repeatedPValues[3, ], c(0.5, 0.017966281, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results51$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results51), NA))) - expect_output(print(results51)$show()) - invisible(capture.output(expect_error(summary(results51), NA))) - expect_output(summary(results51)$show()) - results51CodeBased <- eval(parse(text = getObjectRCode(results51, stringWrapParagraphWidth = NULL))) - expect_equal(results51CodeBased$thetaH1, results51$thetaH1, tolerance = 1e-06) - expect_equal(results51CodeBased$assumedStDevs, results51$assumedStDevs, tolerance = 1e-06) - expect_equal(results51CodeBased$conditionalRejectionProbabilities, results51$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results51CodeBased$conditionalPower, results51$conditionalPower, tolerance = 1e-06) - expect_equal(results51CodeBased$repeatedConfidenceIntervalLowerBounds, results51$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results51CodeBased$repeatedConfidenceIntervalUpperBounds, results51$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results51CodeBased$repeatedPValues, results51$repeatedPValues, tolerance = 1e-06) - expect_type(names(results51), "character") - df <- as.data.frame(results51) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results51) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results52 <- getAnalysisResults(design = design1, dataInput = dataExample2, - intersectionTest = "Simes", varianceOption = "pairwisePooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results52' with expected results - expect_equal(results52$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results52$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results52$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results52$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results52$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results52$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results52$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results52$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results52$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results52$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results52$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results52$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results52$conditionalRejectionProbabilities[1, ], c(0.043219831, 0.15803856, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results52$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results52$conditionalRejectionProbabilities[2, ], c(0.038533075, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results52$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results52$conditionalRejectionProbabilities[3, ], c(0.052145589, 0.35513472, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results52$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results52$conditionalPower[1, ], c(NA_real_, NA_real_, 0.45436587, 0.6990644), tolerance = 1e-06, label = paste0("c(", paste0(results52$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results52$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results52$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results52$conditionalPower[3, ], c(NA_real_, NA_real_, 0.83835744, 0.95050484), tolerance = 1e-06, label = paste0("c(", paste0(results52$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results52$repeatedConfidenceIntervalLowerBounds[1, ], c(-44.549821, -27.945069, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results52$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results52$repeatedConfidenceIntervalLowerBounds[2, ], c(-36.048567, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results52$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results52$repeatedConfidenceIntervalLowerBounds[3, ], c(-47.483405, -32.356999, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results52$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results52$repeatedConfidenceIntervalUpperBounds[1, ], c(14.549821, 4.1213996, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results52$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results52$repeatedConfidenceIntervalUpperBounds[2, ], c(16.848567, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results52$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results52$repeatedConfidenceIntervalUpperBounds[3, ], c(12.483405, -0.16013976, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results52$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results52$repeatedPValues[1, ], c(0.5, 0.07440366, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results52$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results52$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results52$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results52$repeatedPValues[3, ], c(0.5, 0.015356079, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results52$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results52), NA))) - expect_output(print(results52)$show()) - invisible(capture.output(expect_error(summary(results52), NA))) - expect_output(summary(results52)$show()) - results52CodeBased <- eval(parse(text = getObjectRCode(results52, stringWrapParagraphWidth = NULL))) - expect_equal(results52CodeBased$thetaH1, results52$thetaH1, tolerance = 1e-06) - expect_equal(results52CodeBased$assumedStDevs, results52$assumedStDevs, tolerance = 1e-06) - expect_equal(results52CodeBased$conditionalRejectionProbabilities, results52$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results52CodeBased$conditionalPower, results52$conditionalPower, tolerance = 1e-06) - expect_equal(results52CodeBased$repeatedConfidenceIntervalLowerBounds, results52$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results52CodeBased$repeatedConfidenceIntervalUpperBounds, results52$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results52CodeBased$repeatedPValues, results52$repeatedPValues, tolerance = 1e-06) - expect_type(names(results52), "character") - df <- as.data.frame(results52) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results52) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results53 <- getAnalysisResults(design = design1, dataInput = dataExample2, - intersectionTest = "Simes", varianceOption = "pairwisePooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results53' with expected results - expect_equal(results53$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results53$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results53$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results53$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results53$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results53$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results53$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results53$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results53$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results53$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results53$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results53$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results53$conditionalRejectionProbabilities[1, ], c(0.039664178, 0.14221619, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results53$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results53$conditionalRejectionProbabilities[2, ], c(0.037322005, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results53$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results53$conditionalRejectionProbabilities[3, ], c(0.048226966, 0.31219358, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results53$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results53$conditionalPower[1, ], c(NA_real_, NA_real_, 0.42415922, 0.67684078), tolerance = 1e-06, label = paste0("c(", paste0(results53$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results53$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results53$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results53$conditionalPower[3, ], c(NA_real_, NA_real_, 0.80494934, 0.93846621), tolerance = 1e-06, label = paste0("c(", paste0(results53$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results53$repeatedConfidenceIntervalLowerBounds[1, ], c(-48.601467, -28.627869, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results53$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results53$repeatedConfidenceIntervalLowerBounds[2, ], c(-39.353637, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results53$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results53$repeatedConfidenceIntervalLowerBounds[3, ], c(-51.403927, -32.999307, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results53$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results53$repeatedConfidenceIntervalUpperBounds[1, ], c(18.601467, 4.8144337, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results53$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results53$repeatedConfidenceIntervalUpperBounds[2, ], c(20.153637, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results53$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results53$repeatedConfidenceIntervalUpperBounds[3, ], c(16.403927, 0.48327212, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results53$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results53$repeatedPValues[1, ], c(0.5, 0.086711756, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results53$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results53$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results53$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results53$repeatedPValues[3, ], c(0.5, 0.021078114, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results53$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results53), NA))) - expect_output(print(results53)$show()) - invisible(capture.output(expect_error(summary(results53), NA))) - expect_output(summary(results53)$show()) - results53CodeBased <- eval(parse(text = getObjectRCode(results53, stringWrapParagraphWidth = NULL))) - expect_equal(results53CodeBased$thetaH1, results53$thetaH1, tolerance = 1e-06) - expect_equal(results53CodeBased$assumedStDevs, results53$assumedStDevs, tolerance = 1e-06) - expect_equal(results53CodeBased$conditionalRejectionProbabilities, results53$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results53CodeBased$conditionalPower, results53$conditionalPower, tolerance = 1e-06) - expect_equal(results53CodeBased$repeatedConfidenceIntervalLowerBounds, results53$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results53CodeBased$repeatedConfidenceIntervalUpperBounds, results53$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results53CodeBased$repeatedPValues, results53$repeatedPValues, tolerance = 1e-06) - expect_type(names(results53), "character") - df <- as.data.frame(results53) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results53) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results54 <- getAnalysisResults(design = design1, dataInput = dataExample2, - intersectionTest = "Sidak", varianceOption = "notPooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results54' with expected results - expect_equal(results54$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results54$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results54$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results54$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results54$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results54$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results54$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results54$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results54$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results54$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results54$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results54$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results54$conditionalRejectionProbabilities[1, ], c(0.044513617, 0.16250147, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results54$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results54$conditionalRejectionProbabilities[2, ], c(0.03844608, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results54$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results54$conditionalRejectionProbabilities[3, ], c(0.049538053, 0.34419132, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results54$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results54$conditionalPower[1, ], c(NA_real_, NA_real_, 0.46254707, 0.70494473), tolerance = 1e-06, label = paste0("c(", paste0(results54$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results54$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results54$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results54$conditionalPower[3, ], c(NA_real_, NA_real_, 0.83038985, 0.94768376), tolerance = 1e-06, label = paste0("c(", paste0(results54$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results54$repeatedConfidenceIntervalLowerBounds[1, ], c(-44.393216, -27.725836, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results54$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results54$repeatedConfidenceIntervalLowerBounds[2, ], c(-36.089915, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results54$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results54$repeatedConfidenceIntervalLowerBounds[3, ], c(-47.069516, -32.182569, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results54$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results54$repeatedConfidenceIntervalUpperBounds[1, ], c(14.393216, 4.0328452, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results54$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results54$repeatedConfidenceIntervalUpperBounds[2, ], c(16.889915, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results54$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results54$repeatedConfidenceIntervalUpperBounds[3, ], c(12.069516, -0.29402607, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results54$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results54$repeatedPValues[1, ], c(0.5, 0.071351909, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results54$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results54$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results54$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results54$repeatedPValues[3, ], c(0.5, 0.016637815, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results54$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results54), NA))) - expect_output(print(results54)$show()) - invisible(capture.output(expect_error(summary(results54), NA))) - expect_output(summary(results54)$show()) - results54CodeBased <- eval(parse(text = getObjectRCode(results54, stringWrapParagraphWidth = NULL))) - expect_equal(results54CodeBased$thetaH1, results54$thetaH1, tolerance = 1e-06) - expect_equal(results54CodeBased$assumedStDevs, results54$assumedStDevs, tolerance = 1e-06) - expect_equal(results54CodeBased$conditionalRejectionProbabilities, results54$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results54CodeBased$conditionalPower, results54$conditionalPower, tolerance = 1e-06) - expect_equal(results54CodeBased$repeatedConfidenceIntervalLowerBounds, results54$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results54CodeBased$repeatedConfidenceIntervalUpperBounds, results54$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results54CodeBased$repeatedPValues, results54$repeatedPValues, tolerance = 1e-06) - expect_type(names(results54), "character") - df <- as.data.frame(results54) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results54) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results55 <- getAnalysisResults(design = design1, dataInput = dataExample2, - intersectionTest = "Sidak", varianceOption = "notPooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results55' with expected results - expect_equal(results55$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results55$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results55$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results55$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results55$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results55$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results55$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results55$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results55$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results55$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results55$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results55$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results55$conditionalRejectionProbabilities[1, ], c(0.040941914, 0.14648989, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results55$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results55$conditionalRejectionProbabilities[2, ], c(0.037171319, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results55$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results55$conditionalRejectionProbabilities[3, ], c(0.043912863, 0.29382832, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results55$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results55$conditionalPower[1, ], c(NA_real_, NA_real_, 0.4325103, 0.68306799), tolerance = 1e-06, label = paste0("c(", paste0(results55$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results55$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results55$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results55$conditionalPower[3, ], c(NA_real_, NA_real_, 0.78874215, 0.93242714), tolerance = 1e-06, label = paste0("c(", paste0(results55$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results55$repeatedConfidenceIntervalLowerBounds[1, ], c(-48.431163, -28.407231, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results55$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results55$repeatedConfidenceIntervalLowerBounds[2, ], c(-39.624453, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results55$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results55$repeatedConfidenceIntervalLowerBounds[3, ], c(-50.936268, -32.815818, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results55$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results55$repeatedConfidenceIntervalUpperBounds[1, ], c(18.431163, 4.7231897, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results55$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results55$repeatedConfidenceIntervalUpperBounds[2, ], c(20.424453, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results55$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results55$repeatedConfidenceIntervalUpperBounds[3, ], c(15.936268, 0.34247232, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results55$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results55$repeatedPValues[1, ], c(0.5, 0.083136439, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results55$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results55$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results55$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results55$repeatedPValues[3, ], c(0.5, 0.024192808, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results55$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results55), NA))) - expect_output(print(results55)$show()) - invisible(capture.output(expect_error(summary(results55), NA))) - expect_output(summary(results55)$show()) - results55CodeBased <- eval(parse(text = getObjectRCode(results55, stringWrapParagraphWidth = NULL))) - expect_equal(results55CodeBased$thetaH1, results55$thetaH1, tolerance = 1e-06) - expect_equal(results55CodeBased$assumedStDevs, results55$assumedStDevs, tolerance = 1e-06) - expect_equal(results55CodeBased$conditionalRejectionProbabilities, results55$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results55CodeBased$conditionalPower, results55$conditionalPower, tolerance = 1e-06) - expect_equal(results55CodeBased$repeatedConfidenceIntervalLowerBounds, results55$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results55CodeBased$repeatedConfidenceIntervalUpperBounds, results55$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results55CodeBased$repeatedPValues, results55$repeatedPValues, tolerance = 1e-06) - expect_type(names(results55), "character") - df <- as.data.frame(results55) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results55) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results56 <- getAnalysisResults(design = design1, dataInput = dataExample2, - intersectionTest = "Sidak", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results56' with expected results - expect_equal(results56$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results56$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results56$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results56$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results56$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results56$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results56$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results56$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results56$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results56$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results56$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results56$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results56$conditionalRejectionProbabilities[1, ], c(0.043192758, 0.15430882, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results56$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results56$conditionalRejectionProbabilities[2, ], c(0.034321105, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results56$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results56$conditionalRejectionProbabilities[3, ], c(0.050842102, 0.35990794, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results56$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results56$conditionalPower[1, ], c(NA_real_, NA_real_, 0.44741759, 0.6940249), tolerance = 1e-06, label = paste0("c(", paste0(results56$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results56$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results56$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results56$conditionalPower[3, ], c(NA_real_, NA_real_, 0.84172467, 0.95168763), tolerance = 1e-06, label = paste0("c(", paste0(results56$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results56$repeatedConfidenceIntervalLowerBounds[1, ], c(-44.800321, -27.943326, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results56$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results56$repeatedConfidenceIntervalLowerBounds[2, ], c(-38.430944, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results56$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results56$repeatedConfidenceIntervalLowerBounds[3, ], c(-46.785003, -32.005071, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results56$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results56$repeatedConfidenceIntervalUpperBounds[1, ], c(14.800321, 4.2506387, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results56$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results56$repeatedConfidenceIntervalUpperBounds[2, ], c(19.230944, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results56$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results56$repeatedConfidenceIntervalUpperBounds[3, ], c(11.785003, -0.46968016, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results56$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results56$repeatedPValues[1, ], c(0.5, 0.077086341, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results56$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results56$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results56$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results56$repeatedPValues[3, ], c(0.5, 0.014829652, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results56$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results56), NA))) - expect_output(print(results56)$show()) - invisible(capture.output(expect_error(summary(results56), NA))) - expect_output(summary(results56)$show()) - results56CodeBased <- eval(parse(text = getObjectRCode(results56, stringWrapParagraphWidth = NULL))) - expect_equal(results56CodeBased$thetaH1, results56$thetaH1, tolerance = 1e-06) - expect_equal(results56CodeBased$assumedStDevs, results56$assumedStDevs, tolerance = 1e-06) - expect_equal(results56CodeBased$conditionalRejectionProbabilities, results56$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results56CodeBased$conditionalPower, results56$conditionalPower, tolerance = 1e-06) - expect_equal(results56CodeBased$repeatedConfidenceIntervalLowerBounds, results56$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results56CodeBased$repeatedConfidenceIntervalUpperBounds, results56$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results56CodeBased$repeatedPValues, results56$repeatedPValues, tolerance = 1e-06) - expect_type(names(results56), "character") - df <- as.data.frame(results56) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results56) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results57 <- getAnalysisResults(design = design1, dataInput = dataExample2, - intersectionTest = "Sidak", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results57' with expected results - expect_equal(results57$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results57$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results57$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results57$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results57$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results57$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results57$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results57$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results57$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results57$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results57$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results57$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results57$conditionalRejectionProbabilities[1, ], c(0.041569453, 0.14613212, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results57$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results57$conditionalRejectionProbabilities[2, ], c(0.033856262, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results57$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results57$conditionalRejectionProbabilities[3, ], c(0.047839714, 0.32760313, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results57$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results57$conditionalPower[1, ], c(NA_real_, NA_real_, 0.43181681, 0.68255335), tolerance = 1e-06, label = paste0("c(", paste0(results57$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results57$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results57$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results57$conditionalPower[3, ], c(NA_real_, NA_real_, 0.81761872, 0.94309649), tolerance = 1e-06, label = paste0("c(", paste0(results57$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results57$repeatedConfidenceIntervalLowerBounds[1, ], c(-46.565416, -28.357046, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results57$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results57$repeatedConfidenceIntervalLowerBounds[2, ], c(-40.138622, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results57$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results57$repeatedConfidenceIntervalLowerBounds[3, ], c(-48.519575, -32.386196, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results57$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results57$repeatedConfidenceIntervalUpperBounds[1, ], c(16.565416, 4.6248784, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results57$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results57$repeatedConfidenceIntervalUpperBounds[2, ], c(20.938622, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results57$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results57$repeatedConfidenceIntervalUpperBounds[3, ], c(13.519575, -0.10461531, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results57$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results57$repeatedPValues[1, ], c(0.5, 0.083428262, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results57$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results57$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results57$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results57$repeatedPValues[3, ], c(0.5, 0.018799791, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results57$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results57), NA))) - expect_output(print(results57)$show()) - invisible(capture.output(expect_error(summary(results57), NA))) - expect_output(summary(results57)$show()) - results57CodeBased <- eval(parse(text = getObjectRCode(results57, stringWrapParagraphWidth = NULL))) - expect_equal(results57CodeBased$thetaH1, results57$thetaH1, tolerance = 1e-06) - expect_equal(results57CodeBased$assumedStDevs, results57$assumedStDevs, tolerance = 1e-06) - expect_equal(results57CodeBased$conditionalRejectionProbabilities, results57$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results57CodeBased$conditionalPower, results57$conditionalPower, tolerance = 1e-06) - expect_equal(results57CodeBased$repeatedConfidenceIntervalLowerBounds, results57$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results57CodeBased$repeatedConfidenceIntervalUpperBounds, results57$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results57CodeBased$repeatedPValues, results57$repeatedPValues, tolerance = 1e-06) - expect_type(names(results57), "character") - df <- as.data.frame(results57) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results57) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results58 <- getAnalysisResults(design = design1, dataInput = dataExample2, - intersectionTest = "Sidak", varianceOption = "pairwisePooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results58' with expected results - expect_equal(results58$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results58$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results58$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results58$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results58$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results58$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results58$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results58$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results58$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results58$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results58$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results58$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results58$conditionalRejectionProbabilities[1, ], c(0.044003076, 0.16034604, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results58$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results58$conditionalRejectionProbabilities[2, ], c(0.038533075, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results58$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results58$conditionalRejectionProbabilities[3, ], c(0.047740982, 0.33733332, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results58$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results58$conditionalPower[1, ], c(NA_real_, NA_real_, 0.45861366, 0.70212467), tolerance = 1e-06, label = paste0("c(", paste0(results58$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results58$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results58$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results58$conditionalPower[3, ], c(NA_real_, NA_real_, 0.82521432, 0.94583446), tolerance = 1e-06, label = paste0("c(", paste0(results58$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results58$repeatedConfidenceIntervalLowerBounds[1, ], c(-44.548, -27.773536, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results58$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results58$repeatedConfidenceIntervalLowerBounds[2, ], c(-36.046937, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results58$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results58$repeatedConfidenceIntervalLowerBounds[3, ], c(-47.481556, -32.250037, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results58$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results58$repeatedConfidenceIntervalUpperBounds[1, ], c(14.548, 4.0869288, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results58$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results58$repeatedConfidenceIntervalUpperBounds[2, ], c(16.846937, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results58$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results58$repeatedConfidenceIntervalUpperBounds[3, ], c(12.481557, -0.21501802, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results58$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results58$repeatedPValues[1, ], c(0.5, 0.072804352, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results58$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results58$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results58$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results58$repeatedPValues[3, ], c(0.5, 0.017498028, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results58$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results58), NA))) - expect_output(print(results58)$show()) - invisible(capture.output(expect_error(summary(results58), NA))) - expect_output(summary(results58)$show()) - results58CodeBased <- eval(parse(text = getObjectRCode(results58, stringWrapParagraphWidth = NULL))) - expect_equal(results58CodeBased$thetaH1, results58$thetaH1, tolerance = 1e-06) - expect_equal(results58CodeBased$assumedStDevs, results58$assumedStDevs, tolerance = 1e-06) - expect_equal(results58CodeBased$conditionalRejectionProbabilities, results58$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results58CodeBased$conditionalPower, results58$conditionalPower, tolerance = 1e-06) - expect_equal(results58CodeBased$repeatedConfidenceIntervalLowerBounds, results58$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results58CodeBased$repeatedConfidenceIntervalUpperBounds, results58$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results58CodeBased$repeatedPValues, results58$repeatedPValues, tolerance = 1e-06) - expect_type(names(results58), "character") - df <- as.data.frame(results58) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results58) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results59 <- getAnalysisResults(design = design1, dataInput = dataExample2, - intersectionTest = "Sidak", varianceOption = "pairwisePooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results59' with expected results - expect_equal(results59$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results59$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results59$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results59$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results59$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results59$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results59$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results59$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results59$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results59$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results59$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results59$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results59$conditionalRejectionProbabilities[1, ], c(0.040514523, 0.14472681, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results59$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results59$conditionalRejectionProbabilities[2, ], c(0.037322005, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results59$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results59$conditionalRejectionProbabilities[3, ], c(0.042460333, 0.28832504, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results59$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results59$conditionalPower[1, ], c(NA_real_, NA_real_, 0.42908294, 0.68052019), tolerance = 1e-06, label = paste0("c(", paste0(results59$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results59$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results59$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results59$conditionalPower[3, ], c(NA_real_, NA_real_, 0.78363361, 0.93049656), tolerance = 1e-06, label = paste0("c(", paste0(results59$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results59$repeatedConfidenceIntervalLowerBounds[1, ], c(-48.598892, -28.449073, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results59$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results59$repeatedConfidenceIntervalLowerBounds[2, ], c(-39.351395, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results59$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results59$repeatedConfidenceIntervalLowerBounds[3, ], c(-51.401351, -32.883177, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results59$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results59$repeatedConfidenceIntervalUpperBounds[1, ], c(18.598892, 4.7729883, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results59$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results59$repeatedConfidenceIntervalUpperBounds[2, ], c(20.151395, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results59$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results59$repeatedConfidenceIntervalUpperBounds[3, ], c(16.401351, 0.41981706, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results59$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results59$repeatedPValues[1, ], c(0.5, 0.084586974, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results59$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results59$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results59$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results59$repeatedPValues[3, ], c(0.5, 0.025221821, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results59$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results59), NA))) - expect_output(print(results59)$show()) - invisible(capture.output(expect_error(summary(results59), NA))) - expect_output(summary(results59)$show()) - results59CodeBased <- eval(parse(text = getObjectRCode(results59, stringWrapParagraphWidth = NULL))) - expect_equal(results59CodeBased$thetaH1, results59$thetaH1, tolerance = 1e-06) - expect_equal(results59CodeBased$assumedStDevs, results59$assumedStDevs, tolerance = 1e-06) - expect_equal(results59CodeBased$conditionalRejectionProbabilities, results59$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results59CodeBased$conditionalPower, results59$conditionalPower, tolerance = 1e-06) - expect_equal(results59CodeBased$repeatedConfidenceIntervalLowerBounds, results59$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results59CodeBased$repeatedConfidenceIntervalUpperBounds, results59$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results59CodeBased$repeatedPValues, results59$repeatedPValues, tolerance = 1e-06) - expect_type(names(results59), "character") - df <- as.data.frame(results59) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results59) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results60 <- getAnalysisResults(design = design1, dataInput = dataExample2, - intersectionTest = "Dunnett", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results60' with expected results - expect_equal(results60$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results60$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results60$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results60$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results60$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results60$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results60$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results60$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results60$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results60$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results60$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results60$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results60$conditionalRejectionProbabilities[1, ], c(0.046821821, 0.16471602, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results60$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results60$conditionalRejectionProbabilities[2, ], c(0.034321105, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results60$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results60$conditionalRejectionProbabilities[3, ], c(0.056787656, 0.38875311, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results60$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results60$conditionalPower[1, ], c(NA_real_, NA_real_, 0.46655424, 0.70780427), tolerance = 1e-06, label = paste0("c(", paste0(results60$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results60$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results60$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results60$conditionalPower[3, ], c(NA_real_, NA_real_, 0.8607721, 0.95827226), tolerance = 1e-06, label = paste0("c(", paste0(results60$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results60$repeatedConfidenceIntervalLowerBounds[1, ], c(-44.645334, -27.415422, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results60$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results60$repeatedConfidenceIntervalLowerBounds[2, ], c(-38.280999, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results60$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results60$repeatedConfidenceIntervalLowerBounds[3, ], c(-46.632695, -31.563129, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results60$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results60$repeatedConfidenceIntervalUpperBounds[1, ], c(14.645333, 3.927683, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results60$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results60$repeatedConfidenceIntervalUpperBounds[2, ], c(19.080998, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results60$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results60$repeatedConfidenceIntervalUpperBounds[3, ], c(11.632695, -0.82950364, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results60$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results60$repeatedPValues[1, ], c(0.5, 0.069897558, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results60$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results60$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results60$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results60$repeatedPValues[3, ], c(0.5, 0.012021087, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results60$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results60), NA))) - expect_output(print(results60)$show()) - invisible(capture.output(expect_error(summary(results60), NA))) - expect_output(summary(results60)$show()) - results60CodeBased <- eval(parse(text = getObjectRCode(results60, stringWrapParagraphWidth = NULL))) - expect_equal(results60CodeBased$thetaH1, results60$thetaH1, tolerance = 1e-06) - expect_equal(results60CodeBased$assumedStDevs, results60$assumedStDevs, tolerance = 1e-06) - expect_equal(results60CodeBased$conditionalRejectionProbabilities, results60$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results60CodeBased$conditionalPower, results60$conditionalPower, tolerance = 1e-06) - expect_equal(results60CodeBased$repeatedConfidenceIntervalLowerBounds, results60$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results60CodeBased$repeatedConfidenceIntervalUpperBounds, results60$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results60CodeBased$repeatedPValues, results60$repeatedPValues, tolerance = 1e-06) - expect_type(names(results60), "character") - df <- as.data.frame(results60) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results60) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results61 <- getAnalysisResults(design = design1, dataInput = dataExample2, - intersectionTest = "Dunnett", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results61' with expected results - expect_equal(results61$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results61$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results61$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results61$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results61$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results61$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results61$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results61$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results61$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results61$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results61$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results61$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results61$conditionalRejectionProbabilities[1, ], c(0.045317687, 0.15683192, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results61$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results61$conditionalRejectionProbabilities[2, ], c(0.033856262, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results61$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results61$conditionalRejectionProbabilities[3, ], c(0.054085103, 0.3588303, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results61$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results61$conditionalPower[1, ], c(NA_real_, NA_real_, 0.45212919, 0.69744676), tolerance = 1e-06, label = paste0("c(", paste0(results61$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results61$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results61$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results61$conditionalPower[3, ], c(NA_real_, NA_real_, 0.84097006, 0.95142305), tolerance = 1e-06, label = paste0("c(", paste0(results61$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results61$repeatedConfidenceIntervalLowerBounds[1, ], c(-46.335113, -27.786662, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results61$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results61$repeatedConfidenceIntervalLowerBounds[2, ], c(-39.91581, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results61$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results61$repeatedConfidenceIntervalLowerBounds[3, ], c(-48.293254, -31.900882, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results61$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results61$repeatedConfidenceIntervalUpperBounds[1, ], c(16.335113, 4.2557288, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results61$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results61$repeatedConfidenceIntervalUpperBounds[2, ], c(20.71581, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results61$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results61$repeatedConfidenceIntervalUpperBounds[3, ], c(13.293254, -0.50940978, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results61$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results61$repeatedPValues[1, ], c(0.5, 0.075258151, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results61$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results61$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results61$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results61$repeatedPValues[3, ], c(0.5, 0.014946954, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results61$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results61), NA))) - expect_output(print(results61)$show()) - invisible(capture.output(expect_error(summary(results61), NA))) - expect_output(summary(results61)$show()) - results61CodeBased <- eval(parse(text = getObjectRCode(results61, stringWrapParagraphWidth = NULL))) - expect_equal(results61CodeBased$thetaH1, results61$thetaH1, tolerance = 1e-06) - expect_equal(results61CodeBased$assumedStDevs, results61$assumedStDevs, tolerance = 1e-06) - expect_equal(results61CodeBased$conditionalRejectionProbabilities, results61$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results61CodeBased$conditionalPower, results61$conditionalPower, tolerance = 1e-06) - expect_equal(results61CodeBased$repeatedConfidenceIntervalLowerBounds, results61$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results61CodeBased$repeatedConfidenceIntervalUpperBounds, results61$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results61CodeBased$repeatedPValues, results61$repeatedPValues, tolerance = 1e-06) - expect_type(names(results61), "character") - df <- as.data.frame(results61) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results61) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results62 <- getAnalysisResults(design = design2, dataInput = dataExample2, - intersectionTest = "Bonferroni", varianceOption = "notPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results62' with expected results - expect_equal(results62$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results62$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results62$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results62$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results62$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results62$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results62$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results62$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results62$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results62$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results62$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results62$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results62$conditionalRejectionProbabilities[1, ], c(0.024608533, 0.053964296, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results62$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results62$conditionalRejectionProbabilities[2, ], c(0.021871903, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results62$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results62$conditionalRejectionProbabilities[3, ], c(0.027261939, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results62$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results62$repeatedConfidenceIntervalLowerBounds[1, ], c(-40.256183, -26.806923, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results62$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results62$repeatedConfidenceIntervalLowerBounds[2, ], c(-32.361515, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results62$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results62$repeatedConfidenceIntervalLowerBounds[3, ], c(-42.907669, -31.664999, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results62$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results62$repeatedConfidenceIntervalUpperBounds[1, ], c(10.256183, 4.0576303, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results62$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results62$repeatedConfidenceIntervalUpperBounds[2, ], c(13.161515, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results62$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results62$repeatedConfidenceIntervalUpperBounds[3, ], c(7.9076686, -0.4326836, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results62$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results62$repeatedPValues[1, ], c(0.17463845, 0.062131804, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results62$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results62$repeatedPValues[2, ], c(0.20337355, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results62$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results62$repeatedPValues[3, ], c(0.1527221, 0.015597359, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results62$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results62$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.277, 0.453), tolerance = 1e-06, label = paste0("c(", paste0(results62$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results62$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results62$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results62$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results62$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results62), NA))) - expect_output(print(results62)$show()) - invisible(capture.output(expect_error(summary(results62), NA))) - expect_output(summary(results62)$show()) - results62CodeBased <- eval(parse(text = getObjectRCode(results62, stringWrapParagraphWidth = NULL))) - expect_equal(results62CodeBased$thetaH1, results62$thetaH1, tolerance = 1e-06) - expect_equal(results62CodeBased$assumedStDevs, results62$assumedStDevs, tolerance = 1e-06) - expect_equal(results62CodeBased$conditionalRejectionProbabilities, results62$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results62CodeBased$repeatedConfidenceIntervalLowerBounds, results62$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results62CodeBased$repeatedConfidenceIntervalUpperBounds, results62$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results62CodeBased$repeatedPValues, results62$repeatedPValues, tolerance = 1e-06) - expect_equal(results62CodeBased$conditionalPowerSimulated, results62$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results62), "character") - df <- as.data.frame(results62) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results62) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results63 <- getAnalysisResults(design = design2, dataInput = dataExample2, - intersectionTest = "Bonferroni", varianceOption = "notPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results63' with expected results - expect_equal(results63$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results63$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results63$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results63$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results63$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results63$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results63$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results63$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results63$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results63$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results63$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results63$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results63$conditionalRejectionProbabilities[1, ], c(0.022711489, 0.047669561, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results63$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results63$conditionalRejectionProbabilities[2, ], c(0.021234311, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results63$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results63$conditionalRejectionProbabilities[3, ], c(0.024147032, 0.14148061, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results63$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results63$repeatedConfidenceIntervalLowerBounds[1, ], c(-42.830851, -27.447651, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results63$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results63$repeatedConfidenceIntervalLowerBounds[2, ], c(-34.616779, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results63$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results63$repeatedConfidenceIntervalLowerBounds[3, ], c(-45.376075, -32.257244, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results63$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results63$repeatedConfidenceIntervalUpperBounds[1, ], c(12.830851, 4.722817, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results63$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results63$repeatedConfidenceIntervalUpperBounds[2, ], c(15.416779, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results63$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results63$repeatedConfidenceIntervalUpperBounds[3, ], c(10.376075, 0.16648466, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results63$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results63$repeatedPValues[1, ], c(0.19376148, 0.070634747, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results63$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results63$repeatedPValues[2, ], c(0.2112175, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results63$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results63$repeatedPValues[3, ], c(0.17899101, 0.021776202, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results63$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results63$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.257, 0.434), tolerance = 1e-06, label = paste0("c(", paste0(results63$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results63$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results63$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results63$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 0.656, 0.797), tolerance = 1e-06, label = paste0("c(", paste0(results63$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results63), NA))) - expect_output(print(results63)$show()) - invisible(capture.output(expect_error(summary(results63), NA))) - expect_output(summary(results63)$show()) - results63CodeBased <- eval(parse(text = getObjectRCode(results63, stringWrapParagraphWidth = NULL))) - expect_equal(results63CodeBased$thetaH1, results63$thetaH1, tolerance = 1e-06) - expect_equal(results63CodeBased$assumedStDevs, results63$assumedStDevs, tolerance = 1e-06) - expect_equal(results63CodeBased$conditionalRejectionProbabilities, results63$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results63CodeBased$repeatedConfidenceIntervalLowerBounds, results63$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results63CodeBased$repeatedConfidenceIntervalUpperBounds, results63$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results63CodeBased$repeatedPValues, results63$repeatedPValues, tolerance = 1e-06) - expect_equal(results63CodeBased$conditionalPowerSimulated, results63$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results63), "character") - df <- as.data.frame(results63) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results63) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results64 <- getAnalysisResults(design = design2, dataInput = dataExample2, - intersectionTest = "Bonferroni", varianceOption = "overallPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results64' with expected results - expect_equal(results64$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results64$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results64$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results64$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results64$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results64$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results64$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results64$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results64$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results64$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results64$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results64$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results64$conditionalRejectionProbabilities[1, ], c(0.02389937, 0.050606752, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results64$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results64$conditionalRejectionProbabilities[2, ], c(0.019837849, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results64$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results64$conditionalRejectionProbabilities[3, ], c(0.028008383, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results64$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results64$repeatedConfidenceIntervalLowerBounds[1, ], c(-40.605988, -27.021858, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results64$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results64$repeatedConfidenceIntervalLowerBounds[2, ], c(-34.373049, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results64$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results64$repeatedConfidenceIntervalLowerBounds[3, ], c(-42.6632, -31.486561, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results64$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results64$repeatedConfidenceIntervalUpperBounds[1, ], c(10.605988, 4.2731734, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results64$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results64$repeatedConfidenceIntervalUpperBounds[2, ], c(15.173049, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results64$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results64$repeatedConfidenceIntervalUpperBounds[3, ], c(7.6631999, -0.60791563, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results64$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results64$repeatedPValues[1, ], c(0.18140284, 0.066412839, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results64$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results64$repeatedPValues[2, ], c(0.23027951, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results64$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results64$repeatedPValues[3, ], c(0.14737581, 0.014014262, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results64$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results64$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.268, 0.445), tolerance = 1e-06, label = paste0("c(", paste0(results64$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results64$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results64$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results64$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results64$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results64), NA))) - expect_output(print(results64)$show()) - invisible(capture.output(expect_error(summary(results64), NA))) - expect_output(summary(results64)$show()) - results64CodeBased <- eval(parse(text = getObjectRCode(results64, stringWrapParagraphWidth = NULL))) - expect_equal(results64CodeBased$thetaH1, results64$thetaH1, tolerance = 1e-06) - expect_equal(results64CodeBased$assumedStDevs, results64$assumedStDevs, tolerance = 1e-06) - expect_equal(results64CodeBased$conditionalRejectionProbabilities, results64$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results64CodeBased$repeatedConfidenceIntervalLowerBounds, results64$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results64CodeBased$repeatedConfidenceIntervalUpperBounds, results64$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results64CodeBased$repeatedPValues, results64$repeatedPValues, tolerance = 1e-06) - expect_equal(results64CodeBased$conditionalPowerSimulated, results64$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results64), "character") - df <- as.data.frame(results64) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results64) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results65 <- getAnalysisResults(design = design2, dataInput = dataExample2, - intersectionTest = "Bonferroni", varianceOption = "overallPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results65' with expected results - expect_equal(results65$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results65$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results65$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results65$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results65$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results65$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results65$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results65$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results65$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results65$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results65$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results65$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results65$conditionalRejectionProbabilities[1, ], c(0.023040094, 0.047419024, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results65$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results65$conditionalRejectionProbabilities[2, ], c(0.019613852, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results65$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results65$conditionalRejectionProbabilities[3, ], c(0.026303733, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results65$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results65$repeatedConfidenceIntervalLowerBounds[1, ], c(-41.74771, -27.425347, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results65$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results65$repeatedConfidenceIntervalLowerBounds[2, ], c(-35.477631, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results65$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results65$repeatedConfidenceIntervalLowerBounds[3, ], c(-43.785178, -31.856528, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results65$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results65$repeatedConfidenceIntervalUpperBounds[1, ], c(11.74771, 4.6401767, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results65$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results65$repeatedConfidenceIntervalUpperBounds[2, ], c(16.277631, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results65$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results65$repeatedConfidenceIntervalUpperBounds[3, ], c(8.7851784, -0.25415362, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results65$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results65$repeatedPValues[1, ], c(0.19020524, 0.071018123, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results65$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results65$repeatedPValues[2, ], c(0.23360401, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results65$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results65$repeatedPValues[3, ], c(0.16007682, 0.01742078, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results65$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results65$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.256, 0.433), tolerance = 1e-06, label = paste0("c(", paste0(results65$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results65$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results65$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results65$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results65$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results65), NA))) - expect_output(print(results65)$show()) - invisible(capture.output(expect_error(summary(results65), NA))) - expect_output(summary(results65)$show()) - results65CodeBased <- eval(parse(text = getObjectRCode(results65, stringWrapParagraphWidth = NULL))) - expect_equal(results65CodeBased$thetaH1, results65$thetaH1, tolerance = 1e-06) - expect_equal(results65CodeBased$assumedStDevs, results65$assumedStDevs, tolerance = 1e-06) - expect_equal(results65CodeBased$conditionalRejectionProbabilities, results65$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results65CodeBased$repeatedConfidenceIntervalLowerBounds, results65$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results65CodeBased$repeatedConfidenceIntervalUpperBounds, results65$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results65CodeBased$repeatedPValues, results65$repeatedPValues, tolerance = 1e-06) - expect_equal(results65CodeBased$conditionalPowerSimulated, results65$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results65), "character") - df <- as.data.frame(results65) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results65) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results66 <- getAnalysisResults(design = design2, dataInput = dataExample2, - intersectionTest = "Bonferroni", varianceOption = "pairwisePooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results66' with expected results - expect_equal(results66$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results66$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results66$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results66$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results66$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results66$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results66$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results66$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results66$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results66$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results66$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results66$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results66$conditionalRejectionProbabilities[1, ], c(0.024333354, 0.053095357, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results66$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results66$conditionalRejectionProbabilities[2, ], c(0.021915713, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results66$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results66$conditionalRejectionProbabilities[3, ], c(0.026248507, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results66$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results66$repeatedConfidenceIntervalLowerBounds[1, ], c(-40.389181, -26.847363, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results66$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results66$repeatedConfidenceIntervalLowerBounds[2, ], c(-32.324586, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results66$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results66$repeatedConfidenceIntervalLowerBounds[3, ], c(-43.261715, -31.705217, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results66$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results66$repeatedConfidenceIntervalUpperBounds[1, ], c(10.389181, 4.1091853, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results66$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results66$repeatedConfidenceIntervalUpperBounds[2, ], c(13.124586, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results66$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results66$repeatedConfidenceIntervalUpperBounds[3, ], c(8.2617152, -0.37246523, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results66$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results66$repeatedPValues[1, ], c(0.17721241, 0.063189426, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results66$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results66$repeatedPValues[2, ], c(0.20285189, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results66$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results66$repeatedPValues[3, ], c(0.16051933, 0.01616384, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results66$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results66$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.274, 0.453), tolerance = 1e-06, label = paste0("c(", paste0(results66$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results66$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results66$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results66$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results66$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results66), NA))) - expect_output(print(results66)$show()) - invisible(capture.output(expect_error(summary(results66), NA))) - expect_output(summary(results66)$show()) - results66CodeBased <- eval(parse(text = getObjectRCode(results66, stringWrapParagraphWidth = NULL))) - expect_equal(results66CodeBased$thetaH1, results66$thetaH1, tolerance = 1e-06) - expect_equal(results66CodeBased$assumedStDevs, results66$assumedStDevs, tolerance = 1e-06) - expect_equal(results66CodeBased$conditionalRejectionProbabilities, results66$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results66CodeBased$repeatedConfidenceIntervalLowerBounds, results66$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results66CodeBased$repeatedConfidenceIntervalUpperBounds, results66$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results66CodeBased$repeatedPValues, results66$repeatedPValues, tolerance = 1e-06) - expect_equal(results66CodeBased$conditionalPowerSimulated, results66$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results66), "character") - df <- as.data.frame(results66) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results66) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results67 <- getAnalysisResults(design = design2, dataInput = dataExample2, - intersectionTest = "Bonferroni", varianceOption = "pairwisePooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results67' with expected results - expect_equal(results67$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results67$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results67$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results67$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results67$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results67$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results67$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results67$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results67$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results67$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results67$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results67$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results67$conditionalRejectionProbabilities[1, ], c(0.02248882, 0.047009108, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results67$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results67$conditionalRejectionProbabilities[2, ], c(0.021309255, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results67$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results67$conditionalRejectionProbabilities[3, ], c(0.023369532, 0.13794488, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results67$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results67$repeatedConfidenceIntervalLowerBounds[1, ], c(-42.972232, -27.481288, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results67$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results67$repeatedConfidenceIntervalLowerBounds[2, ], c(-34.436237, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results67$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results67$repeatedConfidenceIntervalLowerBounds[3, ], c(-45.763994, -32.295837, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results67$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results67$repeatedConfidenceIntervalUpperBounds[1, ], c(12.972232, 4.7692163, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results67$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results67$repeatedConfidenceIntervalUpperBounds[2, ], c(15.236237, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results67$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results67$repeatedConfidenceIntervalUpperBounds[3, ], c(10.763995, 0.22335705, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results67$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results67$repeatedPValues[1, ], c(0.19623626, 0.071653269, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results67$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results67$repeatedPValues[2, ], c(0.21026955, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results67$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results67$repeatedPValues[3, ], c(0.18674722, 0.022408487, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results67$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results67$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.256, 0.431), tolerance = 1e-06, label = paste0("c(", paste0(results67$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results67$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results67$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results67$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 0.652, 0.795), tolerance = 1e-06, label = paste0("c(", paste0(results67$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results67), NA))) - expect_output(print(results67)$show()) - invisible(capture.output(expect_error(summary(results67), NA))) - expect_output(summary(results67)$show()) - results67CodeBased <- eval(parse(text = getObjectRCode(results67, stringWrapParagraphWidth = NULL))) - expect_equal(results67CodeBased$thetaH1, results67$thetaH1, tolerance = 1e-06) - expect_equal(results67CodeBased$assumedStDevs, results67$assumedStDevs, tolerance = 1e-06) - expect_equal(results67CodeBased$conditionalRejectionProbabilities, results67$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results67CodeBased$repeatedConfidenceIntervalLowerBounds, results67$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results67CodeBased$repeatedConfidenceIntervalUpperBounds, results67$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results67CodeBased$repeatedPValues, results67$repeatedPValues, tolerance = 1e-06) - expect_equal(results67CodeBased$conditionalPowerSimulated, results67$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results67), "character") - df <- as.data.frame(results67) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results67) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results68 <- getAnalysisResults(design = design2, dataInput = dataExample2, - intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results68' with expected results - expect_equal(results68$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results68$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results68$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results68$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results68$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results68$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results68$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results68$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results68$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results68$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results68$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results68$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results68$conditionalRejectionProbabilities[1, ], c(0.024608533, 0.053964296, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results68$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results68$conditionalRejectionProbabilities[2, ], c(0.021871903, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results68$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results68$conditionalRejectionProbabilities[3, ], c(0.029595078, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results68$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results68$repeatedConfidenceIntervalLowerBounds[1, ], c(-40.256183, -26.806923, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results68$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results68$repeatedConfidenceIntervalLowerBounds[2, ], c(-32.361515, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results68$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results68$repeatedConfidenceIntervalLowerBounds[3, ], c(-42.907669, -31.664999, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results68$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results68$repeatedConfidenceIntervalUpperBounds[1, ], c(10.256183, 4.0576303, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results68$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results68$repeatedConfidenceIntervalUpperBounds[2, ], c(13.161515, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results68$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results68$repeatedConfidenceIntervalUpperBounds[3, ], c(7.9076686, -0.4326836, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results68$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results68$repeatedPValues[1, ], c(0.17463845, 0.062131804, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results68$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results68$repeatedPValues[2, ], c(0.20337355, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results68$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results68$repeatedPValues[3, ], c(0.13700176, 0.014275569, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results68$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results68$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.277, 0.453), tolerance = 1e-06, label = paste0("c(", paste0(results68$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results68$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results68$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results68$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results68$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results68), NA))) - expect_output(print(results68)$show()) - invisible(capture.output(expect_error(summary(results68), NA))) - expect_output(summary(results68)$show()) - results68CodeBased <- eval(parse(text = getObjectRCode(results68, stringWrapParagraphWidth = NULL))) - expect_equal(results68CodeBased$thetaH1, results68$thetaH1, tolerance = 1e-06) - expect_equal(results68CodeBased$assumedStDevs, results68$assumedStDevs, tolerance = 1e-06) - expect_equal(results68CodeBased$conditionalRejectionProbabilities, results68$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results68CodeBased$repeatedConfidenceIntervalLowerBounds, results68$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results68CodeBased$repeatedConfidenceIntervalUpperBounds, results68$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results68CodeBased$repeatedPValues, results68$repeatedPValues, tolerance = 1e-06) - expect_equal(results68CodeBased$conditionalPowerSimulated, results68$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results68), "character") - df <- as.data.frame(results68) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results68) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results69 <- getAnalysisResults(design = design2, dataInput = dataExample2, - intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results69' with expected results - expect_equal(results69$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results69$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results69$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results69$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results69$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results69$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results69$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results69$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results69$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results69$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results69$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results69$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results69$conditionalRejectionProbabilities[1, ], c(0.022711489, 0.047669561, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results69$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results69$conditionalRejectionProbabilities[2, ], c(0.021234311, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results69$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results69$conditionalRejectionProbabilities[3, ], c(0.027312859, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results69$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results69$repeatedConfidenceIntervalLowerBounds[1, ], c(-42.830851, -27.447651, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results69$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results69$repeatedConfidenceIntervalLowerBounds[2, ], c(-34.616779, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results69$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results69$repeatedConfidenceIntervalLowerBounds[3, ], c(-45.376075, -32.257244, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results69$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results69$repeatedConfidenceIntervalUpperBounds[1, ], c(12.830851, 4.722817, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results69$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results69$repeatedConfidenceIntervalUpperBounds[2, ], c(15.416779, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results69$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results69$repeatedConfidenceIntervalUpperBounds[3, ], c(10.376075, 0.16648466, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results69$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results69$repeatedPValues[1, ], c(0.19376148, 0.070634747, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results69$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results69$repeatedPValues[2, ], c(0.2112175, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results69$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results69$repeatedPValues[3, ], c(0.15234731, 0.019097336, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results69$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results69$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.257, 0.434), tolerance = 1e-06, label = paste0("c(", paste0(results69$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results69$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results69$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results69$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results69$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results69), NA))) - expect_output(print(results69)$show()) - invisible(capture.output(expect_error(summary(results69), NA))) - expect_output(summary(results69)$show()) - results69CodeBased <- eval(parse(text = getObjectRCode(results69, stringWrapParagraphWidth = NULL))) - expect_equal(results69CodeBased$thetaH1, results69$thetaH1, tolerance = 1e-06) - expect_equal(results69CodeBased$assumedStDevs, results69$assumedStDevs, tolerance = 1e-06) - expect_equal(results69CodeBased$conditionalRejectionProbabilities, results69$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results69CodeBased$repeatedConfidenceIntervalLowerBounds, results69$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results69CodeBased$repeatedConfidenceIntervalUpperBounds, results69$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results69CodeBased$repeatedPValues, results69$repeatedPValues, tolerance = 1e-06) - expect_equal(results69CodeBased$conditionalPowerSimulated, results69$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results69), "character") - df <- as.data.frame(results69) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results69) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results70 <- getAnalysisResults(design = design2, dataInput = dataExample2, - intersectionTest = "Simes", varianceOption = "overallPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results70' with expected results - expect_equal(results70$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results70$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results70$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results70$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results70$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results70$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results70$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results70$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results70$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results70$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results70$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results70$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results70$conditionalRejectionProbabilities[1, ], c(0.02389937, 0.050606752, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results70$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results70$conditionalRejectionProbabilities[2, ], c(0.019837849, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results70$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results70$conditionalRejectionProbabilities[3, ], c(0.028741907, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results70$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results70$repeatedConfidenceIntervalLowerBounds[1, ], c(-40.605988, -27.021858, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results70$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results70$repeatedConfidenceIntervalLowerBounds[2, ], c(-34.373049, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results70$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results70$repeatedConfidenceIntervalLowerBounds[3, ], c(-42.6632, -31.486561, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results70$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results70$repeatedConfidenceIntervalUpperBounds[1, ], c(10.605988, 4.2731734, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results70$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results70$repeatedConfidenceIntervalUpperBounds[2, ], c(15.173049, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results70$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results70$repeatedConfidenceIntervalUpperBounds[3, ], c(7.6631999, -0.60791563, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results70$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results70$repeatedPValues[1, ], c(0.18140284, 0.066412839, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results70$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results70$repeatedPValues[2, ], c(0.23027951, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results70$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results70$repeatedPValues[3, ], c(0.14242148, 0.013628025, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results70$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results70$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.268, 0.445), tolerance = 1e-06, label = paste0("c(", paste0(results70$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results70$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results70$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results70$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results70$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results70), NA))) - expect_output(print(results70)$show()) - invisible(capture.output(expect_error(summary(results70), NA))) - expect_output(summary(results70)$show()) - results70CodeBased <- eval(parse(text = getObjectRCode(results70, stringWrapParagraphWidth = NULL))) - expect_equal(results70CodeBased$thetaH1, results70$thetaH1, tolerance = 1e-06) - expect_equal(results70CodeBased$assumedStDevs, results70$assumedStDevs, tolerance = 1e-06) - expect_equal(results70CodeBased$conditionalRejectionProbabilities, results70$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results70CodeBased$repeatedConfidenceIntervalLowerBounds, results70$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results70CodeBased$repeatedConfidenceIntervalUpperBounds, results70$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results70CodeBased$repeatedPValues, results70$repeatedPValues, tolerance = 1e-06) - expect_equal(results70CodeBased$conditionalPowerSimulated, results70$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results70), "character") - df <- as.data.frame(results70) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results70) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results71 <- getAnalysisResults(design = design2, dataInput = dataExample2, - intersectionTest = "Simes", varianceOption = "overallPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results71' with expected results - expect_equal(results71$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results71$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results71$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results71$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results71$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results71$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results71$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results71$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results71$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results71$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results71$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results71$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results71$conditionalRejectionProbabilities[1, ], c(0.023040094, 0.047419024, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results71$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results71$conditionalRejectionProbabilities[2, ], c(0.019613852, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results71$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results71$conditionalRejectionProbabilities[3, ], c(0.027708171, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results71$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results71$repeatedConfidenceIntervalLowerBounds[1, ], c(-41.74771, -27.425347, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results71$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results71$repeatedConfidenceIntervalLowerBounds[2, ], c(-35.477631, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results71$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results71$repeatedConfidenceIntervalLowerBounds[3, ], c(-43.785178, -31.856528, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results71$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results71$repeatedConfidenceIntervalUpperBounds[1, ], c(11.74771, 4.6401767, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results71$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results71$repeatedConfidenceIntervalUpperBounds[2, ], c(16.277631, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results71$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results71$repeatedConfidenceIntervalUpperBounds[3, ], c(8.7851784, -0.25415362, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results71$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results71$repeatedPValues[1, ], c(0.19020524, 0.071018123, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results71$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results71$repeatedPValues[2, ], c(0.23360401, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results71$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results71$repeatedPValues[3, ], c(0.1494882, 0.016474737, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results71$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results71$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.256, 0.433), tolerance = 1e-06, label = paste0("c(", paste0(results71$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results71$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results71$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results71$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results71$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results71), NA))) - expect_output(print(results71)$show()) - invisible(capture.output(expect_error(summary(results71), NA))) - expect_output(summary(results71)$show()) - results71CodeBased <- eval(parse(text = getObjectRCode(results71, stringWrapParagraphWidth = NULL))) - expect_equal(results71CodeBased$thetaH1, results71$thetaH1, tolerance = 1e-06) - expect_equal(results71CodeBased$assumedStDevs, results71$assumedStDevs, tolerance = 1e-06) - expect_equal(results71CodeBased$conditionalRejectionProbabilities, results71$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results71CodeBased$repeatedConfidenceIntervalLowerBounds, results71$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results71CodeBased$repeatedConfidenceIntervalUpperBounds, results71$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results71CodeBased$repeatedPValues, results71$repeatedPValues, tolerance = 1e-06) - expect_equal(results71CodeBased$conditionalPowerSimulated, results71$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results71), "character") - df <- as.data.frame(results71) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results71) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results72 <- getAnalysisResults(design = design2, dataInput = dataExample2, - intersectionTest = "Simes", varianceOption = "pairwisePooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results72' with expected results - expect_equal(results72$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results72$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results72$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results72$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results72$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results72$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results72$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results72$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results72$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results72$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results72$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results72$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results72$conditionalRejectionProbabilities[1, ], c(0.024333354, 0.053095357, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results72$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results72$conditionalRejectionProbabilities[2, ], c(0.021915713, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results72$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results72$conditionalRejectionProbabilities[3, ], c(0.029264016, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results72$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results72$repeatedConfidenceIntervalLowerBounds[1, ], c(-40.389181, -26.847363, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results72$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results72$repeatedConfidenceIntervalLowerBounds[2, ], c(-32.324586, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results72$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results72$repeatedConfidenceIntervalLowerBounds[3, ], c(-43.261715, -31.705217, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results72$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results72$repeatedConfidenceIntervalUpperBounds[1, ], c(10.389181, 4.1091853, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results72$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results72$repeatedConfidenceIntervalUpperBounds[2, ], c(13.124586, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results72$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results72$repeatedConfidenceIntervalUpperBounds[3, ], c(8.2617152, -0.37246523, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results72$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results72$repeatedPValues[1, ], c(0.17721241, 0.063189426, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results72$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results72$repeatedPValues[2, ], c(0.20285189, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results72$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results72$repeatedPValues[3, ], c(0.13906265, 0.014376658, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results72$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results72$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.274, 0.453), tolerance = 1e-06, label = paste0("c(", paste0(results72$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results72$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results72$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results72$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results72$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results72), NA))) - expect_output(print(results72)$show()) - invisible(capture.output(expect_error(summary(results72), NA))) - expect_output(summary(results72)$show()) - results72CodeBased <- eval(parse(text = getObjectRCode(results72, stringWrapParagraphWidth = NULL))) - expect_equal(results72CodeBased$thetaH1, results72$thetaH1, tolerance = 1e-06) - expect_equal(results72CodeBased$assumedStDevs, results72$assumedStDevs, tolerance = 1e-06) - expect_equal(results72CodeBased$conditionalRejectionProbabilities, results72$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results72CodeBased$repeatedConfidenceIntervalLowerBounds, results72$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results72CodeBased$repeatedConfidenceIntervalUpperBounds, results72$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results72CodeBased$repeatedPValues, results72$repeatedPValues, tolerance = 1e-06) - expect_equal(results72CodeBased$conditionalPowerSimulated, results72$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results72), "character") - df <- as.data.frame(results72) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results72) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results73 <- getAnalysisResults(design = design2, dataInput = dataExample2, - intersectionTest = "Simes", varianceOption = "pairwisePooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results73' with expected results - expect_equal(results73$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results73$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results73$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results73$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results73$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results73$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results73$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results73$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results73$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results73$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results73$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results73$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results73$conditionalRejectionProbabilities[1, ], c(0.02248882, 0.047009108, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results73$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results73$conditionalRejectionProbabilities[2, ], c(0.021309255, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results73$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results73$conditionalRejectionProbabilities[3, ], c(0.027044989, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results73$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results73$repeatedConfidenceIntervalLowerBounds[1, ], c(-42.972232, -27.481288, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results73$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results73$repeatedConfidenceIntervalLowerBounds[2, ], c(-34.436237, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results73$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results73$repeatedConfidenceIntervalLowerBounds[3, ], c(-45.763994, -32.295837, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results73$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results73$repeatedConfidenceIntervalUpperBounds[1, ], c(12.972232, 4.7692163, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results73$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results73$repeatedConfidenceIntervalUpperBounds[2, ], c(15.236237, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results73$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results73$repeatedConfidenceIntervalUpperBounds[3, ], c(10.763995, 0.22335705, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results73$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results73$repeatedPValues[1, ], c(0.19623626, 0.071653269, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results73$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results73$repeatedPValues[2, ], c(0.21026955, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results73$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results73$repeatedPValues[3, ], c(0.15433667, 0.019180306, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results73$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results73$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.256, 0.431), tolerance = 1e-06, label = paste0("c(", paste0(results73$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results73$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results73$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results73$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results73$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results73), NA))) - expect_output(print(results73)$show()) - invisible(capture.output(expect_error(summary(results73), NA))) - expect_output(summary(results73)$show()) - results73CodeBased <- eval(parse(text = getObjectRCode(results73, stringWrapParagraphWidth = NULL))) - expect_equal(results73CodeBased$thetaH1, results73$thetaH1, tolerance = 1e-06) - expect_equal(results73CodeBased$assumedStDevs, results73$assumedStDevs, tolerance = 1e-06) - expect_equal(results73CodeBased$conditionalRejectionProbabilities, results73$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results73CodeBased$repeatedConfidenceIntervalLowerBounds, results73$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results73CodeBased$repeatedConfidenceIntervalUpperBounds, results73$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results73CodeBased$repeatedPValues, results73$repeatedPValues, tolerance = 1e-06) - expect_equal(results73CodeBased$conditionalPowerSimulated, results73$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results73), "character") - df <- as.data.frame(results73) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results73) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results74 <- getAnalysisResults(design = design2, dataInput = dataExample2, - intersectionTest = "Sidak", varianceOption = "notPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results74' with expected results - expect_equal(results74$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results74$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results74$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results74$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results74$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results74$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results74$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results74$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results74$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results74$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results74$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results74$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results74$conditionalRejectionProbabilities[1, ], c(0.025021019, 0.054834069, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results74$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results74$conditionalRejectionProbabilities[2, ], c(0.021871903, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results74$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results74$conditionalRejectionProbabilities[3, ], c(0.027777772, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results74$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results74$repeatedConfidenceIntervalLowerBounds[1, ], c(-40.247199, -26.680539, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results74$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results74$repeatedConfidenceIntervalLowerBounds[2, ], c(-32.353418, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results74$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results74$repeatedConfidenceIntervalLowerBounds[3, ], c(-42.898631, -31.584065, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results74$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results74$repeatedConfidenceIntervalUpperBounds[1, ], c(10.247199, 4.0258193, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results74$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results74$repeatedConfidenceIntervalUpperBounds[2, ], c(13.153418, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results74$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results74$repeatedConfidenceIntervalUpperBounds[3, ], c(7.8986307, -0.47811558, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results74$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results74$repeatedPValues[1, ], c(0.17089623, 0.061105652, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results74$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results74$repeatedPValues[2, ], c(0.20337355, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results74$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results74$repeatedPValues[3, ], c(0.14899419, 0.015246407, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results74$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results74$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.283, 0.454), tolerance = 1e-06, label = paste0("c(", paste0(results74$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results74$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results74$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results74$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results74$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results74), NA))) - expect_output(print(results74)$show()) - invisible(capture.output(expect_error(summary(results74), NA))) - expect_output(summary(results74)$show()) - results74CodeBased <- eval(parse(text = getObjectRCode(results74, stringWrapParagraphWidth = NULL))) - expect_equal(results74CodeBased$thetaH1, results74$thetaH1, tolerance = 1e-06) - expect_equal(results74CodeBased$assumedStDevs, results74$assumedStDevs, tolerance = 1e-06) - expect_equal(results74CodeBased$conditionalRejectionProbabilities, results74$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results74CodeBased$repeatedConfidenceIntervalLowerBounds, results74$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results74CodeBased$repeatedConfidenceIntervalUpperBounds, results74$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results74CodeBased$repeatedPValues, results74$repeatedPValues, tolerance = 1e-06) - expect_equal(results74CodeBased$conditionalPowerSimulated, results74$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results74), "character") - df <- as.data.frame(results74) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results74) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results75 <- getAnalysisResults(design = design2, dataInput = dataExample2, - intersectionTest = "Sidak", varianceOption = "notPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results75' with expected results - expect_equal(results75$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results75$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results75$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results75$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results75$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results75$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results75$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results75$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results75$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results75$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results75$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results75$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results75$conditionalRejectionProbabilities[1, ], c(0.023144095, 0.048545015, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results75$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results75$conditionalRejectionProbabilities[2, ], c(0.021234311, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results75$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results75$conditionalRejectionProbabilities[3, ], c(0.0247006, 0.1449328, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results75$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results75$repeatedConfidenceIntervalLowerBounds[1, ], c(-42.8192, -27.314543, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results75$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results75$repeatedConfidenceIntervalLowerBounds[2, ], c(-34.60635, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results75$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results75$repeatedConfidenceIntervalLowerBounds[3, ], c(-45.364486, -32.169333, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results75$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results75$repeatedConfidenceIntervalUpperBounds[1, ], c(12.8192, 4.6852584, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results75$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results75$repeatedConfidenceIntervalUpperBounds[2, ], c(15.40635, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results75$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results75$repeatedConfidenceIntervalUpperBounds[3, ], c(10.364486, 0.1144866, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results75$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results75$repeatedPValues[1, ], c(0.18910184, 0.069324401, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results75$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results75$repeatedPValues[2, ], c(0.2112175, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results75$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results75$repeatedPValues[3, ], c(0.17379158, 0.021189694, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results75$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results75$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.26, 0.437), tolerance = 1e-06, label = paste0("c(", paste0(results75$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results75$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results75$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results75$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 0.66, 0.799), tolerance = 1e-06, label = paste0("c(", paste0(results75$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results75), NA))) - expect_output(print(results75)$show()) - invisible(capture.output(expect_error(summary(results75), NA))) - expect_output(summary(results75)$show()) - results75CodeBased <- eval(parse(text = getObjectRCode(results75, stringWrapParagraphWidth = NULL))) - expect_equal(results75CodeBased$thetaH1, results75$thetaH1, tolerance = 1e-06) - expect_equal(results75CodeBased$assumedStDevs, results75$assumedStDevs, tolerance = 1e-06) - expect_equal(results75CodeBased$conditionalRejectionProbabilities, results75$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results75CodeBased$repeatedConfidenceIntervalLowerBounds, results75$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results75CodeBased$repeatedConfidenceIntervalUpperBounds, results75$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results75CodeBased$repeatedPValues, results75$repeatedPValues, tolerance = 1e-06) - expect_equal(results75CodeBased$conditionalPowerSimulated, results75$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results75), "character") - df <- as.data.frame(results75) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results75) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results76 <- getAnalysisResults(design = design2, dataInput = dataExample2, - intersectionTest = "Sidak", varianceOption = "overallPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results76' with expected results - expect_equal(results76$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results76$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results76$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results76$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results76$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results76$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results76$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results76$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results76$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results76$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results76$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results76$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results76$conditionalRejectionProbabilities[1, ], c(0.024319059, 0.051462476, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results76$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results76$conditionalRejectionProbabilities[2, ], c(0.019837849, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results76$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results76$conditionalRejectionProbabilities[3, ], c(0.028516214, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results76$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results76$repeatedConfidenceIntervalLowerBounds[1, ], c(-40.59688, -26.894985, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results76$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results76$repeatedConfidenceIntervalLowerBounds[2, ], c(-34.364237, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results76$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results76$repeatedConfidenceIntervalLowerBounds[3, ], c(-42.654249, -31.405859, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results76$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results76$repeatedConfidenceIntervalUpperBounds[1, ], c(10.59688, 4.2407133, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results76$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results76$repeatedConfidenceIntervalUpperBounds[2, ], c(15.164237, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results76$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results76$repeatedConfidenceIntervalUpperBounds[3, ], c(7.6542489, -0.6529301, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results76$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results76$repeatedPValues[1, ], c(0.17734783, 0.06527034, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results76$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results76$repeatedPValues[2, ], c(0.23027951, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results76$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results76$repeatedPValues[3, ], c(0.14391589, 0.013711948, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results76$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results76$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.271, 0.447), tolerance = 1e-06, label = paste0("c(", paste0(results76$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results76$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results76$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results76$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results76$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results76), NA))) - expect_output(print(results76)$show()) - invisible(capture.output(expect_error(summary(results76), NA))) - expect_output(summary(results76)$show()) - results76CodeBased <- eval(parse(text = getObjectRCode(results76, stringWrapParagraphWidth = NULL))) - expect_equal(results76CodeBased$thetaH1, results76$thetaH1, tolerance = 1e-06) - expect_equal(results76CodeBased$assumedStDevs, results76$assumedStDevs, tolerance = 1e-06) - expect_equal(results76CodeBased$conditionalRejectionProbabilities, results76$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results76CodeBased$repeatedConfidenceIntervalLowerBounds, results76$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results76CodeBased$repeatedConfidenceIntervalUpperBounds, results76$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results76CodeBased$repeatedPValues, results76$repeatedPValues, tolerance = 1e-06) - expect_equal(results76CodeBased$conditionalPowerSimulated, results76$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results76), "character") - df <- as.data.frame(results76) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results76) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results77 <- getAnalysisResults(design = design2, dataInput = dataExample2, - intersectionTest = "Sidak", varianceOption = "overallPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results77' with expected results - expect_equal(results77$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results77$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results77$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results77$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results77$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results77$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results77$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results77$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results77$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results77$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results77$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results77$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results77$conditionalRejectionProbabilities[1, ], c(0.023469013, 0.048270226, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results77$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results77$conditionalRejectionProbabilities[2, ], c(0.019613852, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results77$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results77$conditionalRejectionProbabilities[3, ], c(0.026830382, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results77$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results77$repeatedConfidenceIntervalLowerBounds[1, ], c(-41.737451, -27.295819, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results77$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results77$repeatedConfidenceIntervalLowerBounds[2, ], c(-35.467707, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results77$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results77$repeatedConfidenceIntervalLowerBounds[3, ], c(-43.775098, -31.772829, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results77$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results77$repeatedConfidenceIntervalUpperBounds[1, ], c(11.737451, 4.6050352, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results77$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results77$repeatedConfidenceIntervalUpperBounds[2, ], c(16.267707, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results77$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results77$repeatedConfidenceIntervalUpperBounds[3, ], c(8.7750975, -0.30217392, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results77$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results77$repeatedPValues[1, ], c(0.18572393, 0.069730666, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results77$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results77$repeatedPValues[2, ], c(0.23360401, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results77$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results77$repeatedPValues[3, ], c(0.15596268, 0.017006886, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results77$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results77$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.26, 0.436), tolerance = 1e-06, label = paste0("c(", paste0(results77$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results77$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results77$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results77$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results77$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results77), NA))) - expect_output(print(results77)$show()) - invisible(capture.output(expect_error(summary(results77), NA))) - expect_output(summary(results77)$show()) - results77CodeBased <- eval(parse(text = getObjectRCode(results77, stringWrapParagraphWidth = NULL))) - expect_equal(results77CodeBased$thetaH1, results77$thetaH1, tolerance = 1e-06) - expect_equal(results77CodeBased$assumedStDevs, results77$assumedStDevs, tolerance = 1e-06) - expect_equal(results77CodeBased$conditionalRejectionProbabilities, results77$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results77CodeBased$repeatedConfidenceIntervalLowerBounds, results77$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results77CodeBased$repeatedConfidenceIntervalUpperBounds, results77$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results77CodeBased$repeatedPValues, results77$repeatedPValues, tolerance = 1e-06) - expect_equal(results77CodeBased$conditionalPowerSimulated, results77$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results77), "character") - df <- as.data.frame(results77) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results77) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results78 <- getAnalysisResults(design = design2, dataInput = dataExample2, - intersectionTest = "Sidak", varianceOption = "pairwisePooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results78' with expected results - expect_equal(results78$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results78$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results78$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results78$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results78$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results78$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results78$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results78$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results78$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results78$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results78$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results78$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results78$conditionalRejectionProbabilities[1, ], c(0.024748593, 0.053966892, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results78$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results78$conditionalRejectionProbabilities[2, ], c(0.021915713, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results78$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results78$conditionalRejectionProbabilities[3, ], c(0.0267758, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results78$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results78$repeatedConfidenceIntervalLowerBounds[1, ], c(-40.38015, -26.720108, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results78$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results78$repeatedConfidenceIntervalLowerBounds[2, ], c(-32.316502, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results78$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results78$repeatedConfidenceIntervalLowerBounds[3, ], c(-43.252551, -31.62149, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results78$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results78$repeatedConfidenceIntervalUpperBounds[1, ], c(10.38015, 4.0770639, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results78$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results78$repeatedConfidenceIntervalUpperBounds[2, ], c(13.116502, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results78$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results78$repeatedConfidenceIntervalUpperBounds[3, ], c(8.2525514, -0.41959343, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results78$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results78$repeatedPValues[1, ], c(0.17335289, 0.062127989, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results78$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results78$repeatedPValues[2, ], c(0.20285189, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results78$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results78$repeatedPValues[3, ], c(0.15638134, 0.015781417, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results78$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results78$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.277, 0.453), tolerance = 1e-06, label = paste0("c(", paste0(results78$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results78$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results78$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results78$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results78$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results78), NA))) - expect_output(print(results78)$show()) - invisible(capture.output(expect_error(summary(results78), NA))) - expect_output(summary(results78)$show()) - results78CodeBased <- eval(parse(text = getObjectRCode(results78, stringWrapParagraphWidth = NULL))) - expect_equal(results78CodeBased$thetaH1, results78$thetaH1, tolerance = 1e-06) - expect_equal(results78CodeBased$assumedStDevs, results78$assumedStDevs, tolerance = 1e-06) - expect_equal(results78CodeBased$conditionalRejectionProbabilities, results78$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results78CodeBased$repeatedConfidenceIntervalLowerBounds, results78$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results78CodeBased$repeatedConfidenceIntervalUpperBounds, results78$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results78CodeBased$repeatedPValues, results78$repeatedPValues, tolerance = 1e-06) - expect_equal(results78CodeBased$conditionalPowerSimulated, results78$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results78), "character") - df <- as.data.frame(results78) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results78) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results79 <- getAnalysisResults(design = design2, dataInput = dataExample2, - intersectionTest = "Sidak", varianceOption = "pairwisePooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results79' with expected results - expect_equal(results79$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results79$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results79$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results79$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results79$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results79$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results79$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results79$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results79$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results79$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results79$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results79$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results79$conditionalRejectionProbabilities[1, ], c(0.022923976, 0.04788638, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results79$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results79$conditionalRejectionProbabilities[2, ], c(0.021309255, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results79$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results79$conditionalRejectionProbabilities[3, ], c(0.023933809, 0.14146912, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results79$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results79$repeatedConfidenceIntervalLowerBounds[1, ], c(-42.960526, -27.347242, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results79$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results79$repeatedConfidenceIntervalLowerBounds[2, ], c(-34.425975, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results79$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results79$repeatedConfidenceIntervalLowerBounds[3, ], c(-45.752245, -32.205007, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results79$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results79$repeatedConfidenceIntervalUpperBounds[1, ], c(12.960526, 4.7313117, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results79$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results79$repeatedConfidenceIntervalUpperBounds[2, ], c(15.225975, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results79$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results79$repeatedConfidenceIntervalUpperBounds[3, ], c(10.752245, 0.16953037, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results79$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results79$repeatedPValues[1, ], c(0.19144883, 0.07030573, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results79$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results79$repeatedPValues[2, ], c(0.21026955, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results79$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results79$repeatedPValues[3, ], c(0.18106429, 0.021778109, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results79$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results79$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.259, 0.434), tolerance = 1e-06, label = paste0("c(", paste0(results79$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results79$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results79$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results79$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 0.656, 0.797), tolerance = 1e-06, label = paste0("c(", paste0(results79$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results79), NA))) - expect_output(print(results79)$show()) - invisible(capture.output(expect_error(summary(results79), NA))) - expect_output(summary(results79)$show()) - results79CodeBased <- eval(parse(text = getObjectRCode(results79, stringWrapParagraphWidth = NULL))) - expect_equal(results79CodeBased$thetaH1, results79$thetaH1, tolerance = 1e-06) - expect_equal(results79CodeBased$assumedStDevs, results79$assumedStDevs, tolerance = 1e-06) - expect_equal(results79CodeBased$conditionalRejectionProbabilities, results79$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results79CodeBased$repeatedConfidenceIntervalLowerBounds, results79$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results79CodeBased$repeatedConfidenceIntervalUpperBounds, results79$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results79CodeBased$repeatedPValues, results79$repeatedPValues, tolerance = 1e-06) - expect_equal(results79CodeBased$conditionalPowerSimulated, results79$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results79), "character") - df <- as.data.frame(results79) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results79) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results80 <- getAnalysisResults(design = design2, dataInput = dataExample2, - intersectionTest = "Dunnett", varianceOption = "overallPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results80' with expected results - expect_equal(results80$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results80$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results80$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results80$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results80$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results80$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results80$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results80$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results80$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results80$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results80$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results80$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results80$conditionalRejectionProbabilities[1, ], c(0.026270241, 0.055429536, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results80$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results80$conditionalRejectionProbabilities[2, ], c(0.019837849, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results80$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results80$conditionalRejectionProbabilities[3, ], c(0.032007473, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results80$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results80$repeatedConfidenceIntervalLowerBounds[1, ], c(-40.308137, -26.527814, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results80$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results80$repeatedConfidenceIntervalLowerBounds[2, ], c(-34.084887, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results80$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results80$repeatedConfidenceIntervalLowerBounds[3, ], c(-42.370499, -31.063081, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results80$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results80$repeatedConfidenceIntervalUpperBounds[1, ], c(10.308137, 3.9366921, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results80$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results80$repeatedConfidenceIntervalUpperBounds[2, ], c(14.884887, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results80$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results80$repeatedConfidenceIntervalUpperBounds[3, ], c(7.3704995, -0.96851041, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results80$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results80$repeatedPValues[1, ], c(0.1603448, 0.060420915, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results80$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results80$repeatedPValues[2, ], c(0.23027951, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results80$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results80$repeatedPValues[3, ], c(0.12340907, 0.011635803, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results80$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results80$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.286, 0.457), tolerance = 1e-06, label = paste0("c(", paste0(results80$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results80$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results80$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results80$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results80$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results80), NA))) - expect_output(print(results80)$show()) - invisible(capture.output(expect_error(summary(results80), NA))) - expect_output(summary(results80)$show()) - results80CodeBased <- eval(parse(text = getObjectRCode(results80, stringWrapParagraphWidth = NULL))) - expect_equal(results80CodeBased$thetaH1, results80$thetaH1, tolerance = 1e-06) - expect_equal(results80CodeBased$assumedStDevs, results80$assumedStDevs, tolerance = 1e-06) - expect_equal(results80CodeBased$conditionalRejectionProbabilities, results80$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results80CodeBased$repeatedConfidenceIntervalLowerBounds, results80$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results80CodeBased$repeatedConfidenceIntervalUpperBounds, results80$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results80CodeBased$repeatedPValues, results80$repeatedPValues, tolerance = 1e-06) - expect_equal(results80CodeBased$conditionalPowerSimulated, results80$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results80), "character") - df <- as.data.frame(results80) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results80) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results81 <- getAnalysisResults(design = design2, dataInput = dataExample2, - intersectionTest = "Dunnett", varianceOption = "overallPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results81' with expected results - expect_equal(results81$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results81$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results81$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results81$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results81$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results81$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results81$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results81$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results81$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results81$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results81$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results81$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results81$conditionalRejectionProbabilities[1, ], c(0.025452912, 0.052195908, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results81$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results81$conditionalRejectionProbabilities[2, ], c(0.019613852, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results81$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results81$conditionalRejectionProbabilities[3, ], c(0.030394861, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results81$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results81$repeatedConfidenceIntervalLowerBounds[1, ], c(-41.358826, -26.891429, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results81$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results81$repeatedConfidenceIntervalLowerBounds[2, ], c(-35.101397, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results81$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results81$repeatedConfidenceIntervalLowerBounds[3, ], c(-43.40302, -31.392896, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results81$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results81$repeatedConfidenceIntervalUpperBounds[1, ], c(11.358826, 4.2590391, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results81$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results81$repeatedConfidenceIntervalUpperBounds[2, ], c(15.901398, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results81$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results81$repeatedConfidenceIntervalUpperBounds[3, ], c(8.4030195, -0.65705914, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results81$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results81$repeatedPValues[1, ], c(0.16712065, 0.064319528, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results81$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results81$repeatedPValues[2, ], c(0.23360401, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results81$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results81$repeatedPValues[3, ], c(0.13222768, 0.014210719, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results81$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(results81$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.272, 0.449), tolerance = 1e-06, label = paste0("c(", paste0(results81$conditionalPowerSimulated[1, ], collapse = ", "), ")")) - expect_equal(results81$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results81$conditionalPowerSimulated[2, ], collapse = ", "), ")")) - expect_equal(results81$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results81$conditionalPowerSimulated[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results81), NA))) - expect_output(print(results81)$show()) - invisible(capture.output(expect_error(summary(results81), NA))) - expect_output(summary(results81)$show()) - results81CodeBased <- eval(parse(text = getObjectRCode(results81, stringWrapParagraphWidth = NULL))) - expect_equal(results81CodeBased$thetaH1, results81$thetaH1, tolerance = 1e-06) - expect_equal(results81CodeBased$assumedStDevs, results81$assumedStDevs, tolerance = 1e-06) - expect_equal(results81CodeBased$conditionalRejectionProbabilities, results81$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results81CodeBased$repeatedConfidenceIntervalLowerBounds, results81$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results81CodeBased$repeatedConfidenceIntervalUpperBounds, results81$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results81CodeBased$repeatedPValues, results81$repeatedPValues, tolerance = 1e-06) - expect_equal(results81CodeBased$conditionalPowerSimulated, results81$conditionalPowerSimulated, tolerance = 1e-06) - expect_type(names(results81), "character") - df <- as.data.frame(results81) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results81) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Formula]{fs:multiarmRejectionRule} - # @refFS[Formula]{fs:adjustedPValueDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} - # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} - # @refFS[Formula]{fs:adjustedPValueSubsetSidak} - # @refFS[Formula]{fs:adjustedPValueSubsetSimes} - # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} - # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} - # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} - # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} - # @refFS[Formula]{fs:conditionalPowerMultiArm} - # @refFS[Formula]{fs:conditionalRejectionProbability} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} - # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} - # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} - # @refFS[Formula]{fs:adjustedPValueForRCISidak} - # @refFS[Formula]{fs:computeRCIsMultiArm} - results82 <- getAnalysisResults(design = design3, dataInput = dataExample2, - intersectionTest = "Dunnett", varianceOption = "overallPooled", normalApproximation = TRUE, directionUpper = FALSE) - - ## Comparison of the results of AnalysisResultsConditionalDunnett object 'results82' with expected results - expect_equal(results82$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results82$thetaH1[1, ], collapse = ", "), ")")) - expect_equal(results82$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results82$thetaH1[2, ], collapse = ", "), ")")) - expect_equal(results82$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results82$thetaH1[3, ], collapse = ", "), ")")) - expect_equal(results82$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results82$assumedStDevs[1, ], collapse = ", "), ")")) - expect_equal(results82$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results82$assumedStDevs[2, ], collapse = ", "), ")")) - expect_equal(results82$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results82$assumedStDevs[3, ], collapse = ", "), ")")) - expect_equal(results82$conditionalRejectionProbabilities[1, ], c(NA_real_, 0.061352937), tolerance = 1e-06, label = paste0("c(", paste0(results82$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(results82$conditionalRejectionProbabilities[2, ], c(NA_real_, 0.03744742), tolerance = 1e-06, label = paste0("c(", paste0(results82$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(results82$conditionalRejectionProbabilities[3, ], c(NA_real_, 0.086511764), tolerance = 1e-06, label = paste0("c(", paste0(results82$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(results82$conditionalPower[1, ], c(NA_real_, NA_real_), label = paste0("c(", paste0(results82$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(results82$conditionalPower[2, ], c(NA_real_, NA_real_), label = paste0("c(", paste0(results82$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(results82$conditionalPower[3, ], c(NA_real_, NA_real_), label = paste0("c(", paste0(results82$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(results82$repeatedConfidenceIntervalLowerBounds[1, ], c(NA_real_, -22.538727), tolerance = 1e-06, label = paste0("c(", paste0(results82$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(results82$repeatedConfidenceIntervalLowerBounds[2, ], c(NA_real_, NA_real_), label = paste0("c(", paste0(results82$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(results82$repeatedConfidenceIntervalLowerBounds[3, ], c(NA_real_, -26.753532), tolerance = 1e-06, label = paste0("c(", paste0(results82$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(results82$repeatedConfidenceIntervalUpperBounds[1, ], c(NA_real_, 0.72441408), tolerance = 1e-06, label = paste0("c(", paste0(results82$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(results82$repeatedConfidenceIntervalUpperBounds[2, ], c(NA_real_, NA_real_), label = paste0("c(", paste0(results82$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(results82$repeatedConfidenceIntervalUpperBounds[3, ], c(NA_real_, -3.9389155), tolerance = 1e-06, label = paste0("c(", paste0(results82$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(results82$repeatedPValues[1, ], c(NA_real_, 0.017445576), tolerance = 1e-06, label = paste0("c(", paste0(results82$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(results82$repeatedPValues[2, ], c(NA_real_, NA_real_), label = paste0("c(", paste0(results82$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(results82$repeatedPValues[3, ], c(NA_real_, 0.0019493527), tolerance = 1e-06, label = paste0("c(", paste0(results82$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(results82), NA))) - expect_output(print(results82)$show()) - invisible(capture.output(expect_error(summary(results82), NA))) - expect_output(summary(results82)$show()) - results82CodeBased <- eval(parse(text = getObjectRCode(results82, stringWrapParagraphWidth = NULL))) - expect_equal(results82CodeBased$thetaH1, results82$thetaH1, tolerance = 1e-06) - expect_equal(results82CodeBased$assumedStDevs, results82$assumedStDevs, tolerance = 1e-06) - expect_equal(results82CodeBased$conditionalRejectionProbabilities, results82$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(results82CodeBased$conditionalPower, results82$conditionalPower, tolerance = 1e-06) - expect_equal(results82CodeBased$repeatedConfidenceIntervalLowerBounds, results82$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(results82CodeBased$repeatedConfidenceIntervalUpperBounds, results82$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(results82CodeBased$repeatedPValues, results82$repeatedPValues, tolerance = 1e-06) - expect_type(names(results82), "character") - df <- as.data.frame(results82) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(results82) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - + design1 <- getDesignInverseNormal( + kMax = 4, alpha = 0.02, futilityBounds = c(-0.5, 0, 0.5), + bindingFutility = FALSE, typeOfDesign = "asKD", gammaA = 1.2, informationRates = c(0.15, 0.4, 0.7, 1) + ) + + design2 <- getDesignFisher( + kMax = 4, alpha = 0.02, alpha0Vec = c(0.7, 0.5, 0.3), method = "equalAlpha", + bindingFutility = TRUE, informationRates = c(0.15, 0.4, 0.7, 1) + ) + + design3 <- getDesignConditionalDunnett(alpha = 0.02, informationAtInterim = 0.4, secondStageConditioning = TRUE) + + # directionUpper = TRUE + dataExample1 <- getDataset( + n1 = c(13, 25), + n2 = c(15, NA), + n3 = c(14, 27), + n4 = c(12, 29), + means1 = c(24.2, 22.2), + means2 = c(18.8, NA), + means3 = c(26.7, 27.7), + means4 = c(9.2, 12.2), + stDevs1 = c(24.4, 22.1), + stDevs2 = c(21.2, NA), + stDevs3 = c(25.6, 23.2), + stDevs4 = c(21.5, 22.7) + ) + + # directionUpper = FALSE + dataExample2 <- getDataset( + n1 = c(13, 25), + n2 = c(15, NA), + n3 = c(14, 27), + n4 = c(12, 29), + means1 = -c(24.2, 22.2), + means2 = -c(18.8, NA), + means3 = -c(26.7, 27.7), + means4 = -c(9.2, 12.2), + stDevs1 = c(24.4, 22.1), + stDevs2 = c(21.2, NA), + stDevs3 = c(25.6, 23.2), + stDevs4 = c(21.5, 22.7) + ) + + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results1 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + intersectionTest = "Bonferroni", varianceOption = "notPooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results1' with expected results + expect_equal(results1$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results1$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results1$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results1$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results1$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results1$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results1$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results1$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results1$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results1$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results1$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results1$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results1$conditionalRejectionProbabilities[1, ], c(0.043739576, 0.16022367, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results1$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results1$conditionalRejectionProbabilities[2, ], c(0.03844608, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results1$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results1$conditionalRejectionProbabilities[3, ], c(0.048616927, 0.34001465, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results1$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results1$conditionalPower[1, ], c(NA_real_, NA_real_, 0.45838936, 0.70196346), tolerance = 1e-06, label = paste0("c(", paste0(results1$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results1$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results1$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results1$conditionalPower[3, ], c(NA_real_, NA_real_, 0.827255, 0.9465652), tolerance = 1e-06, label = paste0("c(", paste0(results1$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results1$repeatedConfidenceIntervalLowerBounds[1, ], c(-14.395028, -4.0669228, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results1$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results1$repeatedConfidenceIntervalLowerBounds[2, ], c(-16.891548, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results1$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results1$repeatedConfidenceIntervalLowerBounds[3, ], c(-12.071338, 0.24153969, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results1$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results1$repeatedConfidenceIntervalUpperBounds[1, ], c(44.395028, 27.895908, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results1$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results1$repeatedConfidenceIntervalUpperBounds[2, ], c(36.091548, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results1$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results1$repeatedConfidenceIntervalUpperBounds[3, ], c(47.071339, 32.285152, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results1$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results1$repeatedPValues[1, ], c(0.5, 0.072888275, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results1$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results1$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results1$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results1$repeatedPValues[3, ], c(0.5, 0.017155659, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results1$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results1), NA))) + expect_output(print(results1)$show()) + invisible(capture.output(expect_error(summary(results1), NA))) + expect_output(summary(results1)$show()) + results1CodeBased <- eval(parse(text = getObjectRCode(results1, stringWrapParagraphWidth = NULL))) + expect_equal(results1CodeBased$thetaH1, results1$thetaH1, tolerance = 1e-06) + expect_equal(results1CodeBased$assumedStDevs, results1$assumedStDevs, tolerance = 1e-06) + expect_equal(results1CodeBased$conditionalRejectionProbabilities, results1$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results1CodeBased$conditionalPower, results1$conditionalPower, tolerance = 1e-06) + expect_equal(results1CodeBased$repeatedConfidenceIntervalLowerBounds, results1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results1CodeBased$repeatedConfidenceIntervalUpperBounds, results1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results1CodeBased$repeatedPValues, results1$repeatedPValues, tolerance = 1e-06) + expect_type(names(results1), "character") + df <- as.data.frame(results1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + .skipTestIfDisabled() + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results2 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + intersectionTest = "Bonferroni", varianceOption = "notPooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results2' with expected results + expect_equal(results2$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results2$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results2$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results2$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results2$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results2$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results2$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results2$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results2$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results2$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results2$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results2$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results2$conditionalRejectionProbabilities[1, ], c(0.040100206, 0.14400686, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results2$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results2$conditionalRejectionProbabilities[2, ], c(0.037171319, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results2$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results2$conditionalRejectionProbabilities[3, ], c(0.042866371, 0.28890175, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results2$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results2$conditionalPower[1, ], c(NA_real_, NA_real_, 0.42767622, 0.67947129), tolerance = 1e-06, label = paste0("c(", paste0(results2$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results2$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results2$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results2$conditionalPower[3, ], c(NA_real_, NA_real_, 0.78417464, 0.93070164), tolerance = 1e-06, label = paste0("c(", paste0(results2$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results2$repeatedConfidenceIntervalLowerBounds[1, ], c(-18.433726, -4.7641755, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results2$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results2$repeatedConfidenceIntervalLowerBounds[2, ], c(-20.426743, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results2$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results2$repeatedConfidenceIntervalLowerBounds[3, ], c(-15.938808, -0.40329832, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results2$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results2$repeatedConfidenceIntervalUpperBounds[1, ], c(48.433726, 28.584393, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results2$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results2$repeatedConfidenceIntervalUpperBounds[2, ], c(39.626743, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results2$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results2$repeatedConfidenceIntervalUpperBounds[3, ], c(50.938808, 32.927366, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results2$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results2$repeatedPValues[1, ], c(0.5, 0.085188742, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results2$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results2$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results2$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results2$repeatedPValues[3, ], c(0.5, 0.025112148, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results2$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results2), NA))) + expect_output(print(results2)$show()) + invisible(capture.output(expect_error(summary(results2), NA))) + expect_output(summary(results2)$show()) + results2CodeBased <- eval(parse(text = getObjectRCode(results2, stringWrapParagraphWidth = NULL))) + expect_equal(results2CodeBased$thetaH1, results2$thetaH1, tolerance = 1e-06) + expect_equal(results2CodeBased$assumedStDevs, results2$assumedStDevs, tolerance = 1e-06) + expect_equal(results2CodeBased$conditionalRejectionProbabilities, results2$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results2CodeBased$conditionalPower, results2$conditionalPower, tolerance = 1e-06) + expect_equal(results2CodeBased$repeatedConfidenceIntervalLowerBounds, results2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results2CodeBased$repeatedConfidenceIntervalUpperBounds, results2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results2CodeBased$repeatedPValues, results2$repeatedPValues, tolerance = 1e-06) + expect_type(names(results2), "character") + df <- as.data.frame(results2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results3 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + intersectionTest = "Bonferroni", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results3' with expected results + expect_equal(results3$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results3$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results3$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results3$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results3$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results3$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results3$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results3$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results3$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results3$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results3$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results3$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results3$conditionalRejectionProbabilities[1, ], c(0.042394596, 0.15198143, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results3$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results3$conditionalRejectionProbabilities[2, ], c(0.034321105, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results3$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results3$conditionalRejectionProbabilities[3, ], c(0.049947129, 0.35588618, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results3$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results3$conditionalPower[1, ], c(NA_real_, NA_real_, 0.44302928, 0.69082025), tolerance = 1e-06, label = paste0("c(", paste0(results3$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results3$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results3$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results3$conditionalPower[3, ], c(NA_real_, NA_real_, 0.83889182, 0.95069292), tolerance = 1e-06, label = paste0("c(", paste0(results3$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results3$repeatedConfidenceIntervalLowerBounds[1, ], c(-14.802158, -4.2854677, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results3$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results3$repeatedConfidenceIntervalLowerBounds[2, ], c(-19.232721, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results3$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results3$repeatedConfidenceIntervalLowerBounds[3, ], c(-11.786808, 0.41764226, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results3$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results3$repeatedConfidenceIntervalUpperBounds[1, ], c(44.802158, 28.113845, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results3$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results3$repeatedConfidenceIntervalUpperBounds[2, ], c(38.432721, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results3$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results3$repeatedConfidenceIntervalUpperBounds[3, ], c(46.786808, 32.10754, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results3$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results3$repeatedPValues[1, ], c(0.5, 0.078823932, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results3$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results3$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results3$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results3$repeatedPValues[3, ], c(0.5, 0.015272156, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results3$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results3), NA))) + expect_output(print(results3)$show()) + invisible(capture.output(expect_error(summary(results3), NA))) + expect_output(summary(results3)$show()) + results3CodeBased <- eval(parse(text = getObjectRCode(results3, stringWrapParagraphWidth = NULL))) + expect_equal(results3CodeBased$thetaH1, results3$thetaH1, tolerance = 1e-06) + expect_equal(results3CodeBased$assumedStDevs, results3$assumedStDevs, tolerance = 1e-06) + expect_equal(results3CodeBased$conditionalRejectionProbabilities, results3$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results3CodeBased$conditionalPower, results3$conditionalPower, tolerance = 1e-06) + expect_equal(results3CodeBased$repeatedConfidenceIntervalLowerBounds, results3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results3CodeBased$repeatedConfidenceIntervalUpperBounds, results3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results3CodeBased$repeatedPValues, results3$repeatedPValues, tolerance = 1e-06) + expect_type(names(results3), "character") + df <- as.data.frame(results3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results4 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + intersectionTest = "Bonferroni", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results4' with expected results + expect_equal(results4$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results4$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results4$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results4$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results4$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results4$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results4$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results4$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results4$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results4$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results4$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results4$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results4$conditionalRejectionProbabilities[1, ], c(0.040740209, 0.14372404, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results4$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results4$conditionalRejectionProbabilities[2, ], c(0.033856262, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results4$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results4$conditionalRejectionProbabilities[3, ], c(0.046882975, 0.32321322, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results4$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results4$conditionalPower[1, ], c(NA_real_, NA_real_, 0.42712247, 0.6790579), tolerance = 1e-06, label = paste0("c(", paste0(results4$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results4$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results4$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results4$conditionalPower[3, ], c(NA_real_, NA_real_, 0.81409137, 0.94181531), tolerance = 1e-06, label = paste0("c(", paste0(results4$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results4$repeatedConfidenceIntervalLowerBounds[1, ], c(-16.567569, -4.662798, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results4$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results4$repeatedConfidenceIntervalLowerBounds[2, ], c(-20.940706, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results4$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results4$repeatedConfidenceIntervalLowerBounds[3, ], c(-13.521691, 0.049006969, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results4$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results4$repeatedConfidenceIntervalUpperBounds[1, ], c(46.567569, 28.528695, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results4$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results4$repeatedConfidenceIntervalUpperBounds[2, ], c(40.140706, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results4$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results4$repeatedConfidenceIntervalUpperBounds[3, ], c(48.521691, 32.491814, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results4$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results4$repeatedPValues[1, ], c(0.5, 0.08542716, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results4$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results4$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results4$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results4$repeatedPValues[3, ], c(0.5, 0.019420631, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results4$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results4), NA))) + expect_output(print(results4)$show()) + invisible(capture.output(expect_error(summary(results4), NA))) + expect_output(summary(results4)$show()) + results4CodeBased <- eval(parse(text = getObjectRCode(results4, stringWrapParagraphWidth = NULL))) + expect_equal(results4CodeBased$thetaH1, results4$thetaH1, tolerance = 1e-06) + expect_equal(results4CodeBased$assumedStDevs, results4$assumedStDevs, tolerance = 1e-06) + expect_equal(results4CodeBased$conditionalRejectionProbabilities, results4$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results4CodeBased$conditionalPower, results4$conditionalPower, tolerance = 1e-06) + expect_equal(results4CodeBased$repeatedConfidenceIntervalLowerBounds, results4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results4CodeBased$repeatedConfidenceIntervalUpperBounds, results4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results4CodeBased$repeatedPValues, results4$repeatedPValues, tolerance = 1e-06) + expect_type(names(results4), "character") + df <- as.data.frame(results4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results5 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + intersectionTest = "Bonferroni", varianceOption = "pairwisePooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results5' with expected results + expect_equal(results5$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results5$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results5$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results5$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results5$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results5$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results5$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results5$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results5$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results5$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results5$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results5$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results5$conditionalRejectionProbabilities[1, ], c(0.043219831, 0.15803856, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results5$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results5$conditionalRejectionProbabilities[2, ], c(0.038533075, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results5$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results5$conditionalRejectionProbabilities[3, ], c(0.046782116, 0.33290332, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results5$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results5$conditionalPower[1, ], c(NA_real_, NA_real_, 0.45436587, 0.6990644), tolerance = 1e-06, label = paste0("c(", paste0(results5$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results5$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results5$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results5$conditionalPower[3, ], c(NA_real_, NA_real_, 0.8217936, 0.94460493), tolerance = 1e-06, label = paste0("c(", paste0(results5$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results5$repeatedConfidenceIntervalLowerBounds[1, ], c(-14.549821, -4.1213996, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results5$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results5$repeatedConfidenceIntervalLowerBounds[2, ], c(-16.848567, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results5$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results5$repeatedConfidenceIntervalLowerBounds[3, ], c(-12.483405, 0.16013976, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results5$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results5$repeatedConfidenceIntervalUpperBounds[1, ], c(44.549821, 27.945069, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results5$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results5$repeatedConfidenceIntervalUpperBounds[2, ], c(36.048567, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results5$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results5$repeatedConfidenceIntervalUpperBounds[3, ], c(47.483405, 32.356999, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results5$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results5$repeatedPValues[1, ], c(0.5, 0.07440366, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results5$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results5$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results5$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results5$repeatedPValues[3, ], c(0.5, 0.018077861, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results5$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results5), NA))) + expect_output(print(results5)$show()) + invisible(capture.output(expect_error(summary(results5), NA))) + expect_output(summary(results5)$show()) + results5CodeBased <- eval(parse(text = getObjectRCode(results5, stringWrapParagraphWidth = NULL))) + expect_equal(results5CodeBased$thetaH1, results5$thetaH1, tolerance = 1e-06) + expect_equal(results5CodeBased$assumedStDevs, results5$assumedStDevs, tolerance = 1e-06) + expect_equal(results5CodeBased$conditionalRejectionProbabilities, results5$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results5CodeBased$conditionalPower, results5$conditionalPower, tolerance = 1e-06) + expect_equal(results5CodeBased$repeatedConfidenceIntervalLowerBounds, results5$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results5CodeBased$repeatedConfidenceIntervalUpperBounds, results5$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results5CodeBased$repeatedPValues, results5$repeatedPValues, tolerance = 1e-06) + expect_type(names(results5), "character") + df <- as.data.frame(results5) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results5) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results6 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + intersectionTest = "Bonferroni", varianceOption = "pairwisePooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results6' with expected results + expect_equal(results6$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results6$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results6$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results6$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results6$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results6$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results6$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results6$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results6$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results6$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results6$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results6$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results6$conditionalRejectionProbabilities[1, ], c(0.039664178, 0.14221619, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results6$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results6$conditionalRejectionProbabilities[2, ], c(0.037322005, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results6$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results6$conditionalRejectionProbabilities[3, ], c(0.041377736, 0.28315003, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results6$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results6$conditionalPower[1, ], c(NA_real_, NA_real_, 0.42415922, 0.67684078), tolerance = 1e-06, label = paste0("c(", paste0(results6$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results6$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results6$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results6$conditionalPower[3, ], c(NA_real_, NA_real_, 0.77871789, 0.92862656), tolerance = 1e-06, label = paste0("c(", paste0(results6$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results6$repeatedConfidenceIntervalLowerBounds[1, ], c(-18.601467, -4.8144337, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results6$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results6$repeatedConfidenceIntervalLowerBounds[2, ], c(-20.153637, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results6$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results6$repeatedConfidenceIntervalLowerBounds[3, ], c(-16.403927, -0.48327212, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results6$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results6$repeatedConfidenceIntervalUpperBounds[1, ], c(48.601467, 28.627869, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results6$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results6$repeatedConfidenceIntervalUpperBounds[2, ], c(39.353637, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results6$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results6$repeatedConfidenceIntervalUpperBounds[3, ], c(51.403927, 32.999307, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results6$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results6$repeatedPValues[1, ], c(0.5, 0.086711756, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results6$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results6$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results6$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results6$repeatedPValues[3, ], c(0.5, 0.026234621, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results6$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results6), NA))) + expect_output(print(results6)$show()) + invisible(capture.output(expect_error(summary(results6), NA))) + expect_output(summary(results6)$show()) + results6CodeBased <- eval(parse(text = getObjectRCode(results6, stringWrapParagraphWidth = NULL))) + expect_equal(results6CodeBased$thetaH1, results6$thetaH1, tolerance = 1e-06) + expect_equal(results6CodeBased$assumedStDevs, results6$assumedStDevs, tolerance = 1e-06) + expect_equal(results6CodeBased$conditionalRejectionProbabilities, results6$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results6CodeBased$conditionalPower, results6$conditionalPower, tolerance = 1e-06) + expect_equal(results6CodeBased$repeatedConfidenceIntervalLowerBounds, results6$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results6CodeBased$repeatedConfidenceIntervalUpperBounds, results6$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results6CodeBased$repeatedPValues, results6$repeatedPValues, tolerance = 1e-06) + expect_type(names(results6), "character") + df <- as.data.frame(results6) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results6) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results7 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results7' with expected results + expect_equal(results7$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results7$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results7$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results7$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results7$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results7$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results7$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results7$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results7$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results7$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results7$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results7$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results7$conditionalRejectionProbabilities[1, ], c(0.043739576, 0.16022367, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results7$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results7$conditionalRejectionProbabilities[2, ], c(0.03844608, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results7$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results7$conditionalRejectionProbabilities[3, ], c(0.052717287, 0.35672949, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results7$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results7$conditionalPower[1, ], c(NA_real_, NA_real_, 0.45838936, 0.70196346), tolerance = 1e-06, label = paste0("c(", paste0(results7$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results7$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results7$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results7$conditionalPower[3, ], c(NA_real_, NA_real_, 0.83948961, 0.95090316), tolerance = 1e-06, label = paste0("c(", paste0(results7$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results7$repeatedConfidenceIntervalLowerBounds[1, ], c(-14.395028, -4.0669228, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results7$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results7$repeatedConfidenceIntervalLowerBounds[2, ], c(-16.891548, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results7$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results7$repeatedConfidenceIntervalLowerBounds[3, ], c(-12.071338, 0.24153969, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results7$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results7$repeatedConfidenceIntervalUpperBounds[1, ], c(44.395028, 27.895908, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results7$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results7$repeatedConfidenceIntervalUpperBounds[2, ], c(36.091548, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results7$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results7$repeatedConfidenceIntervalUpperBounds[3, ], c(47.071339, 32.285152, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results7$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results7$repeatedPValues[1, ], c(0.5, 0.072888275, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results7$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results7$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results7$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results7$repeatedPValues[3, ], c(0.5, 0.015177743, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results7$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results7), NA))) + expect_output(print(results7)$show()) + invisible(capture.output(expect_error(summary(results7), NA))) + expect_output(summary(results7)$show()) + results7CodeBased <- eval(parse(text = getObjectRCode(results7, stringWrapParagraphWidth = NULL))) + expect_equal(results7CodeBased$thetaH1, results7$thetaH1, tolerance = 1e-06) + expect_equal(results7CodeBased$assumedStDevs, results7$assumedStDevs, tolerance = 1e-06) + expect_equal(results7CodeBased$conditionalRejectionProbabilities, results7$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results7CodeBased$conditionalPower, results7$conditionalPower, tolerance = 1e-06) + expect_equal(results7CodeBased$repeatedConfidenceIntervalLowerBounds, results7$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results7CodeBased$repeatedConfidenceIntervalUpperBounds, results7$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results7CodeBased$repeatedPValues, results7$repeatedPValues, tolerance = 1e-06) + expect_type(names(results7), "character") + df <- as.data.frame(results7) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results7) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results8 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results8' with expected results + expect_equal(results8$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results8$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results8$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results8$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results8$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results8$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results8$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results8$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results8$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results8$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results8$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results8$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results8$conditionalRejectionProbabilities[1, ], c(0.040100206, 0.14400686, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results8$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results8$conditionalRejectionProbabilities[2, ], c(0.037171319, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results8$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results8$conditionalRejectionProbabilities[3, ], c(0.048708233, 0.3133215, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results8$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results8$conditionalPower[1, ], c(NA_real_, NA_real_, 0.42767622, 0.67947129), tolerance = 1e-06, label = paste0("c(", paste0(results8$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results8$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results8$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results8$conditionalPower[3, ], c(NA_real_, NA_real_, 0.80590445, 0.93881804), tolerance = 1e-06, label = paste0("c(", paste0(results8$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results8$repeatedConfidenceIntervalLowerBounds[1, ], c(-18.433726, -4.7641755, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results8$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results8$repeatedConfidenceIntervalLowerBounds[2, ], c(-20.426743, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results8$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results8$repeatedConfidenceIntervalLowerBounds[3, ], c(-15.938808, -0.40329832, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results8$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results8$repeatedConfidenceIntervalUpperBounds[1, ], c(48.433726, 28.584393, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results8$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results8$repeatedConfidenceIntervalUpperBounds[2, ], c(39.626743, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results8$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results8$repeatedConfidenceIntervalUpperBounds[3, ], c(50.938808, 32.927366, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results8$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results8$repeatedPValues[1, ], c(0.5, 0.085188742, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results8$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results8$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results8$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results8$repeatedPValues[3, ], c(0.5, 0.020901685, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results8$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results8), NA))) + expect_output(print(results8)$show()) + invisible(capture.output(expect_error(summary(results8), NA))) + expect_output(summary(results8)$show()) + results8CodeBased <- eval(parse(text = getObjectRCode(results8, stringWrapParagraphWidth = NULL))) + expect_equal(results8CodeBased$thetaH1, results8$thetaH1, tolerance = 1e-06) + expect_equal(results8CodeBased$assumedStDevs, results8$assumedStDevs, tolerance = 1e-06) + expect_equal(results8CodeBased$conditionalRejectionProbabilities, results8$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results8CodeBased$conditionalPower, results8$conditionalPower, tolerance = 1e-06) + expect_equal(results8CodeBased$repeatedConfidenceIntervalLowerBounds, results8$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results8CodeBased$repeatedConfidenceIntervalUpperBounds, results8$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results8CodeBased$repeatedPValues, results8$repeatedPValues, tolerance = 1e-06) + expect_type(names(results8), "character") + df <- as.data.frame(results8) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results8) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results9 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + intersectionTest = "Simes", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results9' with expected results + expect_equal(results9$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results9$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results9$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results9$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results9$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results9$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results9$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results9$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results9$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results9$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results9$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results9$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results9$conditionalRejectionProbabilities[1, ], c(0.042394596, 0.15198143, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results9$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results9$conditionalRejectionProbabilities[2, ], c(0.034321105, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results9$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results9$conditionalRejectionProbabilities[3, ], c(0.051237296, 0.36121246, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results9$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results9$conditionalPower[1, ], c(NA_real_, NA_real_, 0.44302928, 0.69082025), tolerance = 1e-06, label = paste0("c(", paste0(results9$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results9$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results9$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results9$conditionalPower[3, ], c(NA_real_, NA_real_, 0.84263383, 0.95200602), tolerance = 1e-06, label = paste0("c(", paste0(results9$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results9$repeatedConfidenceIntervalLowerBounds[1, ], c(-14.802158, -4.2854677, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results9$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results9$repeatedConfidenceIntervalLowerBounds[2, ], c(-19.232721, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results9$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results9$repeatedConfidenceIntervalLowerBounds[3, ], c(-11.786808, 0.41764226, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results9$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results9$repeatedConfidenceIntervalUpperBounds[1, ], c(44.802158, 28.113845, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results9$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results9$repeatedConfidenceIntervalUpperBounds[2, ], c(38.432721, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results9$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results9$repeatedConfidenceIntervalUpperBounds[3, ], c(46.786808, 32.10754, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results9$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results9$repeatedPValues[1, ], c(0.5, 0.078823932, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results9$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results9$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results9$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results9$repeatedPValues[3, ], c(0.5, 0.014689462, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results9$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results9), NA))) + expect_output(print(results9)$show()) + invisible(capture.output(expect_error(summary(results9), NA))) + expect_output(summary(results9)$show()) + results9CodeBased <- eval(parse(text = getObjectRCode(results9, stringWrapParagraphWidth = NULL))) + expect_equal(results9CodeBased$thetaH1, results9$thetaH1, tolerance = 1e-06) + expect_equal(results9CodeBased$assumedStDevs, results9$assumedStDevs, tolerance = 1e-06) + expect_equal(results9CodeBased$conditionalRejectionProbabilities, results9$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results9CodeBased$conditionalPower, results9$conditionalPower, tolerance = 1e-06) + expect_equal(results9CodeBased$repeatedConfidenceIntervalLowerBounds, results9$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results9CodeBased$repeatedConfidenceIntervalUpperBounds, results9$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results9CodeBased$repeatedPValues, results9$repeatedPValues, tolerance = 1e-06) + expect_type(names(results9), "character") + df <- as.data.frame(results9) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results9) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results10 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + intersectionTest = "Simes", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results10' with expected results + expect_equal(results10$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results10$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results10$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results10$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results10$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results10$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results10$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results10$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results10$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results10$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results10$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results10$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results10$conditionalRejectionProbabilities[1, ], c(0.040740209, 0.14372404, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results10$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results10$conditionalRejectionProbabilities[2, ], c(0.033856262, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results10$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results10$conditionalRejectionProbabilities[3, ], c(0.049414261, 0.33374326, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results10$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results10$conditionalPower[1, ], c(NA_real_, NA_real_, 0.42712247, 0.6790579), tolerance = 1e-06, label = paste0("c(", paste0(results10$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results10$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results10$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results10$conditionalPower[3, ], c(NA_real_, NA_real_, 0.82244694, 0.94484021), tolerance = 1e-06, label = paste0("c(", paste0(results10$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results10$repeatedConfidenceIntervalLowerBounds[1, ], c(-16.567569, -4.662798, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results10$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results10$repeatedConfidenceIntervalLowerBounds[2, ], c(-20.940706, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results10$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results10$repeatedConfidenceIntervalLowerBounds[3, ], c(-13.521691, 0.049006969, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results10$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results10$repeatedConfidenceIntervalUpperBounds[1, ], c(46.567569, 28.528695, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results10$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results10$repeatedConfidenceIntervalUpperBounds[2, ], c(40.140706, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results10$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results10$repeatedConfidenceIntervalUpperBounds[3, ], c(48.521691, 32.491814, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results10$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results10$repeatedPValues[1, ], c(0.5, 0.08542716, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results10$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results10$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results10$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results10$repeatedPValues[3, ], c(0.5, 0.017966281, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results10$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results10), NA))) + expect_output(print(results10)$show()) + invisible(capture.output(expect_error(summary(results10), NA))) + expect_output(summary(results10)$show()) + results10CodeBased <- eval(parse(text = getObjectRCode(results10, stringWrapParagraphWidth = NULL))) + expect_equal(results10CodeBased$thetaH1, results10$thetaH1, tolerance = 1e-06) + expect_equal(results10CodeBased$assumedStDevs, results10$assumedStDevs, tolerance = 1e-06) + expect_equal(results10CodeBased$conditionalRejectionProbabilities, results10$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results10CodeBased$conditionalPower, results10$conditionalPower, tolerance = 1e-06) + expect_equal(results10CodeBased$repeatedConfidenceIntervalLowerBounds, results10$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results10CodeBased$repeatedConfidenceIntervalUpperBounds, results10$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results10CodeBased$repeatedPValues, results10$repeatedPValues, tolerance = 1e-06) + expect_type(names(results10), "character") + df <- as.data.frame(results10) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results10) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results11 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + intersectionTest = "Simes", varianceOption = "pairwisePooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results11' with expected results + expect_equal(results11$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results11$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results11$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results11$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results11$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results11$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results11$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results11$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results11$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results11$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results11$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results11$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results11$conditionalRejectionProbabilities[1, ], c(0.043219831, 0.15803856, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results11$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results11$conditionalRejectionProbabilities[2, ], c(0.038533075, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results11$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results11$conditionalRejectionProbabilities[3, ], c(0.052145589, 0.35513472, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results11$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results11$conditionalPower[1, ], c(NA_real_, NA_real_, 0.45436587, 0.6990644), tolerance = 1e-06, label = paste0("c(", paste0(results11$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results11$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results11$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results11$conditionalPower[3, ], c(NA_real_, NA_real_, 0.83835744, 0.95050484), tolerance = 1e-06, label = paste0("c(", paste0(results11$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results11$repeatedConfidenceIntervalLowerBounds[1, ], c(-14.549821, -4.1213996, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results11$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results11$repeatedConfidenceIntervalLowerBounds[2, ], c(-16.848567, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results11$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results11$repeatedConfidenceIntervalLowerBounds[3, ], c(-12.483405, 0.16013976, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results11$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results11$repeatedConfidenceIntervalUpperBounds[1, ], c(44.549821, 27.945069, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results11$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results11$repeatedConfidenceIntervalUpperBounds[2, ], c(36.048567, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results11$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results11$repeatedConfidenceIntervalUpperBounds[3, ], c(47.483405, 32.356999, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results11$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results11$repeatedPValues[1, ], c(0.5, 0.07440366, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results11$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results11$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results11$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results11$repeatedPValues[3, ], c(0.5, 0.015356079, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results11$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results11), NA))) + expect_output(print(results11)$show()) + invisible(capture.output(expect_error(summary(results11), NA))) + expect_output(summary(results11)$show()) + results11CodeBased <- eval(parse(text = getObjectRCode(results11, stringWrapParagraphWidth = NULL))) + expect_equal(results11CodeBased$thetaH1, results11$thetaH1, tolerance = 1e-06) + expect_equal(results11CodeBased$assumedStDevs, results11$assumedStDevs, tolerance = 1e-06) + expect_equal(results11CodeBased$conditionalRejectionProbabilities, results11$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results11CodeBased$conditionalPower, results11$conditionalPower, tolerance = 1e-06) + expect_equal(results11CodeBased$repeatedConfidenceIntervalLowerBounds, results11$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results11CodeBased$repeatedConfidenceIntervalUpperBounds, results11$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results11CodeBased$repeatedPValues, results11$repeatedPValues, tolerance = 1e-06) + expect_type(names(results11), "character") + df <- as.data.frame(results11) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results11) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results12 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + intersectionTest = "Simes", varianceOption = "pairwisePooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results12' with expected results + expect_equal(results12$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results12$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results12$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results12$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results12$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results12$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results12$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results12$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results12$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results12$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results12$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results12$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results12$conditionalRejectionProbabilities[1, ], c(0.039664178, 0.14221619, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results12$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results12$conditionalRejectionProbabilities[2, ], c(0.037322005, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results12$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results12$conditionalRejectionProbabilities[3, ], c(0.048226966, 0.31219358, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results12$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results12$conditionalPower[1, ], c(NA_real_, NA_real_, 0.42415922, 0.67684078), tolerance = 1e-06, label = paste0("c(", paste0(results12$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results12$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results12$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results12$conditionalPower[3, ], c(NA_real_, NA_real_, 0.80494934, 0.93846621), tolerance = 1e-06, label = paste0("c(", paste0(results12$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results12$repeatedConfidenceIntervalLowerBounds[1, ], c(-18.601467, -4.8144337, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results12$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results12$repeatedConfidenceIntervalLowerBounds[2, ], c(-20.153637, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results12$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results12$repeatedConfidenceIntervalLowerBounds[3, ], c(-16.403927, -0.48327212, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results12$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results12$repeatedConfidenceIntervalUpperBounds[1, ], c(48.601467, 28.627869, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results12$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results12$repeatedConfidenceIntervalUpperBounds[2, ], c(39.353637, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results12$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results12$repeatedConfidenceIntervalUpperBounds[3, ], c(51.403927, 32.999307, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results12$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results12$repeatedPValues[1, ], c(0.5, 0.086711756, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results12$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results12$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results12$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results12$repeatedPValues[3, ], c(0.5, 0.021078114, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results12$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results12), NA))) + expect_output(print(results12)$show()) + invisible(capture.output(expect_error(summary(results12), NA))) + expect_output(summary(results12)$show()) + results12CodeBased <- eval(parse(text = getObjectRCode(results12, stringWrapParagraphWidth = NULL))) + expect_equal(results12CodeBased$thetaH1, results12$thetaH1, tolerance = 1e-06) + expect_equal(results12CodeBased$assumedStDevs, results12$assumedStDevs, tolerance = 1e-06) + expect_equal(results12CodeBased$conditionalRejectionProbabilities, results12$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results12CodeBased$conditionalPower, results12$conditionalPower, tolerance = 1e-06) + expect_equal(results12CodeBased$repeatedConfidenceIntervalLowerBounds, results12$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results12CodeBased$repeatedConfidenceIntervalUpperBounds, results12$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results12CodeBased$repeatedPValues, results12$repeatedPValues, tolerance = 1e-06) + expect_type(names(results12), "character") + df <- as.data.frame(results12) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results12) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results13 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + intersectionTest = "Sidak", varianceOption = "notPooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results13' with expected results + expect_equal(results13$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results13$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results13$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results13$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results13$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results13$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results13$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results13$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results13$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results13$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results13$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results13$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results13$conditionalRejectionProbabilities[1, ], c(0.044513617, 0.16250147, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results13$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results13$conditionalRejectionProbabilities[2, ], c(0.03844608, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results13$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results13$conditionalRejectionProbabilities[3, ], c(0.049538053, 0.34419132, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results13$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results13$conditionalPower[1, ], c(NA_real_, NA_real_, 0.46254707, 0.70494473), tolerance = 1e-06, label = paste0("c(", paste0(results13$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results13$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results13$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results13$conditionalPower[3, ], c(NA_real_, NA_real_, 0.83038985, 0.94768376), tolerance = 1e-06, label = paste0("c(", paste0(results13$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results13$repeatedConfidenceIntervalLowerBounds[1, ], c(-14.393216, -4.0328452, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results13$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results13$repeatedConfidenceIntervalLowerBounds[2, ], c(-16.889915, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results13$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results13$repeatedConfidenceIntervalLowerBounds[3, ], c(-12.069516, 0.29402607, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results13$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results13$repeatedConfidenceIntervalUpperBounds[1, ], c(44.393216, 27.725836, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results13$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results13$repeatedConfidenceIntervalUpperBounds[2, ], c(36.089915, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results13$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results13$repeatedConfidenceIntervalUpperBounds[3, ], c(47.069516, 32.182569, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results13$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results13$repeatedPValues[1, ], c(0.5, 0.071351909, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results13$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results13$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results13$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results13$repeatedPValues[3, ], c(0.5, 0.016637815, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results13$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results13), NA))) + expect_output(print(results13)$show()) + invisible(capture.output(expect_error(summary(results13), NA))) + expect_output(summary(results13)$show()) + results13CodeBased <- eval(parse(text = getObjectRCode(results13, stringWrapParagraphWidth = NULL))) + expect_equal(results13CodeBased$thetaH1, results13$thetaH1, tolerance = 1e-06) + expect_equal(results13CodeBased$assumedStDevs, results13$assumedStDevs, tolerance = 1e-06) + expect_equal(results13CodeBased$conditionalRejectionProbabilities, results13$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results13CodeBased$conditionalPower, results13$conditionalPower, tolerance = 1e-06) + expect_equal(results13CodeBased$repeatedConfidenceIntervalLowerBounds, results13$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results13CodeBased$repeatedConfidenceIntervalUpperBounds, results13$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results13CodeBased$repeatedPValues, results13$repeatedPValues, tolerance = 1e-06) + expect_type(names(results13), "character") + df <- as.data.frame(results13) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results13) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results14 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + intersectionTest = "Sidak", varianceOption = "notPooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results14' with expected results + expect_equal(results14$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results14$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results14$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results14$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results14$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results14$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results14$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results14$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results14$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results14$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results14$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results14$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results14$conditionalRejectionProbabilities[1, ], c(0.040941914, 0.14648989, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results14$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results14$conditionalRejectionProbabilities[2, ], c(0.037171319, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results14$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results14$conditionalRejectionProbabilities[3, ], c(0.043912863, 0.29382832, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results14$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results14$conditionalPower[1, ], c(NA_real_, NA_real_, 0.4325103, 0.68306799), tolerance = 1e-06, label = paste0("c(", paste0(results14$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results14$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results14$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results14$conditionalPower[3, ], c(NA_real_, NA_real_, 0.78874215, 0.93242714), tolerance = 1e-06, label = paste0("c(", paste0(results14$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results14$repeatedConfidenceIntervalLowerBounds[1, ], c(-18.431163, -4.7231897, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results14$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results14$repeatedConfidenceIntervalLowerBounds[2, ], c(-20.424453, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results14$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results14$repeatedConfidenceIntervalLowerBounds[3, ], c(-15.936268, -0.34247232, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results14$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results14$repeatedConfidenceIntervalUpperBounds[1, ], c(48.431163, 28.407231, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results14$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results14$repeatedConfidenceIntervalUpperBounds[2, ], c(39.624453, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results14$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results14$repeatedConfidenceIntervalUpperBounds[3, ], c(50.936268, 32.815818, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results14$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results14$repeatedPValues[1, ], c(0.5, 0.083136439, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results14$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results14$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results14$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results14$repeatedPValues[3, ], c(0.5, 0.024192808, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results14$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results14), NA))) + expect_output(print(results14)$show()) + invisible(capture.output(expect_error(summary(results14), NA))) + expect_output(summary(results14)$show()) + results14CodeBased <- eval(parse(text = getObjectRCode(results14, stringWrapParagraphWidth = NULL))) + expect_equal(results14CodeBased$thetaH1, results14$thetaH1, tolerance = 1e-06) + expect_equal(results14CodeBased$assumedStDevs, results14$assumedStDevs, tolerance = 1e-06) + expect_equal(results14CodeBased$conditionalRejectionProbabilities, results14$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results14CodeBased$conditionalPower, results14$conditionalPower, tolerance = 1e-06) + expect_equal(results14CodeBased$repeatedConfidenceIntervalLowerBounds, results14$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results14CodeBased$repeatedConfidenceIntervalUpperBounds, results14$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results14CodeBased$repeatedPValues, results14$repeatedPValues, tolerance = 1e-06) + expect_type(names(results14), "character") + df <- as.data.frame(results14) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results14) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results15 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + intersectionTest = "Sidak", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results15' with expected results + expect_equal(results15$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results15$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results15$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results15$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results15$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results15$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results15$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results15$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results15$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results15$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results15$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results15$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results15$conditionalRejectionProbabilities[1, ], c(0.043192758, 0.15430882, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results15$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results15$conditionalRejectionProbabilities[2, ], c(0.034321105, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results15$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results15$conditionalRejectionProbabilities[3, ], c(0.050842102, 0.35990794, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results15$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results15$conditionalPower[1, ], c(NA_real_, NA_real_, 0.44741759, 0.6940249), tolerance = 1e-06, label = paste0("c(", paste0(results15$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results15$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results15$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results15$conditionalPower[3, ], c(NA_real_, NA_real_, 0.84172467, 0.95168763), tolerance = 1e-06, label = paste0("c(", paste0(results15$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results15$repeatedConfidenceIntervalLowerBounds[1, ], c(-14.800321, -4.2506387, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results15$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results15$repeatedConfidenceIntervalLowerBounds[2, ], c(-19.230944, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results15$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results15$repeatedConfidenceIntervalLowerBounds[3, ], c(-11.785003, 0.46968016, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results15$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results15$repeatedConfidenceIntervalUpperBounds[1, ], c(44.800321, 27.943326, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results15$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results15$repeatedConfidenceIntervalUpperBounds[2, ], c(38.430944, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results15$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results15$repeatedConfidenceIntervalUpperBounds[3, ], c(46.785003, 32.005071, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results15$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results15$repeatedPValues[1, ], c(0.5, 0.077086341, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results15$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results15$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results15$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results15$repeatedPValues[3, ], c(0.5, 0.014829652, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results15$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results15), NA))) + expect_output(print(results15)$show()) + invisible(capture.output(expect_error(summary(results15), NA))) + expect_output(summary(results15)$show()) + results15CodeBased <- eval(parse(text = getObjectRCode(results15, stringWrapParagraphWidth = NULL))) + expect_equal(results15CodeBased$thetaH1, results15$thetaH1, tolerance = 1e-06) + expect_equal(results15CodeBased$assumedStDevs, results15$assumedStDevs, tolerance = 1e-06) + expect_equal(results15CodeBased$conditionalRejectionProbabilities, results15$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results15CodeBased$conditionalPower, results15$conditionalPower, tolerance = 1e-06) + expect_equal(results15CodeBased$repeatedConfidenceIntervalLowerBounds, results15$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results15CodeBased$repeatedConfidenceIntervalUpperBounds, results15$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results15CodeBased$repeatedPValues, results15$repeatedPValues, tolerance = 1e-06) + expect_type(names(results15), "character") + df <- as.data.frame(results15) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results15) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results16 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + intersectionTest = "Sidak", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results16' with expected results + expect_equal(results16$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results16$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results16$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results16$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results16$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results16$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results16$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results16$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results16$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results16$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results16$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results16$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results16$conditionalRejectionProbabilities[1, ], c(0.041569453, 0.14613212, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results16$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results16$conditionalRejectionProbabilities[2, ], c(0.033856262, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results16$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results16$conditionalRejectionProbabilities[3, ], c(0.047839714, 0.32760313, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results16$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results16$conditionalPower[1, ], c(NA_real_, NA_real_, 0.43181681, 0.68255335), tolerance = 1e-06, label = paste0("c(", paste0(results16$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results16$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results16$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results16$conditionalPower[3, ], c(NA_real_, NA_real_, 0.81761872, 0.94309649), tolerance = 1e-06, label = paste0("c(", paste0(results16$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results16$repeatedConfidenceIntervalLowerBounds[1, ], c(-16.565416, -4.6248784, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results16$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results16$repeatedConfidenceIntervalLowerBounds[2, ], c(-20.938622, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results16$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results16$repeatedConfidenceIntervalLowerBounds[3, ], c(-13.519575, 0.10461531, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results16$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results16$repeatedConfidenceIntervalUpperBounds[1, ], c(46.565416, 28.357046, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results16$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results16$repeatedConfidenceIntervalUpperBounds[2, ], c(40.138622, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results16$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results16$repeatedConfidenceIntervalUpperBounds[3, ], c(48.519575, 32.386196, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results16$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results16$repeatedPValues[1, ], c(0.5, 0.083428262, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results16$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results16$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results16$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results16$repeatedPValues[3, ], c(0.5, 0.018799791, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results16$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results16), NA))) + expect_output(print(results16)$show()) + invisible(capture.output(expect_error(summary(results16), NA))) + expect_output(summary(results16)$show()) + results16CodeBased <- eval(parse(text = getObjectRCode(results16, stringWrapParagraphWidth = NULL))) + expect_equal(results16CodeBased$thetaH1, results16$thetaH1, tolerance = 1e-06) + expect_equal(results16CodeBased$assumedStDevs, results16$assumedStDevs, tolerance = 1e-06) + expect_equal(results16CodeBased$conditionalRejectionProbabilities, results16$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results16CodeBased$conditionalPower, results16$conditionalPower, tolerance = 1e-06) + expect_equal(results16CodeBased$repeatedConfidenceIntervalLowerBounds, results16$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results16CodeBased$repeatedConfidenceIntervalUpperBounds, results16$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results16CodeBased$repeatedPValues, results16$repeatedPValues, tolerance = 1e-06) + expect_type(names(results16), "character") + df <- as.data.frame(results16) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results16) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results17 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + intersectionTest = "Sidak", varianceOption = "pairwisePooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results17' with expected results + expect_equal(results17$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results17$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results17$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results17$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results17$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results17$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results17$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results17$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results17$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results17$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results17$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results17$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results17$conditionalRejectionProbabilities[1, ], c(0.044003076, 0.16034604, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results17$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results17$conditionalRejectionProbabilities[2, ], c(0.038533075, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results17$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results17$conditionalRejectionProbabilities[3, ], c(0.047740982, 0.33733332, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results17$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results17$conditionalPower[1, ], c(NA_real_, NA_real_, 0.45861366, 0.70212467), tolerance = 1e-06, label = paste0("c(", paste0(results17$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results17$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results17$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results17$conditionalPower[3, ], c(NA_real_, NA_real_, 0.82521432, 0.94583446), tolerance = 1e-06, label = paste0("c(", paste0(results17$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results17$repeatedConfidenceIntervalLowerBounds[1, ], c(-14.548, -4.0869288, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results17$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results17$repeatedConfidenceIntervalLowerBounds[2, ], c(-16.846937, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results17$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results17$repeatedConfidenceIntervalLowerBounds[3, ], c(-12.481557, 0.21501802, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results17$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results17$repeatedConfidenceIntervalUpperBounds[1, ], c(44.548, 27.773536, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results17$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results17$repeatedConfidenceIntervalUpperBounds[2, ], c(36.046937, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results17$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results17$repeatedConfidenceIntervalUpperBounds[3, ], c(47.481556, 32.250037, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results17$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results17$repeatedPValues[1, ], c(0.5, 0.072804352, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results17$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results17$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results17$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results17$repeatedPValues[3, ], c(0.5, 0.017498028, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results17$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results17), NA))) + expect_output(print(results17)$show()) + invisible(capture.output(expect_error(summary(results17), NA))) + expect_output(summary(results17)$show()) + results17CodeBased <- eval(parse(text = getObjectRCode(results17, stringWrapParagraphWidth = NULL))) + expect_equal(results17CodeBased$thetaH1, results17$thetaH1, tolerance = 1e-06) + expect_equal(results17CodeBased$assumedStDevs, results17$assumedStDevs, tolerance = 1e-06) + expect_equal(results17CodeBased$conditionalRejectionProbabilities, results17$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results17CodeBased$conditionalPower, results17$conditionalPower, tolerance = 1e-06) + expect_equal(results17CodeBased$repeatedConfidenceIntervalLowerBounds, results17$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results17CodeBased$repeatedConfidenceIntervalUpperBounds, results17$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results17CodeBased$repeatedPValues, results17$repeatedPValues, tolerance = 1e-06) + expect_type(names(results17), "character") + df <- as.data.frame(results17) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results17) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results18 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + intersectionTest = "Sidak", varianceOption = "pairwisePooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results18' with expected results + expect_equal(results18$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results18$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results18$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results18$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results18$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results18$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results18$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results18$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results18$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results18$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results18$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results18$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results18$conditionalRejectionProbabilities[1, ], c(0.040514523, 0.14472681, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results18$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results18$conditionalRejectionProbabilities[2, ], c(0.037322005, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results18$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results18$conditionalRejectionProbabilities[3, ], c(0.042460333, 0.28832504, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results18$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results18$conditionalPower[1, ], c(NA_real_, NA_real_, 0.42908294, 0.68052019), tolerance = 1e-06, label = paste0("c(", paste0(results18$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results18$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results18$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results18$conditionalPower[3, ], c(NA_real_, NA_real_, 0.78363361, 0.93049656), tolerance = 1e-06, label = paste0("c(", paste0(results18$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results18$repeatedConfidenceIntervalLowerBounds[1, ], c(-18.598892, -4.7729883, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results18$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results18$repeatedConfidenceIntervalLowerBounds[2, ], c(-20.151395, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results18$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results18$repeatedConfidenceIntervalLowerBounds[3, ], c(-16.401351, -0.41981706, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results18$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results18$repeatedConfidenceIntervalUpperBounds[1, ], c(48.598892, 28.449073, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results18$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results18$repeatedConfidenceIntervalUpperBounds[2, ], c(39.351395, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results18$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results18$repeatedConfidenceIntervalUpperBounds[3, ], c(51.401351, 32.883177, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results18$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results18$repeatedPValues[1, ], c(0.5, 0.084586974, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results18$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results18$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results18$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results18$repeatedPValues[3, ], c(0.5, 0.025221821, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results18$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results18), NA))) + expect_output(print(results18)$show()) + invisible(capture.output(expect_error(summary(results18), NA))) + expect_output(summary(results18)$show()) + results18CodeBased <- eval(parse(text = getObjectRCode(results18, stringWrapParagraphWidth = NULL))) + expect_equal(results18CodeBased$thetaH1, results18$thetaH1, tolerance = 1e-06) + expect_equal(results18CodeBased$assumedStDevs, results18$assumedStDevs, tolerance = 1e-06) + expect_equal(results18CodeBased$conditionalRejectionProbabilities, results18$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results18CodeBased$conditionalPower, results18$conditionalPower, tolerance = 1e-06) + expect_equal(results18CodeBased$repeatedConfidenceIntervalLowerBounds, results18$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results18CodeBased$repeatedConfidenceIntervalUpperBounds, results18$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results18CodeBased$repeatedPValues, results18$repeatedPValues, tolerance = 1e-06) + expect_type(names(results18), "character") + df <- as.data.frame(results18) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results18) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results19 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + intersectionTest = "Dunnett", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results19' with expected results + expect_equal(results19$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results19$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results19$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results19$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results19$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results19$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results19$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results19$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results19$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results19$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results19$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results19$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results19$conditionalRejectionProbabilities[1, ], c(0.046821821, 0.16471602, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results19$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results19$conditionalRejectionProbabilities[2, ], c(0.034321105, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results19$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results19$conditionalRejectionProbabilities[3, ], c(0.056787656, 0.38875311, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results19$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results19$conditionalPower[1, ], c(NA_real_, NA_real_, 0.46655424, 0.70780427), tolerance = 1e-06, label = paste0("c(", paste0(results19$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results19$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results19$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results19$conditionalPower[3, ], c(NA_real_, NA_real_, 0.8607721, 0.95827226), tolerance = 1e-06, label = paste0("c(", paste0(results19$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results19$repeatedConfidenceIntervalLowerBounds[1, ], c(-14.645333, -3.927683, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results19$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results19$repeatedConfidenceIntervalLowerBounds[2, ], c(-19.080998, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results19$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results19$repeatedConfidenceIntervalLowerBounds[3, ], c(-11.632695, 0.82950364, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results19$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results19$repeatedConfidenceIntervalUpperBounds[1, ], c(44.645334, 27.415422, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results19$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results19$repeatedConfidenceIntervalUpperBounds[2, ], c(38.280999, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results19$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results19$repeatedConfidenceIntervalUpperBounds[3, ], c(46.632695, 31.563129, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results19$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results19$repeatedPValues[1, ], c(0.5, 0.069897558, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results19$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results19$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results19$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results19$repeatedPValues[3, ], c(0.5, 0.012021087, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results19$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results19), NA))) + expect_output(print(results19)$show()) + invisible(capture.output(expect_error(summary(results19), NA))) + expect_output(summary(results19)$show()) + results19CodeBased <- eval(parse(text = getObjectRCode(results19, stringWrapParagraphWidth = NULL))) + expect_equal(results19CodeBased$thetaH1, results19$thetaH1, tolerance = 1e-06) + expect_equal(results19CodeBased$assumedStDevs, results19$assumedStDevs, tolerance = 1e-06) + expect_equal(results19CodeBased$conditionalRejectionProbabilities, results19$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results19CodeBased$conditionalPower, results19$conditionalPower, tolerance = 1e-06) + expect_equal(results19CodeBased$repeatedConfidenceIntervalLowerBounds, results19$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results19CodeBased$repeatedConfidenceIntervalUpperBounds, results19$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results19CodeBased$repeatedPValues, results19$repeatedPValues, tolerance = 1e-06) + expect_type(names(results19), "character") + df <- as.data.frame(results19) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results19) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results20 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + intersectionTest = "Dunnett", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results20' with expected results + expect_equal(results20$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results20$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results20$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results20$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results20$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results20$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results20$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results20$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results20$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results20$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results20$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results20$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results20$conditionalRejectionProbabilities[1, ], c(0.045317687, 0.15683192, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results20$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results20$conditionalRejectionProbabilities[2, ], c(0.033856262, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results20$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results20$conditionalRejectionProbabilities[3, ], c(0.054085103, 0.3588303, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results20$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results20$conditionalPower[1, ], c(NA_real_, NA_real_, 0.45212919, 0.69744676), tolerance = 1e-06, label = paste0("c(", paste0(results20$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results20$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results20$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results20$conditionalPower[3, ], c(NA_real_, NA_real_, 0.84097006, 0.95142305), tolerance = 1e-06, label = paste0("c(", paste0(results20$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results20$repeatedConfidenceIntervalLowerBounds[1, ], c(-16.335113, -4.2557288, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results20$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results20$repeatedConfidenceIntervalLowerBounds[2, ], c(-20.71581, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results20$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results20$repeatedConfidenceIntervalLowerBounds[3, ], c(-13.293254, 0.50940978, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results20$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results20$repeatedConfidenceIntervalUpperBounds[1, ], c(46.335113, 27.786662, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results20$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results20$repeatedConfidenceIntervalUpperBounds[2, ], c(39.91581, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results20$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results20$repeatedConfidenceIntervalUpperBounds[3, ], c(48.293254, 31.900882, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results20$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results20$repeatedPValues[1, ], c(0.5, 0.075258151, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results20$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results20$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results20$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results20$repeatedPValues[3, ], c(0.5, 0.014946954, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results20$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results20), NA))) + expect_output(print(results20)$show()) + invisible(capture.output(expect_error(summary(results20), NA))) + expect_output(summary(results20)$show()) + results20CodeBased <- eval(parse(text = getObjectRCode(results20, stringWrapParagraphWidth = NULL))) + expect_equal(results20CodeBased$thetaH1, results20$thetaH1, tolerance = 1e-06) + expect_equal(results20CodeBased$assumedStDevs, results20$assumedStDevs, tolerance = 1e-06) + expect_equal(results20CodeBased$conditionalRejectionProbabilities, results20$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results20CodeBased$conditionalPower, results20$conditionalPower, tolerance = 1e-06) + expect_equal(results20CodeBased$repeatedConfidenceIntervalLowerBounds, results20$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results20CodeBased$repeatedConfidenceIntervalUpperBounds, results20$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results20CodeBased$repeatedPValues, results20$repeatedPValues, tolerance = 1e-06) + expect_type(names(results20), "character") + df <- as.data.frame(results20) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results20) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results21 <- getAnalysisResults( + design = design2, dataInput = dataExample1, + intersectionTest = "Bonferroni", varianceOption = "notPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results21' with expected results + expect_equal(results21$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results21$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results21$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results21$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results21$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results21$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results21$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results21$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results21$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results21$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results21$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results21$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results21$conditionalRejectionProbabilities[1, ], c(0.024608533, 0.053964296, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results21$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results21$conditionalRejectionProbabilities[2, ], c(0.021871903, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results21$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results21$conditionalRejectionProbabilities[3, ], c(0.027261939, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results21$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results21$repeatedConfidenceIntervalLowerBounds[1, ], c(-10.256183, -4.0576303, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results21$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results21$repeatedConfidenceIntervalLowerBounds[2, ], c(-13.161515, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results21$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results21$repeatedConfidenceIntervalLowerBounds[3, ], c(-7.9076686, 0.4326836, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results21$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results21$repeatedConfidenceIntervalUpperBounds[1, ], c(40.256183, 26.806923, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results21$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results21$repeatedConfidenceIntervalUpperBounds[2, ], c(32.361515, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results21$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results21$repeatedConfidenceIntervalUpperBounds[3, ], c(42.907669, 31.664999, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results21$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results21$repeatedPValues[1, ], c(0.17463845, 0.062131804, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results21$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results21$repeatedPValues[2, ], c(0.20337355, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results21$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results21$repeatedPValues[3, ], c(0.1527221, 0.015597359, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results21$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results21$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.277, 0.453), tolerance = 1e-06, label = paste0("c(", paste0(results21$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results21$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results21$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results21$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results21$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results21), NA))) + expect_output(print(results21)$show()) + invisible(capture.output(expect_error(summary(results21), NA))) + expect_output(summary(results21)$show()) + results21CodeBased <- eval(parse(text = getObjectRCode(results21, stringWrapParagraphWidth = NULL))) + expect_equal(results21CodeBased$thetaH1, results21$thetaH1, tolerance = 1e-06) + expect_equal(results21CodeBased$assumedStDevs, results21$assumedStDevs, tolerance = 1e-06) + expect_equal(results21CodeBased$conditionalRejectionProbabilities, results21$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results21CodeBased$repeatedConfidenceIntervalLowerBounds, results21$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results21CodeBased$repeatedConfidenceIntervalUpperBounds, results21$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results21CodeBased$repeatedPValues, results21$repeatedPValues, tolerance = 1e-06) + expect_equal(results21CodeBased$conditionalPowerSimulated, results21$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results21), "character") + df <- as.data.frame(results21) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results21) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results22 <- getAnalysisResults( + design = design2, dataInput = dataExample1, + intersectionTest = "Bonferroni", varianceOption = "notPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results22' with expected results + expect_equal(results22$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results22$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results22$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results22$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results22$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results22$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results22$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results22$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results22$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results22$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results22$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results22$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results22$conditionalRejectionProbabilities[1, ], c(0.022711489, 0.047669561, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results22$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results22$conditionalRejectionProbabilities[2, ], c(0.021234311, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results22$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results22$conditionalRejectionProbabilities[3, ], c(0.024147032, 0.14148061, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results22$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results22$repeatedConfidenceIntervalLowerBounds[1, ], c(-12.830851, -4.722817, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results22$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results22$repeatedConfidenceIntervalLowerBounds[2, ], c(-15.416779, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results22$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results22$repeatedConfidenceIntervalLowerBounds[3, ], c(-10.376075, -0.16648466, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results22$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results22$repeatedConfidenceIntervalUpperBounds[1, ], c(42.830851, 27.447651, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results22$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results22$repeatedConfidenceIntervalUpperBounds[2, ], c(34.616779, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results22$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results22$repeatedConfidenceIntervalUpperBounds[3, ], c(45.376075, 32.257244, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results22$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results22$repeatedPValues[1, ], c(0.19376148, 0.070634747, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results22$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results22$repeatedPValues[2, ], c(0.2112175, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results22$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results22$repeatedPValues[3, ], c(0.17899101, 0.021776202, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results22$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results22$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.257, 0.434), tolerance = 1e-06, label = paste0("c(", paste0(results22$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results22$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results22$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results22$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 0.656, 0.797), tolerance = 1e-06, label = paste0("c(", paste0(results22$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results22), NA))) + expect_output(print(results22)$show()) + invisible(capture.output(expect_error(summary(results22), NA))) + expect_output(summary(results22)$show()) + results22CodeBased <- eval(parse(text = getObjectRCode(results22, stringWrapParagraphWidth = NULL))) + expect_equal(results22CodeBased$thetaH1, results22$thetaH1, tolerance = 1e-06) + expect_equal(results22CodeBased$assumedStDevs, results22$assumedStDevs, tolerance = 1e-06) + expect_equal(results22CodeBased$conditionalRejectionProbabilities, results22$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results22CodeBased$repeatedConfidenceIntervalLowerBounds, results22$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results22CodeBased$repeatedConfidenceIntervalUpperBounds, results22$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results22CodeBased$repeatedPValues, results22$repeatedPValues, tolerance = 1e-06) + expect_equal(results22CodeBased$conditionalPowerSimulated, results22$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results22), "character") + df <- as.data.frame(results22) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results22) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results23 <- getAnalysisResults( + design = design2, dataInput = dataExample1, + intersectionTest = "Bonferroni", varianceOption = "overallPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results23' with expected results + expect_equal(results23$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results23$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results23$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results23$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results23$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results23$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results23$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results23$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results23$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results23$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results23$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results23$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results23$conditionalRejectionProbabilities[1, ], c(0.02389937, 0.050606752, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results23$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results23$conditionalRejectionProbabilities[2, ], c(0.019837849, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results23$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results23$conditionalRejectionProbabilities[3, ], c(0.028008383, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results23$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results23$repeatedConfidenceIntervalLowerBounds[1, ], c(-10.605988, -4.2731734, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results23$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results23$repeatedConfidenceIntervalLowerBounds[2, ], c(-15.173049, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results23$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results23$repeatedConfidenceIntervalLowerBounds[3, ], c(-7.6631999, 0.60791563, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results23$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results23$repeatedConfidenceIntervalUpperBounds[1, ], c(40.605988, 27.021858, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results23$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results23$repeatedConfidenceIntervalUpperBounds[2, ], c(34.373049, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results23$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results23$repeatedConfidenceIntervalUpperBounds[3, ], c(42.6632, 31.486561, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results23$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results23$repeatedPValues[1, ], c(0.18140284, 0.066412839, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results23$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results23$repeatedPValues[2, ], c(0.23027951, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results23$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results23$repeatedPValues[3, ], c(0.14737581, 0.014014262, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results23$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results23$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.268, 0.445), tolerance = 1e-06, label = paste0("c(", paste0(results23$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results23$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results23$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results23$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results23$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results23), NA))) + expect_output(print(results23)$show()) + invisible(capture.output(expect_error(summary(results23), NA))) + expect_output(summary(results23)$show()) + results23CodeBased <- eval(parse(text = getObjectRCode(results23, stringWrapParagraphWidth = NULL))) + expect_equal(results23CodeBased$thetaH1, results23$thetaH1, tolerance = 1e-06) + expect_equal(results23CodeBased$assumedStDevs, results23$assumedStDevs, tolerance = 1e-06) + expect_equal(results23CodeBased$conditionalRejectionProbabilities, results23$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results23CodeBased$repeatedConfidenceIntervalLowerBounds, results23$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results23CodeBased$repeatedConfidenceIntervalUpperBounds, results23$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results23CodeBased$repeatedPValues, results23$repeatedPValues, tolerance = 1e-06) + expect_equal(results23CodeBased$conditionalPowerSimulated, results23$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results23), "character") + df <- as.data.frame(results23) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results23) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results24 <- getAnalysisResults( + design = design2, dataInput = dataExample1, + intersectionTest = "Bonferroni", varianceOption = "overallPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results24' with expected results + expect_equal(results24$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results24$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results24$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results24$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results24$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results24$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results24$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results24$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results24$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results24$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results24$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results24$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results24$conditionalRejectionProbabilities[1, ], c(0.023040094, 0.047419024, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results24$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results24$conditionalRejectionProbabilities[2, ], c(0.019613852, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results24$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results24$conditionalRejectionProbabilities[3, ], c(0.026303733, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results24$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results24$repeatedConfidenceIntervalLowerBounds[1, ], c(-11.74771, -4.6401767, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results24$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results24$repeatedConfidenceIntervalLowerBounds[2, ], c(-16.277631, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results24$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results24$repeatedConfidenceIntervalLowerBounds[3, ], c(-8.7851784, 0.25415362, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results24$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results24$repeatedConfidenceIntervalUpperBounds[1, ], c(41.74771, 27.425347, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results24$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results24$repeatedConfidenceIntervalUpperBounds[2, ], c(35.477631, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results24$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results24$repeatedConfidenceIntervalUpperBounds[3, ], c(43.785178, 31.856528, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results24$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results24$repeatedPValues[1, ], c(0.19020524, 0.071018123, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results24$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results24$repeatedPValues[2, ], c(0.23360401, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results24$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results24$repeatedPValues[3, ], c(0.16007682, 0.01742078, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results24$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results24$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.256, 0.433), tolerance = 1e-06, label = paste0("c(", paste0(results24$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results24$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results24$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results24$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results24$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results24), NA))) + expect_output(print(results24)$show()) + invisible(capture.output(expect_error(summary(results24), NA))) + expect_output(summary(results24)$show()) + results24CodeBased <- eval(parse(text = getObjectRCode(results24, stringWrapParagraphWidth = NULL))) + expect_equal(results24CodeBased$thetaH1, results24$thetaH1, tolerance = 1e-06) + expect_equal(results24CodeBased$assumedStDevs, results24$assumedStDevs, tolerance = 1e-06) + expect_equal(results24CodeBased$conditionalRejectionProbabilities, results24$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results24CodeBased$repeatedConfidenceIntervalLowerBounds, results24$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results24CodeBased$repeatedConfidenceIntervalUpperBounds, results24$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results24CodeBased$repeatedPValues, results24$repeatedPValues, tolerance = 1e-06) + expect_equal(results24CodeBased$conditionalPowerSimulated, results24$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results24), "character") + df <- as.data.frame(results24) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results24) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results25 <- getAnalysisResults( + design = design2, dataInput = dataExample1, + intersectionTest = "Bonferroni", varianceOption = "pairwisePooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results25' with expected results + expect_equal(results25$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results25$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results25$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results25$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results25$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results25$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results25$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results25$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results25$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results25$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results25$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results25$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results25$conditionalRejectionProbabilities[1, ], c(0.024333354, 0.053095357, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results25$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results25$conditionalRejectionProbabilities[2, ], c(0.021915713, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results25$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results25$conditionalRejectionProbabilities[3, ], c(0.026248507, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results25$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results25$repeatedConfidenceIntervalLowerBounds[1, ], c(-10.389181, -4.1091853, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results25$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results25$repeatedConfidenceIntervalLowerBounds[2, ], c(-13.124586, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results25$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results25$repeatedConfidenceIntervalLowerBounds[3, ], c(-8.2617152, 0.37246523, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results25$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results25$repeatedConfidenceIntervalUpperBounds[1, ], c(40.389181, 26.847363, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results25$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results25$repeatedConfidenceIntervalUpperBounds[2, ], c(32.324586, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results25$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results25$repeatedConfidenceIntervalUpperBounds[3, ], c(43.261715, 31.705217, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results25$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results25$repeatedPValues[1, ], c(0.17721241, 0.063189426, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results25$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results25$repeatedPValues[2, ], c(0.20285189, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results25$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results25$repeatedPValues[3, ], c(0.16051933, 0.01616384, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results25$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results25$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.274, 0.453), tolerance = 1e-06, label = paste0("c(", paste0(results25$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results25$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results25$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results25$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results25$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results25), NA))) + expect_output(print(results25)$show()) + invisible(capture.output(expect_error(summary(results25), NA))) + expect_output(summary(results25)$show()) + results25CodeBased <- eval(parse(text = getObjectRCode(results25, stringWrapParagraphWidth = NULL))) + expect_equal(results25CodeBased$thetaH1, results25$thetaH1, tolerance = 1e-06) + expect_equal(results25CodeBased$assumedStDevs, results25$assumedStDevs, tolerance = 1e-06) + expect_equal(results25CodeBased$conditionalRejectionProbabilities, results25$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results25CodeBased$repeatedConfidenceIntervalLowerBounds, results25$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results25CodeBased$repeatedConfidenceIntervalUpperBounds, results25$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results25CodeBased$repeatedPValues, results25$repeatedPValues, tolerance = 1e-06) + expect_equal(results25CodeBased$conditionalPowerSimulated, results25$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results25), "character") + df <- as.data.frame(results25) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results25) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results26 <- getAnalysisResults( + design = design2, dataInput = dataExample1, + intersectionTest = "Bonferroni", varianceOption = "pairwisePooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results26' with expected results + expect_equal(results26$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results26$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results26$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results26$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results26$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results26$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results26$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results26$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results26$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results26$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results26$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results26$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results26$conditionalRejectionProbabilities[1, ], c(0.02248882, 0.047009108, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results26$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results26$conditionalRejectionProbabilities[2, ], c(0.021309255, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results26$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results26$conditionalRejectionProbabilities[3, ], c(0.023369532, 0.13794488, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results26$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results26$repeatedConfidenceIntervalLowerBounds[1, ], c(-12.972232, -4.7692163, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results26$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results26$repeatedConfidenceIntervalLowerBounds[2, ], c(-15.236237, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results26$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results26$repeatedConfidenceIntervalLowerBounds[3, ], c(-10.763995, -0.22335705, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results26$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results26$repeatedConfidenceIntervalUpperBounds[1, ], c(42.972232, 27.481288, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results26$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results26$repeatedConfidenceIntervalUpperBounds[2, ], c(34.436237, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results26$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results26$repeatedConfidenceIntervalUpperBounds[3, ], c(45.763994, 32.295837, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results26$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results26$repeatedPValues[1, ], c(0.19623626, 0.071653269, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results26$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results26$repeatedPValues[2, ], c(0.21026955, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results26$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results26$repeatedPValues[3, ], c(0.18674722, 0.022408487, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results26$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results26$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.256, 0.431), tolerance = 1e-06, label = paste0("c(", paste0(results26$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results26$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results26$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results26$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 0.652, 0.795), tolerance = 1e-06, label = paste0("c(", paste0(results26$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results26), NA))) + expect_output(print(results26)$show()) + invisible(capture.output(expect_error(summary(results26), NA))) + expect_output(summary(results26)$show()) + results26CodeBased <- eval(parse(text = getObjectRCode(results26, stringWrapParagraphWidth = NULL))) + expect_equal(results26CodeBased$thetaH1, results26$thetaH1, tolerance = 1e-06) + expect_equal(results26CodeBased$assumedStDevs, results26$assumedStDevs, tolerance = 1e-06) + expect_equal(results26CodeBased$conditionalRejectionProbabilities, results26$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results26CodeBased$repeatedConfidenceIntervalLowerBounds, results26$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results26CodeBased$repeatedConfidenceIntervalUpperBounds, results26$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results26CodeBased$repeatedPValues, results26$repeatedPValues, tolerance = 1e-06) + expect_equal(results26CodeBased$conditionalPowerSimulated, results26$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results26), "character") + df <- as.data.frame(results26) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results26) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results27 <- getAnalysisResults( + design = design2, dataInput = dataExample1, + intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results27' with expected results + expect_equal(results27$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results27$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results27$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results27$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results27$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results27$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results27$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results27$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results27$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results27$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results27$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results27$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results27$conditionalRejectionProbabilities[1, ], c(0.024608533, 0.053964296, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results27$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results27$conditionalRejectionProbabilities[2, ], c(0.021871903, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results27$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results27$conditionalRejectionProbabilities[3, ], c(0.029595078, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results27$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results27$repeatedConfidenceIntervalLowerBounds[1, ], c(-10.256183, -4.0576303, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results27$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results27$repeatedConfidenceIntervalLowerBounds[2, ], c(-13.161515, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results27$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results27$repeatedConfidenceIntervalLowerBounds[3, ], c(-7.9076686, 0.4326836, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results27$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results27$repeatedConfidenceIntervalUpperBounds[1, ], c(40.256183, 26.806923, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results27$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results27$repeatedConfidenceIntervalUpperBounds[2, ], c(32.361515, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results27$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results27$repeatedConfidenceIntervalUpperBounds[3, ], c(42.907669, 31.664999, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results27$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results27$repeatedPValues[1, ], c(0.17463845, 0.062131804, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results27$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results27$repeatedPValues[2, ], c(0.20337355, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results27$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results27$repeatedPValues[3, ], c(0.13700176, 0.014275569, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results27$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results27$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.277, 0.453), tolerance = 1e-06, label = paste0("c(", paste0(results27$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results27$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results27$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results27$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results27$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results27), NA))) + expect_output(print(results27)$show()) + invisible(capture.output(expect_error(summary(results27), NA))) + expect_output(summary(results27)$show()) + results27CodeBased <- eval(parse(text = getObjectRCode(results27, stringWrapParagraphWidth = NULL))) + expect_equal(results27CodeBased$thetaH1, results27$thetaH1, tolerance = 1e-06) + expect_equal(results27CodeBased$assumedStDevs, results27$assumedStDevs, tolerance = 1e-06) + expect_equal(results27CodeBased$conditionalRejectionProbabilities, results27$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results27CodeBased$repeatedConfidenceIntervalLowerBounds, results27$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results27CodeBased$repeatedConfidenceIntervalUpperBounds, results27$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results27CodeBased$repeatedPValues, results27$repeatedPValues, tolerance = 1e-06) + expect_equal(results27CodeBased$conditionalPowerSimulated, results27$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results27), "character") + df <- as.data.frame(results27) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results27) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results28 <- getAnalysisResults( + design = design2, dataInput = dataExample1, + intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results28' with expected results + expect_equal(results28$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results28$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results28$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results28$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results28$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results28$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results28$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results28$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results28$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results28$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results28$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results28$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results28$conditionalRejectionProbabilities[1, ], c(0.022711489, 0.047669561, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results28$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results28$conditionalRejectionProbabilities[2, ], c(0.021234311, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results28$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results28$conditionalRejectionProbabilities[3, ], c(0.027312859, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results28$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results28$repeatedConfidenceIntervalLowerBounds[1, ], c(-12.830851, -4.722817, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results28$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results28$repeatedConfidenceIntervalLowerBounds[2, ], c(-15.416779, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results28$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results28$repeatedConfidenceIntervalLowerBounds[3, ], c(-10.376075, -0.16648466, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results28$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results28$repeatedConfidenceIntervalUpperBounds[1, ], c(42.830851, 27.447651, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results28$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results28$repeatedConfidenceIntervalUpperBounds[2, ], c(34.616779, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results28$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results28$repeatedConfidenceIntervalUpperBounds[3, ], c(45.376075, 32.257244, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results28$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results28$repeatedPValues[1, ], c(0.19376148, 0.070634747, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results28$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results28$repeatedPValues[2, ], c(0.2112175, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results28$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results28$repeatedPValues[3, ], c(0.15234731, 0.019097336, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results28$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results28$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.257, 0.434), tolerance = 1e-06, label = paste0("c(", paste0(results28$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results28$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results28$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results28$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results28$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results28), NA))) + expect_output(print(results28)$show()) + invisible(capture.output(expect_error(summary(results28), NA))) + expect_output(summary(results28)$show()) + results28CodeBased <- eval(parse(text = getObjectRCode(results28, stringWrapParagraphWidth = NULL))) + expect_equal(results28CodeBased$thetaH1, results28$thetaH1, tolerance = 1e-06) + expect_equal(results28CodeBased$assumedStDevs, results28$assumedStDevs, tolerance = 1e-06) + expect_equal(results28CodeBased$conditionalRejectionProbabilities, results28$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results28CodeBased$repeatedConfidenceIntervalLowerBounds, results28$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results28CodeBased$repeatedConfidenceIntervalUpperBounds, results28$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results28CodeBased$repeatedPValues, results28$repeatedPValues, tolerance = 1e-06) + expect_equal(results28CodeBased$conditionalPowerSimulated, results28$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results28), "character") + df <- as.data.frame(results28) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results28) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results29 <- getAnalysisResults( + design = design2, dataInput = dataExample1, + intersectionTest = "Simes", varianceOption = "overallPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results29' with expected results + expect_equal(results29$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results29$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results29$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results29$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results29$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results29$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results29$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results29$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results29$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results29$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results29$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results29$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results29$conditionalRejectionProbabilities[1, ], c(0.02389937, 0.050606752, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results29$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results29$conditionalRejectionProbabilities[2, ], c(0.019837849, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results29$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results29$conditionalRejectionProbabilities[3, ], c(0.028741907, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results29$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results29$repeatedConfidenceIntervalLowerBounds[1, ], c(-10.605988, -4.2731734, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results29$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results29$repeatedConfidenceIntervalLowerBounds[2, ], c(-15.173049, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results29$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results29$repeatedConfidenceIntervalLowerBounds[3, ], c(-7.6631999, 0.60791563, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results29$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results29$repeatedConfidenceIntervalUpperBounds[1, ], c(40.605988, 27.021858, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results29$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results29$repeatedConfidenceIntervalUpperBounds[2, ], c(34.373049, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results29$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results29$repeatedConfidenceIntervalUpperBounds[3, ], c(42.6632, 31.486561, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results29$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results29$repeatedPValues[1, ], c(0.18140284, 0.066412839, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results29$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results29$repeatedPValues[2, ], c(0.23027951, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results29$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results29$repeatedPValues[3, ], c(0.14242148, 0.013628025, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results29$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results29$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.268, 0.445), tolerance = 1e-06, label = paste0("c(", paste0(results29$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results29$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results29$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results29$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results29$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results29), NA))) + expect_output(print(results29)$show()) + invisible(capture.output(expect_error(summary(results29), NA))) + expect_output(summary(results29)$show()) + results29CodeBased <- eval(parse(text = getObjectRCode(results29, stringWrapParagraphWidth = NULL))) + expect_equal(results29CodeBased$thetaH1, results29$thetaH1, tolerance = 1e-06) + expect_equal(results29CodeBased$assumedStDevs, results29$assumedStDevs, tolerance = 1e-06) + expect_equal(results29CodeBased$conditionalRejectionProbabilities, results29$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results29CodeBased$repeatedConfidenceIntervalLowerBounds, results29$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results29CodeBased$repeatedConfidenceIntervalUpperBounds, results29$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results29CodeBased$repeatedPValues, results29$repeatedPValues, tolerance = 1e-06) + expect_equal(results29CodeBased$conditionalPowerSimulated, results29$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results29), "character") + df <- as.data.frame(results29) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results29) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results30 <- getAnalysisResults( + design = design2, dataInput = dataExample1, + intersectionTest = "Simes", varianceOption = "overallPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results30' with expected results + expect_equal(results30$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results30$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results30$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results30$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results30$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results30$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results30$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results30$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results30$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results30$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results30$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results30$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results30$conditionalRejectionProbabilities[1, ], c(0.023040094, 0.047419024, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results30$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results30$conditionalRejectionProbabilities[2, ], c(0.019613852, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results30$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results30$conditionalRejectionProbabilities[3, ], c(0.027708171, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results30$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results30$repeatedConfidenceIntervalLowerBounds[1, ], c(-11.74771, -4.6401767, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results30$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results30$repeatedConfidenceIntervalLowerBounds[2, ], c(-16.277631, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results30$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results30$repeatedConfidenceIntervalLowerBounds[3, ], c(-8.7851784, 0.25415362, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results30$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results30$repeatedConfidenceIntervalUpperBounds[1, ], c(41.74771, 27.425347, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results30$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results30$repeatedConfidenceIntervalUpperBounds[2, ], c(35.477631, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results30$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results30$repeatedConfidenceIntervalUpperBounds[3, ], c(43.785178, 31.856528, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results30$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results30$repeatedPValues[1, ], c(0.19020524, 0.071018123, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results30$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results30$repeatedPValues[2, ], c(0.23360401, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results30$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results30$repeatedPValues[3, ], c(0.1494882, 0.016474737, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results30$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results30$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.256, 0.433), tolerance = 1e-06, label = paste0("c(", paste0(results30$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results30$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results30$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results30$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results30$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results30), NA))) + expect_output(print(results30)$show()) + invisible(capture.output(expect_error(summary(results30), NA))) + expect_output(summary(results30)$show()) + results30CodeBased <- eval(parse(text = getObjectRCode(results30, stringWrapParagraphWidth = NULL))) + expect_equal(results30CodeBased$thetaH1, results30$thetaH1, tolerance = 1e-06) + expect_equal(results30CodeBased$assumedStDevs, results30$assumedStDevs, tolerance = 1e-06) + expect_equal(results30CodeBased$conditionalRejectionProbabilities, results30$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results30CodeBased$repeatedConfidenceIntervalLowerBounds, results30$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results30CodeBased$repeatedConfidenceIntervalUpperBounds, results30$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results30CodeBased$repeatedPValues, results30$repeatedPValues, tolerance = 1e-06) + expect_equal(results30CodeBased$conditionalPowerSimulated, results30$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results30), "character") + df <- as.data.frame(results30) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results30) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results31 <- getAnalysisResults( + design = design2, dataInput = dataExample1, + intersectionTest = "Simes", varianceOption = "pairwisePooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results31' with expected results + expect_equal(results31$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results31$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results31$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results31$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results31$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results31$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results31$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results31$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results31$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results31$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results31$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results31$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results31$conditionalRejectionProbabilities[1, ], c(0.024333354, 0.053095357, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results31$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results31$conditionalRejectionProbabilities[2, ], c(0.021915713, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results31$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results31$conditionalRejectionProbabilities[3, ], c(0.029264016, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results31$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results31$repeatedConfidenceIntervalLowerBounds[1, ], c(-10.389181, -4.1091853, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results31$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results31$repeatedConfidenceIntervalLowerBounds[2, ], c(-13.124586, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results31$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results31$repeatedConfidenceIntervalLowerBounds[3, ], c(-8.2617152, 0.37246523, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results31$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results31$repeatedConfidenceIntervalUpperBounds[1, ], c(40.389181, 26.847363, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results31$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results31$repeatedConfidenceIntervalUpperBounds[2, ], c(32.324586, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results31$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results31$repeatedConfidenceIntervalUpperBounds[3, ], c(43.261715, 31.705217, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results31$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results31$repeatedPValues[1, ], c(0.17721241, 0.063189426, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results31$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results31$repeatedPValues[2, ], c(0.20285189, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results31$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results31$repeatedPValues[3, ], c(0.13906265, 0.014376658, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results31$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results31$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.274, 0.453), tolerance = 1e-06, label = paste0("c(", paste0(results31$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results31$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results31$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results31$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results31$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results31), NA))) + expect_output(print(results31)$show()) + invisible(capture.output(expect_error(summary(results31), NA))) + expect_output(summary(results31)$show()) + results31CodeBased <- eval(parse(text = getObjectRCode(results31, stringWrapParagraphWidth = NULL))) + expect_equal(results31CodeBased$thetaH1, results31$thetaH1, tolerance = 1e-06) + expect_equal(results31CodeBased$assumedStDevs, results31$assumedStDevs, tolerance = 1e-06) + expect_equal(results31CodeBased$conditionalRejectionProbabilities, results31$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results31CodeBased$repeatedConfidenceIntervalLowerBounds, results31$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results31CodeBased$repeatedConfidenceIntervalUpperBounds, results31$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results31CodeBased$repeatedPValues, results31$repeatedPValues, tolerance = 1e-06) + expect_equal(results31CodeBased$conditionalPowerSimulated, results31$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results31), "character") + df <- as.data.frame(results31) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results31) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results32 <- getAnalysisResults( + design = design2, dataInput = dataExample1, + intersectionTest = "Simes", varianceOption = "pairwisePooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results32' with expected results + expect_equal(results32$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results32$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results32$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results32$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results32$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results32$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results32$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results32$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results32$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results32$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results32$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results32$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results32$conditionalRejectionProbabilities[1, ], c(0.02248882, 0.047009108, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results32$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results32$conditionalRejectionProbabilities[2, ], c(0.021309255, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results32$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results32$conditionalRejectionProbabilities[3, ], c(0.027044989, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results32$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results32$repeatedConfidenceIntervalLowerBounds[1, ], c(-12.972232, -4.7692163, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results32$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results32$repeatedConfidenceIntervalLowerBounds[2, ], c(-15.236237, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results32$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results32$repeatedConfidenceIntervalLowerBounds[3, ], c(-10.763995, -0.22335705, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results32$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results32$repeatedConfidenceIntervalUpperBounds[1, ], c(42.972232, 27.481288, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results32$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results32$repeatedConfidenceIntervalUpperBounds[2, ], c(34.436237, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results32$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results32$repeatedConfidenceIntervalUpperBounds[3, ], c(45.763994, 32.295837, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results32$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results32$repeatedPValues[1, ], c(0.19623626, 0.071653269, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results32$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results32$repeatedPValues[2, ], c(0.21026955, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results32$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results32$repeatedPValues[3, ], c(0.15433667, 0.019180306, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results32$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results32$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.256, 0.431), tolerance = 1e-06, label = paste0("c(", paste0(results32$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results32$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results32$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results32$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results32$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results32), NA))) + expect_output(print(results32)$show()) + invisible(capture.output(expect_error(summary(results32), NA))) + expect_output(summary(results32)$show()) + results32CodeBased <- eval(parse(text = getObjectRCode(results32, stringWrapParagraphWidth = NULL))) + expect_equal(results32CodeBased$thetaH1, results32$thetaH1, tolerance = 1e-06) + expect_equal(results32CodeBased$assumedStDevs, results32$assumedStDevs, tolerance = 1e-06) + expect_equal(results32CodeBased$conditionalRejectionProbabilities, results32$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results32CodeBased$repeatedConfidenceIntervalLowerBounds, results32$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results32CodeBased$repeatedConfidenceIntervalUpperBounds, results32$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results32CodeBased$repeatedPValues, results32$repeatedPValues, tolerance = 1e-06) + expect_equal(results32CodeBased$conditionalPowerSimulated, results32$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results32), "character") + df <- as.data.frame(results32) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results32) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results33 <- getAnalysisResults( + design = design2, dataInput = dataExample1, + intersectionTest = "Sidak", varianceOption = "notPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results33' with expected results + expect_equal(results33$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results33$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results33$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results33$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results33$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results33$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results33$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results33$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results33$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results33$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results33$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results33$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results33$conditionalRejectionProbabilities[1, ], c(0.025021019, 0.054834069, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results33$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results33$conditionalRejectionProbabilities[2, ], c(0.021871903, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results33$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results33$conditionalRejectionProbabilities[3, ], c(0.027777772, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results33$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results33$repeatedConfidenceIntervalLowerBounds[1, ], c(-10.247199, -4.0258193, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results33$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results33$repeatedConfidenceIntervalLowerBounds[2, ], c(-13.153418, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results33$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results33$repeatedConfidenceIntervalLowerBounds[3, ], c(-7.8986307, 0.47811558, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results33$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results33$repeatedConfidenceIntervalUpperBounds[1, ], c(40.247199, 26.680539, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results33$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results33$repeatedConfidenceIntervalUpperBounds[2, ], c(32.353418, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results33$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results33$repeatedConfidenceIntervalUpperBounds[3, ], c(42.898631, 31.584065, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results33$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results33$repeatedPValues[1, ], c(0.17089623, 0.061105652, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results33$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results33$repeatedPValues[2, ], c(0.20337355, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results33$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results33$repeatedPValues[3, ], c(0.14899419, 0.015246407, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results33$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results33$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.283, 0.454), tolerance = 1e-06, label = paste0("c(", paste0(results33$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results33$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results33$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results33$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results33$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results33), NA))) + expect_output(print(results33)$show()) + invisible(capture.output(expect_error(summary(results33), NA))) + expect_output(summary(results33)$show()) + results33CodeBased <- eval(parse(text = getObjectRCode(results33, stringWrapParagraphWidth = NULL))) + expect_equal(results33CodeBased$thetaH1, results33$thetaH1, tolerance = 1e-06) + expect_equal(results33CodeBased$assumedStDevs, results33$assumedStDevs, tolerance = 1e-06) + expect_equal(results33CodeBased$conditionalRejectionProbabilities, results33$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results33CodeBased$repeatedConfidenceIntervalLowerBounds, results33$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results33CodeBased$repeatedConfidenceIntervalUpperBounds, results33$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results33CodeBased$repeatedPValues, results33$repeatedPValues, tolerance = 1e-06) + expect_equal(results33CodeBased$conditionalPowerSimulated, results33$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results33), "character") + df <- as.data.frame(results33) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results33) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results34 <- getAnalysisResults( + design = design2, dataInput = dataExample1, + intersectionTest = "Sidak", varianceOption = "notPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results34' with expected results + expect_equal(results34$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results34$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results34$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results34$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results34$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results34$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results34$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results34$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results34$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results34$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results34$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results34$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results34$conditionalRejectionProbabilities[1, ], c(0.023144095, 0.048545015, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results34$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results34$conditionalRejectionProbabilities[2, ], c(0.021234311, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results34$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results34$conditionalRejectionProbabilities[3, ], c(0.0247006, 0.1449328, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results34$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results34$repeatedConfidenceIntervalLowerBounds[1, ], c(-12.8192, -4.6852584, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results34$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results34$repeatedConfidenceIntervalLowerBounds[2, ], c(-15.40635, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results34$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results34$repeatedConfidenceIntervalLowerBounds[3, ], c(-10.364486, -0.1144866, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results34$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results34$repeatedConfidenceIntervalUpperBounds[1, ], c(42.8192, 27.314543, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results34$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results34$repeatedConfidenceIntervalUpperBounds[2, ], c(34.60635, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results34$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results34$repeatedConfidenceIntervalUpperBounds[3, ], c(45.364486, 32.169333, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results34$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results34$repeatedPValues[1, ], c(0.18910184, 0.069324401, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results34$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results34$repeatedPValues[2, ], c(0.2112175, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results34$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results34$repeatedPValues[3, ], c(0.17379158, 0.021189694, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results34$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results34$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.26, 0.437), tolerance = 1e-06, label = paste0("c(", paste0(results34$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results34$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results34$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results34$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 0.66, 0.799), tolerance = 1e-06, label = paste0("c(", paste0(results34$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results34), NA))) + expect_output(print(results34)$show()) + invisible(capture.output(expect_error(summary(results34), NA))) + expect_output(summary(results34)$show()) + results34CodeBased <- eval(parse(text = getObjectRCode(results34, stringWrapParagraphWidth = NULL))) + expect_equal(results34CodeBased$thetaH1, results34$thetaH1, tolerance = 1e-06) + expect_equal(results34CodeBased$assumedStDevs, results34$assumedStDevs, tolerance = 1e-06) + expect_equal(results34CodeBased$conditionalRejectionProbabilities, results34$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results34CodeBased$repeatedConfidenceIntervalLowerBounds, results34$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results34CodeBased$repeatedConfidenceIntervalUpperBounds, results34$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results34CodeBased$repeatedPValues, results34$repeatedPValues, tolerance = 1e-06) + expect_equal(results34CodeBased$conditionalPowerSimulated, results34$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results34), "character") + df <- as.data.frame(results34) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results34) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results35 <- getAnalysisResults( + design = design2, dataInput = dataExample1, + intersectionTest = "Sidak", varianceOption = "overallPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results35' with expected results + expect_equal(results35$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results35$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results35$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results35$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results35$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results35$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results35$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results35$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results35$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results35$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results35$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results35$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results35$conditionalRejectionProbabilities[1, ], c(0.024319059, 0.051462476, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results35$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results35$conditionalRejectionProbabilities[2, ], c(0.019837849, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results35$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results35$conditionalRejectionProbabilities[3, ], c(0.028516214, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results35$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results35$repeatedConfidenceIntervalLowerBounds[1, ], c(-10.59688, -4.2407133, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results35$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results35$repeatedConfidenceIntervalLowerBounds[2, ], c(-15.164237, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results35$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results35$repeatedConfidenceIntervalLowerBounds[3, ], c(-7.6542489, 0.6529301, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results35$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results35$repeatedConfidenceIntervalUpperBounds[1, ], c(40.59688, 26.894985, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results35$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results35$repeatedConfidenceIntervalUpperBounds[2, ], c(34.364237, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results35$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results35$repeatedConfidenceIntervalUpperBounds[3, ], c(42.654249, 31.405859, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results35$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results35$repeatedPValues[1, ], c(0.17734783, 0.06527034, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results35$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results35$repeatedPValues[2, ], c(0.23027951, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results35$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results35$repeatedPValues[3, ], c(0.14391589, 0.013711948, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results35$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results35$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.271, 0.447), tolerance = 1e-06, label = paste0("c(", paste0(results35$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results35$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results35$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results35$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results35$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results35), NA))) + expect_output(print(results35)$show()) + invisible(capture.output(expect_error(summary(results35), NA))) + expect_output(summary(results35)$show()) + results35CodeBased <- eval(parse(text = getObjectRCode(results35, stringWrapParagraphWidth = NULL))) + expect_equal(results35CodeBased$thetaH1, results35$thetaH1, tolerance = 1e-06) + expect_equal(results35CodeBased$assumedStDevs, results35$assumedStDevs, tolerance = 1e-06) + expect_equal(results35CodeBased$conditionalRejectionProbabilities, results35$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results35CodeBased$repeatedConfidenceIntervalLowerBounds, results35$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results35CodeBased$repeatedConfidenceIntervalUpperBounds, results35$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results35CodeBased$repeatedPValues, results35$repeatedPValues, tolerance = 1e-06) + expect_equal(results35CodeBased$conditionalPowerSimulated, results35$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results35), "character") + df <- as.data.frame(results35) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results35) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results36 <- getAnalysisResults( + design = design2, dataInput = dataExample1, + intersectionTest = "Sidak", varianceOption = "overallPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results36' with expected results + expect_equal(results36$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results36$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results36$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results36$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results36$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results36$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results36$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results36$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results36$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results36$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results36$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results36$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results36$conditionalRejectionProbabilities[1, ], c(0.023469013, 0.048270226, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results36$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results36$conditionalRejectionProbabilities[2, ], c(0.019613852, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results36$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results36$conditionalRejectionProbabilities[3, ], c(0.026830382, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results36$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results36$repeatedConfidenceIntervalLowerBounds[1, ], c(-11.737451, -4.6050352, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results36$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results36$repeatedConfidenceIntervalLowerBounds[2, ], c(-16.267707, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results36$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results36$repeatedConfidenceIntervalLowerBounds[3, ], c(-8.7750975, 0.30217392, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results36$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results36$repeatedConfidenceIntervalUpperBounds[1, ], c(41.737451, 27.295819, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results36$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results36$repeatedConfidenceIntervalUpperBounds[2, ], c(35.467707, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results36$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results36$repeatedConfidenceIntervalUpperBounds[3, ], c(43.775098, 31.772829, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results36$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results36$repeatedPValues[1, ], c(0.18572393, 0.069730666, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results36$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results36$repeatedPValues[2, ], c(0.23360401, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results36$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results36$repeatedPValues[3, ], c(0.15596268, 0.017006886, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results36$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results36$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.26, 0.436), tolerance = 1e-06, label = paste0("c(", paste0(results36$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results36$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results36$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results36$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results36$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results36), NA))) + expect_output(print(results36)$show()) + invisible(capture.output(expect_error(summary(results36), NA))) + expect_output(summary(results36)$show()) + results36CodeBased <- eval(parse(text = getObjectRCode(results36, stringWrapParagraphWidth = NULL))) + expect_equal(results36CodeBased$thetaH1, results36$thetaH1, tolerance = 1e-06) + expect_equal(results36CodeBased$assumedStDevs, results36$assumedStDevs, tolerance = 1e-06) + expect_equal(results36CodeBased$conditionalRejectionProbabilities, results36$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results36CodeBased$repeatedConfidenceIntervalLowerBounds, results36$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results36CodeBased$repeatedConfidenceIntervalUpperBounds, results36$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results36CodeBased$repeatedPValues, results36$repeatedPValues, tolerance = 1e-06) + expect_equal(results36CodeBased$conditionalPowerSimulated, results36$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results36), "character") + df <- as.data.frame(results36) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results36) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results37 <- getAnalysisResults( + design = design2, dataInput = dataExample1, + intersectionTest = "Sidak", varianceOption = "pairwisePooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results37' with expected results + expect_equal(results37$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results37$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results37$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results37$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results37$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results37$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results37$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results37$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results37$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results37$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results37$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results37$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results37$conditionalRejectionProbabilities[1, ], c(0.024748593, 0.053966892, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results37$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results37$conditionalRejectionProbabilities[2, ], c(0.021915713, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results37$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results37$conditionalRejectionProbabilities[3, ], c(0.0267758, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results37$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results37$repeatedConfidenceIntervalLowerBounds[1, ], c(-10.38015, -4.0770639, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results37$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results37$repeatedConfidenceIntervalLowerBounds[2, ], c(-13.116502, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results37$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results37$repeatedConfidenceIntervalLowerBounds[3, ], c(-8.2525514, 0.41959343, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results37$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results37$repeatedConfidenceIntervalUpperBounds[1, ], c(40.38015, 26.720108, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results37$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results37$repeatedConfidenceIntervalUpperBounds[2, ], c(32.316502, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results37$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results37$repeatedConfidenceIntervalUpperBounds[3, ], c(43.252551, 31.62149, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results37$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results37$repeatedPValues[1, ], c(0.17335289, 0.062127989, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results37$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results37$repeatedPValues[2, ], c(0.20285189, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results37$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results37$repeatedPValues[3, ], c(0.15638134, 0.015781417, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results37$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results37$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.277, 0.453), tolerance = 1e-06, label = paste0("c(", paste0(results37$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results37$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results37$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results37$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results37$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results37), NA))) + expect_output(print(results37)$show()) + invisible(capture.output(expect_error(summary(results37), NA))) + expect_output(summary(results37)$show()) + results37CodeBased <- eval(parse(text = getObjectRCode(results37, stringWrapParagraphWidth = NULL))) + expect_equal(results37CodeBased$thetaH1, results37$thetaH1, tolerance = 1e-06) + expect_equal(results37CodeBased$assumedStDevs, results37$assumedStDevs, tolerance = 1e-06) + expect_equal(results37CodeBased$conditionalRejectionProbabilities, results37$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results37CodeBased$repeatedConfidenceIntervalLowerBounds, results37$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results37CodeBased$repeatedConfidenceIntervalUpperBounds, results37$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results37CodeBased$repeatedPValues, results37$repeatedPValues, tolerance = 1e-06) + expect_equal(results37CodeBased$conditionalPowerSimulated, results37$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results37), "character") + df <- as.data.frame(results37) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results37) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results38 <- getAnalysisResults( + design = design2, dataInput = dataExample1, + intersectionTest = "Sidak", varianceOption = "pairwisePooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results38' with expected results + expect_equal(results38$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results38$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results38$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results38$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results38$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results38$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results38$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results38$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results38$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results38$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results38$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results38$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results38$conditionalRejectionProbabilities[1, ], c(0.022923976, 0.04788638, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results38$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results38$conditionalRejectionProbabilities[2, ], c(0.021309255, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results38$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results38$conditionalRejectionProbabilities[3, ], c(0.023933809, 0.14146912, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results38$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results38$repeatedConfidenceIntervalLowerBounds[1, ], c(-12.960526, -4.7313117, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results38$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results38$repeatedConfidenceIntervalLowerBounds[2, ], c(-15.225975, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results38$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results38$repeatedConfidenceIntervalLowerBounds[3, ], c(-10.752245, -0.16953037, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results38$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results38$repeatedConfidenceIntervalUpperBounds[1, ], c(42.960526, 27.347242, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results38$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results38$repeatedConfidenceIntervalUpperBounds[2, ], c(34.425975, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results38$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results38$repeatedConfidenceIntervalUpperBounds[3, ], c(45.752245, 32.205007, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results38$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results38$repeatedPValues[1, ], c(0.19144883, 0.07030573, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results38$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results38$repeatedPValues[2, ], c(0.21026955, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results38$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results38$repeatedPValues[3, ], c(0.18106429, 0.021778109, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results38$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results38$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.259, 0.434), tolerance = 1e-06, label = paste0("c(", paste0(results38$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results38$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results38$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results38$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 0.656, 0.797), tolerance = 1e-06, label = paste0("c(", paste0(results38$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results38), NA))) + expect_output(print(results38)$show()) + invisible(capture.output(expect_error(summary(results38), NA))) + expect_output(summary(results38)$show()) + results38CodeBased <- eval(parse(text = getObjectRCode(results38, stringWrapParagraphWidth = NULL))) + expect_equal(results38CodeBased$thetaH1, results38$thetaH1, tolerance = 1e-06) + expect_equal(results38CodeBased$assumedStDevs, results38$assumedStDevs, tolerance = 1e-06) + expect_equal(results38CodeBased$conditionalRejectionProbabilities, results38$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results38CodeBased$repeatedConfidenceIntervalLowerBounds, results38$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results38CodeBased$repeatedConfidenceIntervalUpperBounds, results38$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results38CodeBased$repeatedPValues, results38$repeatedPValues, tolerance = 1e-06) + expect_equal(results38CodeBased$conditionalPowerSimulated, results38$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results38), "character") + df <- as.data.frame(results38) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results38) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results39 <- getAnalysisResults( + design = design2, dataInput = dataExample1, + intersectionTest = "Dunnett", varianceOption = "overallPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results39' with expected results + expect_equal(results39$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results39$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results39$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results39$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results39$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results39$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results39$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results39$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results39$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results39$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results39$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results39$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results39$conditionalRejectionProbabilities[1, ], c(0.026270241, 0.055429536, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results39$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results39$conditionalRejectionProbabilities[2, ], c(0.019837849, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results39$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results39$conditionalRejectionProbabilities[3, ], c(0.032007473, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results39$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results39$repeatedConfidenceIntervalLowerBounds[1, ], c(-10.308137, -3.9366921, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results39$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results39$repeatedConfidenceIntervalLowerBounds[2, ], c(-14.884887, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results39$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results39$repeatedConfidenceIntervalLowerBounds[3, ], c(-7.3704995, 0.96851041, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results39$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results39$repeatedConfidenceIntervalUpperBounds[1, ], c(40.308137, 26.527814, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results39$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results39$repeatedConfidenceIntervalUpperBounds[2, ], c(34.084887, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results39$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results39$repeatedConfidenceIntervalUpperBounds[3, ], c(42.370499, 31.063081, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results39$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results39$repeatedPValues[1, ], c(0.1603448, 0.060420915, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results39$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results39$repeatedPValues[2, ], c(0.23027951, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results39$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results39$repeatedPValues[3, ], c(0.12340907, 0.011635803, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results39$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results39$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.286, 0.457), tolerance = 1e-06, label = paste0("c(", paste0(results39$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results39$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results39$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results39$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results39$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results39), NA))) + expect_output(print(results39)$show()) + invisible(capture.output(expect_error(summary(results39), NA))) + expect_output(summary(results39)$show()) + results39CodeBased <- eval(parse(text = getObjectRCode(results39, stringWrapParagraphWidth = NULL))) + expect_equal(results39CodeBased$thetaH1, results39$thetaH1, tolerance = 1e-06) + expect_equal(results39CodeBased$assumedStDevs, results39$assumedStDevs, tolerance = 1e-06) + expect_equal(results39CodeBased$conditionalRejectionProbabilities, results39$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results39CodeBased$repeatedConfidenceIntervalLowerBounds, results39$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results39CodeBased$repeatedConfidenceIntervalUpperBounds, results39$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results39CodeBased$repeatedPValues, results39$repeatedPValues, tolerance = 1e-06) + expect_equal(results39CodeBased$conditionalPowerSimulated, results39$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results39), "character") + df <- as.data.frame(results39) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results39) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results40 <- getAnalysisResults( + design = design2, dataInput = dataExample1, + intersectionTest = "Dunnett", varianceOption = "overallPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results40' with expected results + expect_equal(results40$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results40$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results40$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results40$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results40$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results40$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results40$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results40$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results40$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results40$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results40$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results40$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results40$conditionalRejectionProbabilities[1, ], c(0.025452912, 0.052195908, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results40$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results40$conditionalRejectionProbabilities[2, ], c(0.019613852, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results40$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results40$conditionalRejectionProbabilities[3, ], c(0.030394861, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results40$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results40$repeatedConfidenceIntervalLowerBounds[1, ], c(-11.358826, -4.2590391, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results40$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results40$repeatedConfidenceIntervalLowerBounds[2, ], c(-15.901398, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results40$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results40$repeatedConfidenceIntervalLowerBounds[3, ], c(-8.4030195, 0.65705914, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results40$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results40$repeatedConfidenceIntervalUpperBounds[1, ], c(41.358826, 26.891429, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results40$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results40$repeatedConfidenceIntervalUpperBounds[2, ], c(35.101397, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results40$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results40$repeatedConfidenceIntervalUpperBounds[3, ], c(43.40302, 31.392896, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results40$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results40$repeatedPValues[1, ], c(0.16712065, 0.064319528, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results40$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results40$repeatedPValues[2, ], c(0.23360401, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results40$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results40$repeatedPValues[3, ], c(0.13222768, 0.014210719, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results40$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results40$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.272, 0.449), tolerance = 1e-06, label = paste0("c(", paste0(results40$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results40$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results40$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results40$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results40$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results40), NA))) + expect_output(print(results40)$show()) + invisible(capture.output(expect_error(summary(results40), NA))) + expect_output(summary(results40)$show()) + results40CodeBased <- eval(parse(text = getObjectRCode(results40, stringWrapParagraphWidth = NULL))) + expect_equal(results40CodeBased$thetaH1, results40$thetaH1, tolerance = 1e-06) + expect_equal(results40CodeBased$assumedStDevs, results40$assumedStDevs, tolerance = 1e-06) + expect_equal(results40CodeBased$conditionalRejectionProbabilities, results40$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results40CodeBased$repeatedConfidenceIntervalLowerBounds, results40$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results40CodeBased$repeatedConfidenceIntervalUpperBounds, results40$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results40CodeBased$repeatedPValues, results40$repeatedPValues, tolerance = 1e-06) + expect_equal(results40CodeBased$conditionalPowerSimulated, results40$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results40), "character") + df <- as.data.frame(results40) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results40) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results41 <- getAnalysisResults( + design = design3, dataInput = dataExample1, + intersectionTest = "Dunnett", varianceOption = "overallPooled", normalApproximation = TRUE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsConditionalDunnett object 'results41' with expected results + expect_equal(results41$thetaH1[1, ], 11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results41$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results41$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results41$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results41$thetaH1[3, ], 16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results41$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results41$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results41$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results41$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results41$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results41$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results41$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results41$conditionalRejectionProbabilities[1, ], c(NA_real_, 0.061352937), tolerance = 1e-05, label = paste0("c(", paste0(results41$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results41$conditionalRejectionProbabilities[2, ], c(NA_real_, 0.03744742), tolerance = 1e-06, label = paste0("c(", paste0(results41$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results41$conditionalRejectionProbabilities[3, ], c(NA_real_, 0.086511764), tolerance = 1e-06, label = paste0("c(", paste0(results41$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results41$conditionalPower[1, ], c(NA_real_, NA_real_), label = paste0("c(", paste0(results41$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results41$conditionalPower[2, ], c(NA_real_, NA_real_), label = paste0("c(", paste0(results41$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results41$conditionalPower[3, ], c(NA_real_, NA_real_), label = paste0("c(", paste0(results41$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results41$repeatedConfidenceIntervalLowerBounds[1, ], c(NA_real_, -0.72441408), tolerance = 1e-06, label = paste0("c(", paste0(results41$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results41$repeatedConfidenceIntervalLowerBounds[2, ], c(NA_real_, NA_real_), label = paste0("c(", paste0(results41$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results41$repeatedConfidenceIntervalLowerBounds[3, ], c(NA_real_, 3.9389155), tolerance = 1e-06, label = paste0("c(", paste0(results41$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results41$repeatedConfidenceIntervalUpperBounds[1, ], c(NA_real_, 22.538727), tolerance = 1e-06, label = paste0("c(", paste0(results41$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results41$repeatedConfidenceIntervalUpperBounds[2, ], c(NA_real_, NA_real_), label = paste0("c(", paste0(results41$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results41$repeatedConfidenceIntervalUpperBounds[3, ], c(NA_real_, 26.753532), tolerance = 1e-06, label = paste0("c(", paste0(results41$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results41$repeatedPValues[1, ], c(NA_real_, 0.017445576), tolerance = 1e-06, label = paste0("c(", paste0(results41$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results41$repeatedPValues[2, ], c(NA_real_, NA_real_), label = paste0("c(", paste0(results41$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results41$repeatedPValues[3, ], c(NA_real_, 0.0019493527), tolerance = 1e-06, label = paste0("c(", paste0(results41$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results41), NA))) + expect_output(print(results41)$show()) + invisible(capture.output(expect_error(summary(results41), NA))) + expect_output(summary(results41)$show()) + results41CodeBased <- eval(parse(text = getObjectRCode(results41, stringWrapParagraphWidth = NULL))) + expect_equal(results41CodeBased$thetaH1, results41$thetaH1, tolerance = 1e-06) + expect_equal(results41CodeBased$assumedStDevs, results41$assumedStDevs, tolerance = 1e-06) + expect_equal(results41CodeBased$conditionalRejectionProbabilities, results41$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results41CodeBased$conditionalPower, results41$conditionalPower, tolerance = 1e-06) + expect_equal(results41CodeBased$repeatedConfidenceIntervalLowerBounds, results41$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results41CodeBased$repeatedConfidenceIntervalUpperBounds, results41$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results41CodeBased$repeatedPValues, results41$repeatedPValues, tolerance = 1e-06) + expect_type(names(results41), "character") + df <- as.data.frame(results41) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results41) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results42 <- getAnalysisResults( + design = design1, dataInput = dataExample2, + intersectionTest = "Bonferroni", varianceOption = "notPooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results42' with expected results + expect_equal(results42$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results42$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results42$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results42$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results42$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results42$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results42$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results42$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results42$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results42$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results42$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results42$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results42$conditionalRejectionProbabilities[1, ], c(0.043739576, 0.16022367, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results42$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results42$conditionalRejectionProbabilities[2, ], c(0.03844608, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results42$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results42$conditionalRejectionProbabilities[3, ], c(0.048616927, 0.34001465, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results42$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results42$conditionalPower[1, ], c(NA_real_, NA_real_, 0.45838936, 0.70196346), tolerance = 1e-06, label = paste0("c(", paste0(results42$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results42$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results42$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results42$conditionalPower[3, ], c(NA_real_, NA_real_, 0.827255, 0.9465652), tolerance = 1e-06, label = paste0("c(", paste0(results42$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results42$repeatedConfidenceIntervalLowerBounds[1, ], c(-44.395028, -27.895908, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results42$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results42$repeatedConfidenceIntervalLowerBounds[2, ], c(-36.091548, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results42$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results42$repeatedConfidenceIntervalLowerBounds[3, ], c(-47.071339, -32.285152, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results42$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results42$repeatedConfidenceIntervalUpperBounds[1, ], c(14.395028, 4.0669228, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results42$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results42$repeatedConfidenceIntervalUpperBounds[2, ], c(16.891548, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results42$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results42$repeatedConfidenceIntervalUpperBounds[3, ], c(12.071338, -0.24153969, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results42$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results42$repeatedPValues[1, ], c(0.5, 0.072888275, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results42$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results42$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results42$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results42$repeatedPValues[3, ], c(0.5, 0.017155659, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results42$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results42), NA))) + expect_output(print(results42)$show()) + invisible(capture.output(expect_error(summary(results42), NA))) + expect_output(summary(results42)$show()) + results42CodeBased <- eval(parse(text = getObjectRCode(results42, stringWrapParagraphWidth = NULL))) + expect_equal(results42CodeBased$thetaH1, results42$thetaH1, tolerance = 1e-06) + expect_equal(results42CodeBased$assumedStDevs, results42$assumedStDevs, tolerance = 1e-06) + expect_equal(results42CodeBased$conditionalRejectionProbabilities, results42$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results42CodeBased$conditionalPower, results42$conditionalPower, tolerance = 1e-06) + expect_equal(results42CodeBased$repeatedConfidenceIntervalLowerBounds, results42$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results42CodeBased$repeatedConfidenceIntervalUpperBounds, results42$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results42CodeBased$repeatedPValues, results42$repeatedPValues, tolerance = 1e-06) + expect_type(names(results42), "character") + df <- as.data.frame(results42) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results42) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results43 <- getAnalysisResults( + design = design1, dataInput = dataExample2, + intersectionTest = "Bonferroni", varianceOption = "notPooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results43' with expected results + expect_equal(results43$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results43$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results43$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results43$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results43$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results43$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results43$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results43$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results43$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results43$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results43$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results43$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results43$conditionalRejectionProbabilities[1, ], c(0.040100206, 0.14400686, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results43$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results43$conditionalRejectionProbabilities[2, ], c(0.037171319, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results43$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results43$conditionalRejectionProbabilities[3, ], c(0.042866371, 0.28890175, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results43$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results43$conditionalPower[1, ], c(NA_real_, NA_real_, 0.42767622, 0.67947129), tolerance = 1e-06, label = paste0("c(", paste0(results43$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results43$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results43$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results43$conditionalPower[3, ], c(NA_real_, NA_real_, 0.78417464, 0.93070164), tolerance = 1e-06, label = paste0("c(", paste0(results43$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results43$repeatedConfidenceIntervalLowerBounds[1, ], c(-48.433726, -28.584393, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results43$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results43$repeatedConfidenceIntervalLowerBounds[2, ], c(-39.626743, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results43$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results43$repeatedConfidenceIntervalLowerBounds[3, ], c(-50.938808, -32.927366, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results43$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results43$repeatedConfidenceIntervalUpperBounds[1, ], c(18.433726, 4.7641755, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results43$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results43$repeatedConfidenceIntervalUpperBounds[2, ], c(20.426743, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results43$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results43$repeatedConfidenceIntervalUpperBounds[3, ], c(15.938808, 0.40329832, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results43$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results43$repeatedPValues[1, ], c(0.5, 0.085188742, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results43$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results43$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results43$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results43$repeatedPValues[3, ], c(0.5, 0.025112148, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results43$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results43), NA))) + expect_output(print(results43)$show()) + invisible(capture.output(expect_error(summary(results43), NA))) + expect_output(summary(results43)$show()) + results43CodeBased <- eval(parse(text = getObjectRCode(results43, stringWrapParagraphWidth = NULL))) + expect_equal(results43CodeBased$thetaH1, results43$thetaH1, tolerance = 1e-06) + expect_equal(results43CodeBased$assumedStDevs, results43$assumedStDevs, tolerance = 1e-06) + expect_equal(results43CodeBased$conditionalRejectionProbabilities, results43$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results43CodeBased$conditionalPower, results43$conditionalPower, tolerance = 1e-06) + expect_equal(results43CodeBased$repeatedConfidenceIntervalLowerBounds, results43$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results43CodeBased$repeatedConfidenceIntervalUpperBounds, results43$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results43CodeBased$repeatedPValues, results43$repeatedPValues, tolerance = 1e-06) + expect_type(names(results43), "character") + df <- as.data.frame(results43) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results43) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results44 <- getAnalysisResults( + design = design1, dataInput = dataExample2, + intersectionTest = "Bonferroni", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results44' with expected results + expect_equal(results44$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results44$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results44$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results44$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results44$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results44$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results44$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results44$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results44$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results44$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results44$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results44$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results44$conditionalRejectionProbabilities[1, ], c(0.042394596, 0.15198143, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results44$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results44$conditionalRejectionProbabilities[2, ], c(0.034321105, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results44$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results44$conditionalRejectionProbabilities[3, ], c(0.049947129, 0.35588618, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results44$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results44$conditionalPower[1, ], c(NA_real_, NA_real_, 0.44302928, 0.69082025), tolerance = 1e-06, label = paste0("c(", paste0(results44$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results44$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results44$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results44$conditionalPower[3, ], c(NA_real_, NA_real_, 0.83889182, 0.95069292), tolerance = 1e-06, label = paste0("c(", paste0(results44$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results44$repeatedConfidenceIntervalLowerBounds[1, ], c(-44.802158, -28.113845, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results44$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results44$repeatedConfidenceIntervalLowerBounds[2, ], c(-38.432721, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results44$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results44$repeatedConfidenceIntervalLowerBounds[3, ], c(-46.786808, -32.10754, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results44$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results44$repeatedConfidenceIntervalUpperBounds[1, ], c(14.802158, 4.2854677, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results44$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results44$repeatedConfidenceIntervalUpperBounds[2, ], c(19.232721, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results44$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results44$repeatedConfidenceIntervalUpperBounds[3, ], c(11.786808, -0.41764226, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results44$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results44$repeatedPValues[1, ], c(0.5, 0.078823932, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results44$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results44$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results44$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results44$repeatedPValues[3, ], c(0.5, 0.015272156, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results44$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results44), NA))) + expect_output(print(results44)$show()) + invisible(capture.output(expect_error(summary(results44), NA))) + expect_output(summary(results44)$show()) + results44CodeBased <- eval(parse(text = getObjectRCode(results44, stringWrapParagraphWidth = NULL))) + expect_equal(results44CodeBased$thetaH1, results44$thetaH1, tolerance = 1e-06) + expect_equal(results44CodeBased$assumedStDevs, results44$assumedStDevs, tolerance = 1e-06) + expect_equal(results44CodeBased$conditionalRejectionProbabilities, results44$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results44CodeBased$conditionalPower, results44$conditionalPower, tolerance = 1e-06) + expect_equal(results44CodeBased$repeatedConfidenceIntervalLowerBounds, results44$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results44CodeBased$repeatedConfidenceIntervalUpperBounds, results44$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results44CodeBased$repeatedPValues, results44$repeatedPValues, tolerance = 1e-06) + expect_type(names(results44), "character") + df <- as.data.frame(results44) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results44) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results45 <- getAnalysisResults( + design = design1, dataInput = dataExample2, + intersectionTest = "Bonferroni", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results45' with expected results + expect_equal(results45$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results45$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results45$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results45$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results45$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results45$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results45$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results45$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results45$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results45$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results45$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results45$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results45$conditionalRejectionProbabilities[1, ], c(0.040740209, 0.14372404, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results45$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results45$conditionalRejectionProbabilities[2, ], c(0.033856262, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results45$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results45$conditionalRejectionProbabilities[3, ], c(0.046882975, 0.32321322, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results45$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results45$conditionalPower[1, ], c(NA_real_, NA_real_, 0.42712247, 0.6790579), tolerance = 1e-06, label = paste0("c(", paste0(results45$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results45$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results45$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results45$conditionalPower[3, ], c(NA_real_, NA_real_, 0.81409137, 0.94181531), tolerance = 1e-06, label = paste0("c(", paste0(results45$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results45$repeatedConfidenceIntervalLowerBounds[1, ], c(-46.567569, -28.528695, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results45$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results45$repeatedConfidenceIntervalLowerBounds[2, ], c(-40.140706, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results45$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results45$repeatedConfidenceIntervalLowerBounds[3, ], c(-48.521691, -32.491814, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results45$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results45$repeatedConfidenceIntervalUpperBounds[1, ], c(16.567569, 4.662798, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results45$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results45$repeatedConfidenceIntervalUpperBounds[2, ], c(20.940706, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results45$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results45$repeatedConfidenceIntervalUpperBounds[3, ], c(13.521691, -0.049006969, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results45$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results45$repeatedPValues[1, ], c(0.5, 0.08542716, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results45$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results45$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results45$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results45$repeatedPValues[3, ], c(0.5, 0.019420631, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results45$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results45), NA))) + expect_output(print(results45)$show()) + invisible(capture.output(expect_error(summary(results45), NA))) + expect_output(summary(results45)$show()) + results45CodeBased <- eval(parse(text = getObjectRCode(results45, stringWrapParagraphWidth = NULL))) + expect_equal(results45CodeBased$thetaH1, results45$thetaH1, tolerance = 1e-06) + expect_equal(results45CodeBased$assumedStDevs, results45$assumedStDevs, tolerance = 1e-06) + expect_equal(results45CodeBased$conditionalRejectionProbabilities, results45$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results45CodeBased$conditionalPower, results45$conditionalPower, tolerance = 1e-06) + expect_equal(results45CodeBased$repeatedConfidenceIntervalLowerBounds, results45$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results45CodeBased$repeatedConfidenceIntervalUpperBounds, results45$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results45CodeBased$repeatedPValues, results45$repeatedPValues, tolerance = 1e-06) + expect_type(names(results45), "character") + df <- as.data.frame(results45) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results45) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results46 <- getAnalysisResults( + design = design1, dataInput = dataExample2, + intersectionTest = "Bonferroni", varianceOption = "pairwisePooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results46' with expected results + expect_equal(results46$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results46$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results46$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results46$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results46$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results46$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results46$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results46$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results46$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results46$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results46$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results46$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results46$conditionalRejectionProbabilities[1, ], c(0.043219831, 0.15803856, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results46$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results46$conditionalRejectionProbabilities[2, ], c(0.038533075, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results46$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results46$conditionalRejectionProbabilities[3, ], c(0.046782116, 0.33290332, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results46$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results46$conditionalPower[1, ], c(NA_real_, NA_real_, 0.45436587, 0.6990644), tolerance = 1e-06, label = paste0("c(", paste0(results46$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results46$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results46$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results46$conditionalPower[3, ], c(NA_real_, NA_real_, 0.8217936, 0.94460493), tolerance = 1e-06, label = paste0("c(", paste0(results46$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results46$repeatedConfidenceIntervalLowerBounds[1, ], c(-44.549821, -27.945069, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results46$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results46$repeatedConfidenceIntervalLowerBounds[2, ], c(-36.048567, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results46$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results46$repeatedConfidenceIntervalLowerBounds[3, ], c(-47.483405, -32.356999, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results46$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results46$repeatedConfidenceIntervalUpperBounds[1, ], c(14.549821, 4.1213996, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results46$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results46$repeatedConfidenceIntervalUpperBounds[2, ], c(16.848567, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results46$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results46$repeatedConfidenceIntervalUpperBounds[3, ], c(12.483405, -0.16013976, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results46$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results46$repeatedPValues[1, ], c(0.5, 0.07440366, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results46$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results46$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results46$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results46$repeatedPValues[3, ], c(0.5, 0.018077861, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results46$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results46), NA))) + expect_output(print(results46)$show()) + invisible(capture.output(expect_error(summary(results46), NA))) + expect_output(summary(results46)$show()) + results46CodeBased <- eval(parse(text = getObjectRCode(results46, stringWrapParagraphWidth = NULL))) + expect_equal(results46CodeBased$thetaH1, results46$thetaH1, tolerance = 1e-06) + expect_equal(results46CodeBased$assumedStDevs, results46$assumedStDevs, tolerance = 1e-06) + expect_equal(results46CodeBased$conditionalRejectionProbabilities, results46$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results46CodeBased$conditionalPower, results46$conditionalPower, tolerance = 1e-06) + expect_equal(results46CodeBased$repeatedConfidenceIntervalLowerBounds, results46$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results46CodeBased$repeatedConfidenceIntervalUpperBounds, results46$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results46CodeBased$repeatedPValues, results46$repeatedPValues, tolerance = 1e-06) + expect_type(names(results46), "character") + df <- as.data.frame(results46) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results46) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results47 <- getAnalysisResults( + design = design1, dataInput = dataExample2, + intersectionTest = "Bonferroni", varianceOption = "pairwisePooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results47' with expected results + expect_equal(results47$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results47$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results47$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results47$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results47$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results47$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results47$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results47$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results47$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results47$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results47$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results47$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results47$conditionalRejectionProbabilities[1, ], c(0.039664178, 0.14221619, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results47$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results47$conditionalRejectionProbabilities[2, ], c(0.037322005, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results47$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results47$conditionalRejectionProbabilities[3, ], c(0.041377736, 0.28315003, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results47$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results47$conditionalPower[1, ], c(NA_real_, NA_real_, 0.42415922, 0.67684078), tolerance = 1e-06, label = paste0("c(", paste0(results47$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results47$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results47$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results47$conditionalPower[3, ], c(NA_real_, NA_real_, 0.77871789, 0.92862656), tolerance = 1e-06, label = paste0("c(", paste0(results47$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results47$repeatedConfidenceIntervalLowerBounds[1, ], c(-48.601467, -28.627869, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results47$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results47$repeatedConfidenceIntervalLowerBounds[2, ], c(-39.353637, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results47$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results47$repeatedConfidenceIntervalLowerBounds[3, ], c(-51.403927, -32.999307, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results47$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results47$repeatedConfidenceIntervalUpperBounds[1, ], c(18.601467, 4.8144337, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results47$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results47$repeatedConfidenceIntervalUpperBounds[2, ], c(20.153637, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results47$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results47$repeatedConfidenceIntervalUpperBounds[3, ], c(16.403927, 0.48327212, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results47$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results47$repeatedPValues[1, ], c(0.5, 0.086711756, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results47$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results47$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results47$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results47$repeatedPValues[3, ], c(0.5, 0.026234621, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results47$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results47), NA))) + expect_output(print(results47)$show()) + invisible(capture.output(expect_error(summary(results47), NA))) + expect_output(summary(results47)$show()) + results47CodeBased <- eval(parse(text = getObjectRCode(results47, stringWrapParagraphWidth = NULL))) + expect_equal(results47CodeBased$thetaH1, results47$thetaH1, tolerance = 1e-06) + expect_equal(results47CodeBased$assumedStDevs, results47$assumedStDevs, tolerance = 1e-06) + expect_equal(results47CodeBased$conditionalRejectionProbabilities, results47$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results47CodeBased$conditionalPower, results47$conditionalPower, tolerance = 1e-06) + expect_equal(results47CodeBased$repeatedConfidenceIntervalLowerBounds, results47$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results47CodeBased$repeatedConfidenceIntervalUpperBounds, results47$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results47CodeBased$repeatedPValues, results47$repeatedPValues, tolerance = 1e-06) + expect_type(names(results47), "character") + df <- as.data.frame(results47) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results47) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results48 <- getAnalysisResults( + design = design1, dataInput = dataExample2, + intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results48' with expected results + expect_equal(results48$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results48$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results48$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results48$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results48$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results48$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results48$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results48$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results48$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results48$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results48$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results48$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results48$conditionalRejectionProbabilities[1, ], c(0.043739576, 0.16022367, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results48$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results48$conditionalRejectionProbabilities[2, ], c(0.03844608, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results48$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results48$conditionalRejectionProbabilities[3, ], c(0.052717287, 0.35672949, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results48$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results48$conditionalPower[1, ], c(NA_real_, NA_real_, 0.45838936, 0.70196346), tolerance = 1e-06, label = paste0("c(", paste0(results48$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results48$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results48$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results48$conditionalPower[3, ], c(NA_real_, NA_real_, 0.83948961, 0.95090316), tolerance = 1e-06, label = paste0("c(", paste0(results48$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results48$repeatedConfidenceIntervalLowerBounds[1, ], c(-44.395028, -27.895908, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results48$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results48$repeatedConfidenceIntervalLowerBounds[2, ], c(-36.091548, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results48$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results48$repeatedConfidenceIntervalLowerBounds[3, ], c(-47.071339, -32.285152, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results48$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results48$repeatedConfidenceIntervalUpperBounds[1, ], c(14.395028, 4.0669228, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results48$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results48$repeatedConfidenceIntervalUpperBounds[2, ], c(16.891548, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results48$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results48$repeatedConfidenceIntervalUpperBounds[3, ], c(12.071338, -0.24153969, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results48$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results48$repeatedPValues[1, ], c(0.5, 0.072888275, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results48$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results48$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results48$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results48$repeatedPValues[3, ], c(0.5, 0.015177743, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results48$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results48), NA))) + expect_output(print(results48)$show()) + invisible(capture.output(expect_error(summary(results48), NA))) + expect_output(summary(results48)$show()) + results48CodeBased <- eval(parse(text = getObjectRCode(results48, stringWrapParagraphWidth = NULL))) + expect_equal(results48CodeBased$thetaH1, results48$thetaH1, tolerance = 1e-06) + expect_equal(results48CodeBased$assumedStDevs, results48$assumedStDevs, tolerance = 1e-06) + expect_equal(results48CodeBased$conditionalRejectionProbabilities, results48$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results48CodeBased$conditionalPower, results48$conditionalPower, tolerance = 1e-06) + expect_equal(results48CodeBased$repeatedConfidenceIntervalLowerBounds, results48$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results48CodeBased$repeatedConfidenceIntervalUpperBounds, results48$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results48CodeBased$repeatedPValues, results48$repeatedPValues, tolerance = 1e-06) + expect_type(names(results48), "character") + df <- as.data.frame(results48) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results48) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results49 <- getAnalysisResults( + design = design1, dataInput = dataExample2, + intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results49' with expected results + expect_equal(results49$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results49$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results49$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results49$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results49$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results49$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results49$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results49$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results49$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results49$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results49$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results49$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results49$conditionalRejectionProbabilities[1, ], c(0.040100206, 0.14400686, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results49$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results49$conditionalRejectionProbabilities[2, ], c(0.037171319, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results49$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results49$conditionalRejectionProbabilities[3, ], c(0.048708233, 0.3133215, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results49$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results49$conditionalPower[1, ], c(NA_real_, NA_real_, 0.42767622, 0.67947129), tolerance = 1e-06, label = paste0("c(", paste0(results49$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results49$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results49$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results49$conditionalPower[3, ], c(NA_real_, NA_real_, 0.80590445, 0.93881804), tolerance = 1e-06, label = paste0("c(", paste0(results49$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results49$repeatedConfidenceIntervalLowerBounds[1, ], c(-48.433726, -28.584393, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results49$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results49$repeatedConfidenceIntervalLowerBounds[2, ], c(-39.626743, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results49$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results49$repeatedConfidenceIntervalLowerBounds[3, ], c(-50.938808, -32.927366, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results49$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results49$repeatedConfidenceIntervalUpperBounds[1, ], c(18.433726, 4.7641755, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results49$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results49$repeatedConfidenceIntervalUpperBounds[2, ], c(20.426743, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results49$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results49$repeatedConfidenceIntervalUpperBounds[3, ], c(15.938808, 0.40329832, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results49$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results49$repeatedPValues[1, ], c(0.5, 0.085188742, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results49$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results49$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results49$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results49$repeatedPValues[3, ], c(0.5, 0.020901685, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results49$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results49), NA))) + expect_output(print(results49)$show()) + invisible(capture.output(expect_error(summary(results49), NA))) + expect_output(summary(results49)$show()) + results49CodeBased <- eval(parse(text = getObjectRCode(results49, stringWrapParagraphWidth = NULL))) + expect_equal(results49CodeBased$thetaH1, results49$thetaH1, tolerance = 1e-06) + expect_equal(results49CodeBased$assumedStDevs, results49$assumedStDevs, tolerance = 1e-06) + expect_equal(results49CodeBased$conditionalRejectionProbabilities, results49$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results49CodeBased$conditionalPower, results49$conditionalPower, tolerance = 1e-06) + expect_equal(results49CodeBased$repeatedConfidenceIntervalLowerBounds, results49$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results49CodeBased$repeatedConfidenceIntervalUpperBounds, results49$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results49CodeBased$repeatedPValues, results49$repeatedPValues, tolerance = 1e-06) + expect_type(names(results49), "character") + df <- as.data.frame(results49) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results49) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results50 <- getAnalysisResults( + design = design1, dataInput = dataExample2, + intersectionTest = "Simes", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results50' with expected results + expect_equal(results50$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results50$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results50$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results50$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results50$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results50$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results50$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results50$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results50$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results50$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results50$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results50$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results50$conditionalRejectionProbabilities[1, ], c(0.042394596, 0.15198143, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results50$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results50$conditionalRejectionProbabilities[2, ], c(0.034321105, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results50$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results50$conditionalRejectionProbabilities[3, ], c(0.051237296, 0.36121246, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results50$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results50$conditionalPower[1, ], c(NA_real_, NA_real_, 0.44302928, 0.69082025), tolerance = 1e-06, label = paste0("c(", paste0(results50$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results50$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results50$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results50$conditionalPower[3, ], c(NA_real_, NA_real_, 0.84263383, 0.95200602), tolerance = 1e-06, label = paste0("c(", paste0(results50$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results50$repeatedConfidenceIntervalLowerBounds[1, ], c(-44.802158, -28.113845, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results50$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results50$repeatedConfidenceIntervalLowerBounds[2, ], c(-38.432721, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results50$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results50$repeatedConfidenceIntervalLowerBounds[3, ], c(-46.786808, -32.10754, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results50$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results50$repeatedConfidenceIntervalUpperBounds[1, ], c(14.802158, 4.2854677, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results50$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results50$repeatedConfidenceIntervalUpperBounds[2, ], c(19.232721, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results50$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results50$repeatedConfidenceIntervalUpperBounds[3, ], c(11.786808, -0.41764226, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results50$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results50$repeatedPValues[1, ], c(0.5, 0.078823932, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results50$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results50$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results50$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results50$repeatedPValues[3, ], c(0.5, 0.014689462, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results50$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results50), NA))) + expect_output(print(results50)$show()) + invisible(capture.output(expect_error(summary(results50), NA))) + expect_output(summary(results50)$show()) + results50CodeBased <- eval(parse(text = getObjectRCode(results50, stringWrapParagraphWidth = NULL))) + expect_equal(results50CodeBased$thetaH1, results50$thetaH1, tolerance = 1e-06) + expect_equal(results50CodeBased$assumedStDevs, results50$assumedStDevs, tolerance = 1e-06) + expect_equal(results50CodeBased$conditionalRejectionProbabilities, results50$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results50CodeBased$conditionalPower, results50$conditionalPower, tolerance = 1e-06) + expect_equal(results50CodeBased$repeatedConfidenceIntervalLowerBounds, results50$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results50CodeBased$repeatedConfidenceIntervalUpperBounds, results50$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results50CodeBased$repeatedPValues, results50$repeatedPValues, tolerance = 1e-06) + expect_type(names(results50), "character") + df <- as.data.frame(results50) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results50) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results51 <- getAnalysisResults( + design = design1, dataInput = dataExample2, + intersectionTest = "Simes", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results51' with expected results + expect_equal(results51$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results51$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results51$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results51$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results51$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results51$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results51$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results51$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results51$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results51$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results51$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results51$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results51$conditionalRejectionProbabilities[1, ], c(0.040740209, 0.14372404, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results51$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results51$conditionalRejectionProbabilities[2, ], c(0.033856262, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results51$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results51$conditionalRejectionProbabilities[3, ], c(0.049414261, 0.33374326, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results51$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results51$conditionalPower[1, ], c(NA_real_, NA_real_, 0.42712247, 0.6790579), tolerance = 1e-06, label = paste0("c(", paste0(results51$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results51$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results51$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results51$conditionalPower[3, ], c(NA_real_, NA_real_, 0.82244694, 0.94484021), tolerance = 1e-06, label = paste0("c(", paste0(results51$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results51$repeatedConfidenceIntervalLowerBounds[1, ], c(-46.567569, -28.528695, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results51$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results51$repeatedConfidenceIntervalLowerBounds[2, ], c(-40.140706, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results51$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results51$repeatedConfidenceIntervalLowerBounds[3, ], c(-48.521691, -32.491814, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results51$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results51$repeatedConfidenceIntervalUpperBounds[1, ], c(16.567569, 4.662798, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results51$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results51$repeatedConfidenceIntervalUpperBounds[2, ], c(20.940706, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results51$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results51$repeatedConfidenceIntervalUpperBounds[3, ], c(13.521691, -0.049006969, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results51$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results51$repeatedPValues[1, ], c(0.5, 0.08542716, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results51$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results51$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results51$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results51$repeatedPValues[3, ], c(0.5, 0.017966281, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results51$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results51), NA))) + expect_output(print(results51)$show()) + invisible(capture.output(expect_error(summary(results51), NA))) + expect_output(summary(results51)$show()) + results51CodeBased <- eval(parse(text = getObjectRCode(results51, stringWrapParagraphWidth = NULL))) + expect_equal(results51CodeBased$thetaH1, results51$thetaH1, tolerance = 1e-06) + expect_equal(results51CodeBased$assumedStDevs, results51$assumedStDevs, tolerance = 1e-06) + expect_equal(results51CodeBased$conditionalRejectionProbabilities, results51$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results51CodeBased$conditionalPower, results51$conditionalPower, tolerance = 1e-06) + expect_equal(results51CodeBased$repeatedConfidenceIntervalLowerBounds, results51$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results51CodeBased$repeatedConfidenceIntervalUpperBounds, results51$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results51CodeBased$repeatedPValues, results51$repeatedPValues, tolerance = 1e-06) + expect_type(names(results51), "character") + df <- as.data.frame(results51) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results51) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results52 <- getAnalysisResults( + design = design1, dataInput = dataExample2, + intersectionTest = "Simes", varianceOption = "pairwisePooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results52' with expected results + expect_equal(results52$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results52$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results52$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results52$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results52$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results52$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results52$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results52$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results52$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results52$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results52$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results52$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results52$conditionalRejectionProbabilities[1, ], c(0.043219831, 0.15803856, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results52$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results52$conditionalRejectionProbabilities[2, ], c(0.038533075, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results52$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results52$conditionalRejectionProbabilities[3, ], c(0.052145589, 0.35513472, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results52$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results52$conditionalPower[1, ], c(NA_real_, NA_real_, 0.45436587, 0.6990644), tolerance = 1e-06, label = paste0("c(", paste0(results52$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results52$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results52$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results52$conditionalPower[3, ], c(NA_real_, NA_real_, 0.83835744, 0.95050484), tolerance = 1e-06, label = paste0("c(", paste0(results52$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results52$repeatedConfidenceIntervalLowerBounds[1, ], c(-44.549821, -27.945069, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results52$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results52$repeatedConfidenceIntervalLowerBounds[2, ], c(-36.048567, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results52$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results52$repeatedConfidenceIntervalLowerBounds[3, ], c(-47.483405, -32.356999, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results52$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results52$repeatedConfidenceIntervalUpperBounds[1, ], c(14.549821, 4.1213996, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results52$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results52$repeatedConfidenceIntervalUpperBounds[2, ], c(16.848567, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results52$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results52$repeatedConfidenceIntervalUpperBounds[3, ], c(12.483405, -0.16013976, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results52$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results52$repeatedPValues[1, ], c(0.5, 0.07440366, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results52$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results52$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results52$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results52$repeatedPValues[3, ], c(0.5, 0.015356079, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results52$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results52), NA))) + expect_output(print(results52)$show()) + invisible(capture.output(expect_error(summary(results52), NA))) + expect_output(summary(results52)$show()) + results52CodeBased <- eval(parse(text = getObjectRCode(results52, stringWrapParagraphWidth = NULL))) + expect_equal(results52CodeBased$thetaH1, results52$thetaH1, tolerance = 1e-06) + expect_equal(results52CodeBased$assumedStDevs, results52$assumedStDevs, tolerance = 1e-06) + expect_equal(results52CodeBased$conditionalRejectionProbabilities, results52$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results52CodeBased$conditionalPower, results52$conditionalPower, tolerance = 1e-06) + expect_equal(results52CodeBased$repeatedConfidenceIntervalLowerBounds, results52$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results52CodeBased$repeatedConfidenceIntervalUpperBounds, results52$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results52CodeBased$repeatedPValues, results52$repeatedPValues, tolerance = 1e-06) + expect_type(names(results52), "character") + df <- as.data.frame(results52) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results52) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results53 <- getAnalysisResults( + design = design1, dataInput = dataExample2, + intersectionTest = "Simes", varianceOption = "pairwisePooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results53' with expected results + expect_equal(results53$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results53$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results53$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results53$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results53$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results53$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results53$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results53$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results53$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results53$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results53$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results53$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results53$conditionalRejectionProbabilities[1, ], c(0.039664178, 0.14221619, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results53$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results53$conditionalRejectionProbabilities[2, ], c(0.037322005, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results53$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results53$conditionalRejectionProbabilities[3, ], c(0.048226966, 0.31219358, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results53$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results53$conditionalPower[1, ], c(NA_real_, NA_real_, 0.42415922, 0.67684078), tolerance = 1e-06, label = paste0("c(", paste0(results53$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results53$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results53$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results53$conditionalPower[3, ], c(NA_real_, NA_real_, 0.80494934, 0.93846621), tolerance = 1e-06, label = paste0("c(", paste0(results53$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results53$repeatedConfidenceIntervalLowerBounds[1, ], c(-48.601467, -28.627869, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results53$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results53$repeatedConfidenceIntervalLowerBounds[2, ], c(-39.353637, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results53$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results53$repeatedConfidenceIntervalLowerBounds[3, ], c(-51.403927, -32.999307, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results53$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results53$repeatedConfidenceIntervalUpperBounds[1, ], c(18.601467, 4.8144337, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results53$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results53$repeatedConfidenceIntervalUpperBounds[2, ], c(20.153637, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results53$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results53$repeatedConfidenceIntervalUpperBounds[3, ], c(16.403927, 0.48327212, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results53$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results53$repeatedPValues[1, ], c(0.5, 0.086711756, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results53$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results53$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results53$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results53$repeatedPValues[3, ], c(0.5, 0.021078114, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results53$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results53), NA))) + expect_output(print(results53)$show()) + invisible(capture.output(expect_error(summary(results53), NA))) + expect_output(summary(results53)$show()) + results53CodeBased <- eval(parse(text = getObjectRCode(results53, stringWrapParagraphWidth = NULL))) + expect_equal(results53CodeBased$thetaH1, results53$thetaH1, tolerance = 1e-06) + expect_equal(results53CodeBased$assumedStDevs, results53$assumedStDevs, tolerance = 1e-06) + expect_equal(results53CodeBased$conditionalRejectionProbabilities, results53$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results53CodeBased$conditionalPower, results53$conditionalPower, tolerance = 1e-06) + expect_equal(results53CodeBased$repeatedConfidenceIntervalLowerBounds, results53$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results53CodeBased$repeatedConfidenceIntervalUpperBounds, results53$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results53CodeBased$repeatedPValues, results53$repeatedPValues, tolerance = 1e-06) + expect_type(names(results53), "character") + df <- as.data.frame(results53) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results53) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results54 <- getAnalysisResults( + design = design1, dataInput = dataExample2, + intersectionTest = "Sidak", varianceOption = "notPooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results54' with expected results + expect_equal(results54$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results54$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results54$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results54$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results54$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results54$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results54$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results54$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results54$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results54$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results54$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results54$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results54$conditionalRejectionProbabilities[1, ], c(0.044513617, 0.16250147, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results54$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results54$conditionalRejectionProbabilities[2, ], c(0.03844608, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results54$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results54$conditionalRejectionProbabilities[3, ], c(0.049538053, 0.34419132, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results54$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results54$conditionalPower[1, ], c(NA_real_, NA_real_, 0.46254707, 0.70494473), tolerance = 1e-06, label = paste0("c(", paste0(results54$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results54$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results54$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results54$conditionalPower[3, ], c(NA_real_, NA_real_, 0.83038985, 0.94768376), tolerance = 1e-06, label = paste0("c(", paste0(results54$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results54$repeatedConfidenceIntervalLowerBounds[1, ], c(-44.393216, -27.725836, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results54$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results54$repeatedConfidenceIntervalLowerBounds[2, ], c(-36.089915, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results54$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results54$repeatedConfidenceIntervalLowerBounds[3, ], c(-47.069516, -32.182569, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results54$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results54$repeatedConfidenceIntervalUpperBounds[1, ], c(14.393216, 4.0328452, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results54$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results54$repeatedConfidenceIntervalUpperBounds[2, ], c(16.889915, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results54$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results54$repeatedConfidenceIntervalUpperBounds[3, ], c(12.069516, -0.29402607, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results54$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results54$repeatedPValues[1, ], c(0.5, 0.071351909, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results54$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results54$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results54$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results54$repeatedPValues[3, ], c(0.5, 0.016637815, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results54$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results54), NA))) + expect_output(print(results54)$show()) + invisible(capture.output(expect_error(summary(results54), NA))) + expect_output(summary(results54)$show()) + results54CodeBased <- eval(parse(text = getObjectRCode(results54, stringWrapParagraphWidth = NULL))) + expect_equal(results54CodeBased$thetaH1, results54$thetaH1, tolerance = 1e-06) + expect_equal(results54CodeBased$assumedStDevs, results54$assumedStDevs, tolerance = 1e-06) + expect_equal(results54CodeBased$conditionalRejectionProbabilities, results54$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results54CodeBased$conditionalPower, results54$conditionalPower, tolerance = 1e-06) + expect_equal(results54CodeBased$repeatedConfidenceIntervalLowerBounds, results54$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results54CodeBased$repeatedConfidenceIntervalUpperBounds, results54$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results54CodeBased$repeatedPValues, results54$repeatedPValues, tolerance = 1e-06) + expect_type(names(results54), "character") + df <- as.data.frame(results54) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results54) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results55 <- getAnalysisResults( + design = design1, dataInput = dataExample2, + intersectionTest = "Sidak", varianceOption = "notPooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results55' with expected results + expect_equal(results55$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results55$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results55$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results55$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results55$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results55$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results55$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results55$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results55$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results55$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results55$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results55$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results55$conditionalRejectionProbabilities[1, ], c(0.040941914, 0.14648989, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results55$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results55$conditionalRejectionProbabilities[2, ], c(0.037171319, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results55$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results55$conditionalRejectionProbabilities[3, ], c(0.043912863, 0.29382832, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results55$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results55$conditionalPower[1, ], c(NA_real_, NA_real_, 0.4325103, 0.68306799), tolerance = 1e-06, label = paste0("c(", paste0(results55$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results55$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results55$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results55$conditionalPower[3, ], c(NA_real_, NA_real_, 0.78874215, 0.93242714), tolerance = 1e-06, label = paste0("c(", paste0(results55$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results55$repeatedConfidenceIntervalLowerBounds[1, ], c(-48.431163, -28.407231, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results55$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results55$repeatedConfidenceIntervalLowerBounds[2, ], c(-39.624453, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results55$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results55$repeatedConfidenceIntervalLowerBounds[3, ], c(-50.936268, -32.815818, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results55$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results55$repeatedConfidenceIntervalUpperBounds[1, ], c(18.431163, 4.7231897, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results55$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results55$repeatedConfidenceIntervalUpperBounds[2, ], c(20.424453, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results55$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results55$repeatedConfidenceIntervalUpperBounds[3, ], c(15.936268, 0.34247232, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results55$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results55$repeatedPValues[1, ], c(0.5, 0.083136439, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results55$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results55$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results55$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results55$repeatedPValues[3, ], c(0.5, 0.024192808, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results55$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results55), NA))) + expect_output(print(results55)$show()) + invisible(capture.output(expect_error(summary(results55), NA))) + expect_output(summary(results55)$show()) + results55CodeBased <- eval(parse(text = getObjectRCode(results55, stringWrapParagraphWidth = NULL))) + expect_equal(results55CodeBased$thetaH1, results55$thetaH1, tolerance = 1e-06) + expect_equal(results55CodeBased$assumedStDevs, results55$assumedStDevs, tolerance = 1e-06) + expect_equal(results55CodeBased$conditionalRejectionProbabilities, results55$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results55CodeBased$conditionalPower, results55$conditionalPower, tolerance = 1e-06) + expect_equal(results55CodeBased$repeatedConfidenceIntervalLowerBounds, results55$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results55CodeBased$repeatedConfidenceIntervalUpperBounds, results55$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results55CodeBased$repeatedPValues, results55$repeatedPValues, tolerance = 1e-06) + expect_type(names(results55), "character") + df <- as.data.frame(results55) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results55) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results56 <- getAnalysisResults( + design = design1, dataInput = dataExample2, + intersectionTest = "Sidak", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results56' with expected results + expect_equal(results56$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results56$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results56$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results56$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results56$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results56$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results56$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results56$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results56$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results56$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results56$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results56$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results56$conditionalRejectionProbabilities[1, ], c(0.043192758, 0.15430882, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results56$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results56$conditionalRejectionProbabilities[2, ], c(0.034321105, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results56$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results56$conditionalRejectionProbabilities[3, ], c(0.050842102, 0.35990794, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results56$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results56$conditionalPower[1, ], c(NA_real_, NA_real_, 0.44741759, 0.6940249), tolerance = 1e-06, label = paste0("c(", paste0(results56$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results56$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results56$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results56$conditionalPower[3, ], c(NA_real_, NA_real_, 0.84172467, 0.95168763), tolerance = 1e-06, label = paste0("c(", paste0(results56$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results56$repeatedConfidenceIntervalLowerBounds[1, ], c(-44.800321, -27.943326, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results56$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results56$repeatedConfidenceIntervalLowerBounds[2, ], c(-38.430944, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results56$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results56$repeatedConfidenceIntervalLowerBounds[3, ], c(-46.785003, -32.005071, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results56$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results56$repeatedConfidenceIntervalUpperBounds[1, ], c(14.800321, 4.2506387, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results56$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results56$repeatedConfidenceIntervalUpperBounds[2, ], c(19.230944, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results56$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results56$repeatedConfidenceIntervalUpperBounds[3, ], c(11.785003, -0.46968016, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results56$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results56$repeatedPValues[1, ], c(0.5, 0.077086341, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results56$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results56$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results56$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results56$repeatedPValues[3, ], c(0.5, 0.014829652, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results56$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results56), NA))) + expect_output(print(results56)$show()) + invisible(capture.output(expect_error(summary(results56), NA))) + expect_output(summary(results56)$show()) + results56CodeBased <- eval(parse(text = getObjectRCode(results56, stringWrapParagraphWidth = NULL))) + expect_equal(results56CodeBased$thetaH1, results56$thetaH1, tolerance = 1e-06) + expect_equal(results56CodeBased$assumedStDevs, results56$assumedStDevs, tolerance = 1e-06) + expect_equal(results56CodeBased$conditionalRejectionProbabilities, results56$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results56CodeBased$conditionalPower, results56$conditionalPower, tolerance = 1e-06) + expect_equal(results56CodeBased$repeatedConfidenceIntervalLowerBounds, results56$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results56CodeBased$repeatedConfidenceIntervalUpperBounds, results56$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results56CodeBased$repeatedPValues, results56$repeatedPValues, tolerance = 1e-06) + expect_type(names(results56), "character") + df <- as.data.frame(results56) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results56) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results57 <- getAnalysisResults( + design = design1, dataInput = dataExample2, + intersectionTest = "Sidak", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results57' with expected results + expect_equal(results57$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results57$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results57$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results57$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results57$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results57$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results57$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results57$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results57$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results57$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results57$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results57$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results57$conditionalRejectionProbabilities[1, ], c(0.041569453, 0.14613212, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results57$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results57$conditionalRejectionProbabilities[2, ], c(0.033856262, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results57$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results57$conditionalRejectionProbabilities[3, ], c(0.047839714, 0.32760313, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results57$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results57$conditionalPower[1, ], c(NA_real_, NA_real_, 0.43181681, 0.68255335), tolerance = 1e-06, label = paste0("c(", paste0(results57$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results57$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results57$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results57$conditionalPower[3, ], c(NA_real_, NA_real_, 0.81761872, 0.94309649), tolerance = 1e-06, label = paste0("c(", paste0(results57$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results57$repeatedConfidenceIntervalLowerBounds[1, ], c(-46.565416, -28.357046, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results57$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results57$repeatedConfidenceIntervalLowerBounds[2, ], c(-40.138622, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results57$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results57$repeatedConfidenceIntervalLowerBounds[3, ], c(-48.519575, -32.386196, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results57$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results57$repeatedConfidenceIntervalUpperBounds[1, ], c(16.565416, 4.6248784, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results57$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results57$repeatedConfidenceIntervalUpperBounds[2, ], c(20.938622, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results57$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results57$repeatedConfidenceIntervalUpperBounds[3, ], c(13.519575, -0.10461531, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results57$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results57$repeatedPValues[1, ], c(0.5, 0.083428262, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results57$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results57$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results57$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results57$repeatedPValues[3, ], c(0.5, 0.018799791, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results57$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results57), NA))) + expect_output(print(results57)$show()) + invisible(capture.output(expect_error(summary(results57), NA))) + expect_output(summary(results57)$show()) + results57CodeBased <- eval(parse(text = getObjectRCode(results57, stringWrapParagraphWidth = NULL))) + expect_equal(results57CodeBased$thetaH1, results57$thetaH1, tolerance = 1e-06) + expect_equal(results57CodeBased$assumedStDevs, results57$assumedStDevs, tolerance = 1e-06) + expect_equal(results57CodeBased$conditionalRejectionProbabilities, results57$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results57CodeBased$conditionalPower, results57$conditionalPower, tolerance = 1e-06) + expect_equal(results57CodeBased$repeatedConfidenceIntervalLowerBounds, results57$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results57CodeBased$repeatedConfidenceIntervalUpperBounds, results57$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results57CodeBased$repeatedPValues, results57$repeatedPValues, tolerance = 1e-06) + expect_type(names(results57), "character") + df <- as.data.frame(results57) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results57) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results58 <- getAnalysisResults( + design = design1, dataInput = dataExample2, + intersectionTest = "Sidak", varianceOption = "pairwisePooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results58' with expected results + expect_equal(results58$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results58$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results58$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results58$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results58$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results58$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results58$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results58$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results58$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results58$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results58$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results58$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results58$conditionalRejectionProbabilities[1, ], c(0.044003076, 0.16034604, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results58$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results58$conditionalRejectionProbabilities[2, ], c(0.038533075, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results58$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results58$conditionalRejectionProbabilities[3, ], c(0.047740982, 0.33733332, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results58$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results58$conditionalPower[1, ], c(NA_real_, NA_real_, 0.45861366, 0.70212467), tolerance = 1e-06, label = paste0("c(", paste0(results58$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results58$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results58$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results58$conditionalPower[3, ], c(NA_real_, NA_real_, 0.82521432, 0.94583446), tolerance = 1e-06, label = paste0("c(", paste0(results58$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results58$repeatedConfidenceIntervalLowerBounds[1, ], c(-44.548, -27.773536, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results58$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results58$repeatedConfidenceIntervalLowerBounds[2, ], c(-36.046937, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results58$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results58$repeatedConfidenceIntervalLowerBounds[3, ], c(-47.481556, -32.250037, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results58$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results58$repeatedConfidenceIntervalUpperBounds[1, ], c(14.548, 4.0869288, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results58$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results58$repeatedConfidenceIntervalUpperBounds[2, ], c(16.846937, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results58$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results58$repeatedConfidenceIntervalUpperBounds[3, ], c(12.481557, -0.21501802, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results58$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results58$repeatedPValues[1, ], c(0.5, 0.072804352, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results58$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results58$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results58$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results58$repeatedPValues[3, ], c(0.5, 0.017498028, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results58$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results58), NA))) + expect_output(print(results58)$show()) + invisible(capture.output(expect_error(summary(results58), NA))) + expect_output(summary(results58)$show()) + results58CodeBased <- eval(parse(text = getObjectRCode(results58, stringWrapParagraphWidth = NULL))) + expect_equal(results58CodeBased$thetaH1, results58$thetaH1, tolerance = 1e-06) + expect_equal(results58CodeBased$assumedStDevs, results58$assumedStDevs, tolerance = 1e-06) + expect_equal(results58CodeBased$conditionalRejectionProbabilities, results58$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results58CodeBased$conditionalPower, results58$conditionalPower, tolerance = 1e-06) + expect_equal(results58CodeBased$repeatedConfidenceIntervalLowerBounds, results58$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results58CodeBased$repeatedConfidenceIntervalUpperBounds, results58$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results58CodeBased$repeatedPValues, results58$repeatedPValues, tolerance = 1e-06) + expect_type(names(results58), "character") + df <- as.data.frame(results58) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results58) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results59 <- getAnalysisResults( + design = design1, dataInput = dataExample2, + intersectionTest = "Sidak", varianceOption = "pairwisePooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results59' with expected results + expect_equal(results59$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results59$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results59$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results59$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results59$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results59$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results59$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results59$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results59$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results59$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results59$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results59$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results59$conditionalRejectionProbabilities[1, ], c(0.040514523, 0.14472681, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results59$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results59$conditionalRejectionProbabilities[2, ], c(0.037322005, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results59$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results59$conditionalRejectionProbabilities[3, ], c(0.042460333, 0.28832504, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results59$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results59$conditionalPower[1, ], c(NA_real_, NA_real_, 0.42908294, 0.68052019), tolerance = 1e-06, label = paste0("c(", paste0(results59$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results59$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results59$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results59$conditionalPower[3, ], c(NA_real_, NA_real_, 0.78363361, 0.93049656), tolerance = 1e-06, label = paste0("c(", paste0(results59$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results59$repeatedConfidenceIntervalLowerBounds[1, ], c(-48.598892, -28.449073, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results59$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results59$repeatedConfidenceIntervalLowerBounds[2, ], c(-39.351395, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results59$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results59$repeatedConfidenceIntervalLowerBounds[3, ], c(-51.401351, -32.883177, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results59$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results59$repeatedConfidenceIntervalUpperBounds[1, ], c(18.598892, 4.7729883, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results59$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results59$repeatedConfidenceIntervalUpperBounds[2, ], c(20.151395, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results59$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results59$repeatedConfidenceIntervalUpperBounds[3, ], c(16.401351, 0.41981706, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results59$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results59$repeatedPValues[1, ], c(0.5, 0.084586974, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results59$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results59$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results59$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results59$repeatedPValues[3, ], c(0.5, 0.025221821, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results59$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results59), NA))) + expect_output(print(results59)$show()) + invisible(capture.output(expect_error(summary(results59), NA))) + expect_output(summary(results59)$show()) + results59CodeBased <- eval(parse(text = getObjectRCode(results59, stringWrapParagraphWidth = NULL))) + expect_equal(results59CodeBased$thetaH1, results59$thetaH1, tolerance = 1e-06) + expect_equal(results59CodeBased$assumedStDevs, results59$assumedStDevs, tolerance = 1e-06) + expect_equal(results59CodeBased$conditionalRejectionProbabilities, results59$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results59CodeBased$conditionalPower, results59$conditionalPower, tolerance = 1e-06) + expect_equal(results59CodeBased$repeatedConfidenceIntervalLowerBounds, results59$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results59CodeBased$repeatedConfidenceIntervalUpperBounds, results59$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results59CodeBased$repeatedPValues, results59$repeatedPValues, tolerance = 1e-06) + expect_type(names(results59), "character") + df <- as.data.frame(results59) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results59) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results60 <- getAnalysisResults( + design = design1, dataInput = dataExample2, + intersectionTest = "Dunnett", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = TRUE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results60' with expected results + expect_equal(results60$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results60$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results60$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results60$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results60$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results60$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results60$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results60$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results60$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results60$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results60$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results60$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results60$conditionalRejectionProbabilities[1, ], c(0.046821821, 0.16471602, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results60$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results60$conditionalRejectionProbabilities[2, ], c(0.034321105, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results60$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results60$conditionalRejectionProbabilities[3, ], c(0.056787656, 0.38875311, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results60$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results60$conditionalPower[1, ], c(NA_real_, NA_real_, 0.46655424, 0.70780427), tolerance = 1e-06, label = paste0("c(", paste0(results60$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results60$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results60$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results60$conditionalPower[3, ], c(NA_real_, NA_real_, 0.8607721, 0.95827226), tolerance = 1e-06, label = paste0("c(", paste0(results60$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results60$repeatedConfidenceIntervalLowerBounds[1, ], c(-44.645334, -27.415422, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results60$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results60$repeatedConfidenceIntervalLowerBounds[2, ], c(-38.280999, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results60$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results60$repeatedConfidenceIntervalLowerBounds[3, ], c(-46.632695, -31.563129, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results60$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results60$repeatedConfidenceIntervalUpperBounds[1, ], c(14.645333, 3.927683, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results60$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results60$repeatedConfidenceIntervalUpperBounds[2, ], c(19.080998, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results60$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results60$repeatedConfidenceIntervalUpperBounds[3, ], c(11.632695, -0.82950364, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results60$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results60$repeatedPValues[1, ], c(0.5, 0.069897558, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results60$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results60$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results60$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results60$repeatedPValues[3, ], c(0.5, 0.012021087, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results60$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results60), NA))) + expect_output(print(results60)$show()) + invisible(capture.output(expect_error(summary(results60), NA))) + expect_output(summary(results60)$show()) + results60CodeBased <- eval(parse(text = getObjectRCode(results60, stringWrapParagraphWidth = NULL))) + expect_equal(results60CodeBased$thetaH1, results60$thetaH1, tolerance = 1e-06) + expect_equal(results60CodeBased$assumedStDevs, results60$assumedStDevs, tolerance = 1e-06) + expect_equal(results60CodeBased$conditionalRejectionProbabilities, results60$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results60CodeBased$conditionalPower, results60$conditionalPower, tolerance = 1e-06) + expect_equal(results60CodeBased$repeatedConfidenceIntervalLowerBounds, results60$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results60CodeBased$repeatedConfidenceIntervalUpperBounds, results60$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results60CodeBased$repeatedPValues, results60$repeatedPValues, tolerance = 1e-06) + expect_type(names(results60), "character") + df <- as.data.frame(results60) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results60) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results61 <- getAnalysisResults( + design = design1, dataInput = dataExample2, + intersectionTest = "Dunnett", varianceOption = "overallPooled", nPlanned = c(20, 20), normalApproximation = FALSE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmInverseNormal object 'results61' with expected results + expect_equal(results61$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results61$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results61$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results61$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results61$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results61$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results61$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results61$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results61$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results61$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results61$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results61$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results61$conditionalRejectionProbabilities[1, ], c(0.045317687, 0.15683192, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results61$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results61$conditionalRejectionProbabilities[2, ], c(0.033856262, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results61$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results61$conditionalRejectionProbabilities[3, ], c(0.054085103, 0.3588303, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results61$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results61$conditionalPower[1, ], c(NA_real_, NA_real_, 0.45212919, 0.69744676), tolerance = 1e-06, label = paste0("c(", paste0(results61$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results61$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results61$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results61$conditionalPower[3, ], c(NA_real_, NA_real_, 0.84097006, 0.95142305), tolerance = 1e-06, label = paste0("c(", paste0(results61$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results61$repeatedConfidenceIntervalLowerBounds[1, ], c(-46.335113, -27.786662, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results61$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results61$repeatedConfidenceIntervalLowerBounds[2, ], c(-39.91581, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results61$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results61$repeatedConfidenceIntervalLowerBounds[3, ], c(-48.293254, -31.900882, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results61$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results61$repeatedConfidenceIntervalUpperBounds[1, ], c(16.335113, 4.2557288, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results61$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results61$repeatedConfidenceIntervalUpperBounds[2, ], c(20.71581, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results61$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results61$repeatedConfidenceIntervalUpperBounds[3, ], c(13.293254, -0.50940978, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results61$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results61$repeatedPValues[1, ], c(0.5, 0.075258151, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results61$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results61$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results61$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results61$repeatedPValues[3, ], c(0.5, 0.014946954, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results61$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results61), NA))) + expect_output(print(results61)$show()) + invisible(capture.output(expect_error(summary(results61), NA))) + expect_output(summary(results61)$show()) + results61CodeBased <- eval(parse(text = getObjectRCode(results61, stringWrapParagraphWidth = NULL))) + expect_equal(results61CodeBased$thetaH1, results61$thetaH1, tolerance = 1e-06) + expect_equal(results61CodeBased$assumedStDevs, results61$assumedStDevs, tolerance = 1e-06) + expect_equal(results61CodeBased$conditionalRejectionProbabilities, results61$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results61CodeBased$conditionalPower, results61$conditionalPower, tolerance = 1e-06) + expect_equal(results61CodeBased$repeatedConfidenceIntervalLowerBounds, results61$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results61CodeBased$repeatedConfidenceIntervalUpperBounds, results61$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results61CodeBased$repeatedPValues, results61$repeatedPValues, tolerance = 1e-06) + expect_type(names(results61), "character") + df <- as.data.frame(results61) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results61) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results62 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + intersectionTest = "Bonferroni", varianceOption = "notPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results62' with expected results + expect_equal(results62$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results62$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results62$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results62$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results62$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results62$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results62$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results62$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results62$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results62$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results62$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results62$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results62$conditionalRejectionProbabilities[1, ], c(0.024608533, 0.053964296, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results62$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results62$conditionalRejectionProbabilities[2, ], c(0.021871903, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results62$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results62$conditionalRejectionProbabilities[3, ], c(0.027261939, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results62$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results62$repeatedConfidenceIntervalLowerBounds[1, ], c(-40.256183, -26.806923, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results62$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results62$repeatedConfidenceIntervalLowerBounds[2, ], c(-32.361515, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results62$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results62$repeatedConfidenceIntervalLowerBounds[3, ], c(-42.907669, -31.664999, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results62$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results62$repeatedConfidenceIntervalUpperBounds[1, ], c(10.256183, 4.0576303, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results62$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results62$repeatedConfidenceIntervalUpperBounds[2, ], c(13.161515, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results62$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results62$repeatedConfidenceIntervalUpperBounds[3, ], c(7.9076686, -0.4326836, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results62$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results62$repeatedPValues[1, ], c(0.17463845, 0.062131804, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results62$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results62$repeatedPValues[2, ], c(0.20337355, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results62$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results62$repeatedPValues[3, ], c(0.1527221, 0.015597359, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results62$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results62$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.277, 0.453), tolerance = 1e-06, label = paste0("c(", paste0(results62$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results62$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results62$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results62$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results62$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results62), NA))) + expect_output(print(results62)$show()) + invisible(capture.output(expect_error(summary(results62), NA))) + expect_output(summary(results62)$show()) + results62CodeBased <- eval(parse(text = getObjectRCode(results62, stringWrapParagraphWidth = NULL))) + expect_equal(results62CodeBased$thetaH1, results62$thetaH1, tolerance = 1e-06) + expect_equal(results62CodeBased$assumedStDevs, results62$assumedStDevs, tolerance = 1e-06) + expect_equal(results62CodeBased$conditionalRejectionProbabilities, results62$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results62CodeBased$repeatedConfidenceIntervalLowerBounds, results62$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results62CodeBased$repeatedConfidenceIntervalUpperBounds, results62$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results62CodeBased$repeatedPValues, results62$repeatedPValues, tolerance = 1e-06) + expect_equal(results62CodeBased$conditionalPowerSimulated, results62$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results62), "character") + df <- as.data.frame(results62) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results62) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results63 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + intersectionTest = "Bonferroni", varianceOption = "notPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results63' with expected results + expect_equal(results63$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results63$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results63$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results63$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results63$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results63$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results63$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results63$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results63$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results63$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results63$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results63$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results63$conditionalRejectionProbabilities[1, ], c(0.022711489, 0.047669561, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results63$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results63$conditionalRejectionProbabilities[2, ], c(0.021234311, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results63$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results63$conditionalRejectionProbabilities[3, ], c(0.024147032, 0.14148061, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results63$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results63$repeatedConfidenceIntervalLowerBounds[1, ], c(-42.830851, -27.447651, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results63$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results63$repeatedConfidenceIntervalLowerBounds[2, ], c(-34.616779, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results63$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results63$repeatedConfidenceIntervalLowerBounds[3, ], c(-45.376075, -32.257244, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results63$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results63$repeatedConfidenceIntervalUpperBounds[1, ], c(12.830851, 4.722817, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results63$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results63$repeatedConfidenceIntervalUpperBounds[2, ], c(15.416779, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results63$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results63$repeatedConfidenceIntervalUpperBounds[3, ], c(10.376075, 0.16648466, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results63$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results63$repeatedPValues[1, ], c(0.19376148, 0.070634747, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results63$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results63$repeatedPValues[2, ], c(0.2112175, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results63$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results63$repeatedPValues[3, ], c(0.17899101, 0.021776202, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results63$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results63$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.257, 0.434), tolerance = 1e-06, label = paste0("c(", paste0(results63$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results63$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results63$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results63$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 0.656, 0.797), tolerance = 1e-06, label = paste0("c(", paste0(results63$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results63), NA))) + expect_output(print(results63)$show()) + invisible(capture.output(expect_error(summary(results63), NA))) + expect_output(summary(results63)$show()) + results63CodeBased <- eval(parse(text = getObjectRCode(results63, stringWrapParagraphWidth = NULL))) + expect_equal(results63CodeBased$thetaH1, results63$thetaH1, tolerance = 1e-06) + expect_equal(results63CodeBased$assumedStDevs, results63$assumedStDevs, tolerance = 1e-06) + expect_equal(results63CodeBased$conditionalRejectionProbabilities, results63$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results63CodeBased$repeatedConfidenceIntervalLowerBounds, results63$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results63CodeBased$repeatedConfidenceIntervalUpperBounds, results63$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results63CodeBased$repeatedPValues, results63$repeatedPValues, tolerance = 1e-06) + expect_equal(results63CodeBased$conditionalPowerSimulated, results63$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results63), "character") + df <- as.data.frame(results63) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results63) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results64 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + intersectionTest = "Bonferroni", varianceOption = "overallPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results64' with expected results + expect_equal(results64$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results64$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results64$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results64$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results64$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results64$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results64$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results64$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results64$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results64$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results64$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results64$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results64$conditionalRejectionProbabilities[1, ], c(0.02389937, 0.050606752, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results64$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results64$conditionalRejectionProbabilities[2, ], c(0.019837849, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results64$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results64$conditionalRejectionProbabilities[3, ], c(0.028008383, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results64$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results64$repeatedConfidenceIntervalLowerBounds[1, ], c(-40.605988, -27.021858, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results64$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results64$repeatedConfidenceIntervalLowerBounds[2, ], c(-34.373049, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results64$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results64$repeatedConfidenceIntervalLowerBounds[3, ], c(-42.6632, -31.486561, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results64$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results64$repeatedConfidenceIntervalUpperBounds[1, ], c(10.605988, 4.2731734, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results64$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results64$repeatedConfidenceIntervalUpperBounds[2, ], c(15.173049, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results64$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results64$repeatedConfidenceIntervalUpperBounds[3, ], c(7.6631999, -0.60791563, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results64$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results64$repeatedPValues[1, ], c(0.18140284, 0.066412839, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results64$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results64$repeatedPValues[2, ], c(0.23027951, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results64$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results64$repeatedPValues[3, ], c(0.14737581, 0.014014262, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results64$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results64$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.268, 0.445), tolerance = 1e-06, label = paste0("c(", paste0(results64$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results64$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results64$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results64$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results64$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results64), NA))) + expect_output(print(results64)$show()) + invisible(capture.output(expect_error(summary(results64), NA))) + expect_output(summary(results64)$show()) + results64CodeBased <- eval(parse(text = getObjectRCode(results64, stringWrapParagraphWidth = NULL))) + expect_equal(results64CodeBased$thetaH1, results64$thetaH1, tolerance = 1e-06) + expect_equal(results64CodeBased$assumedStDevs, results64$assumedStDevs, tolerance = 1e-06) + expect_equal(results64CodeBased$conditionalRejectionProbabilities, results64$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results64CodeBased$repeatedConfidenceIntervalLowerBounds, results64$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results64CodeBased$repeatedConfidenceIntervalUpperBounds, results64$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results64CodeBased$repeatedPValues, results64$repeatedPValues, tolerance = 1e-06) + expect_equal(results64CodeBased$conditionalPowerSimulated, results64$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results64), "character") + df <- as.data.frame(results64) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results64) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results65 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + intersectionTest = "Bonferroni", varianceOption = "overallPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results65' with expected results + expect_equal(results65$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results65$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results65$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results65$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results65$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results65$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results65$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results65$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results65$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results65$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results65$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results65$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results65$conditionalRejectionProbabilities[1, ], c(0.023040094, 0.047419024, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results65$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results65$conditionalRejectionProbabilities[2, ], c(0.019613852, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results65$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results65$conditionalRejectionProbabilities[3, ], c(0.026303733, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results65$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results65$repeatedConfidenceIntervalLowerBounds[1, ], c(-41.74771, -27.425347, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results65$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results65$repeatedConfidenceIntervalLowerBounds[2, ], c(-35.477631, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results65$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results65$repeatedConfidenceIntervalLowerBounds[3, ], c(-43.785178, -31.856528, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results65$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results65$repeatedConfidenceIntervalUpperBounds[1, ], c(11.74771, 4.6401767, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results65$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results65$repeatedConfidenceIntervalUpperBounds[2, ], c(16.277631, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results65$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results65$repeatedConfidenceIntervalUpperBounds[3, ], c(8.7851784, -0.25415362, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results65$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results65$repeatedPValues[1, ], c(0.19020524, 0.071018123, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results65$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results65$repeatedPValues[2, ], c(0.23360401, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results65$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results65$repeatedPValues[3, ], c(0.16007682, 0.01742078, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results65$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results65$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.256, 0.433), tolerance = 1e-06, label = paste0("c(", paste0(results65$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results65$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results65$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results65$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results65$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results65), NA))) + expect_output(print(results65)$show()) + invisible(capture.output(expect_error(summary(results65), NA))) + expect_output(summary(results65)$show()) + results65CodeBased <- eval(parse(text = getObjectRCode(results65, stringWrapParagraphWidth = NULL))) + expect_equal(results65CodeBased$thetaH1, results65$thetaH1, tolerance = 1e-06) + expect_equal(results65CodeBased$assumedStDevs, results65$assumedStDevs, tolerance = 1e-06) + expect_equal(results65CodeBased$conditionalRejectionProbabilities, results65$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results65CodeBased$repeatedConfidenceIntervalLowerBounds, results65$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results65CodeBased$repeatedConfidenceIntervalUpperBounds, results65$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results65CodeBased$repeatedPValues, results65$repeatedPValues, tolerance = 1e-06) + expect_equal(results65CodeBased$conditionalPowerSimulated, results65$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results65), "character") + df <- as.data.frame(results65) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results65) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results66 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + intersectionTest = "Bonferroni", varianceOption = "pairwisePooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results66' with expected results + expect_equal(results66$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results66$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results66$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results66$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results66$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results66$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results66$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results66$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results66$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results66$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results66$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results66$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results66$conditionalRejectionProbabilities[1, ], c(0.024333354, 0.053095357, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results66$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results66$conditionalRejectionProbabilities[2, ], c(0.021915713, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results66$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results66$conditionalRejectionProbabilities[3, ], c(0.026248507, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results66$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results66$repeatedConfidenceIntervalLowerBounds[1, ], c(-40.389181, -26.847363, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results66$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results66$repeatedConfidenceIntervalLowerBounds[2, ], c(-32.324586, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results66$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results66$repeatedConfidenceIntervalLowerBounds[3, ], c(-43.261715, -31.705217, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results66$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results66$repeatedConfidenceIntervalUpperBounds[1, ], c(10.389181, 4.1091853, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results66$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results66$repeatedConfidenceIntervalUpperBounds[2, ], c(13.124586, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results66$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results66$repeatedConfidenceIntervalUpperBounds[3, ], c(8.2617152, -0.37246523, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results66$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results66$repeatedPValues[1, ], c(0.17721241, 0.063189426, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results66$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results66$repeatedPValues[2, ], c(0.20285189, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results66$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results66$repeatedPValues[3, ], c(0.16051933, 0.01616384, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results66$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results66$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.274, 0.453), tolerance = 1e-06, label = paste0("c(", paste0(results66$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results66$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results66$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results66$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results66$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results66), NA))) + expect_output(print(results66)$show()) + invisible(capture.output(expect_error(summary(results66), NA))) + expect_output(summary(results66)$show()) + results66CodeBased <- eval(parse(text = getObjectRCode(results66, stringWrapParagraphWidth = NULL))) + expect_equal(results66CodeBased$thetaH1, results66$thetaH1, tolerance = 1e-06) + expect_equal(results66CodeBased$assumedStDevs, results66$assumedStDevs, tolerance = 1e-06) + expect_equal(results66CodeBased$conditionalRejectionProbabilities, results66$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results66CodeBased$repeatedConfidenceIntervalLowerBounds, results66$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results66CodeBased$repeatedConfidenceIntervalUpperBounds, results66$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results66CodeBased$repeatedPValues, results66$repeatedPValues, tolerance = 1e-06) + expect_equal(results66CodeBased$conditionalPowerSimulated, results66$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results66), "character") + df <- as.data.frame(results66) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results66) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results67 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + intersectionTest = "Bonferroni", varianceOption = "pairwisePooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results67' with expected results + expect_equal(results67$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results67$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results67$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results67$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results67$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results67$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results67$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results67$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results67$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results67$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results67$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results67$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results67$conditionalRejectionProbabilities[1, ], c(0.02248882, 0.047009108, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results67$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results67$conditionalRejectionProbabilities[2, ], c(0.021309255, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results67$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results67$conditionalRejectionProbabilities[3, ], c(0.023369532, 0.13794488, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results67$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results67$repeatedConfidenceIntervalLowerBounds[1, ], c(-42.972232, -27.481288, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results67$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results67$repeatedConfidenceIntervalLowerBounds[2, ], c(-34.436237, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results67$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results67$repeatedConfidenceIntervalLowerBounds[3, ], c(-45.763994, -32.295837, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results67$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results67$repeatedConfidenceIntervalUpperBounds[1, ], c(12.972232, 4.7692163, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results67$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results67$repeatedConfidenceIntervalUpperBounds[2, ], c(15.236237, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results67$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results67$repeatedConfidenceIntervalUpperBounds[3, ], c(10.763995, 0.22335705, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results67$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results67$repeatedPValues[1, ], c(0.19623626, 0.071653269, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results67$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results67$repeatedPValues[2, ], c(0.21026955, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results67$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results67$repeatedPValues[3, ], c(0.18674722, 0.022408487, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results67$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results67$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.256, 0.431), tolerance = 1e-06, label = paste0("c(", paste0(results67$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results67$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results67$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results67$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 0.652, 0.795), tolerance = 1e-06, label = paste0("c(", paste0(results67$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results67), NA))) + expect_output(print(results67)$show()) + invisible(capture.output(expect_error(summary(results67), NA))) + expect_output(summary(results67)$show()) + results67CodeBased <- eval(parse(text = getObjectRCode(results67, stringWrapParagraphWidth = NULL))) + expect_equal(results67CodeBased$thetaH1, results67$thetaH1, tolerance = 1e-06) + expect_equal(results67CodeBased$assumedStDevs, results67$assumedStDevs, tolerance = 1e-06) + expect_equal(results67CodeBased$conditionalRejectionProbabilities, results67$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results67CodeBased$repeatedConfidenceIntervalLowerBounds, results67$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results67CodeBased$repeatedConfidenceIntervalUpperBounds, results67$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results67CodeBased$repeatedPValues, results67$repeatedPValues, tolerance = 1e-06) + expect_equal(results67CodeBased$conditionalPowerSimulated, results67$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results67), "character") + df <- as.data.frame(results67) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results67) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results68 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results68' with expected results + expect_equal(results68$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results68$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results68$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results68$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results68$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results68$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results68$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results68$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results68$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results68$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results68$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results68$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results68$conditionalRejectionProbabilities[1, ], c(0.024608533, 0.053964296, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results68$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results68$conditionalRejectionProbabilities[2, ], c(0.021871903, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results68$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results68$conditionalRejectionProbabilities[3, ], c(0.029595078, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results68$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results68$repeatedConfidenceIntervalLowerBounds[1, ], c(-40.256183, -26.806923, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results68$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results68$repeatedConfidenceIntervalLowerBounds[2, ], c(-32.361515, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results68$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results68$repeatedConfidenceIntervalLowerBounds[3, ], c(-42.907669, -31.664999, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results68$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results68$repeatedConfidenceIntervalUpperBounds[1, ], c(10.256183, 4.0576303, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results68$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results68$repeatedConfidenceIntervalUpperBounds[2, ], c(13.161515, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results68$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results68$repeatedConfidenceIntervalUpperBounds[3, ], c(7.9076686, -0.4326836, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results68$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results68$repeatedPValues[1, ], c(0.17463845, 0.062131804, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results68$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results68$repeatedPValues[2, ], c(0.20337355, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results68$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results68$repeatedPValues[3, ], c(0.13700176, 0.014275569, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results68$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results68$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.277, 0.453), tolerance = 1e-06, label = paste0("c(", paste0(results68$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results68$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results68$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results68$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results68$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results68), NA))) + expect_output(print(results68)$show()) + invisible(capture.output(expect_error(summary(results68), NA))) + expect_output(summary(results68)$show()) + results68CodeBased <- eval(parse(text = getObjectRCode(results68, stringWrapParagraphWidth = NULL))) + expect_equal(results68CodeBased$thetaH1, results68$thetaH1, tolerance = 1e-06) + expect_equal(results68CodeBased$assumedStDevs, results68$assumedStDevs, tolerance = 1e-06) + expect_equal(results68CodeBased$conditionalRejectionProbabilities, results68$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results68CodeBased$repeatedConfidenceIntervalLowerBounds, results68$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results68CodeBased$repeatedConfidenceIntervalUpperBounds, results68$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results68CodeBased$repeatedPValues, results68$repeatedPValues, tolerance = 1e-06) + expect_equal(results68CodeBased$conditionalPowerSimulated, results68$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results68), "character") + df <- as.data.frame(results68) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results68) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results69 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results69' with expected results + expect_equal(results69$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results69$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results69$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results69$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results69$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results69$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results69$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results69$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results69$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results69$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results69$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results69$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results69$conditionalRejectionProbabilities[1, ], c(0.022711489, 0.047669561, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results69$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results69$conditionalRejectionProbabilities[2, ], c(0.021234311, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results69$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results69$conditionalRejectionProbabilities[3, ], c(0.027312859, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results69$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results69$repeatedConfidenceIntervalLowerBounds[1, ], c(-42.830851, -27.447651, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results69$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results69$repeatedConfidenceIntervalLowerBounds[2, ], c(-34.616779, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results69$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results69$repeatedConfidenceIntervalLowerBounds[3, ], c(-45.376075, -32.257244, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results69$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results69$repeatedConfidenceIntervalUpperBounds[1, ], c(12.830851, 4.722817, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results69$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results69$repeatedConfidenceIntervalUpperBounds[2, ], c(15.416779, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results69$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results69$repeatedConfidenceIntervalUpperBounds[3, ], c(10.376075, 0.16648466, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results69$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results69$repeatedPValues[1, ], c(0.19376148, 0.070634747, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results69$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results69$repeatedPValues[2, ], c(0.2112175, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results69$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results69$repeatedPValues[3, ], c(0.15234731, 0.019097336, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results69$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results69$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.257, 0.434), tolerance = 1e-06, label = paste0("c(", paste0(results69$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results69$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results69$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results69$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results69$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results69), NA))) + expect_output(print(results69)$show()) + invisible(capture.output(expect_error(summary(results69), NA))) + expect_output(summary(results69)$show()) + results69CodeBased <- eval(parse(text = getObjectRCode(results69, stringWrapParagraphWidth = NULL))) + expect_equal(results69CodeBased$thetaH1, results69$thetaH1, tolerance = 1e-06) + expect_equal(results69CodeBased$assumedStDevs, results69$assumedStDevs, tolerance = 1e-06) + expect_equal(results69CodeBased$conditionalRejectionProbabilities, results69$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results69CodeBased$repeatedConfidenceIntervalLowerBounds, results69$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results69CodeBased$repeatedConfidenceIntervalUpperBounds, results69$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results69CodeBased$repeatedPValues, results69$repeatedPValues, tolerance = 1e-06) + expect_equal(results69CodeBased$conditionalPowerSimulated, results69$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results69), "character") + df <- as.data.frame(results69) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results69) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results70 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + intersectionTest = "Simes", varianceOption = "overallPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results70' with expected results + expect_equal(results70$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results70$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results70$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results70$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results70$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results70$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results70$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results70$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results70$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results70$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results70$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results70$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results70$conditionalRejectionProbabilities[1, ], c(0.02389937, 0.050606752, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results70$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results70$conditionalRejectionProbabilities[2, ], c(0.019837849, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results70$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results70$conditionalRejectionProbabilities[3, ], c(0.028741907, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results70$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results70$repeatedConfidenceIntervalLowerBounds[1, ], c(-40.605988, -27.021858, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results70$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results70$repeatedConfidenceIntervalLowerBounds[2, ], c(-34.373049, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results70$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results70$repeatedConfidenceIntervalLowerBounds[3, ], c(-42.6632, -31.486561, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results70$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results70$repeatedConfidenceIntervalUpperBounds[1, ], c(10.605988, 4.2731734, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results70$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results70$repeatedConfidenceIntervalUpperBounds[2, ], c(15.173049, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results70$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results70$repeatedConfidenceIntervalUpperBounds[3, ], c(7.6631999, -0.60791563, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results70$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results70$repeatedPValues[1, ], c(0.18140284, 0.066412839, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results70$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results70$repeatedPValues[2, ], c(0.23027951, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results70$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results70$repeatedPValues[3, ], c(0.14242148, 0.013628025, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results70$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results70$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.268, 0.445), tolerance = 1e-06, label = paste0("c(", paste0(results70$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results70$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results70$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results70$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results70$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results70), NA))) + expect_output(print(results70)$show()) + invisible(capture.output(expect_error(summary(results70), NA))) + expect_output(summary(results70)$show()) + results70CodeBased <- eval(parse(text = getObjectRCode(results70, stringWrapParagraphWidth = NULL))) + expect_equal(results70CodeBased$thetaH1, results70$thetaH1, tolerance = 1e-06) + expect_equal(results70CodeBased$assumedStDevs, results70$assumedStDevs, tolerance = 1e-06) + expect_equal(results70CodeBased$conditionalRejectionProbabilities, results70$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results70CodeBased$repeatedConfidenceIntervalLowerBounds, results70$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results70CodeBased$repeatedConfidenceIntervalUpperBounds, results70$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results70CodeBased$repeatedPValues, results70$repeatedPValues, tolerance = 1e-06) + expect_equal(results70CodeBased$conditionalPowerSimulated, results70$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results70), "character") + df <- as.data.frame(results70) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results70) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results71 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + intersectionTest = "Simes", varianceOption = "overallPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results71' with expected results + expect_equal(results71$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results71$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results71$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results71$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results71$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results71$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results71$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results71$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results71$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results71$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results71$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results71$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results71$conditionalRejectionProbabilities[1, ], c(0.023040094, 0.047419024, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results71$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results71$conditionalRejectionProbabilities[2, ], c(0.019613852, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results71$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results71$conditionalRejectionProbabilities[3, ], c(0.027708171, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results71$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results71$repeatedConfidenceIntervalLowerBounds[1, ], c(-41.74771, -27.425347, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results71$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results71$repeatedConfidenceIntervalLowerBounds[2, ], c(-35.477631, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results71$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results71$repeatedConfidenceIntervalLowerBounds[3, ], c(-43.785178, -31.856528, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results71$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results71$repeatedConfidenceIntervalUpperBounds[1, ], c(11.74771, 4.6401767, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results71$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results71$repeatedConfidenceIntervalUpperBounds[2, ], c(16.277631, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results71$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results71$repeatedConfidenceIntervalUpperBounds[3, ], c(8.7851784, -0.25415362, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results71$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results71$repeatedPValues[1, ], c(0.19020524, 0.071018123, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results71$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results71$repeatedPValues[2, ], c(0.23360401, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results71$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results71$repeatedPValues[3, ], c(0.1494882, 0.016474737, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results71$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results71$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.256, 0.433), tolerance = 1e-06, label = paste0("c(", paste0(results71$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results71$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results71$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results71$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results71$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results71), NA))) + expect_output(print(results71)$show()) + invisible(capture.output(expect_error(summary(results71), NA))) + expect_output(summary(results71)$show()) + results71CodeBased <- eval(parse(text = getObjectRCode(results71, stringWrapParagraphWidth = NULL))) + expect_equal(results71CodeBased$thetaH1, results71$thetaH1, tolerance = 1e-06) + expect_equal(results71CodeBased$assumedStDevs, results71$assumedStDevs, tolerance = 1e-06) + expect_equal(results71CodeBased$conditionalRejectionProbabilities, results71$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results71CodeBased$repeatedConfidenceIntervalLowerBounds, results71$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results71CodeBased$repeatedConfidenceIntervalUpperBounds, results71$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results71CodeBased$repeatedPValues, results71$repeatedPValues, tolerance = 1e-06) + expect_equal(results71CodeBased$conditionalPowerSimulated, results71$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results71), "character") + df <- as.data.frame(results71) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results71) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results72 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + intersectionTest = "Simes", varianceOption = "pairwisePooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results72' with expected results + expect_equal(results72$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results72$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results72$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results72$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results72$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results72$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results72$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results72$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results72$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results72$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results72$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results72$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results72$conditionalRejectionProbabilities[1, ], c(0.024333354, 0.053095357, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results72$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results72$conditionalRejectionProbabilities[2, ], c(0.021915713, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results72$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results72$conditionalRejectionProbabilities[3, ], c(0.029264016, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results72$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results72$repeatedConfidenceIntervalLowerBounds[1, ], c(-40.389181, -26.847363, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results72$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results72$repeatedConfidenceIntervalLowerBounds[2, ], c(-32.324586, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results72$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results72$repeatedConfidenceIntervalLowerBounds[3, ], c(-43.261715, -31.705217, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results72$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results72$repeatedConfidenceIntervalUpperBounds[1, ], c(10.389181, 4.1091853, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results72$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results72$repeatedConfidenceIntervalUpperBounds[2, ], c(13.124586, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results72$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results72$repeatedConfidenceIntervalUpperBounds[3, ], c(8.2617152, -0.37246523, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results72$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results72$repeatedPValues[1, ], c(0.17721241, 0.063189426, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results72$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results72$repeatedPValues[2, ], c(0.20285189, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results72$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results72$repeatedPValues[3, ], c(0.13906265, 0.014376658, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results72$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results72$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.274, 0.453), tolerance = 1e-06, label = paste0("c(", paste0(results72$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results72$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results72$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results72$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results72$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results72), NA))) + expect_output(print(results72)$show()) + invisible(capture.output(expect_error(summary(results72), NA))) + expect_output(summary(results72)$show()) + results72CodeBased <- eval(parse(text = getObjectRCode(results72, stringWrapParagraphWidth = NULL))) + expect_equal(results72CodeBased$thetaH1, results72$thetaH1, tolerance = 1e-06) + expect_equal(results72CodeBased$assumedStDevs, results72$assumedStDevs, tolerance = 1e-06) + expect_equal(results72CodeBased$conditionalRejectionProbabilities, results72$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results72CodeBased$repeatedConfidenceIntervalLowerBounds, results72$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results72CodeBased$repeatedConfidenceIntervalUpperBounds, results72$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results72CodeBased$repeatedPValues, results72$repeatedPValues, tolerance = 1e-06) + expect_equal(results72CodeBased$conditionalPowerSimulated, results72$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results72), "character") + df <- as.data.frame(results72) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results72) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results73 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + intersectionTest = "Simes", varianceOption = "pairwisePooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results73' with expected results + expect_equal(results73$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results73$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results73$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results73$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results73$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results73$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results73$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results73$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results73$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results73$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results73$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results73$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results73$conditionalRejectionProbabilities[1, ], c(0.02248882, 0.047009108, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results73$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results73$conditionalRejectionProbabilities[2, ], c(0.021309255, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results73$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results73$conditionalRejectionProbabilities[3, ], c(0.027044989, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results73$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results73$repeatedConfidenceIntervalLowerBounds[1, ], c(-42.972232, -27.481288, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results73$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results73$repeatedConfidenceIntervalLowerBounds[2, ], c(-34.436237, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results73$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results73$repeatedConfidenceIntervalLowerBounds[3, ], c(-45.763994, -32.295837, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results73$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results73$repeatedConfidenceIntervalUpperBounds[1, ], c(12.972232, 4.7692163, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results73$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results73$repeatedConfidenceIntervalUpperBounds[2, ], c(15.236237, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results73$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results73$repeatedConfidenceIntervalUpperBounds[3, ], c(10.763995, 0.22335705, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results73$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results73$repeatedPValues[1, ], c(0.19623626, 0.071653269, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results73$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results73$repeatedPValues[2, ], c(0.21026955, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results73$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results73$repeatedPValues[3, ], c(0.15433667, 0.019180306, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results73$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results73$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.256, 0.431), tolerance = 1e-06, label = paste0("c(", paste0(results73$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results73$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results73$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results73$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results73$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results73), NA))) + expect_output(print(results73)$show()) + invisible(capture.output(expect_error(summary(results73), NA))) + expect_output(summary(results73)$show()) + results73CodeBased <- eval(parse(text = getObjectRCode(results73, stringWrapParagraphWidth = NULL))) + expect_equal(results73CodeBased$thetaH1, results73$thetaH1, tolerance = 1e-06) + expect_equal(results73CodeBased$assumedStDevs, results73$assumedStDevs, tolerance = 1e-06) + expect_equal(results73CodeBased$conditionalRejectionProbabilities, results73$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results73CodeBased$repeatedConfidenceIntervalLowerBounds, results73$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results73CodeBased$repeatedConfidenceIntervalUpperBounds, results73$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results73CodeBased$repeatedPValues, results73$repeatedPValues, tolerance = 1e-06) + expect_equal(results73CodeBased$conditionalPowerSimulated, results73$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results73), "character") + df <- as.data.frame(results73) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results73) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results74 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + intersectionTest = "Sidak", varianceOption = "notPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results74' with expected results + expect_equal(results74$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results74$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results74$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results74$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results74$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results74$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results74$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results74$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results74$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results74$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results74$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results74$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results74$conditionalRejectionProbabilities[1, ], c(0.025021019, 0.054834069, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results74$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results74$conditionalRejectionProbabilities[2, ], c(0.021871903, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results74$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results74$conditionalRejectionProbabilities[3, ], c(0.027777772, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results74$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results74$repeatedConfidenceIntervalLowerBounds[1, ], c(-40.247199, -26.680539, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results74$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results74$repeatedConfidenceIntervalLowerBounds[2, ], c(-32.353418, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results74$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results74$repeatedConfidenceIntervalLowerBounds[3, ], c(-42.898631, -31.584065, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results74$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results74$repeatedConfidenceIntervalUpperBounds[1, ], c(10.247199, 4.0258193, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results74$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results74$repeatedConfidenceIntervalUpperBounds[2, ], c(13.153418, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results74$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results74$repeatedConfidenceIntervalUpperBounds[3, ], c(7.8986307, -0.47811558, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results74$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results74$repeatedPValues[1, ], c(0.17089623, 0.061105652, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results74$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results74$repeatedPValues[2, ], c(0.20337355, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results74$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results74$repeatedPValues[3, ], c(0.14899419, 0.015246407, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results74$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results74$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.283, 0.454), tolerance = 1e-06, label = paste0("c(", paste0(results74$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results74$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results74$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results74$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results74$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results74), NA))) + expect_output(print(results74)$show()) + invisible(capture.output(expect_error(summary(results74), NA))) + expect_output(summary(results74)$show()) + results74CodeBased <- eval(parse(text = getObjectRCode(results74, stringWrapParagraphWidth = NULL))) + expect_equal(results74CodeBased$thetaH1, results74$thetaH1, tolerance = 1e-06) + expect_equal(results74CodeBased$assumedStDevs, results74$assumedStDevs, tolerance = 1e-06) + expect_equal(results74CodeBased$conditionalRejectionProbabilities, results74$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results74CodeBased$repeatedConfidenceIntervalLowerBounds, results74$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results74CodeBased$repeatedConfidenceIntervalUpperBounds, results74$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results74CodeBased$repeatedPValues, results74$repeatedPValues, tolerance = 1e-06) + expect_equal(results74CodeBased$conditionalPowerSimulated, results74$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results74), "character") + df <- as.data.frame(results74) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results74) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results75 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + intersectionTest = "Sidak", varianceOption = "notPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results75' with expected results + expect_equal(results75$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results75$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results75$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results75$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results75$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results75$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results75$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results75$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results75$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results75$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results75$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results75$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results75$conditionalRejectionProbabilities[1, ], c(0.023144095, 0.048545015, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results75$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results75$conditionalRejectionProbabilities[2, ], c(0.021234311, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results75$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results75$conditionalRejectionProbabilities[3, ], c(0.0247006, 0.1449328, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results75$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results75$repeatedConfidenceIntervalLowerBounds[1, ], c(-42.8192, -27.314543, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results75$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results75$repeatedConfidenceIntervalLowerBounds[2, ], c(-34.60635, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results75$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results75$repeatedConfidenceIntervalLowerBounds[3, ], c(-45.364486, -32.169333, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results75$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results75$repeatedConfidenceIntervalUpperBounds[1, ], c(12.8192, 4.6852584, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results75$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results75$repeatedConfidenceIntervalUpperBounds[2, ], c(15.40635, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results75$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results75$repeatedConfidenceIntervalUpperBounds[3, ], c(10.364486, 0.1144866, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results75$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results75$repeatedPValues[1, ], c(0.18910184, 0.069324401, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results75$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results75$repeatedPValues[2, ], c(0.2112175, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results75$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results75$repeatedPValues[3, ], c(0.17379158, 0.021189694, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results75$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results75$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.26, 0.437), tolerance = 1e-06, label = paste0("c(", paste0(results75$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results75$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results75$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results75$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 0.66, 0.799), tolerance = 1e-06, label = paste0("c(", paste0(results75$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results75), NA))) + expect_output(print(results75)$show()) + invisible(capture.output(expect_error(summary(results75), NA))) + expect_output(summary(results75)$show()) + results75CodeBased <- eval(parse(text = getObjectRCode(results75, stringWrapParagraphWidth = NULL))) + expect_equal(results75CodeBased$thetaH1, results75$thetaH1, tolerance = 1e-06) + expect_equal(results75CodeBased$assumedStDevs, results75$assumedStDevs, tolerance = 1e-06) + expect_equal(results75CodeBased$conditionalRejectionProbabilities, results75$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results75CodeBased$repeatedConfidenceIntervalLowerBounds, results75$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results75CodeBased$repeatedConfidenceIntervalUpperBounds, results75$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results75CodeBased$repeatedPValues, results75$repeatedPValues, tolerance = 1e-06) + expect_equal(results75CodeBased$conditionalPowerSimulated, results75$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results75), "character") + df <- as.data.frame(results75) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results75) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results76 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + intersectionTest = "Sidak", varianceOption = "overallPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results76' with expected results + expect_equal(results76$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results76$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results76$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results76$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results76$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results76$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results76$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results76$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results76$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results76$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results76$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results76$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results76$conditionalRejectionProbabilities[1, ], c(0.024319059, 0.051462476, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results76$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results76$conditionalRejectionProbabilities[2, ], c(0.019837849, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results76$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results76$conditionalRejectionProbabilities[3, ], c(0.028516214, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results76$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results76$repeatedConfidenceIntervalLowerBounds[1, ], c(-40.59688, -26.894985, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results76$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results76$repeatedConfidenceIntervalLowerBounds[2, ], c(-34.364237, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results76$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results76$repeatedConfidenceIntervalLowerBounds[3, ], c(-42.654249, -31.405859, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results76$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results76$repeatedConfidenceIntervalUpperBounds[1, ], c(10.59688, 4.2407133, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results76$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results76$repeatedConfidenceIntervalUpperBounds[2, ], c(15.164237, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results76$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results76$repeatedConfidenceIntervalUpperBounds[3, ], c(7.6542489, -0.6529301, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results76$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results76$repeatedPValues[1, ], c(0.17734783, 0.06527034, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results76$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results76$repeatedPValues[2, ], c(0.23027951, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results76$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results76$repeatedPValues[3, ], c(0.14391589, 0.013711948, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results76$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results76$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.271, 0.447), tolerance = 1e-06, label = paste0("c(", paste0(results76$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results76$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results76$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results76$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results76$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results76), NA))) + expect_output(print(results76)$show()) + invisible(capture.output(expect_error(summary(results76), NA))) + expect_output(summary(results76)$show()) + results76CodeBased <- eval(parse(text = getObjectRCode(results76, stringWrapParagraphWidth = NULL))) + expect_equal(results76CodeBased$thetaH1, results76$thetaH1, tolerance = 1e-06) + expect_equal(results76CodeBased$assumedStDevs, results76$assumedStDevs, tolerance = 1e-06) + expect_equal(results76CodeBased$conditionalRejectionProbabilities, results76$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results76CodeBased$repeatedConfidenceIntervalLowerBounds, results76$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results76CodeBased$repeatedConfidenceIntervalUpperBounds, results76$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results76CodeBased$repeatedPValues, results76$repeatedPValues, tolerance = 1e-06) + expect_equal(results76CodeBased$conditionalPowerSimulated, results76$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results76), "character") + df <- as.data.frame(results76) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results76) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results77 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + intersectionTest = "Sidak", varianceOption = "overallPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results77' with expected results + expect_equal(results77$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results77$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results77$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results77$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results77$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results77$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results77$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results77$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results77$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results77$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results77$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results77$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results77$conditionalRejectionProbabilities[1, ], c(0.023469013, 0.048270226, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results77$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results77$conditionalRejectionProbabilities[2, ], c(0.019613852, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results77$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results77$conditionalRejectionProbabilities[3, ], c(0.026830382, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results77$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results77$repeatedConfidenceIntervalLowerBounds[1, ], c(-41.737451, -27.295819, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results77$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results77$repeatedConfidenceIntervalLowerBounds[2, ], c(-35.467707, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results77$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results77$repeatedConfidenceIntervalLowerBounds[3, ], c(-43.775098, -31.772829, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results77$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results77$repeatedConfidenceIntervalUpperBounds[1, ], c(11.737451, 4.6050352, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results77$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results77$repeatedConfidenceIntervalUpperBounds[2, ], c(16.267707, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results77$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results77$repeatedConfidenceIntervalUpperBounds[3, ], c(8.7750975, -0.30217392, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results77$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results77$repeatedPValues[1, ], c(0.18572393, 0.069730666, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results77$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results77$repeatedPValues[2, ], c(0.23360401, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results77$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results77$repeatedPValues[3, ], c(0.15596268, 0.017006886, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results77$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results77$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.26, 0.436), tolerance = 1e-06, label = paste0("c(", paste0(results77$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results77$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results77$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results77$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results77$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results77), NA))) + expect_output(print(results77)$show()) + invisible(capture.output(expect_error(summary(results77), NA))) + expect_output(summary(results77)$show()) + results77CodeBased <- eval(parse(text = getObjectRCode(results77, stringWrapParagraphWidth = NULL))) + expect_equal(results77CodeBased$thetaH1, results77$thetaH1, tolerance = 1e-06) + expect_equal(results77CodeBased$assumedStDevs, results77$assumedStDevs, tolerance = 1e-06) + expect_equal(results77CodeBased$conditionalRejectionProbabilities, results77$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results77CodeBased$repeatedConfidenceIntervalLowerBounds, results77$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results77CodeBased$repeatedConfidenceIntervalUpperBounds, results77$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results77CodeBased$repeatedPValues, results77$repeatedPValues, tolerance = 1e-06) + expect_equal(results77CodeBased$conditionalPowerSimulated, results77$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results77), "character") + df <- as.data.frame(results77) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results77) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results78 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + intersectionTest = "Sidak", varianceOption = "pairwisePooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results78' with expected results + expect_equal(results78$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results78$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results78$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results78$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results78$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results78$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results78$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results78$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results78$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results78$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results78$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results78$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results78$conditionalRejectionProbabilities[1, ], c(0.024748593, 0.053966892, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results78$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results78$conditionalRejectionProbabilities[2, ], c(0.021915713, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results78$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results78$conditionalRejectionProbabilities[3, ], c(0.0267758, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results78$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results78$repeatedConfidenceIntervalLowerBounds[1, ], c(-40.38015, -26.720108, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results78$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results78$repeatedConfidenceIntervalLowerBounds[2, ], c(-32.316502, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results78$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results78$repeatedConfidenceIntervalLowerBounds[3, ], c(-43.252551, -31.62149, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results78$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results78$repeatedConfidenceIntervalUpperBounds[1, ], c(10.38015, 4.0770639, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results78$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results78$repeatedConfidenceIntervalUpperBounds[2, ], c(13.116502, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results78$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results78$repeatedConfidenceIntervalUpperBounds[3, ], c(8.2525514, -0.41959343, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results78$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results78$repeatedPValues[1, ], c(0.17335289, 0.062127989, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results78$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results78$repeatedPValues[2, ], c(0.20285189, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results78$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results78$repeatedPValues[3, ], c(0.15638134, 0.015781417, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results78$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results78$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.277, 0.453), tolerance = 1e-06, label = paste0("c(", paste0(results78$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results78$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results78$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results78$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results78$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results78), NA))) + expect_output(print(results78)$show()) + invisible(capture.output(expect_error(summary(results78), NA))) + expect_output(summary(results78)$show()) + results78CodeBased <- eval(parse(text = getObjectRCode(results78, stringWrapParagraphWidth = NULL))) + expect_equal(results78CodeBased$thetaH1, results78$thetaH1, tolerance = 1e-06) + expect_equal(results78CodeBased$assumedStDevs, results78$assumedStDevs, tolerance = 1e-06) + expect_equal(results78CodeBased$conditionalRejectionProbabilities, results78$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results78CodeBased$repeatedConfidenceIntervalLowerBounds, results78$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results78CodeBased$repeatedConfidenceIntervalUpperBounds, results78$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results78CodeBased$repeatedPValues, results78$repeatedPValues, tolerance = 1e-06) + expect_equal(results78CodeBased$conditionalPowerSimulated, results78$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results78), "character") + df <- as.data.frame(results78) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results78) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results79 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + intersectionTest = "Sidak", varianceOption = "pairwisePooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results79' with expected results + expect_equal(results79$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results79$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results79$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results79$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results79$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results79$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results79$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results79$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results79$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results79$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results79$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results79$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results79$conditionalRejectionProbabilities[1, ], c(0.022923976, 0.04788638, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results79$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results79$conditionalRejectionProbabilities[2, ], c(0.021309255, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results79$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results79$conditionalRejectionProbabilities[3, ], c(0.023933809, 0.14146912, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results79$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results79$repeatedConfidenceIntervalLowerBounds[1, ], c(-42.960526, -27.347242, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results79$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results79$repeatedConfidenceIntervalLowerBounds[2, ], c(-34.425975, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results79$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results79$repeatedConfidenceIntervalLowerBounds[3, ], c(-45.752245, -32.205007, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results79$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results79$repeatedConfidenceIntervalUpperBounds[1, ], c(12.960526, 4.7313117, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results79$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results79$repeatedConfidenceIntervalUpperBounds[2, ], c(15.225975, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results79$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results79$repeatedConfidenceIntervalUpperBounds[3, ], c(10.752245, 0.16953037, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results79$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results79$repeatedPValues[1, ], c(0.19144883, 0.07030573, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results79$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results79$repeatedPValues[2, ], c(0.21026955, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results79$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results79$repeatedPValues[3, ], c(0.18106429, 0.021778109, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results79$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results79$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.259, 0.434), tolerance = 1e-06, label = paste0("c(", paste0(results79$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results79$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results79$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results79$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 0.656, 0.797), tolerance = 1e-06, label = paste0("c(", paste0(results79$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results79), NA))) + expect_output(print(results79)$show()) + invisible(capture.output(expect_error(summary(results79), NA))) + expect_output(summary(results79)$show()) + results79CodeBased <- eval(parse(text = getObjectRCode(results79, stringWrapParagraphWidth = NULL))) + expect_equal(results79CodeBased$thetaH1, results79$thetaH1, tolerance = 1e-06) + expect_equal(results79CodeBased$assumedStDevs, results79$assumedStDevs, tolerance = 1e-06) + expect_equal(results79CodeBased$conditionalRejectionProbabilities, results79$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results79CodeBased$repeatedConfidenceIntervalLowerBounds, results79$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results79CodeBased$repeatedConfidenceIntervalUpperBounds, results79$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results79CodeBased$repeatedPValues, results79$repeatedPValues, tolerance = 1e-06) + expect_equal(results79CodeBased$conditionalPowerSimulated, results79$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results79), "character") + df <- as.data.frame(results79) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results79) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results80 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + intersectionTest = "Dunnett", varianceOption = "overallPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = TRUE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results80' with expected results + expect_equal(results80$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results80$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results80$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results80$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results80$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results80$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results80$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results80$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results80$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results80$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results80$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results80$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results80$conditionalRejectionProbabilities[1, ], c(0.026270241, 0.055429536, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results80$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results80$conditionalRejectionProbabilities[2, ], c(0.019837849, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results80$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results80$conditionalRejectionProbabilities[3, ], c(0.032007473, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results80$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results80$repeatedConfidenceIntervalLowerBounds[1, ], c(-40.308137, -26.527814, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results80$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results80$repeatedConfidenceIntervalLowerBounds[2, ], c(-34.084887, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results80$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results80$repeatedConfidenceIntervalLowerBounds[3, ], c(-42.370499, -31.063081, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results80$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results80$repeatedConfidenceIntervalUpperBounds[1, ], c(10.308137, 3.9366921, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results80$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results80$repeatedConfidenceIntervalUpperBounds[2, ], c(14.884887, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results80$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results80$repeatedConfidenceIntervalUpperBounds[3, ], c(7.3704995, -0.96851041, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results80$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results80$repeatedPValues[1, ], c(0.1603448, 0.060420915, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results80$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results80$repeatedPValues[2, ], c(0.23027951, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results80$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results80$repeatedPValues[3, ], c(0.12340907, 0.011635803, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results80$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results80$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.286, 0.457), tolerance = 1e-06, label = paste0("c(", paste0(results80$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results80$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results80$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results80$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results80$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results80), NA))) + expect_output(print(results80)$show()) + invisible(capture.output(expect_error(summary(results80), NA))) + expect_output(summary(results80)$show()) + results80CodeBased <- eval(parse(text = getObjectRCode(results80, stringWrapParagraphWidth = NULL))) + expect_equal(results80CodeBased$thetaH1, results80$thetaH1, tolerance = 1e-06) + expect_equal(results80CodeBased$assumedStDevs, results80$assumedStDevs, tolerance = 1e-06) + expect_equal(results80CodeBased$conditionalRejectionProbabilities, results80$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results80CodeBased$repeatedConfidenceIntervalLowerBounds, results80$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results80CodeBased$repeatedConfidenceIntervalUpperBounds, results80$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results80CodeBased$repeatedPValues, results80$repeatedPValues, tolerance = 1e-06) + expect_equal(results80CodeBased$conditionalPowerSimulated, results80$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results80), "character") + df <- as.data.frame(results80) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results80) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results81 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + intersectionTest = "Dunnett", varianceOption = "overallPooled", nPlanned = c(20, 20), seed = 1234, iterations = 1000, normalApproximation = FALSE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsMultiArmFisher object 'results81' with expected results + expect_equal(results81$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results81$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results81$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results81$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results81$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results81$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results81$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results81$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results81$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results81$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results81$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results81$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results81$conditionalRejectionProbabilities[1, ], c(0.025452912, 0.052195908, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results81$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results81$conditionalRejectionProbabilities[2, ], c(0.019613852, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results81$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results81$conditionalRejectionProbabilities[3, ], c(0.030394861, 1, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results81$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results81$repeatedConfidenceIntervalLowerBounds[1, ], c(-41.358826, -26.891429, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results81$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results81$repeatedConfidenceIntervalLowerBounds[2, ], c(-35.101397, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results81$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results81$repeatedConfidenceIntervalLowerBounds[3, ], c(-43.40302, -31.392896, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results81$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results81$repeatedConfidenceIntervalUpperBounds[1, ], c(11.358826, 4.2590391, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results81$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results81$repeatedConfidenceIntervalUpperBounds[2, ], c(15.901398, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results81$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results81$repeatedConfidenceIntervalUpperBounds[3, ], c(8.4030195, -0.65705914, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results81$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results81$repeatedPValues[1, ], c(0.16712065, 0.064319528, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results81$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results81$repeatedPValues[2, ], c(0.23360401, NA_real_, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results81$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results81$repeatedPValues[3, ], c(0.13222768, 0.014210719, NA_real_, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(results81$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(results81$conditionalPowerSimulated[1, ], c(NA_real_, NA_real_, 0.272, 0.449), tolerance = 1e-06, label = paste0("c(", paste0(results81$conditionalPowerSimulated[1, ], collapse = ", "), ")")) + expect_equal(results81$conditionalPowerSimulated[2, ], c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(results81$conditionalPowerSimulated[2, ], collapse = ", "), ")")) + expect_equal(results81$conditionalPowerSimulated[3, ], c(NA_real_, NA_real_, 1, 1), label = paste0("c(", paste0(results81$conditionalPowerSimulated[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results81), NA))) + expect_output(print(results81)$show()) + invisible(capture.output(expect_error(summary(results81), NA))) + expect_output(summary(results81)$show()) + results81CodeBased <- eval(parse(text = getObjectRCode(results81, stringWrapParagraphWidth = NULL))) + expect_equal(results81CodeBased$thetaH1, results81$thetaH1, tolerance = 1e-06) + expect_equal(results81CodeBased$assumedStDevs, results81$assumedStDevs, tolerance = 1e-06) + expect_equal(results81CodeBased$conditionalRejectionProbabilities, results81$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results81CodeBased$repeatedConfidenceIntervalLowerBounds, results81$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results81CodeBased$repeatedConfidenceIntervalUpperBounds, results81$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results81CodeBased$repeatedPValues, results81$repeatedPValues, tolerance = 1e-06) + expect_equal(results81CodeBased$conditionalPowerSimulated, results81$conditionalPowerSimulated, tolerance = 1e-06) + expect_type(names(results81), "character") + df <- as.data.frame(results81) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results81) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Formula]{fs:multiarmRejectionRule} + # @refFS[Formula]{fs:adjustedPValueDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetDunnett} + # @refFS[Formula]{fs:adjustedPValueSubsetBonferroni} + # @refFS[Formula]{fs:adjustedPValueSubsetSidak} + # @refFS[Formula]{fs:adjustedPValueSubsetSimes} + # @refFS[Formula]{fs:adjustedPValueSubsetHierarchical} + # @refFS[Formula]{fs:conditionalRejectionProbabilityDunnett} + # @refFS[Formula]{fs:pValueConditionalSecondStageDunnett} + # @refFS[Formula]{fs:pValueUnconditionalSecondStageDunnett} + # @refFS[Formula]{fs:conditionalPowerMultiArm} + # @refFS[Formula]{fs:conditionalRejectionProbability} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalRejectionProbabilityMultiArm} + # @refFS[Formula]{fs:calculationRepeatedpValueMultiArm} + # @refFS[Formula]{fs:adjustedPValueForRCIDunnett} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimes} + # @refFS[Formula]{fs:adjustedPValueForRCISidak} + # @refFS[Formula]{fs:computeRCIsMultiArm} + results82 <- getAnalysisResults( + design = design3, dataInput = dataExample2, + intersectionTest = "Dunnett", varianceOption = "overallPooled", normalApproximation = TRUE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsConditionalDunnett object 'results82' with expected results + expect_equal(results82$thetaH1[1, ], -11.562259, tolerance = 1e-06, label = paste0("c(", paste0(results82$thetaH1[1, ], collapse = ", "), ")")) + expect_equal(results82$thetaH1[2, ], NA_real_, label = paste0("c(", paste0(results82$thetaH1[2, ], collapse = ", "), ")")) + expect_equal(results82$thetaH1[3, ], -16.036585, tolerance = 1e-06, label = paste0("c(", paste0(results82$thetaH1[3, ], collapse = ", "), ")")) + expect_equal(results82$assumedStDevs[1, ], 22.357668, tolerance = 1e-06, label = paste0("c(", paste0(results82$assumedStDevs[1, ], collapse = ", "), ")")) + expect_equal(results82$assumedStDevs[2, ], NA_real_, label = paste0("c(", paste0(results82$assumedStDevs[2, ], collapse = ", "), ")")) + expect_equal(results82$assumedStDevs[3, ], 22.943518, tolerance = 1e-06, label = paste0("c(", paste0(results82$assumedStDevs[3, ], collapse = ", "), ")")) + expect_equal(results82$conditionalRejectionProbabilities[1, ], c(NA_real_, 0.061352937), tolerance = 1e-05, label = paste0("c(", paste0(results82$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(results82$conditionalRejectionProbabilities[2, ], c(NA_real_, 0.03744742), tolerance = 1e-06, label = paste0("c(", paste0(results82$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(results82$conditionalRejectionProbabilities[3, ], c(NA_real_, 0.086511764), tolerance = 1e-06, label = paste0("c(", paste0(results82$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(results82$conditionalPower[1, ], c(NA_real_, NA_real_), label = paste0("c(", paste0(results82$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(results82$conditionalPower[2, ], c(NA_real_, NA_real_), label = paste0("c(", paste0(results82$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(results82$conditionalPower[3, ], c(NA_real_, NA_real_), label = paste0("c(", paste0(results82$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(results82$repeatedConfidenceIntervalLowerBounds[1, ], c(NA_real_, -22.538727), tolerance = 1e-06, label = paste0("c(", paste0(results82$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(results82$repeatedConfidenceIntervalLowerBounds[2, ], c(NA_real_, NA_real_), label = paste0("c(", paste0(results82$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(results82$repeatedConfidenceIntervalLowerBounds[3, ], c(NA_real_, -26.753532), tolerance = 1e-06, label = paste0("c(", paste0(results82$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(results82$repeatedConfidenceIntervalUpperBounds[1, ], c(NA_real_, 0.72441408), tolerance = 1e-06, label = paste0("c(", paste0(results82$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(results82$repeatedConfidenceIntervalUpperBounds[2, ], c(NA_real_, NA_real_), label = paste0("c(", paste0(results82$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(results82$repeatedConfidenceIntervalUpperBounds[3, ], c(NA_real_, -3.9389155), tolerance = 1e-06, label = paste0("c(", paste0(results82$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(results82$repeatedPValues[1, ], c(NA_real_, 0.017445576), tolerance = 1e-06, label = paste0("c(", paste0(results82$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(results82$repeatedPValues[2, ], c(NA_real_, NA_real_), label = paste0("c(", paste0(results82$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(results82$repeatedPValues[3, ], c(NA_real_, 0.0019493527), tolerance = 1e-06, label = paste0("c(", paste0(results82$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(results82), NA))) + expect_output(print(results82)$show()) + invisible(capture.output(expect_error(summary(results82), NA))) + expect_output(summary(results82)$show()) + results82CodeBased <- eval(parse(text = getObjectRCode(results82, stringWrapParagraphWidth = NULL))) + expect_equal(results82CodeBased$thetaH1, results82$thetaH1, tolerance = 1e-06) + expect_equal(results82CodeBased$assumedStDevs, results82$assumedStDevs, tolerance = 1e-06) + expect_equal(results82CodeBased$conditionalRejectionProbabilities, results82$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(results82CodeBased$conditionalPower, results82$conditionalPower, tolerance = 1e-06) + expect_equal(results82CodeBased$repeatedConfidenceIntervalLowerBounds, results82$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(results82CodeBased$repeatedConfidenceIntervalUpperBounds, results82$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(results82CodeBased$repeatedPValues, results82$repeatedPValues, tolerance = 1e-06) + expect_type(names(results82), "character") + df <- as.data.frame(results82) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(results82) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } }) diff --git a/tests/testthat/test-f_core_assertions.R b/tests/testthat/test-f_core_assertions.R index 2ae6a5e1..07ec8287 100644 --- a/tests/testthat/test-f_core_assertions.R +++ b/tests/testthat/test-f_core_assertions.R @@ -1,253 +1,254 @@ -## | -## | *Unit tests* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | RPACT package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File name: test-f_core_assertions.R -## | Creation date: 08 November 2023, 09:09:35 -## | File version: $Revision$ -## | Last changed: $Date$ -## | Last changed by: $Author$ -## | - -test_plan_section("Testing Assertion Functions") - - -test_that("Testing '.assertIsInClosedInterval'", { - invisible(capture.output(expect_error(.assertIsInClosedInterval(x = 0, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) - invisible(capture.output(expect_error(.assertIsInClosedInterval(x = 1, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) - invisible(capture.output(expect_error(.assertIsInClosedInterval(x = 0.0001, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) - invisible(capture.output(expect_error(.assertIsInClosedInterval(x = 0.9999, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) - invisible(capture.output(expect_error(.assertIsInClosedInterval(x = NA_real_, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) - invisible(capture.output(expect_error(.assertIsInClosedInterval(x = NA_real_, xName = "x", lower = 0, upper = 1, naAllowed = TRUE), NA))) - invisible(capture.output(expect_error(.assertIsInClosedInterval(x = c(1, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = TRUE), NA))) - invisible(capture.output(expect_error(.assertIsInClosedInterval(x = c(NA_real_, 0, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = TRUE), NA))) - - expect_error(.assertIsInClosedInterval(x = -0.0001, xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) - expect_error(.assertIsInClosedInterval(x = -0.0001, xName = "x", lower = 0, upper = NA_real_, naAllowed = FALSE)) - expect_error(.assertIsInClosedInterval(x = 1.0001, xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) - expect_error(.assertIsInClosedInterval(x = c(1, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) - expect_error(.assertIsInClosedInterval(x = c(-1, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = TRUE)) - expect_error(.assertIsInClosedInterval(x = c(NA_real_, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) - expect_error(.assertIsInClosedInterval(x = c(0, -1, 1, 2), xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) - -}) - -test_that("Testing '.assertIsInOpenInterval'", { - - invisible(capture.output(expect_error(.assertIsInOpenInterval(x = 0.0001, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) - invisible(capture.output(expect_error(.assertIsInOpenInterval(x = 0.9999, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) - invisible(capture.output(expect_error(.assertIsInOpenInterval(x = NA_real_, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) - invisible(capture.output(expect_error(.assertIsInOpenInterval(x = NA_real_, xName = "x", lower = 0, upper = 1, naAllowed = TRUE), NA))) - invisible(capture.output(expect_error(.assertIsInOpenInterval(x = c(0.9999, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = TRUE), NA))) - invisible(capture.output(expect_error(.assertIsInOpenInterval(x = c(NA_real_, 0.0001, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = TRUE), NA))) - - expect_error(.assertIsInOpenInterval(x = 0, xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) - expect_error(.assertIsInOpenInterval(x = 0, xName = "x", lower = 0, upper = NA_real_, naAllowed = FALSE)) - expect_error(.assertIsInOpenInterval(x = 1, xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) - expect_error(.assertIsInOpenInterval(x = c(1.0001, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) - expect_error(.assertIsInOpenInterval(x = c(-1, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = TRUE)) - expect_error(.assertIsInOpenInterval(x = c(NA_real_, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) - expect_error(.assertIsInOpenInterval(x = c(0, -1, 1, 2), xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) - -}) - -test_that("Testing '.assertDesignParameterExists'", { - - expect_error(.assertDesignParameterExists(), - "Missing argument: 'design' must be defined", - fixed = TRUE - ) - - expect_error(.assertDesignParameterExists(design = getAssertionTestDesign()), - "Missing argument: 'parameterName' must be defined", - fixed = TRUE - ) - - expect_error(.assertDesignParameterExists(design = getAssertionTestDesign(), parameterName = "kMax"), - "Missing argument: 'defaultValue' must be defined", - fixed = TRUE - ) - - expect_error(.assertDesignParameterExists( - design = getAssertionTestDesign(), - parameterName = "kMax", defaultValue = C_KMAX_DEFAULT - ), - "Missing argument: parameter 'kMax' must be specified in design", - fixed = TRUE - ) - - expect_error(.assertDesignParameterExists( - design = getAssertionTestDesign(kMax = NA_integer_), - parameterName = "kMax", defaultValue = C_KMAX_DEFAULT - ), - "Missing argument: parameter 'kMax' must be specified in design", - fixed = TRUE - ) - -}) - -test_that("Testing '.assertIsValidThetaRange'", { - - expect_error(.assertIsValidThetaRange(thetaRange = c()), - "Illegal argument: 'thetaRange' (NULL) must be a vector with two entries defining minimum and maximum or a sequence of numeric values with length > 2", - fixed = TRUE - ) - - expect_error(.assertIsValidThetaRange(thetaRange = c(1, -2)), - "Illegal argument: 'thetaRange' with length 2 must contain minimum < maximum (1 >= -2)", - fixed = TRUE - ) - - expect_equal(.assertIsValidThetaRange(thetaRange = c(1, 2, 3)), c(1, 2, 3)) - - expect_equal(.assertIsValidThetaRange(thetaRange = c(-1, 2)), seq(-1, 2, 3 / C_THETA_RANGE_SEQUENCE_LENGTH_DEFAULT)) - -}) - -test_that("Testing '.assertIsSingleNumber'", { - - expect_error(.assertIsSingleNumber(NA, "x"), - "Illegal argument: 'x' (NA) must be a valid numeric value", - fixed = TRUE - ) - - expect_error(.assertIsSingleNumber(NULL, "x"), - "Missing argument: 'x' must be a valid numeric value", - fixed = TRUE - ) - - expect_error(.assertIsSingleNumber(c(1, 2), "x"), - "Illegal argument: 'x' c(1, 2) must be a single numeric value", - fixed = TRUE - ) - - expect_error(.assertIsSingleNumber(numeric(0), "x"), - "Missing argument: 'x' must be a valid numeric value", - fixed = TRUE - ) - -}) - -test_that("Testing '.assertAssociatedArgumentsAreDefined'", { - - expect_error(.assertAssociatedArgumentsAreDefined(a = NA, b = 1), - "Missing argument: 'a' must be defined because 'b' is defined", - fixed = TRUE - ) - - expect_error(.assertAssociatedArgumentsAreDefined(a = NA, b = 1, c = NA), - "Missing argument: 'a', 'c' must be defined because 'b' is defined", - fixed = TRUE - ) - - expect_error(.assertAssociatedArgumentsAreDefined(a = NA, b = 1, c = 2), - "Missing argument: 'a' must be defined because 'b', 'c' are defined", - fixed = TRUE - ) - -}) - -test_that("Testing '.associatedArgumentsAreDefined'", { - - expect_equal(.associatedArgumentsAreDefined(nPlanned = NA_real_, thetaH1 = NA_real_), FALSE) - - expect_warning(expect_equal(.associatedArgumentsAreDefined(nPlanned = NA_real_, thetaH1 = 1), FALSE), - "Incomplete associated arguments: 'nPlanned' should be defined because 'thetaH1' is defined", - fixed = TRUE - ) - - expect_equal(.associatedArgumentsAreDefined(nPlanned = 1, thetaH1 = 1), TRUE) - -}) - -test_that("Testing '.isValidNPlanned'", { - - expect_equal(.isValidNPlanned(nPlanned = c(1, 2), kMax = 4, stage = 2), TRUE) - - expect_silent(.isValidNPlanned(nPlanned = NA_real_, kMax = 4, stage = 2)) - - expect_warning(.isValidNPlanned(nPlanned = c(1), kMax = 4, stage = 2), - "'nPlanned' (1) will be ignored: length must be equal to 2 (kMax - stage = 4 - 2)", - fixed = TRUE - ) - - expect_warning(.isValidNPlanned(nPlanned = c(1, 2, 3), kMax = 4, stage = 2), - "'nPlanned' (1, 2, 3) will be ignored: length must be equal to 2 (kMax - stage = 4 - 2)", - fixed = TRUE - ) - -}) - -test_that("Testing '.assertIsValidSummaryIntervalFormat'", { - - .assertIsValidSummaryIntervalFormat("[%s; %s]") - .assertIsValidSummaryIntervalFormat("%s - %s") - .assertIsValidSummaryIntervalFormat("(%s, %s)") - - expect_error(.assertIsValidSummaryIntervalFormat("[%s; %s; %s]")) - expect_error(.assertIsValidSummaryIntervalFormat("[%s]")) - expect_error(.assertIsValidSummaryIntervalFormat("")) - expect_error(.assertIsValidSummaryIntervalFormat(1)) - -}) - -test_that("Testing '.assertIsSingleInteger'", { - - expect_error(.assertIsSingleInteger(NA_integer_, "x", naAllowed = FALSE)) - expect_error(.assertIsSingleInteger(-1, "x", naAllowed = FALSE)) - expect_error(.assertIsSingleInteger(-1, "x", naAllowed = FALSE, validateType = FALSE), NA) - expect_error(.assertIsSingleInteger(NA_integer_, "x", naAllowed = TRUE), NA) - expect_error(.assertIsSingleInteger(-1, "x", naAllowed = TRUE)) - expect_error(.assertIsSingleInteger("1", "x", naAllowed = TRUE)) - expect_error(.assertIsSingleInteger(1, "x", naAllowed = TRUE, validateType = TRUE)) - expect_error(.assertIsSingleInteger(1, "x", naAllowed = TRUE, validateType = FALSE), NA) - -}) - -test_that("Testing '.assertIsSinglePositiveInteger'", { - - expect_error(.assertIsSinglePositiveInteger(NA_integer_, "x", naAllowed = FALSE)) - expect_error(.assertIsSinglePositiveInteger(-1, "x", naAllowed = FALSE)) - expect_error(.assertIsSinglePositiveInteger(NA_integer_, "x", naAllowed = TRUE), NA) - expect_error(.assertIsSinglePositiveInteger(NA_real_, "x", naAllowed = TRUE)) - expect_error(.assertIsSinglePositiveInteger(-1, "x", naAllowed = TRUE)) - expect_error(.assertIsSinglePositiveInteger("1", "x", naAllowed = TRUE)) - expect_error(.assertIsSinglePositiveInteger(1, "x", naAllowed = TRUE, validateType = TRUE)) - expect_error(.assertIsSinglePositiveInteger(1, "x", naAllowed = TRUE, validateType = FALSE), NA) - -}) - -test_that("Testing '.assertIsSingleLogical'", { - - expect_error(.assertIsSingleLogical("TRUE", "x", naAllowed = FALSE)) - expect_error(.assertIsSingleLogical("FALSE", "x", naAllowed = FALSE)) - expect_error(.assertIsSingleLogical(TRUE, "x", naAllowed = FALSE), NA) - expect_error(.assertIsSingleLogical(FALSE, "x", naAllowed = FALSE), NA) - expect_error(.assertIsSingleLogical(NA, "x", naAllowed = TRUE), NA) - expect_error(.assertIsSingleLogical(NA, "x", naAllowed = FALSE)) - -}) - -test_that("Testing '.assertIsValidMatrix'", { - - expect_error(.assertIsValidMatrix(c(), "x", naAllowed = FALSE)) - expect_error(.assertIsValidMatrix(NULL, "x", naAllowed = FALSE)) - expect_error(.assertIsValidMatrix(1:3, "x", naAllowed = FALSE)) - expect_error(.assertIsValidMatrix(1:3, "x", naAllowed = TRUE)) - expect_error(.assertIsValidMatrix("a", "x", naAllowed = FALSE)) - expect_error(.assertIsValidMatrix("a", "x", naAllowed = TRUE)) - expect_error(.assertIsValidMatrix(NA, "x", naAllowed = FALSE)) - expect_error(.assertIsValidMatrix(NA, "x", naAllowed = TRUE)) -}) - +## | +## | *Unit tests* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | RPACT package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File name: test-f_core_assertions.R +## | Creation date: 08 November 2023, 09:09:35 +## | File version: $Revision$ +## | Last changed: $Date$ +## | Last changed by: $Author$ +## | + +test_plan_section("Testing Assertion Functions") + + +test_that("Testing '.assertIsInClosedInterval'", { + invisible(capture.output(expect_error(.assertIsInClosedInterval(x = 0, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) + invisible(capture.output(expect_error(.assertIsInClosedInterval(x = 1, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) + invisible(capture.output(expect_error(.assertIsInClosedInterval(x = 0.0001, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) + invisible(capture.output(expect_error(.assertIsInClosedInterval(x = 0.9999, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) + invisible(capture.output(expect_error(.assertIsInClosedInterval(x = NA_real_, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) + invisible(capture.output(expect_error(.assertIsInClosedInterval(x = NA_real_, xName = "x", lower = 0, upper = 1, naAllowed = TRUE), NA))) + invisible(capture.output(expect_error(.assertIsInClosedInterval(x = c(1, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = TRUE), NA))) + invisible(capture.output(expect_error(.assertIsInClosedInterval(x = c(NA_real_, 0, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = TRUE), NA))) + + expect_error(.assertIsInClosedInterval(x = -0.0001, xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) + expect_error(.assertIsInClosedInterval(x = -0.0001, xName = "x", lower = 0, upper = NA_real_, naAllowed = FALSE)) + expect_error(.assertIsInClosedInterval(x = 1.0001, xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) + expect_error(.assertIsInClosedInterval(x = c(1, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) + expect_error(.assertIsInClosedInterval(x = c(-1, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = TRUE)) + expect_error(.assertIsInClosedInterval(x = c(NA_real_, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) + expect_error(.assertIsInClosedInterval(x = c(0, -1, 1, 2), xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) + +}) + +test_that("Testing '.assertIsInOpenInterval'", { + + invisible(capture.output(expect_error(.assertIsInOpenInterval(x = 0.0001, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) + invisible(capture.output(expect_error(.assertIsInOpenInterval(x = 0.9999, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) + invisible(capture.output(expect_error(.assertIsInOpenInterval(x = NA_real_, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) + invisible(capture.output(expect_error(.assertIsInOpenInterval(x = NA_real_, xName = "x", lower = 0, upper = 1, naAllowed = TRUE), NA))) + invisible(capture.output(expect_error(.assertIsInOpenInterval(x = c(0.9999, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = TRUE), NA))) + invisible(capture.output(expect_error(.assertIsInOpenInterval(x = c(NA_real_, 0.0001, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = TRUE), NA))) + + expect_error(.assertIsInOpenInterval(x = 0, xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) + expect_error(.assertIsInOpenInterval(x = 0, xName = "x", lower = 0, upper = NA_real_, naAllowed = FALSE)) + expect_error(.assertIsInOpenInterval(x = 1, xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) + expect_error(.assertIsInOpenInterval(x = c(1.0001, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) + expect_error(.assertIsInOpenInterval(x = c(-1, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = TRUE)) + expect_error(.assertIsInOpenInterval(x = c(NA_real_, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) + expect_error(.assertIsInOpenInterval(x = c(0, -1, 1, 2), xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) + +}) + +test_that("Testing '.assertDesignParameterExists'", { + + expect_error(.assertDesignParameterExists(), + "Missing argument: 'design' must be defined", + fixed = TRUE + ) + + expect_error(.assertDesignParameterExists(design = getAssertionTestDesign()), + "Missing argument: 'parameterName' must be defined", + fixed = TRUE + ) + + expect_error(.assertDesignParameterExists(design = getAssertionTestDesign(), parameterName = "kMax"), + "Missing argument: 'defaultValue' must be defined", + fixed = TRUE + ) + + expect_error(.assertDesignParameterExists( + design = getAssertionTestDesign(), + parameterName = "kMax", defaultValue = C_KMAX_DEFAULT + ), + "Missing argument: parameter 'kMax' must be specified in design", + fixed = TRUE + ) + + expect_error(.assertDesignParameterExists( + design = getAssertionTestDesign(kMax = NA_integer_), + parameterName = "kMax", defaultValue = C_KMAX_DEFAULT + ), + "Missing argument: parameter 'kMax' must be specified in design", + fixed = TRUE + ) + +}) + +test_that("Testing '.assertIsValidThetaRange'", { + + expect_error(.assertIsValidThetaRange(thetaRange = c()), + "Illegal argument: 'thetaRange' (NULL) must be a vector with two entries defining minimum and maximum or a sequence of numeric values with length > 2", + fixed = TRUE + ) + + expect_error(.assertIsValidThetaRange(thetaRange = c(1, -2)), + "Illegal argument: 'thetaRange' with length 2 must contain minimum < maximum (1 >= -2)", + fixed = TRUE + ) + + expect_equal(.assertIsValidThetaRange(thetaRange = c(1, 2, 3)), c(1, 2, 3)) + + expect_equal(.assertIsValidThetaRange(thetaRange = c(-1, 2)), seq(-1, 2, 3 / C_THETA_RANGE_SEQUENCE_LENGTH_DEFAULT)) + +}) + +test_that("Testing '.assertIsSingleNumber'", { + + expect_error(.assertIsSingleNumber(NA, "x"), + "Illegal argument: 'x' (NA) must be a valid numeric value", + fixed = TRUE + ) + + expect_error(.assertIsSingleNumber(NULL, "x"), + "Missing argument: 'x' must be a valid numeric value", + fixed = TRUE + ) + + expect_error(.assertIsSingleNumber(c(1, 2), "x"), + "Illegal argument: 'x' c(1, 2) must be a single numeric value", + fixed = TRUE + ) + + expect_error(.assertIsSingleNumber(numeric(0), "x"), + "Missing argument: 'x' must be a valid numeric value", + fixed = TRUE + ) + +}) + +test_that("Testing '.assertAssociatedArgumentsAreDefined'", { + + expect_error(.assertAssociatedArgumentsAreDefined(a = NA, b = 1), + "Missing argument: 'a' must be defined because 'b' is defined", + fixed = TRUE + ) + + expect_error(.assertAssociatedArgumentsAreDefined(a = NA, b = 1, c = NA), + "Missing argument: 'a', 'c' must be defined because 'b' is defined", + fixed = TRUE + ) + + expect_error(.assertAssociatedArgumentsAreDefined(a = NA, b = 1, c = 2), + "Missing argument: 'a' must be defined because 'b', 'c' are defined", + fixed = TRUE + ) + +}) + +test_that("Testing '.associatedArgumentsAreDefined'", { + + expect_equal(.associatedArgumentsAreDefined(nPlanned = NA_real_, thetaH1 = NA_real_), FALSE) + + expect_warning(expect_equal(.associatedArgumentsAreDefined(nPlanned = NA_real_, thetaH1 = 1), FALSE), + "Incomplete associated arguments: 'nPlanned' should be defined because 'thetaH1' is defined", + fixed = TRUE + ) + + expect_equal(.associatedArgumentsAreDefined(nPlanned = 1, thetaH1 = 1), TRUE) + +}) + +test_that("Testing '.isValidNPlanned'", { + + expect_equal(.isValidNPlanned(nPlanned = c(1, 2), kMax = 4, stage = 2), TRUE) + + expect_silent(.isValidNPlanned(nPlanned = NA_real_, kMax = 4, stage = 2)) + + expect_warning(.isValidNPlanned(nPlanned = c(1), kMax = 4, stage = 2), + "'nPlanned' (1) will be ignored: length must be equal to 2 (kMax - stage = 4 - 2)", + fixed = TRUE + ) + + expect_warning(.isValidNPlanned(nPlanned = c(1, 2, 3), kMax = 4, stage = 2), + "'nPlanned' (1, 2, 3) will be ignored: length must be equal to 2 (kMax - stage = 4 - 2)", + fixed = TRUE + ) + +}) + +test_that("Testing '.assertIsValidSummaryIntervalFormat'", { + + .assertIsValidSummaryIntervalFormat("[%s; %s]") + .assertIsValidSummaryIntervalFormat("%s - %s") + .assertIsValidSummaryIntervalFormat("(%s, %s)") + + expect_error(.assertIsValidSummaryIntervalFormat("[%s; %s; %s]")) + expect_error(.assertIsValidSummaryIntervalFormat("[%s]")) + expect_error(.assertIsValidSummaryIntervalFormat("")) + expect_error(.assertIsValidSummaryIntervalFormat(1)) + +}) + +test_that("Testing '.assertIsSingleInteger'", { + + expect_error(.assertIsSingleInteger(NA_integer_, "x", naAllowed = FALSE)) + expect_error(.assertIsSingleInteger(-1, "x", naAllowed = FALSE)) + expect_error(.assertIsSingleInteger(-1, "x", naAllowed = FALSE, validateType = FALSE), NA) + expect_error(.assertIsSingleInteger(NA_integer_, "x", naAllowed = TRUE), NA) + expect_error(.assertIsSingleInteger(-1, "x", naAllowed = TRUE)) + expect_error(.assertIsSingleInteger("1", "x", naAllowed = TRUE)) + expect_error(.assertIsSingleInteger(1, "x", naAllowed = TRUE, validateType = TRUE)) + expect_error(.assertIsSingleInteger(1, "x", naAllowed = TRUE, validateType = FALSE), NA) + +}) + +test_that("Testing '.assertIsSinglePositiveInteger'", { + + expect_error(.assertIsSinglePositiveInteger(NA_integer_, "x", naAllowed = FALSE)) + expect_error(.assertIsSinglePositiveInteger(-1, "x", naAllowed = FALSE)) + expect_error(.assertIsSinglePositiveInteger(NA_integer_, "x", naAllowed = TRUE), NA) + expect_error(.assertIsSinglePositiveInteger(NA_real_, "x", naAllowed = TRUE)) + expect_error(.assertIsSinglePositiveInteger(-1, "x", naAllowed = TRUE)) + expect_error(.assertIsSinglePositiveInteger("1", "x", naAllowed = TRUE)) + expect_error(.assertIsSinglePositiveInteger(1, "x", naAllowed = TRUE, validateType = TRUE)) + expect_error(.assertIsSinglePositiveInteger(1, "x", naAllowed = TRUE, validateType = FALSE), NA) + +}) + +test_that("Testing '.assertIsSingleLogical'", { + + expect_error(.assertIsSingleLogical("TRUE", "x", naAllowed = FALSE)) + expect_error(.assertIsSingleLogical("FALSE", "x", naAllowed = FALSE)) + expect_error(.assertIsSingleLogical(TRUE, "x", naAllowed = FALSE), NA) + expect_error(.assertIsSingleLogical(FALSE, "x", naAllowed = FALSE), NA) + expect_error(.assertIsSingleLogical(NA, "x", naAllowed = TRUE), NA) + expect_error(.assertIsSingleLogical(NA, "x", naAllowed = FALSE)) + +}) + +test_that("Testing '.assertIsValidMatrix'", { + + expect_error(.assertIsValidMatrix(c(), "x", naAllowed = FALSE)) + expect_error(.assertIsValidMatrix(NULL, "x", naAllowed = FALSE)) + expect_error(.assertIsValidMatrix(1:3, "x", naAllowed = FALSE)) + expect_error(.assertIsValidMatrix(1:3, "x", naAllowed = TRUE)) + expect_error(.assertIsValidMatrix("a", "x", naAllowed = FALSE)) + expect_error(.assertIsValidMatrix("a", "x", naAllowed = TRUE)) + expect_error(.assertIsValidMatrix(NA, "x", naAllowed = FALSE)) + expect_error(.assertIsValidMatrix(NA, "x", naAllowed = TRUE)) + +}) + diff --git a/tests/testthat/test-f_core_output_formats.R b/tests/testthat/test-f_core_output_formats.R index 78431f5e..1af5767b 100644 --- a/tests/testthat/test-f_core_output_formats.R +++ b/tests/testthat/test-f_core_output_formats.R @@ -1,442 +1,443 @@ -## | -## | *Unit tests* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | RPACT package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File name: test-f_core_output_formats.R -## | Creation date: 08 November 2023, 09:09:35 -## | File version: $Revision: 7665 $ -## | Last changed: $Date: 2024-02-23 17:33:46 +0100 (Fr, 23 Feb 2024) $ -## | Last changed by: $Author: pahlke $ -## | - -test_plan_section("Testing the Output Format Functions") - - -test_that("'.formatPValues'", { - # @refFS[Sec.]{fs:sec:outputFormats} - # @refFS[Tab.]{fs:tab:outputFormats} - x <- .formatPValues(0.0000234) - - ## Comparison of the results of character object 'x' with expected results - expect_equal(x, "<0.0001", label = paste0("c(", paste0(x, collapse = ", "), ")")) - - x <- .formatPValues(c(0.0000234, 0.0000134, 0.1234)) - - ## Comparison of the results of character object 'x' with expected results - expect_equal(x, c("<0.0001", "<0.0001", "0.1234"), label = paste0("c(", paste0(x, collapse = ", "), ")")) - - x <- .formatPValues(c(0.0002345678, 0.0000134, 0.1234, 0.000000000001, .00000009999)) - - ## Comparison of the results of character object 'x' with expected results - expect_equal(x, c("0.0002346", "0.0000134", "0.1234000", "<0.000001", "<0.000001"), label = paste0("c(", paste0(x, collapse = ", "), ")")) - - x <- .formatPValues(c(0.00234, 0.000013, 0.1234, 0.000000000001, .00000009999)) - - ## Comparison of the results of character object 'x' with expected results - expect_equal(x, c("0.00234", "<0.0001", "0.12340", "<0.0001", "<0.0001"), label = paste0("c(", paste0(x, collapse = ", "), ")")) - - x <- .formatPValues(c(6.244e-05, 4.906e-02, 1.446e-02, NA_real_)) - - ## Comparison of the results of character object 'x' with expected results - expect_equal(x, c("<0.0001", "0.04906", "0.01446", "NA"), label = paste0("c(", paste0(x, collapse = ", "), ")")) - - x <- .formatPValues(c(6.24408201934656e-05, 7.55449751868031e-05, 1.23207030919836e-05, NA_real_)) - - ## Comparison of the results of character object 'x' with expected results - expect_equal(x, c("<0.0001", "<0.0001", "<0.0001", "NA"), label = paste0("c(", paste0(x, collapse = ", "), ")")) - -}) - -test_that("'.formatRepeatedPValues'", { - - # @refFS[Sec.]{fs:sec:outputFormats} - # @refFS[Tab.]{fs:tab:outputFormats} - x <- .formatRepeatedPValues(c(0.0000234, 0.0000134, 0.1234)) - - ## Comparison of the results of character object 'x' with expected results - expect_equal(x, c("<0.0001", "<0.0001", "0.1234"), label = paste0("c(", paste0(x, collapse = ", "), ")")) - - x <- .formatRepeatedPValues(c(0.0000234, 0.0000134, 0.5234)) - - ## Comparison of the results of character object 'x' with expected results - expect_equal(x, c("<0.0001", "<0.0001", ">0.5"), label = paste0("c(", paste0(x, collapse = ", "), ")")) - - x <- .formatRepeatedPValues(c(0.0000234, 0.0000134, 0.5234, NA_real_)) - - ## Comparison of the results of character object 'x' with expected results - expect_equal(x, c("<0.0001", "<0.0001", ">0.5", "NA"), label = paste0("c(", paste0(x, collapse = ", "), ")")) - -}) - -test_that("'.formatConditionalPower'", { - - # @refFS[Sec.]{fs:sec:outputFormats} - # @refFS[Tab.]{fs:tab:outputFormats} - x <- .formatConditionalPower(c(0.0000234, 0.0000134, 0.5234, NA_real_)) - - ## Comparison of the results of character object 'x' with expected results - expect_equal(x, c("0", "0", "0.5234", "NA"), label = paste0("c(", paste0(x, collapse = ", "), ")")) - - x <- .formatConditionalPower(c(0.234, 0.123456, 0.6, 0.000001)) - - ## Comparison of the results of character object 'x' with expected results - expect_equal(x, c("0.2340", "0.1235", "0.6000", "0"), label = paste0("c(", paste0(x, collapse = ", "), ")")) - -}) - -test_that("'.formatProbabilities'", { - - # @refFS[Sec.]{fs:sec:outputFormats} - # @refFS[Tab.]{fs:tab:outputFormats} - x <- .formatProbabilities(c(NA_real_, NA_real_, 0.4536623, 0.7713048)) - - ## Comparison of the results of character object 'x' with expected results - expect_equal(x, c("NA", "NA", "0.4537", "0.7713"), label = paste0("c(", paste0(x, collapse = ", "), ")")) - -}) - -test_that("'.getDecimalPlaces'", { - - # @refFS[Sec.]{fs:sec:outputFormats} - # @refFS[Tab.]{fs:tab:outputFormats} - x <- .getDecimalPlaces(NA) - - ## Comparison of the results of integer object 'x' with expected results - expect_equal(x, 0, label = paste0("c(", paste0(x, collapse = ", "), ")")) - - x <- .getDecimalPlaces(12.123) - - ## Comparison of the results of integer object 'x' with expected results - expect_equal(x, 3, label = paste0("c(", paste0(x, collapse = ", "), ")")) - - x <- .getDecimalPlaces(c(6.661338e-16, 8.000000e-01, NA_real_)) - - ## Comparison of the results of integer object 'x' with expected results - expect_equal(x, c(15, 1, 0), label = paste0("c(", paste0(x, collapse = ", "), ")")) - - x <- .getDecimalPlaces(c(6.661338e-16, 8.12300000e-02)) - - ## Comparison of the results of integer object 'x' with expected results - expect_equal(x, c(15, 5), label = paste0("c(", paste0(x, collapse = ", "), ")")) - -}) - -test_that(" Internal output format functions throw errors when arguments are missing or wrong", { - - expect_equal(.getFormattedValue(), "NA") - expect_error(.assertIsValitOutputFormatOptionValue()) - expect_error(.getOutputFormatOptions()) - expect_error(.getOptionBasedFormattedValue()) - expect_no_error(getOutputFormat()) - expect_no_error(.getOutputFormat()) - expect_error(.addFieldsToOutputFormatList()) - expect_error(.getOutputFormatParameterNames()) - expect_error(.getOutputFormatFunctionName()) - expect_error(.getOutputFormatKeyByFieldName()) - expect_error(.getOutputFormatKeyByFunctionName()) - -}) - -test_that(".assertIsValidOutputFormatOptionValue handles valid option value'", { - - # Valid option value - optionKey <- "exampleKey" - optionValue <- "roundFunction = ceiling" - - # Call the function being tested - result <- .assertIsValidOutputFormatOptionValue(optionKey, optionValue) - - # Expect no error or exception - expect_null(result) - -}) - -test_that(".assertIsValidOutputFormatOptionValue handles invalid empty option value'", { - - # Invalid empty option value - optionKey <- "exampleKey" - optionValue <- "" - - # Call the function being tested - result <- capture_output(.assertIsValidOutputFormatOptionValue(optionKey, optionValue)) - - # Expect an error message - expect_match(result, "") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.p.value'", { - - key <- "rpact.output.format.p.value" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatPValues") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.repeated.p.value'", { - - key <- "rpact.output.format.repeated.p.value" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatRepeatedPValues") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.probability'", { - - key <- "rpact.output.format.probability" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatProbabilities") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.futility.probability'", { - - key <- "rpact.output.format.futility.probability" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatFutilityProbabilities") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.sample.size'", { - - key <- "rpact.output.format.sample.size" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatSampleSizes") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.event'", { - - key <- "rpact.output.format.event" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatEvents") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.event.time'", { - - key <- "rpact.output.format.event.time" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatEventTime") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.conditional.power'", { - - key <- "rpact.output.format.conditional.power" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatConditionalPower") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.critical.value'", { - - key <- "rpact.output.format.critical.value" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatCriticalValues") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.critical.value.fisher'", { - - key <- "rpact.output.format.critical.value.fisher" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatCriticalValuesFisher") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.test.statistic.fisher'", { - - key <- "rpact.output.format.test.statistic.fisher" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatTestStatisticsFisher") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.test.statistic'", { - - key <- "rpact.output.format.test.statistic" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatTestStatistics") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.rate'", { - - key <- "rpact.output.format.rate" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatRates") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.rate1'", { - - key <- "rpact.output.format.rate1" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatRatesDynamic") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.accrual.intensity'", { - - key <- "rpact.output.format.accrual.intensity" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatAccrualIntensities") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.mean'", { - - key <- "rpact.output.format.mean" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatMeans") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.ratio'", { - - key <- "rpact.output.format.ratio" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatRatios") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.st.dev'", { - - key <- "rpact.output.format.st.dev" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatStDevs") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.duration'", { - - key <- "rpact.output.format.duration" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatDurations") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.time'", { - - key <- "rpact.output.format.time" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatTime") - -}) - -test_that(".getOutputFormatFunctionName returns NULL for unknown key", { - - key <- "unknown.key" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect NULL as the result - expect_null(result) - -}) - -test_that(".getOptionBasedFormattedValue returns NULL for unknown option key", { - - optionKey <- "unknown.key" - value <- 0.123 - - # Call the function being tested - result <- .getOptionBasedFormattedValue(optionKey, value) - - # Expect NULL as the result - expect_null(result) -}) - +## | +## | *Unit tests* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | RPACT package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File name: test-f_core_output_formats.R +## | Creation date: 08 November 2023, 09:09:35 +## | File version: $Revision: 7665 $ +## | Last changed: $Date: 2024-02-23 17:33:46 +0100 (Fr, 23 Feb 2024) $ +## | Last changed by: $Author: pahlke $ +## | + +test_plan_section("Testing the Output Format Functions") + + +test_that("'.formatPValues'", { + # @refFS[Sec.]{fs:sec:outputFormats} + # @refFS[Tab.]{fs:tab:outputFormats} + x <- .formatPValues(0.0000234) + + ## Comparison of the results of character object 'x' with expected results + expect_equal(x, "<0.0001", label = paste0("c(", paste0(x, collapse = ", "), ")")) + + x <- .formatPValues(c(0.0000234, 0.0000134, 0.1234)) + + ## Comparison of the results of character object 'x' with expected results + expect_equal(x, c("<0.0001", "<0.0001", "0.1234"), label = paste0("c(", paste0(x, collapse = ", "), ")")) + + x <- .formatPValues(c(0.0002345678, 0.0000134, 0.1234, 0.000000000001, .00000009999)) + + ## Comparison of the results of character object 'x' with expected results + expect_equal(x, c("0.0002346", "0.0000134", "0.1234000", "<0.000001", "<0.000001"), label = paste0("c(", paste0(x, collapse = ", "), ")")) + + x <- .formatPValues(c(0.00234, 0.000013, 0.1234, 0.000000000001, .00000009999)) + + ## Comparison of the results of character object 'x' with expected results + expect_equal(x, c("0.00234", "<0.0001", "0.12340", "<0.0001", "<0.0001"), label = paste0("c(", paste0(x, collapse = ", "), ")")) + + x <- .formatPValues(c(6.244e-05, 4.906e-02, 1.446e-02, NA_real_)) + + ## Comparison of the results of character object 'x' with expected results + expect_equal(x, c("<0.0001", "0.04906", "0.01446", "NA"), label = paste0("c(", paste0(x, collapse = ", "), ")")) + + x <- .formatPValues(c(6.24408201934656e-05, 7.55449751868031e-05, 1.23207030919836e-05, NA_real_)) + + ## Comparison of the results of character object 'x' with expected results + expect_equal(x, c("<0.0001", "<0.0001", "<0.0001", "NA"), label = paste0("c(", paste0(x, collapse = ", "), ")")) + +}) + +test_that("'.formatRepeatedPValues'", { + + # @refFS[Sec.]{fs:sec:outputFormats} + # @refFS[Tab.]{fs:tab:outputFormats} + x <- .formatRepeatedPValues(c(0.0000234, 0.0000134, 0.1234)) + + ## Comparison of the results of character object 'x' with expected results + expect_equal(x, c("<0.0001", "<0.0001", "0.1234"), label = paste0("c(", paste0(x, collapse = ", "), ")")) + + x <- .formatRepeatedPValues(c(0.0000234, 0.0000134, 0.5234)) + + ## Comparison of the results of character object 'x' with expected results + expect_equal(x, c("<0.0001", "<0.0001", ">0.5"), label = paste0("c(", paste0(x, collapse = ", "), ")")) + + x <- .formatRepeatedPValues(c(0.0000234, 0.0000134, 0.5234, NA_real_)) + + ## Comparison of the results of character object 'x' with expected results + expect_equal(x, c("<0.0001", "<0.0001", ">0.5", "NA"), label = paste0("c(", paste0(x, collapse = ", "), ")")) + +}) + +test_that("'.formatConditionalPower'", { + + # @refFS[Sec.]{fs:sec:outputFormats} + # @refFS[Tab.]{fs:tab:outputFormats} + x <- .formatConditionalPower(c(0.0000234, 0.0000134, 0.5234, NA_real_)) + + ## Comparison of the results of character object 'x' with expected results + expect_equal(x, c("0", "0", "0.5234", "NA"), label = paste0("c(", paste0(x, collapse = ", "), ")")) + + x <- .formatConditionalPower(c(0.234, 0.123456, 0.6, 0.000001)) + + ## Comparison of the results of character object 'x' with expected results + expect_equal(x, c("0.2340", "0.1235", "0.6000", "0"), label = paste0("c(", paste0(x, collapse = ", "), ")")) + +}) + +test_that("'.formatProbabilities'", { + + # @refFS[Sec.]{fs:sec:outputFormats} + # @refFS[Tab.]{fs:tab:outputFormats} + x <- .formatProbabilities(c(NA_real_, NA_real_, 0.4536623, 0.7713048)) + + ## Comparison of the results of character object 'x' with expected results + expect_equal(x, c("NA", "NA", "0.4537", "0.7713"), label = paste0("c(", paste0(x, collapse = ", "), ")")) + +}) + +test_that("'.getDecimalPlaces'", { + + # @refFS[Sec.]{fs:sec:outputFormats} + # @refFS[Tab.]{fs:tab:outputFormats} + x <- .getDecimalPlaces(NA) + + ## Comparison of the results of integer object 'x' with expected results + expect_equal(x, 0, label = paste0("c(", paste0(x, collapse = ", "), ")")) + + x <- .getDecimalPlaces(12.123) + + ## Comparison of the results of integer object 'x' with expected results + expect_equal(x, 3, label = paste0("c(", paste0(x, collapse = ", "), ")")) + + x <- .getDecimalPlaces(c(6.661338e-16, 8.000000e-01, NA_real_)) + + ## Comparison of the results of integer object 'x' with expected results + expect_equal(x, c(15, 1, 0), label = paste0("c(", paste0(x, collapse = ", "), ")")) + + x <- .getDecimalPlaces(c(6.661338e-16, 8.12300000e-02)) + + ## Comparison of the results of integer object 'x' with expected results + expect_equal(x, c(15, 5), label = paste0("c(", paste0(x, collapse = ", "), ")")) + +}) + +test_that(" Internal output format functions throw errors when arguments are missing or wrong", { + + expect_equal(.getFormattedValue(), "NA") + expect_error(.assertIsValitOutputFormatOptionValue()) + expect_error(.getOutputFormatOptions()) + expect_error(.getOptionBasedFormattedValue()) + expect_no_error(getOutputFormat()) + expect_no_error(.getOutputFormat()) + expect_error(.addFieldsToOutputFormatList()) + expect_error(.getOutputFormatParameterNames()) + expect_error(.getOutputFormatFunctionName()) + expect_error(.getOutputFormatKeyByFieldName()) + expect_error(.getOutputFormatKeyByFunctionName()) + +}) + +test_that(".assertIsValidOutputFormatOptionValue handles valid option value'", { + + # Valid option value + optionKey <- "exampleKey" + optionValue <- "roundFunction = ceiling" + + # Call the function being tested + result <- .assertIsValidOutputFormatOptionValue(optionKey, optionValue) + + # Expect no error or exception + expect_null(result) + +}) + +test_that(".assertIsValidOutputFormatOptionValue handles invalid empty option value'", { + + # Invalid empty option value + optionKey <- "exampleKey" + optionValue <- "" + + # Call the function being tested + result <- capture_output(.assertIsValidOutputFormatOptionValue(optionKey, optionValue)) + + # Expect an error message + expect_match(result, "") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.p.value'", { + + key <- "rpact.output.format.p.value" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatPValues") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.repeated.p.value'", { + + key <- "rpact.output.format.repeated.p.value" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatRepeatedPValues") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.probability'", { + + key <- "rpact.output.format.probability" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatProbabilities") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.futility.probability'", { + + key <- "rpact.output.format.futility.probability" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatFutilityProbabilities") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.sample.size'", { + + key <- "rpact.output.format.sample.size" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatSampleSizes") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.event'", { + + key <- "rpact.output.format.event" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatEvents") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.event.time'", { + + key <- "rpact.output.format.event.time" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatEventTime") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.conditional.power'", { + + key <- "rpact.output.format.conditional.power" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatConditionalPower") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.critical.value'", { + + key <- "rpact.output.format.critical.value" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatCriticalValues") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.critical.value.fisher'", { + + key <- "rpact.output.format.critical.value.fisher" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatCriticalValuesFisher") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.test.statistic.fisher'", { + + key <- "rpact.output.format.test.statistic.fisher" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatTestStatisticsFisher") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.test.statistic'", { + + key <- "rpact.output.format.test.statistic" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatTestStatistics") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.rate'", { + + key <- "rpact.output.format.rate" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatRates") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.rate1'", { + + key <- "rpact.output.format.rate1" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatRatesDynamic") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.accrual.intensity'", { + + key <- "rpact.output.format.accrual.intensity" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatAccrualIntensities") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.mean'", { + + key <- "rpact.output.format.mean" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatMeans") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.ratio'", { + + key <- "rpact.output.format.ratio" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatRatios") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.st.dev'", { + + key <- "rpact.output.format.st.dev" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatStDevs") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.duration'", { + + key <- "rpact.output.format.duration" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatDurations") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.time'", { + + key <- "rpact.output.format.time" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatTime") + +}) + +test_that(".getOutputFormatFunctionName returns NULL for unknown key", { + + key <- "unknown.key" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect NULL as the result + expect_null(result) + +}) + +test_that(".getOptionBasedFormattedValue returns NULL for unknown option key", { + + optionKey <- "unknown.key" + value <- 0.123 + + # Call the function being tested + result <- .getOptionBasedFormattedValue(optionKey, value) + + # Expect NULL as the result + expect_null(result) + +}) + diff --git a/tests/testthat/test-f_core_plot.R b/tests/testthat/test-f_core_plot.R index 216e7702..ab1ab70f 100644 --- a/tests/testthat/test-f_core_plot.R +++ b/tests/testthat/test-f_core_plot.R @@ -1,115 +1,116 @@ -## | -## | *Unit tests* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | RPACT package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File name: test-f_core_plot.R -## | Creation date: 08 November 2023, 09:09:36 -## | File version: $Revision: 7662 $ -## | Last changed: $Date: 2024-02-23 12:42:26 +0100 (Fr, 23 Feb 2024) $ -## | Last changed by: $Author: pahlke $ -## | - -test_plan_section("Testing .reconstructSequenceCommand") - - -test_that("The output is as exptected", { - expect_equal(.reconstructSequenceCommand(seq(-1, 1, 0.02)), "seq(-1, 1, 0.02)") - expect_equal(.reconstructSequenceCommand(c()), NA_character_) - expect_equal(.reconstructSequenceCommand(c(1)), "1") - expect_equal(.reconstructSequenceCommand(c(1, 2)), "c(1, 2)") - expect_equal(.reconstructSequenceCommand(c(1, 2, 3)), "c(1, 2, 3)") - expect_equal(.reconstructSequenceCommand(c(1, 2, 3, 4)), "seq(1, 4, 1)") - expect_equal(.reconstructSequenceCommand(c(1, 2, 3, 5)), "c(1, 2, 3, 5)") - - expect_true(grepl(.getRexepSaveCharacter("x$.design"), "x$.design")) - expect_true(grepl(.getRexepSaveCharacter("x$.design"), "c(x$.design, xxx)")) - expect_false(grepl(.getRexepSaveCharacter("x$.design"), "c(x$design, xxx)")) - -}) - -test_that("Internal core plot functions throw errors when arguments are missing or wrong", { - - expect_equal(.addNumberToPlotCaption(caption = "hello", type = "character"), "hello") - - expect_error(.getPlotCaption()) - - expect_error(.getPlotTypeNumber()) - expect_error(.getPlotTypeNumber(type = "test")) - - expect_error(.createPlotResultObject()) - expect_error(.createPlotResultObject(list(x = 1), grid = -1)) - expect_error(.createPlotResultObject(list(x = 1), grid = 101)) - expect_error(.createPlotResultObject(list(x = 1), grid = 101)) - - expect_error(.printPlotShowSourceSeparator()) - - expect_error(plotTypes()) - - expect_error(.isValidVariedParameterVectorForPlotting()) - - expect_error(.removeInvalidPlotTypes()) - - expect_error(getAvailablePlotTypes()) - - expect_error(.getVariedParameterHint()) - - expect_error(.createValidParameterName()) - expect_equal(.createValidParameterName(NULL, "hello"), "hello") - expect_equal(.createValidParameterName("HI", "hello"), "HI$hello") - - expect_null(.showPlotSourceInformation()) - - expect_error(.testPlotCommand()) - - expect_error(.getParameterSetAsDataFrame()) - - expect_error(.getCategories()) - - expect_error(.getAxisLabel()) - expect_equal(.getAxisLabel("heho", NULL), "%heho%") - - expect_error(.allGroupValuesEqual()) - - expect_error(.plotParameterSet()) - - expect_error(.naAndNaNOmit()) - expect_null(.naAndNaNOmit(NULL)) - - expect_error(.getScalingFactors()) - - expect_error(.plotDataFrame()) - - expect_error(.getPointBorder()) - - expect_error(.getLegendPosition()) - - expect_error(.addQnormAlphaLine()) - - expect_equal(.getLambdaStepFunctionByTime(3, NA, 5), 5) - - expect_error(.getLambdaStepFunction()) - - expect_error(getLambdaStepFunction()) - - expect_type(.getRelativeFigureOutputPath(), "character") - - expect_error(saveLastPlot()) - - expect_error(.getGridPlotSettings()) - - expect_error(.getGridLegendPosition()) - - expect_error(.formatSubTitleValue()) -}) - +## | +## | *Unit tests* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | RPACT package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File name: test-f_core_plot.R +## | Creation date: 08 November 2023, 09:09:36 +## | File version: $Revision: 7662 $ +## | Last changed: $Date: 2024-02-23 12:42:26 +0100 (Fr, 23 Feb 2024) $ +## | Last changed by: $Author: pahlke $ +## | + +test_plan_section("Testing .reconstructSequenceCommand") + + +test_that("The output is as exptected", { + expect_equal(.reconstructSequenceCommand(seq(-1, 1, 0.02)), "seq(-1, 1, 0.02)") + expect_equal(.reconstructSequenceCommand(c()), NA_character_) + expect_equal(.reconstructSequenceCommand(c(1)), "1") + expect_equal(.reconstructSequenceCommand(c(1, 2)), "c(1, 2)") + expect_equal(.reconstructSequenceCommand(c(1, 2, 3)), "c(1, 2, 3)") + expect_equal(.reconstructSequenceCommand(c(1, 2, 3, 4)), "seq(1, 4, 1)") + expect_equal(.reconstructSequenceCommand(c(1, 2, 3, 5)), "c(1, 2, 3, 5)") + + expect_true(grepl(.getRexepSaveCharacter("x$.design"), "x$.design")) + expect_true(grepl(.getRexepSaveCharacter("x$.design"), "c(x$.design, xxx)")) + expect_false(grepl(.getRexepSaveCharacter("x$.design"), "c(x$design, xxx)")) + +}) + +test_that("Internal core plot functions throw errors when arguments are missing or wrong", { + + expect_equal(.addNumberToPlotCaption(caption = "hello", type = "character"), "hello") + + expect_error(.getPlotCaption()) + + expect_error(.getPlotTypeNumber()) + expect_error(.getPlotTypeNumber(type = "test")) + + expect_error(.createPlotResultObject()) + expect_error(.createPlotResultObject(list(x = 1), grid = -1)) + expect_error(.createPlotResultObject(list(x = 1), grid = 101)) + expect_error(.createPlotResultObject(list(x = 1), grid = 101)) + + expect_error(.printPlotShowSourceSeparator()) + + expect_error(plotTypes()) + + expect_error(.isValidVariedParameterVectorForPlotting()) + + expect_error(.removeInvalidPlotTypes()) + + expect_error(getAvailablePlotTypes()) + + expect_error(.getVariedParameterHint()) + + expect_error(.createValidParameterName()) + expect_equal(.createValidParameterName(NULL, "hello"), "hello") + expect_equal(.createValidParameterName("HI", "hello"), "HI$hello") + + expect_null(.showPlotSourceInformation()) + + expect_error(.testPlotCommand()) + + expect_error(.getParameterSetAsDataFrame()) + + expect_error(.getCategories()) + + expect_error(.getAxisLabel()) + expect_equal(.getAxisLabel("heho", NULL), "%heho%") + + expect_error(.allGroupValuesEqual()) + + expect_error(.plotParameterSet()) + + expect_error(.naAndNaNOmit()) + expect_null(.naAndNaNOmit(NULL)) + + expect_error(.getScalingFactors()) + + expect_error(.plotDataFrame()) + + expect_error(.getPointBorder()) + + expect_error(.getLegendPosition()) + + expect_error(.addQnormAlphaLine()) + + expect_equal(.getLambdaStepFunctionByTime(3, NA, 5), 5) + + expect_error(.getLambdaStepFunction()) + + expect_error(getLambdaStepFunction()) + + expect_type(.getRelativeFigureOutputPath(), "character") + + expect_error(saveLastPlot()) + + expect_error(.getGridPlotSettings()) + + expect_error(.getGridLegendPosition()) + + expect_error(.formatSubTitleValue()) + +}) + diff --git a/tests/testthat/test-f_design_fisher_combination_test.R b/tests/testthat/test-f_design_fisher_combination_test.R index 0725855c..06180f7a 100644 --- a/tests/testthat/test-f_design_fisher_combination_test.R +++ b/tests/testthat/test-f_design_fisher_combination_test.R @@ -1,564 +1,565 @@ -## | -## | *Unit tests* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | RPACT package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File name: test-f_design_fisher_combination_test.R -## | Creation date: 08 November 2023, 09:09:43 -## | File version: $Revision$ -## | Last changed: $Date$ -## | Last changed by: $Author$ -## | - -test_plan_section("Testing the Fisher Design Functionality") - - -test_that("'getDesignFisher' with default parameters: parameters and results are as expected", { - # @refFS[Tab.]{fs:tab:output:getDesignFisher} - # @refFS[Formula]{fs:FisherCombinationEqualAlpha} - designFisher0 <- getDesignFisher() - - ## Comparison of the results of TrialDesignFisher object 'designFisher0' with expected results - expect_equal(designFisher0$alphaSpent, c(0.012308547, 0.01962413, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher0$alphaSpent, collapse = ", "), ")")) - expect_equal(designFisher0$criticalValues, c(0.012308547, 0.0016635923, 0.00029106687), tolerance = 1e-07, label = paste0("c(", paste0(designFisher0$criticalValues, collapse = ", "), ")")) - expect_equal(designFisher0$stageLevels, c(0.012308547, 0.012308547, 0.012308547), tolerance = 1e-07, label = paste0("c(", paste0(designFisher0$stageLevels, collapse = ", "), ")")) - expect_equal(designFisher0$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher0$nonStochasticCurtailment, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(designFisher0), NA))) - expect_output(print(designFisher0)$show()) - invisible(capture.output(expect_error(summary(designFisher0), NA))) - expect_output(summary(designFisher0)$show()) - designFisher0CodeBased <- eval(parse(text = getObjectRCode(designFisher0, stringWrapParagraphWidth = NULL))) - expect_equal(designFisher0CodeBased$alphaSpent, designFisher0$alphaSpent, tolerance = 1e-07) - expect_equal(designFisher0CodeBased$criticalValues, designFisher0$criticalValues, tolerance = 1e-07) - expect_equal(designFisher0CodeBased$stageLevels, designFisher0$stageLevels, tolerance = 1e-07) - expect_equal(designFisher0CodeBased$nonStochasticCurtailment, designFisher0$nonStochasticCurtailment, tolerance = 1e-07) - expect_type(names(designFisher0), "character") - df <- as.data.frame(designFisher0) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(designFisher0) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignFisher' with default parameters and simulated alpha: parameters and results are as expected", { - - .skipTestIfDisabled() - .skipTestIfNotX64() - - # @refFS[Tab.]{fs:tab:output:getDesignFisher} - # @refFS[Formula]{fs:FisherCombinationEqualAlpha} - designFisher <- getDesignFisher(iterations = 10000, seed = 1234567) - - ## Comparison of the results of TrialDesignFisher object 'designFisher' with expected results - expect_equal(designFisher$alphaSpent, c(0.012308547, 0.01962413, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher$alphaSpent, collapse = ", "), ")")) - expect_equal(designFisher$criticalValues, c(0.012308547, 0.0016635923, 0.00029106687), tolerance = 1e-07, label = paste0("c(", paste0(designFisher$criticalValues, collapse = ", "), ")")) - expect_equal(designFisher$stageLevels, c(0.012308547, 0.012308547, 0.012308547), tolerance = 1e-07, label = paste0("c(", paste0(designFisher$stageLevels, collapse = ", "), ")")) - expect_equal(designFisher$simAlpha, 0.0243, tolerance = 1e-07, label = paste0("c(", paste0(designFisher$simAlpha, collapse = ", "), ")")) - expect_equal(designFisher$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher$nonStochasticCurtailment, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(designFisher), NA))) - expect_output(print(designFisher)$show()) - invisible(capture.output(expect_error(summary(designFisher), NA))) - expect_output(summary(designFisher)$show()) - designFisherCodeBased <- eval(parse(text = getObjectRCode(designFisher, stringWrapParagraphWidth = NULL))) - expect_equal(designFisherCodeBased$alphaSpent, designFisher$alphaSpent, tolerance = 1e-07) - expect_equal(designFisherCodeBased$criticalValues, designFisher$criticalValues, tolerance = 1e-07) - expect_equal(designFisherCodeBased$stageLevels, designFisher$stageLevels, tolerance = 1e-07) - expect_equal(designFisherCodeBased$simAlpha, designFisher$simAlpha, tolerance = 1e-07) - expect_equal(designFisherCodeBased$nonStochasticCurtailment, designFisher$nonStochasticCurtailment, tolerance = 1e-07) - expect_type(names(designFisher), "character") - df <- as.data.frame(designFisher) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(designFisher) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignFisher' with kMax = 2,3,..,6: parameters and results are as expected for different arguments", { - - .skipTestIfDisabled() - - # @refFS[Tab.]{fs:tab:output:getDesignFisher} - # @refFS[Formula]{fs:FisherCombinationFullAlpha} - designFisher1 <- getDesignFisher(kMax = 2, alpha = 0.05, alpha0Vec = 0.5, method = "fullAlpha") - - ## Comparison of the results of TrialDesignFisher object 'designFisher1' with expected results - expect_equal(designFisher1$alphaSpent, c(0.023314852, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(designFisher1$alphaSpent, collapse = ", "), ")")) - expect_equal(designFisher1$criticalValues, c(0.023314852, 0.0087049407), tolerance = 1e-07, label = paste0("c(", paste0(designFisher1$criticalValues, collapse = ", "), ")")) - expect_equal(designFisher1$stageLevels, c(0.023314852, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(designFisher1$stageLevels, collapse = ", "), ")")) - expect_equal(designFisher1$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher1$nonStochasticCurtailment, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(designFisher1), NA))) - expect_output(print(designFisher1)$show()) - invisible(capture.output(expect_error(summary(designFisher1), NA))) - expect_output(summary(designFisher1)$show()) - designFisher1CodeBased <- eval(parse(text = getObjectRCode(designFisher1, stringWrapParagraphWidth = NULL))) - expect_equal(designFisher1CodeBased$alphaSpent, designFisher1$alphaSpent, tolerance = 1e-07) - expect_equal(designFisher1CodeBased$criticalValues, designFisher1$criticalValues, tolerance = 1e-07) - expect_equal(designFisher1CodeBased$stageLevels, designFisher1$stageLevels, tolerance = 1e-07) - expect_equal(designFisher1CodeBased$nonStochasticCurtailment, designFisher1$nonStochasticCurtailment, tolerance = 1e-07) - expect_type(names(designFisher1), "character") - df <- as.data.frame(designFisher1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(designFisher1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignFisher} - # @refFS[Formula]{fs:FisherCombinationEqualAlpha} - designFisher2 <- getDesignFisher(kMax = 3, alpha0Vec = c(0.7, 0.5), informationRates = c(0.1, 0.3, 1), method = "equalAlpha") - - ## Comparison of the results of TrialDesignFisher object 'designFisher2' with expected results - expect_equal(designFisher2$alphaSpent, c(0.011823636, 0.019807903, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher2$alphaSpent, collapse = ", "), ")")) - expect_equal(designFisher2$criticalValues, c(0.011823636, 0.00036698794, 3.0631293e-07), tolerance = 1e-07, label = paste0("c(", paste0(designFisher2$criticalValues, collapse = ", "), ")")) - expect_equal(designFisher2$stageLevels, c(0.011823636, 0.011823636, 0.011823636), tolerance = 1e-07, label = paste0("c(", paste0(designFisher2$stageLevels, collapse = ", "), ")")) - expect_equal(designFisher2$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher2$nonStochasticCurtailment, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(designFisher2), NA))) - expect_output(print(designFisher2)$show()) - invisible(capture.output(expect_error(summary(designFisher2), NA))) - expect_output(summary(designFisher2)$show()) - designFisher2CodeBased <- eval(parse(text = getObjectRCode(designFisher2, stringWrapParagraphWidth = NULL))) - expect_equal(designFisher2CodeBased$alphaSpent, designFisher2$alphaSpent, tolerance = 1e-07) - expect_equal(designFisher2CodeBased$criticalValues, designFisher2$criticalValues, tolerance = 1e-07) - expect_equal(designFisher2CodeBased$stageLevels, designFisher2$stageLevels, tolerance = 1e-07) - expect_equal(designFisher2CodeBased$nonStochasticCurtailment, designFisher2$nonStochasticCurtailment, tolerance = 1e-07) - expect_type(names(designFisher2), "character") - df <- as.data.frame(designFisher2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(designFisher2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignFisher} - # @refFS[Formula]{fs:FisherCombinationEqualAlpha} - designFisher3 <- getDesignFisher(kMax = 4, alpha0Vec = c(0.7, 0.5, 0.3), informationRates = c(0.1, 0.3, 0.6, 1), bindingFutility = FALSE, method = "equalAlpha") - - ## Comparison of the results of TrialDesignFisher object 'designFisher3' with expected results - expect_equal(designFisher3$alphaSpent, c(0.0082575405, 0.014885188, 0.020347598, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher3$alphaSpent, collapse = ", "), ")")) - expect_equal(designFisher3$criticalValues, c(0.0082575405, 0.00021760942, 4.7163541e-06, 8.3369321e-08), tolerance = 1e-07, label = paste0("c(", paste0(designFisher3$criticalValues, collapse = ", "), ")")) - expect_equal(designFisher3$stageLevels, c(0.0082575405, 0.0082575405, 0.0082575405, 0.0082575405), tolerance = 1e-07, label = paste0("c(", paste0(designFisher3$stageLevels, collapse = ", "), ")")) - expect_equal(designFisher3$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher3$nonStochasticCurtailment, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(designFisher3), NA))) - expect_output(print(designFisher3)$show()) - invisible(capture.output(expect_error(summary(designFisher3), NA))) - expect_output(summary(designFisher3)$show()) - designFisher3CodeBased <- eval(parse(text = getObjectRCode(designFisher3, stringWrapParagraphWidth = NULL))) - expect_equal(designFisher3CodeBased$alphaSpent, designFisher3$alphaSpent, tolerance = 1e-07) - expect_equal(designFisher3CodeBased$criticalValues, designFisher3$criticalValues, tolerance = 1e-07) - expect_equal(designFisher3CodeBased$stageLevels, designFisher3$stageLevels, tolerance = 1e-07) - expect_equal(designFisher3CodeBased$nonStochasticCurtailment, designFisher3$nonStochasticCurtailment, tolerance = 1e-07) - expect_type(names(designFisher3), "character") - df <- as.data.frame(designFisher3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(designFisher3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignFisher} - # @refFS[Formula]{fs:FisherCombinationEqualAlpha} - designFisher4 <- getDesignFisher(kMax = 5, alpha0Vec = c(0.7, 0.5, 0.3, 0.3), informationRates = c(0.1, 0.3, 0.5, 0.6, 1), method = "equalAlpha") - - ## Comparison of the results of TrialDesignFisher object 'designFisher4' with expected results - expect_equal(designFisher4$alphaSpent, c(0.011157609, 0.018733282, 0.022750003, 0.024162936, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher4$alphaSpent, collapse = ", "), ")")) - expect_equal(designFisher4$criticalValues, c(0.011157609, 0.00033722277, 2.3068413e-05, 5.4825339e-06, 9.8015456e-08), tolerance = 1e-07, label = paste0("c(", paste0(designFisher4$criticalValues, collapse = ", "), ")")) - expect_equal(designFisher4$stageLevels, c(0.011157609, 0.011157609, 0.011157609, 0.011157609, 0.011157609), tolerance = 1e-07, label = paste0("c(", paste0(designFisher4$stageLevels, collapse = ", "), ")")) - expect_equal(designFisher4$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher4$nonStochasticCurtailment, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(designFisher4), NA))) - expect_output(print(designFisher4)$show()) - invisible(capture.output(expect_error(summary(designFisher4), NA))) - expect_output(summary(designFisher4)$show()) - designFisher4CodeBased <- eval(parse(text = getObjectRCode(designFisher4, stringWrapParagraphWidth = NULL))) - expect_equal(designFisher4CodeBased$alphaSpent, designFisher4$alphaSpent, tolerance = 1e-07) - expect_equal(designFisher4CodeBased$criticalValues, designFisher4$criticalValues, tolerance = 1e-07) - expect_equal(designFisher4CodeBased$stageLevels, designFisher4$stageLevels, tolerance = 1e-07) - expect_equal(designFisher4CodeBased$nonStochasticCurtailment, designFisher4$nonStochasticCurtailment, tolerance = 1e-07) - expect_type(names(designFisher4), "character") - df <- as.data.frame(designFisher4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(designFisher4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignFisher} - # @refFS[Formula]{fs:FisherCombinationEqualAlpha} - designFisher5 <- getDesignFisher(kMax = 5, alpha = 0.2, alpha0Vec = c(0.7, 0.5, 0.3, 0.2), method = "equalAlpha") - - ## Comparison of the results of TrialDesignFisher object 'designFisher5' with expected results - expect_equal(designFisher5$alphaSpent, c(0.12649082, 0.17362071, 0.19349017, 0.19931765, 0.2), tolerance = 1e-07, label = paste0("c(", paste0(designFisher5$alphaSpent, collapse = ", "), ")")) - expect_equal(designFisher5$criticalValues, c(0.12649082, 0.027546669, 0.0068856935, 0.0018391192, 0.00051168366), tolerance = 1e-07, label = paste0("c(", paste0(designFisher5$criticalValues, collapse = ", "), ")")) - expect_equal(designFisher5$stageLevels, c(0.12649082, 0.12649082, 0.12649082, 0.12649082, 0.12649082), tolerance = 1e-07, label = paste0("c(", paste0(designFisher5$stageLevels, collapse = ", "), ")")) - expect_equal(designFisher5$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher5$nonStochasticCurtailment, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(designFisher5), NA))) - expect_output(print(designFisher5)$show()) - invisible(capture.output(expect_error(summary(designFisher5), NA))) - expect_output(summary(designFisher5)$show()) - designFisher5CodeBased <- eval(parse(text = getObjectRCode(designFisher5, stringWrapParagraphWidth = NULL))) - expect_equal(designFisher5CodeBased$alphaSpent, designFisher5$alphaSpent, tolerance = 1e-07) - expect_equal(designFisher5CodeBased$criticalValues, designFisher5$criticalValues, tolerance = 1e-07) - expect_equal(designFisher5CodeBased$stageLevels, designFisher5$stageLevels, tolerance = 1e-07) - expect_equal(designFisher5CodeBased$nonStochasticCurtailment, designFisher5$nonStochasticCurtailment, tolerance = 1e-07) - expect_type(names(designFisher5), "character") - df <- as.data.frame(designFisher5) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(designFisher5) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignFisher} - # @refFS[Formula]{fs:FisherCombinationFullAlpha} - designFisher6 <- getDesignFisher(kMax = 4, informationRates = c(0.1, 0.3, 0.7, 1), method = "fullAlpha") - - ## Comparison of the results of TrialDesignFisher object 'designFisher6' with expected results - expect_equal(designFisher6$alphaSpent, c(1.0550077e-06, 0.00020026524, 0.0065266359, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher6$alphaSpent, collapse = ", "), ")")) - expect_equal(designFisher6$criticalValues, c(1.0550077e-06, 1.0550077e-06, 1.0550077e-06, 1.0550077e-06), tolerance = 1e-07, label = paste0("c(", paste0(designFisher6$criticalValues, collapse = ", "), ")")) - expect_equal(designFisher6$stageLevels, c(1.0550077e-06, 0.00020026524, 0.0065266359, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher6$stageLevels, collapse = ", "), ")")) - expect_equal(designFisher6$nonStochasticCurtailment, TRUE, label = paste0("c(", paste0(designFisher6$nonStochasticCurtailment, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(designFisher6), NA))) - expect_output(print(designFisher6)$show()) - invisible(capture.output(expect_error(summary(designFisher6), NA))) - expect_output(summary(designFisher6)$show()) - designFisher6CodeBased <- eval(parse(text = getObjectRCode(designFisher6, stringWrapParagraphWidth = NULL))) - expect_equal(designFisher6CodeBased$alphaSpent, designFisher6$alphaSpent, tolerance = 1e-07) - expect_equal(designFisher6CodeBased$criticalValues, designFisher6$criticalValues, tolerance = 1e-07) - expect_equal(designFisher6CodeBased$stageLevels, designFisher6$stageLevels, tolerance = 1e-07) - expect_equal(designFisher6CodeBased$nonStochasticCurtailment, designFisher6$nonStochasticCurtailment, tolerance = 1e-07) - expect_type(names(designFisher6), "character") - df <- as.data.frame(designFisher6) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(designFisher6) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignFisher} - # @refFS[Formula]{fs:FisherCombinationFullAlpha} - designFisher7 <- getDesignFisher(kMax = 3, alpha0Vec = c(0.7, 0.6), informationRates = c(0.1, 0.7, 1), method = "fullAlpha") - - ## Comparison of the results of TrialDesignFisher object 'designFisher7' with expected results - expect_equal(designFisher7$alphaSpent, c(2.1580149e-06, 0.0066525356, 0.01947245), tolerance = 1e-07, label = paste0("c(", paste0(designFisher7$alphaSpent, collapse = ", "), ")")) - expect_equal(designFisher7$criticalValues, c(2.1580149e-06, 2.1580149e-06, 2.1580149e-06), tolerance = 1e-07, label = paste0("c(", paste0(designFisher7$criticalValues, collapse = ", "), ")")) - expect_equal(designFisher7$stageLevels, c(2.1580149e-06, 0.008216166, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher7$stageLevels, collapse = ", "), ")")) - expect_equal(designFisher7$nonStochasticCurtailment, TRUE, label = paste0("c(", paste0(designFisher7$nonStochasticCurtailment, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(designFisher7), NA))) - expect_output(print(designFisher7)$show()) - invisible(capture.output(expect_error(summary(designFisher7), NA))) - expect_output(summary(designFisher7)$show()) - designFisher7CodeBased <- eval(parse(text = getObjectRCode(designFisher7, stringWrapParagraphWidth = NULL))) - expect_equal(designFisher7CodeBased$alphaSpent, designFisher7$alphaSpent, tolerance = 1e-07) - expect_equal(designFisher7CodeBased$criticalValues, designFisher7$criticalValues, tolerance = 1e-07) - expect_equal(designFisher7CodeBased$stageLevels, designFisher7$stageLevels, tolerance = 1e-07) - expect_equal(designFisher7CodeBased$nonStochasticCurtailment, designFisher7$nonStochasticCurtailment, tolerance = 1e-07) - expect_type(names(designFisher7), "character") - df <- as.data.frame(designFisher7) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(designFisher7) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignFisher} - # @refFS[Formula]{fs:FisherCombinationNoTreatmentStageInteraction} - designFisher8 <- getDesignFisher(kMax = 4, alpha0Vec = c(0.7, 0.6, 0.5), method = "noInteraction") - - ## Comparison of the results of TrialDesignFisher object 'designFisher8' with expected results - expect_equal(designFisher8$alphaSpent, c(0.0098603693, 0.012073314, 0.018133935, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher8$alphaSpent, collapse = ", "), ")")) - expect_equal(designFisher8$criticalValues, c(0.0098603693, 0.00051915905, 0.00031149543, 0.00015574772), tolerance = 1e-07, label = paste0("c(", paste0(designFisher8$criticalValues, collapse = ", "), ")")) - expect_equal(designFisher8$stageLevels, c(0.0098603693, 0.0044457148, 0.012979977, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher8$stageLevels, collapse = ", "), ")")) - expect_equal(designFisher8$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher8$nonStochasticCurtailment, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(designFisher8), NA))) - expect_output(print(designFisher8)$show()) - invisible(capture.output(expect_error(summary(designFisher8), NA))) - expect_output(summary(designFisher8)$show()) - designFisher8CodeBased <- eval(parse(text = getObjectRCode(designFisher8, stringWrapParagraphWidth = NULL))) - expect_equal(designFisher8CodeBased$alphaSpent, designFisher8$alphaSpent, tolerance = 1e-07) - expect_equal(designFisher8CodeBased$criticalValues, designFisher8$criticalValues, tolerance = 1e-07) - expect_equal(designFisher8CodeBased$stageLevels, designFisher8$stageLevels, tolerance = 1e-07) - expect_equal(designFisher8CodeBased$nonStochasticCurtailment, designFisher8$nonStochasticCurtailment, tolerance = 1e-07) - expect_type(names(designFisher8), "character") - df <- as.data.frame(designFisher8) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(designFisher8) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignFisher} - # @refFS[Formula]{fs:FisherCombinationNoTreatmentStageInteraction} - designFisher9 <- getDesignFisher(kMax = 6, alpha = 0.1, alpha0Vec = c(0.7, 0.6, 0.5, 0.4, 0.3), method = "noInteraction") - - ## Comparison of the results of TrialDesignFisher object 'designFisher9' with expected results - expect_equal(designFisher9$alphaSpent, c(0.058031958, 0.064517887, 0.079453273, 0.092924559, 0.098794775, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(designFisher9$alphaSpent, collapse = ", "), ")")) - expect_equal(designFisher9$criticalValues, c(0.058031958, 0.0026047006, 0.0015628203, 0.00078141017, 0.00031256407, 9.3769221e-05), tolerance = 1e-07, label = paste0("c(", paste0(designFisher9$criticalValues, collapse = ", "), ")")) - expect_equal(designFisher9$stageLevels, c(0.058031958, 0.018103809, 0.044282865, 0.074062827, 0.095655516, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(designFisher9$stageLevels, collapse = ", "), ")")) - expect_equal(designFisher9$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher9$nonStochasticCurtailment, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(designFisher9), NA))) - expect_output(print(designFisher9)$show()) - invisible(capture.output(expect_error(summary(designFisher9), NA))) - expect_output(summary(designFisher9)$show()) - designFisher9CodeBased <- eval(parse(text = getObjectRCode(designFisher9, stringWrapParagraphWidth = NULL))) - expect_equal(designFisher9CodeBased$alphaSpent, designFisher9$alphaSpent, tolerance = 1e-07) - expect_equal(designFisher9CodeBased$criticalValues, designFisher9$criticalValues, tolerance = 1e-07) - expect_equal(designFisher9CodeBased$stageLevels, designFisher9$stageLevels, tolerance = 1e-07) - expect_equal(designFisher9CodeBased$nonStochasticCurtailment, designFisher9$nonStochasticCurtailment, tolerance = 1e-07) - expect_type(names(designFisher9), "character") - df <- as.data.frame(designFisher9) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(designFisher9) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignFisher} - # @refFS[Formula]{fs:FisherCombinationNoTreatmentStageInteraction} - designFisher10 <- getDesignFisher( - kMax = 6, alpha = 0.1, alpha0Vec = c(0.7, 0.6, 0.5, 0.4, 0.3), method = "noInteraction", - informationRates = c(0.1, 0.15, 0.3, 0.4, 0.9, 1) - ) - - ## Comparison of the results of TrialDesignFisher object 'designFisher10' with expected results - expect_equal(designFisher10$alphaSpent, c(0.082381502, 0.082401579, 0.084330144, 0.086806556, 0.10023391, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(designFisher10$alphaSpent, collapse = ", "), ")")) - expect_equal(designFisher10$criticalValues, c(0.082381502, 0.00017925198, 0.00011812048, 5.906024e-05, 3.9204058e-05, 1.1761218e-05), tolerance = 1e-07, label = paste0("c(", paste0(designFisher10$criticalValues, collapse = ", "), ")")) - expect_equal(designFisher10$stageLevels, c(0.082381502, 0.0005998602, 0.0062212598, 0.012409923, 0.09943647, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(designFisher10$stageLevels, collapse = ", "), ")")) - expect_equal(designFisher10$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher10$nonStochasticCurtailment, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(designFisher10), NA))) - expect_output(print(designFisher10)$show()) - invisible(capture.output(expect_error(summary(designFisher10), NA))) - expect_output(summary(designFisher10)$show()) - designFisher10CodeBased <- eval(parse(text = getObjectRCode(designFisher10, stringWrapParagraphWidth = NULL))) - expect_equal(designFisher10CodeBased$alphaSpent, designFisher10$alphaSpent, tolerance = 1e-07) - expect_equal(designFisher10CodeBased$criticalValues, designFisher10$criticalValues, tolerance = 1e-07) - expect_equal(designFisher10CodeBased$stageLevels, designFisher10$stageLevels, tolerance = 1e-07) - expect_equal(designFisher10CodeBased$nonStochasticCurtailment, designFisher10$nonStochasticCurtailment, tolerance = 1e-07) - expect_type(names(designFisher10), "character") - df <- as.data.frame(designFisher10) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(designFisher10) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignFisher} - # @refFS[Formula]{fs:FisherCombinationUserDefinedAlphaSpending} - designFisher11 <- getDesignFisher(kMax = 4, alpha0Vec = c(0.7, 0.6, 0.5), method = "userDefinedAlpha", userAlphaSpending = c(0.01, 0.015, 0.02, 0.025)) - - ## Comparison of the results of TrialDesignFisher object 'designFisher11' with expected results - expect_equal(designFisher11$alphaSpent, c(0.01, 0.015, 0.02, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher11$alphaSpent, collapse = ", "), ")")) - expect_equal(designFisher11$criticalValues, c(0.01, 0.0011768873, 0.00031357454, 0.00011586425), tolerance = 1e-07, label = paste0("c(", paste0(designFisher11$criticalValues, collapse = ", "), ")")) - expect_equal(designFisher11$stageLevels, c(0.01, 0.0091148534, 0.013047692, 0.020300118), tolerance = 1e-07, label = paste0("c(", paste0(designFisher11$stageLevels, collapse = ", "), ")")) - expect_equal(designFisher11$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher11$nonStochasticCurtailment, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(designFisher11), NA))) - expect_output(print(designFisher11)$show()) - invisible(capture.output(expect_error(summary(designFisher11), NA))) - expect_output(summary(designFisher11)$show()) - designFisher11CodeBased <- eval(parse(text = getObjectRCode(designFisher11, stringWrapParagraphWidth = NULL))) - expect_equal(designFisher11CodeBased$alphaSpent, designFisher11$alphaSpent, tolerance = 1e-07) - expect_equal(designFisher11CodeBased$criticalValues, designFisher11$criticalValues, tolerance = 1e-07) - expect_equal(designFisher11CodeBased$stageLevels, designFisher11$stageLevels, tolerance = 1e-07) - expect_equal(designFisher11CodeBased$nonStochasticCurtailment, designFisher11$nonStochasticCurtailment, tolerance = 1e-07) - expect_type(names(designFisher11), "character") - df <- as.data.frame(designFisher11) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(designFisher11) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignFisher} - # @refFS[Formula]{fs:FisherCombinationUserDefinedAlphaSpending} - designFisher12 <- getDesignFisher( - kMax = 4, alpha0Vec = c(0.7, 0.6, 0.5), informationRates = c(0.1, 0.3, 0.7, 1), - method = "userDefinedAlpha", userAlphaSpending = c(0.01, 0.015, 0.02, 0.025) - ) - - ## Comparison of the results of TrialDesignFisher object 'designFisher12' with expected results - expect_equal(designFisher12$alphaSpent, c(0.01, 0.015, 0.02, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher12$alphaSpent, collapse = ", "), ")")) - expect_equal(designFisher12$criticalValues, c(0.01, 0.00018389153, 2.6484943e-06, 5.2344628e-07), tolerance = 1e-07, label = paste0("c(", paste0(designFisher12$criticalValues, collapse = ", "), ")")) - expect_equal(designFisher12$stageLevels, c(0.01, 0.0073532156, 0.0101804, 0.018500415), tolerance = 1e-07, label = paste0("c(", paste0(designFisher12$stageLevels, collapse = ", "), ")")) - expect_equal(designFisher12$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher12$nonStochasticCurtailment, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(designFisher12), NA))) - expect_output(print(designFisher12)$show()) - invisible(capture.output(expect_error(summary(designFisher12), NA))) - expect_output(summary(designFisher12)$show()) - designFisher12CodeBased <- eval(parse(text = getObjectRCode(designFisher12, stringWrapParagraphWidth = NULL))) - expect_equal(designFisher12CodeBased$alphaSpent, designFisher12$alphaSpent, tolerance = 1e-07) - expect_equal(designFisher12CodeBased$criticalValues, designFisher12$criticalValues, tolerance = 1e-07) - expect_equal(designFisher12CodeBased$stageLevels, designFisher12$stageLevels, tolerance = 1e-07) - expect_equal(designFisher12CodeBased$nonStochasticCurtailment, designFisher12$nonStochasticCurtailment, tolerance = 1e-07) - expect_type(names(designFisher12), "character") - df <- as.data.frame(designFisher12) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(designFisher12) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignFisher': illegal arguments throw exceptions as expected", { - - expect_error(getDesignFisher( - method = C_FISHER_METHOD_USER_DEFINED_ALPHA, - userAlphaSpending = c(0.01, 0.02, 0.023, 0.023, 0.025), kMax = 4 - ), - paste0( - "Conflicting arguments: length of 'userAlphaSpending' (5) ", - "must be equal to 'kMax' (4)" - ), - fixed = TRUE - ) - - expect_error(getDesignFisher( - method = C_FISHER_METHOD_USER_DEFINED_ALPHA, - userAlphaSpending = c(0.01, 0.02, 0.025), informationRates = c(0.5, 1) - ), - paste0( - "Conflicting arguments: length of 'userAlphaSpending' (3) ", - "must be equal to length of 'informationRates' (2)" - ), - fixed = TRUE - ) - - expect_error(getDesignFisher( - method = C_FISHER_METHOD_USER_DEFINED_ALPHA, - userAlphaSpending = c(0.01, 0.02, 0.025), informationRates = c(0.4, 1) - ), - paste0( - "Conflicting arguments: length of 'userAlphaSpending' (3) ", - "must be equal to length of 'informationRates' (2)" - ), - fixed = TRUE - ) - - expect_error(getDesignFisher( - method = C_FISHER_METHOD_USER_DEFINED_ALPHA, - userAlphaSpending = c(0.01, 0.02, 0.023, 0.023, 0.021) - ), - paste0( - "'userAlphaSpending' = c(0.01, 0.02, 0.023, 0.023, 0.021) must be a vector that ", - "satisfies the following condition: 0 <= alpha_1 <= .. <= alpha_5 <= alpha = 0.021" - ), - fixed = TRUE - ) - - expect_error(getDesignFisher( - method = C_FISHER_METHOD_USER_DEFINED_ALPHA, - userAlphaSpending = c(0.01, 0.02, 0.023), alpha = 0.02 - ), - paste0( - "'userAlphaSpending' = c(0.01, 0.02, 0.023) must be a vector that ", - "satisfies the following condition: 0 <= alpha_1 <= .. <= alpha_3 <= alpha = 0.02" - ), - fixed = TRUE - ) - - expect_equal(getDesignFisher( - method = C_FISHER_METHOD_USER_DEFINED_ALPHA, - userAlphaSpending = c(0.01, 0.02, 0.023) - )$alpha, 0.023) - - expect_error(getDesignFisher(method = C_FISHER_METHOD_USER_DEFINED_ALPHA), - "Missing argument: parameter 'userAlphaSpending' must be specified in design", - fixed = TRUE - ) - - expect_error(getDesignFisher(kMax = Inf), - paste0( - "Argument out of bounds: 'kMax' (Inf) is out of bounds [1; ", - C_KMAX_UPPER_BOUND_FISHER, "]" - ), - fixed = TRUE - ) - - expect_error(getDesignFisher(kMax = -Inf), - paste0( - "Argument out of bounds: 'kMax' (-Inf) is out of bounds [1; ", - C_KMAX_UPPER_BOUND_FISHER, "]" - ), - fixed = TRUE - ) - - expect_error(getDesignFisher(kMax = -Inf), "Argument out of bounds: 'kMax' (-Inf) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = -10), "Argument out of bounds: 'kMax' (-10) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = -9), "Argument out of bounds: 'kMax' (-9) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = -8), "Argument out of bounds: 'kMax' (-8) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = -7), "Argument out of bounds: 'kMax' (-7) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = -6), "Argument out of bounds: 'kMax' (-6) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = -5), "Argument out of bounds: 'kMax' (-5) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = -4), "Argument out of bounds: 'kMax' (-4) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = -3), "Argument out of bounds: 'kMax' (-3) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = -2), "Argument out of bounds: 'kMax' (-2) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = -1), "Argument out of bounds: 'kMax' (-1) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = 0), "Argument out of bounds: 'kMax' (0) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = 7), "Argument out of bounds: 'kMax' (7) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = 8), "Argument out of bounds: 'kMax' (8) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = 9), "Argument out of bounds: 'kMax' (9) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = 10), "Argument out of bounds: 'kMax' (10) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = 11), "Argument out of bounds: 'kMax' (11) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = 12), "Argument out of bounds: 'kMax' (12) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = 13), "Argument out of bounds: 'kMax' (13) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = 14), "Argument out of bounds: 'kMax' (14) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = 15), "Argument out of bounds: 'kMax' (15) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = 16), "Argument out of bounds: 'kMax' (16) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = Inf), "Argument out of bounds: 'kMax' (Inf) is out of bounds [1; 6]", fixed = TRUE) - - expect_error(getDesignFisher(kMax = 2, informationRates = c(0.01, 0.02, 0.04, 0.05)), "Conflicting arguments: length of 'informationRates' (4) must be equal to 'kMax' (2)", fixed = TRUE) - expect_error(getDesignFisher(kMax = 3, informationRates = c(0.01, 0.02, 0.04, 0.05)), "Conflicting arguments: length of 'informationRates' (4) must be equal to 'kMax' (3)", fixed = TRUE) - expect_error(getDesignFisher(kMax = 5, informationRates = c(0.01, 0.02, 0.04, 0.05)), "Conflicting arguments: length of 'informationRates' (4) must be equal to 'kMax' (5)", fixed = TRUE) - expect_error(getDesignFisher(kMax = 6, informationRates = c(0.01, 0.02, 0.04, 0.05)), "Conflicting arguments: length of 'informationRates' (4) must be equal to 'kMax' (6)", fixed = TRUE) - - expect_error(getDesignFisher(alpha0Vec = c(0, 1)), - "Argument out of bounds: 'alpha0Vec' (0, 1) is out of bounds (0; 1]", - fixed = TRUE - ) - - expect_error(getDesignFisher(alpha0Vec = c(0.1, 1.01)), - "Argument out of bounds: 'alpha0Vec' (0.1, 1.01) is out of bounds (0; 1]", - fixed = TRUE - ) -}) - +## | +## | *Unit tests* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | RPACT package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File name: test-f_design_fisher_combination_test.R +## | Creation date: 08 November 2023, 09:09:43 +## | File version: $Revision$ +## | Last changed: $Date$ +## | Last changed by: $Author$ +## | + +test_plan_section("Testing the Fisher Design Functionality") + + +test_that("'getDesignFisher' with default parameters: parameters and results are as expected", { + # @refFS[Tab.]{fs:tab:output:getDesignFisher} + # @refFS[Formula]{fs:FisherCombinationEqualAlpha} + designFisher0 <- getDesignFisher() + + ## Comparison of the results of TrialDesignFisher object 'designFisher0' with expected results + expect_equal(designFisher0$alphaSpent, c(0.012308547, 0.01962413, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher0$alphaSpent, collapse = ", "), ")")) + expect_equal(designFisher0$criticalValues, c(0.012308547, 0.0016635923, 0.00029106687), tolerance = 1e-07, label = paste0("c(", paste0(designFisher0$criticalValues, collapse = ", "), ")")) + expect_equal(designFisher0$stageLevels, c(0.012308547, 0.012308547, 0.012308547), tolerance = 1e-07, label = paste0("c(", paste0(designFisher0$stageLevels, collapse = ", "), ")")) + expect_equal(designFisher0$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher0$nonStochasticCurtailment, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(designFisher0), NA))) + expect_output(print(designFisher0)$show()) + invisible(capture.output(expect_error(summary(designFisher0), NA))) + expect_output(summary(designFisher0)$show()) + designFisher0CodeBased <- eval(parse(text = getObjectRCode(designFisher0, stringWrapParagraphWidth = NULL))) + expect_equal(designFisher0CodeBased$alphaSpent, designFisher0$alphaSpent, tolerance = 1e-07) + expect_equal(designFisher0CodeBased$criticalValues, designFisher0$criticalValues, tolerance = 1e-07) + expect_equal(designFisher0CodeBased$stageLevels, designFisher0$stageLevels, tolerance = 1e-07) + expect_equal(designFisher0CodeBased$nonStochasticCurtailment, designFisher0$nonStochasticCurtailment, tolerance = 1e-07) + expect_type(names(designFisher0), "character") + df <- as.data.frame(designFisher0) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(designFisher0) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignFisher' with default parameters and simulated alpha: parameters and results are as expected", { + + .skipTestIfDisabled() + .skipTestIfNotX64() + + # @refFS[Tab.]{fs:tab:output:getDesignFisher} + # @refFS[Formula]{fs:FisherCombinationEqualAlpha} + designFisher <- getDesignFisher(iterations = 10000, seed = 1234567) + + ## Comparison of the results of TrialDesignFisher object 'designFisher' with expected results + expect_equal(designFisher$alphaSpent, c(0.012308547, 0.01962413, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher$alphaSpent, collapse = ", "), ")")) + expect_equal(designFisher$criticalValues, c(0.012308547, 0.0016635923, 0.00029106687), tolerance = 1e-07, label = paste0("c(", paste0(designFisher$criticalValues, collapse = ", "), ")")) + expect_equal(designFisher$stageLevels, c(0.012308547, 0.012308547, 0.012308547), tolerance = 1e-07, label = paste0("c(", paste0(designFisher$stageLevels, collapse = ", "), ")")) + expect_equal(designFisher$simAlpha, 0.0243, tolerance = 1e-07, label = paste0("c(", paste0(designFisher$simAlpha, collapse = ", "), ")")) + expect_equal(designFisher$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher$nonStochasticCurtailment, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(designFisher), NA))) + expect_output(print(designFisher)$show()) + invisible(capture.output(expect_error(summary(designFisher), NA))) + expect_output(summary(designFisher)$show()) + designFisherCodeBased <- eval(parse(text = getObjectRCode(designFisher, stringWrapParagraphWidth = NULL))) + expect_equal(designFisherCodeBased$alphaSpent, designFisher$alphaSpent, tolerance = 1e-07) + expect_equal(designFisherCodeBased$criticalValues, designFisher$criticalValues, tolerance = 1e-07) + expect_equal(designFisherCodeBased$stageLevels, designFisher$stageLevels, tolerance = 1e-07) + expect_equal(designFisherCodeBased$simAlpha, designFisher$simAlpha, tolerance = 1e-07) + expect_equal(designFisherCodeBased$nonStochasticCurtailment, designFisher$nonStochasticCurtailment, tolerance = 1e-07) + expect_type(names(designFisher), "character") + df <- as.data.frame(designFisher) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(designFisher) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignFisher' with kMax = 2,3,..,6: parameters and results are as expected for different arguments", { + + .skipTestIfDisabled() + + # @refFS[Tab.]{fs:tab:output:getDesignFisher} + # @refFS[Formula]{fs:FisherCombinationFullAlpha} + designFisher1 <- getDesignFisher(kMax = 2, alpha = 0.05, alpha0Vec = 0.5, method = "fullAlpha") + + ## Comparison of the results of TrialDesignFisher object 'designFisher1' with expected results + expect_equal(designFisher1$alphaSpent, c(0.023314852, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(designFisher1$alphaSpent, collapse = ", "), ")")) + expect_equal(designFisher1$criticalValues, c(0.023314852, 0.0087049407), tolerance = 1e-07, label = paste0("c(", paste0(designFisher1$criticalValues, collapse = ", "), ")")) + expect_equal(designFisher1$stageLevels, c(0.023314852, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(designFisher1$stageLevels, collapse = ", "), ")")) + expect_equal(designFisher1$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher1$nonStochasticCurtailment, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(designFisher1), NA))) + expect_output(print(designFisher1)$show()) + invisible(capture.output(expect_error(summary(designFisher1), NA))) + expect_output(summary(designFisher1)$show()) + designFisher1CodeBased <- eval(parse(text = getObjectRCode(designFisher1, stringWrapParagraphWidth = NULL))) + expect_equal(designFisher1CodeBased$alphaSpent, designFisher1$alphaSpent, tolerance = 1e-07) + expect_equal(designFisher1CodeBased$criticalValues, designFisher1$criticalValues, tolerance = 1e-07) + expect_equal(designFisher1CodeBased$stageLevels, designFisher1$stageLevels, tolerance = 1e-07) + expect_equal(designFisher1CodeBased$nonStochasticCurtailment, designFisher1$nonStochasticCurtailment, tolerance = 1e-07) + expect_type(names(designFisher1), "character") + df <- as.data.frame(designFisher1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(designFisher1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignFisher} + # @refFS[Formula]{fs:FisherCombinationEqualAlpha} + designFisher2 <- getDesignFisher(kMax = 3, alpha0Vec = c(0.7, 0.5), informationRates = c(0.1, 0.3, 1), method = "equalAlpha") + + ## Comparison of the results of TrialDesignFisher object 'designFisher2' with expected results + expect_equal(designFisher2$alphaSpent, c(0.011823636, 0.019807903, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher2$alphaSpent, collapse = ", "), ")")) + expect_equal(designFisher2$criticalValues, c(0.011823636, 0.00036698794, 3.0631293e-07), tolerance = 1e-07, label = paste0("c(", paste0(designFisher2$criticalValues, collapse = ", "), ")")) + expect_equal(designFisher2$stageLevels, c(0.011823636, 0.011823636, 0.011823636), tolerance = 1e-07, label = paste0("c(", paste0(designFisher2$stageLevels, collapse = ", "), ")")) + expect_equal(designFisher2$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher2$nonStochasticCurtailment, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(designFisher2), NA))) + expect_output(print(designFisher2)$show()) + invisible(capture.output(expect_error(summary(designFisher2), NA))) + expect_output(summary(designFisher2)$show()) + designFisher2CodeBased <- eval(parse(text = getObjectRCode(designFisher2, stringWrapParagraphWidth = NULL))) + expect_equal(designFisher2CodeBased$alphaSpent, designFisher2$alphaSpent, tolerance = 1e-07) + expect_equal(designFisher2CodeBased$criticalValues, designFisher2$criticalValues, tolerance = 1e-07) + expect_equal(designFisher2CodeBased$stageLevels, designFisher2$stageLevels, tolerance = 1e-07) + expect_equal(designFisher2CodeBased$nonStochasticCurtailment, designFisher2$nonStochasticCurtailment, tolerance = 1e-07) + expect_type(names(designFisher2), "character") + df <- as.data.frame(designFisher2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(designFisher2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignFisher} + # @refFS[Formula]{fs:FisherCombinationEqualAlpha} + designFisher3 <- getDesignFisher(kMax = 4, alpha0Vec = c(0.7, 0.5, 0.3), informationRates = c(0.1, 0.3, 0.6, 1), bindingFutility = FALSE, method = "equalAlpha") + + ## Comparison of the results of TrialDesignFisher object 'designFisher3' with expected results + expect_equal(designFisher3$alphaSpent, c(0.0082575405, 0.014885188, 0.020347598, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher3$alphaSpent, collapse = ", "), ")")) + expect_equal(designFisher3$criticalValues, c(0.0082575405, 0.00021760942, 4.7163541e-06, 8.3369321e-08), tolerance = 1e-07, label = paste0("c(", paste0(designFisher3$criticalValues, collapse = ", "), ")")) + expect_equal(designFisher3$stageLevels, c(0.0082575405, 0.0082575405, 0.0082575405, 0.0082575405), tolerance = 1e-07, label = paste0("c(", paste0(designFisher3$stageLevels, collapse = ", "), ")")) + expect_equal(designFisher3$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher3$nonStochasticCurtailment, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(designFisher3), NA))) + expect_output(print(designFisher3)$show()) + invisible(capture.output(expect_error(summary(designFisher3), NA))) + expect_output(summary(designFisher3)$show()) + designFisher3CodeBased <- eval(parse(text = getObjectRCode(designFisher3, stringWrapParagraphWidth = NULL))) + expect_equal(designFisher3CodeBased$alphaSpent, designFisher3$alphaSpent, tolerance = 1e-07) + expect_equal(designFisher3CodeBased$criticalValues, designFisher3$criticalValues, tolerance = 1e-07) + expect_equal(designFisher3CodeBased$stageLevels, designFisher3$stageLevels, tolerance = 1e-07) + expect_equal(designFisher3CodeBased$nonStochasticCurtailment, designFisher3$nonStochasticCurtailment, tolerance = 1e-07) + expect_type(names(designFisher3), "character") + df <- as.data.frame(designFisher3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(designFisher3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignFisher} + # @refFS[Formula]{fs:FisherCombinationEqualAlpha} + designFisher4 <- getDesignFisher(kMax = 5, alpha0Vec = c(0.7, 0.5, 0.3, 0.3), informationRates = c(0.1, 0.3, 0.5, 0.6, 1), method = "equalAlpha") + + ## Comparison of the results of TrialDesignFisher object 'designFisher4' with expected results + expect_equal(designFisher4$alphaSpent, c(0.011157609, 0.018733282, 0.022750003, 0.024162936, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher4$alphaSpent, collapse = ", "), ")")) + expect_equal(designFisher4$criticalValues, c(0.011157609, 0.00033722277, 2.3068413e-05, 5.4825339e-06, 9.8015456e-08), tolerance = 1e-07, label = paste0("c(", paste0(designFisher4$criticalValues, collapse = ", "), ")")) + expect_equal(designFisher4$stageLevels, c(0.011157609, 0.011157609, 0.011157609, 0.011157609, 0.011157609), tolerance = 1e-07, label = paste0("c(", paste0(designFisher4$stageLevels, collapse = ", "), ")")) + expect_equal(designFisher4$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher4$nonStochasticCurtailment, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(designFisher4), NA))) + expect_output(print(designFisher4)$show()) + invisible(capture.output(expect_error(summary(designFisher4), NA))) + expect_output(summary(designFisher4)$show()) + designFisher4CodeBased <- eval(parse(text = getObjectRCode(designFisher4, stringWrapParagraphWidth = NULL))) + expect_equal(designFisher4CodeBased$alphaSpent, designFisher4$alphaSpent, tolerance = 1e-07) + expect_equal(designFisher4CodeBased$criticalValues, designFisher4$criticalValues, tolerance = 1e-07) + expect_equal(designFisher4CodeBased$stageLevels, designFisher4$stageLevels, tolerance = 1e-07) + expect_equal(designFisher4CodeBased$nonStochasticCurtailment, designFisher4$nonStochasticCurtailment, tolerance = 1e-07) + expect_type(names(designFisher4), "character") + df <- as.data.frame(designFisher4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(designFisher4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignFisher} + # @refFS[Formula]{fs:FisherCombinationEqualAlpha} + designFisher5 <- getDesignFisher(kMax = 5, alpha = 0.2, alpha0Vec = c(0.7, 0.5, 0.3, 0.2), method = "equalAlpha") + + ## Comparison of the results of TrialDesignFisher object 'designFisher5' with expected results + expect_equal(designFisher5$alphaSpent, c(0.12649082, 0.17362071, 0.19349017, 0.19931765, 0.2), tolerance = 1e-07, label = paste0("c(", paste0(designFisher5$alphaSpent, collapse = ", "), ")")) + expect_equal(designFisher5$criticalValues, c(0.12649082, 0.027546669, 0.0068856935, 0.0018391192, 0.00051168366), tolerance = 1e-07, label = paste0("c(", paste0(designFisher5$criticalValues, collapse = ", "), ")")) + expect_equal(designFisher5$stageLevels, c(0.12649082, 0.12649082, 0.12649082, 0.12649082, 0.12649082), tolerance = 1e-07, label = paste0("c(", paste0(designFisher5$stageLevels, collapse = ", "), ")")) + expect_equal(designFisher5$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher5$nonStochasticCurtailment, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(designFisher5), NA))) + expect_output(print(designFisher5)$show()) + invisible(capture.output(expect_error(summary(designFisher5), NA))) + expect_output(summary(designFisher5)$show()) + designFisher5CodeBased <- eval(parse(text = getObjectRCode(designFisher5, stringWrapParagraphWidth = NULL))) + expect_equal(designFisher5CodeBased$alphaSpent, designFisher5$alphaSpent, tolerance = 1e-07) + expect_equal(designFisher5CodeBased$criticalValues, designFisher5$criticalValues, tolerance = 1e-07) + expect_equal(designFisher5CodeBased$stageLevels, designFisher5$stageLevels, tolerance = 1e-07) + expect_equal(designFisher5CodeBased$nonStochasticCurtailment, designFisher5$nonStochasticCurtailment, tolerance = 1e-07) + expect_type(names(designFisher5), "character") + df <- as.data.frame(designFisher5) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(designFisher5) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignFisher} + # @refFS[Formula]{fs:FisherCombinationFullAlpha} + designFisher6 <- getDesignFisher(kMax = 4, informationRates = c(0.1, 0.3, 0.7, 1), method = "fullAlpha") + + ## Comparison of the results of TrialDesignFisher object 'designFisher6' with expected results + expect_equal(designFisher6$alphaSpent, c(1.0550077e-06, 0.00020026524, 0.0065266359, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher6$alphaSpent, collapse = ", "), ")")) + expect_equal(designFisher6$criticalValues, c(1.0550077e-06, 1.0550077e-06, 1.0550077e-06, 1.0550077e-06), tolerance = 1e-07, label = paste0("c(", paste0(designFisher6$criticalValues, collapse = ", "), ")")) + expect_equal(designFisher6$stageLevels, c(1.0550077e-06, 0.00020026524, 0.0065266359, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher6$stageLevels, collapse = ", "), ")")) + expect_equal(designFisher6$nonStochasticCurtailment, TRUE, label = paste0("c(", paste0(designFisher6$nonStochasticCurtailment, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(designFisher6), NA))) + expect_output(print(designFisher6)$show()) + invisible(capture.output(expect_error(summary(designFisher6), NA))) + expect_output(summary(designFisher6)$show()) + designFisher6CodeBased <- eval(parse(text = getObjectRCode(designFisher6, stringWrapParagraphWidth = NULL))) + expect_equal(designFisher6CodeBased$alphaSpent, designFisher6$alphaSpent, tolerance = 1e-07) + expect_equal(designFisher6CodeBased$criticalValues, designFisher6$criticalValues, tolerance = 1e-07) + expect_equal(designFisher6CodeBased$stageLevels, designFisher6$stageLevels, tolerance = 1e-07) + expect_equal(designFisher6CodeBased$nonStochasticCurtailment, designFisher6$nonStochasticCurtailment, tolerance = 1e-07) + expect_type(names(designFisher6), "character") + df <- as.data.frame(designFisher6) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(designFisher6) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignFisher} + # @refFS[Formula]{fs:FisherCombinationFullAlpha} + designFisher7 <- getDesignFisher(kMax = 3, alpha0Vec = c(0.7, 0.6), informationRates = c(0.1, 0.7, 1), method = "fullAlpha") + + ## Comparison of the results of TrialDesignFisher object 'designFisher7' with expected results + expect_equal(designFisher7$alphaSpent, c(2.1580149e-06, 0.0066525356, 0.01947245), tolerance = 1e-07, label = paste0("c(", paste0(designFisher7$alphaSpent, collapse = ", "), ")")) + expect_equal(designFisher7$criticalValues, c(2.1580149e-06, 2.1580149e-06, 2.1580149e-06), tolerance = 1e-07, label = paste0("c(", paste0(designFisher7$criticalValues, collapse = ", "), ")")) + expect_equal(designFisher7$stageLevels, c(2.1580149e-06, 0.008216166, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher7$stageLevels, collapse = ", "), ")")) + expect_equal(designFisher7$nonStochasticCurtailment, TRUE, label = paste0("c(", paste0(designFisher7$nonStochasticCurtailment, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(designFisher7), NA))) + expect_output(print(designFisher7)$show()) + invisible(capture.output(expect_error(summary(designFisher7), NA))) + expect_output(summary(designFisher7)$show()) + designFisher7CodeBased <- eval(parse(text = getObjectRCode(designFisher7, stringWrapParagraphWidth = NULL))) + expect_equal(designFisher7CodeBased$alphaSpent, designFisher7$alphaSpent, tolerance = 1e-07) + expect_equal(designFisher7CodeBased$criticalValues, designFisher7$criticalValues, tolerance = 1e-07) + expect_equal(designFisher7CodeBased$stageLevels, designFisher7$stageLevels, tolerance = 1e-07) + expect_equal(designFisher7CodeBased$nonStochasticCurtailment, designFisher7$nonStochasticCurtailment, tolerance = 1e-07) + expect_type(names(designFisher7), "character") + df <- as.data.frame(designFisher7) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(designFisher7) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignFisher} + # @refFS[Formula]{fs:FisherCombinationNoTreatmentStageInteraction} + designFisher8 <- getDesignFisher(kMax = 4, alpha0Vec = c(0.7, 0.6, 0.5), method = "noInteraction") + + ## Comparison of the results of TrialDesignFisher object 'designFisher8' with expected results + expect_equal(designFisher8$alphaSpent, c(0.0098603693, 0.012073314, 0.018133935, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher8$alphaSpent, collapse = ", "), ")")) + expect_equal(designFisher8$criticalValues, c(0.0098603693, 0.00051915905, 0.00031149543, 0.00015574772), tolerance = 1e-07, label = paste0("c(", paste0(designFisher8$criticalValues, collapse = ", "), ")")) + expect_equal(designFisher8$stageLevels, c(0.0098603693, 0.0044457148, 0.012979977, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher8$stageLevels, collapse = ", "), ")")) + expect_equal(designFisher8$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher8$nonStochasticCurtailment, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(designFisher8), NA))) + expect_output(print(designFisher8)$show()) + invisible(capture.output(expect_error(summary(designFisher8), NA))) + expect_output(summary(designFisher8)$show()) + designFisher8CodeBased <- eval(parse(text = getObjectRCode(designFisher8, stringWrapParagraphWidth = NULL))) + expect_equal(designFisher8CodeBased$alphaSpent, designFisher8$alphaSpent, tolerance = 1e-07) + expect_equal(designFisher8CodeBased$criticalValues, designFisher8$criticalValues, tolerance = 1e-07) + expect_equal(designFisher8CodeBased$stageLevels, designFisher8$stageLevels, tolerance = 1e-07) + expect_equal(designFisher8CodeBased$nonStochasticCurtailment, designFisher8$nonStochasticCurtailment, tolerance = 1e-07) + expect_type(names(designFisher8), "character") + df <- as.data.frame(designFisher8) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(designFisher8) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignFisher} + # @refFS[Formula]{fs:FisherCombinationNoTreatmentStageInteraction} + designFisher9 <- getDesignFisher(kMax = 6, alpha = 0.1, alpha0Vec = c(0.7, 0.6, 0.5, 0.4, 0.3), method = "noInteraction") + + ## Comparison of the results of TrialDesignFisher object 'designFisher9' with expected results + expect_equal(designFisher9$alphaSpent, c(0.058031958, 0.064517887, 0.079453273, 0.092924559, 0.098794775, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(designFisher9$alphaSpent, collapse = ", "), ")")) + expect_equal(designFisher9$criticalValues, c(0.058031958, 0.0026047006, 0.0015628203, 0.00078141017, 0.00031256407, 9.3769221e-05), tolerance = 1e-07, label = paste0("c(", paste0(designFisher9$criticalValues, collapse = ", "), ")")) + expect_equal(designFisher9$stageLevels, c(0.058031958, 0.018103809, 0.044282865, 0.074062827, 0.095655516, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(designFisher9$stageLevels, collapse = ", "), ")")) + expect_equal(designFisher9$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher9$nonStochasticCurtailment, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(designFisher9), NA))) + expect_output(print(designFisher9)$show()) + invisible(capture.output(expect_error(summary(designFisher9), NA))) + expect_output(summary(designFisher9)$show()) + designFisher9CodeBased <- eval(parse(text = getObjectRCode(designFisher9, stringWrapParagraphWidth = NULL))) + expect_equal(designFisher9CodeBased$alphaSpent, designFisher9$alphaSpent, tolerance = 1e-07) + expect_equal(designFisher9CodeBased$criticalValues, designFisher9$criticalValues, tolerance = 1e-07) + expect_equal(designFisher9CodeBased$stageLevels, designFisher9$stageLevels, tolerance = 1e-07) + expect_equal(designFisher9CodeBased$nonStochasticCurtailment, designFisher9$nonStochasticCurtailment, tolerance = 1e-07) + expect_type(names(designFisher9), "character") + df <- as.data.frame(designFisher9) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(designFisher9) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignFisher} + # @refFS[Formula]{fs:FisherCombinationNoTreatmentStageInteraction} + designFisher10 <- getDesignFisher( + kMax = 6, alpha = 0.1, alpha0Vec = c(0.7, 0.6, 0.5, 0.4, 0.3), method = "noInteraction", + informationRates = c(0.1, 0.15, 0.3, 0.4, 0.9, 1) + ) + + ## Comparison of the results of TrialDesignFisher object 'designFisher10' with expected results + expect_equal(designFisher10$alphaSpent, c(0.082381502, 0.082401579, 0.084330144, 0.086806556, 0.10023391, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(designFisher10$alphaSpent, collapse = ", "), ")")) + expect_equal(designFisher10$criticalValues, c(0.082381502, 0.00017925198, 0.00011812048, 5.906024e-05, 3.9204058e-05, 1.1761218e-05), tolerance = 1e-07, label = paste0("c(", paste0(designFisher10$criticalValues, collapse = ", "), ")")) + expect_equal(designFisher10$stageLevels, c(0.082381502, 0.0005998602, 0.0062212598, 0.012409923, 0.09943647, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(designFisher10$stageLevels, collapse = ", "), ")")) + expect_equal(designFisher10$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher10$nonStochasticCurtailment, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(designFisher10), NA))) + expect_output(print(designFisher10)$show()) + invisible(capture.output(expect_error(summary(designFisher10), NA))) + expect_output(summary(designFisher10)$show()) + designFisher10CodeBased <- eval(parse(text = getObjectRCode(designFisher10, stringWrapParagraphWidth = NULL))) + expect_equal(designFisher10CodeBased$alphaSpent, designFisher10$alphaSpent, tolerance = 1e-07) + expect_equal(designFisher10CodeBased$criticalValues, designFisher10$criticalValues, tolerance = 1e-07) + expect_equal(designFisher10CodeBased$stageLevels, designFisher10$stageLevels, tolerance = 1e-07) + expect_equal(designFisher10CodeBased$nonStochasticCurtailment, designFisher10$nonStochasticCurtailment, tolerance = 1e-07) + expect_type(names(designFisher10), "character") + df <- as.data.frame(designFisher10) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(designFisher10) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignFisher} + # @refFS[Formula]{fs:FisherCombinationUserDefinedAlphaSpending} + designFisher11 <- getDesignFisher(kMax = 4, alpha0Vec = c(0.7, 0.6, 0.5), method = "userDefinedAlpha", userAlphaSpending = c(0.01, 0.015, 0.02, 0.025)) + + ## Comparison of the results of TrialDesignFisher object 'designFisher11' with expected results + expect_equal(designFisher11$alphaSpent, c(0.01, 0.015, 0.02, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher11$alphaSpent, collapse = ", "), ")")) + expect_equal(designFisher11$criticalValues, c(0.01, 0.0011768873, 0.00031357454, 0.00011586425), tolerance = 1e-07, label = paste0("c(", paste0(designFisher11$criticalValues, collapse = ", "), ")")) + expect_equal(designFisher11$stageLevels, c(0.01, 0.0091148534, 0.013047692, 0.020300118), tolerance = 1e-07, label = paste0("c(", paste0(designFisher11$stageLevels, collapse = ", "), ")")) + expect_equal(designFisher11$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher11$nonStochasticCurtailment, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(designFisher11), NA))) + expect_output(print(designFisher11)$show()) + invisible(capture.output(expect_error(summary(designFisher11), NA))) + expect_output(summary(designFisher11)$show()) + designFisher11CodeBased <- eval(parse(text = getObjectRCode(designFisher11, stringWrapParagraphWidth = NULL))) + expect_equal(designFisher11CodeBased$alphaSpent, designFisher11$alphaSpent, tolerance = 1e-07) + expect_equal(designFisher11CodeBased$criticalValues, designFisher11$criticalValues, tolerance = 1e-07) + expect_equal(designFisher11CodeBased$stageLevels, designFisher11$stageLevels, tolerance = 1e-07) + expect_equal(designFisher11CodeBased$nonStochasticCurtailment, designFisher11$nonStochasticCurtailment, tolerance = 1e-07) + expect_type(names(designFisher11), "character") + df <- as.data.frame(designFisher11) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(designFisher11) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignFisher} + # @refFS[Formula]{fs:FisherCombinationUserDefinedAlphaSpending} + designFisher12 <- getDesignFisher( + kMax = 4, alpha0Vec = c(0.7, 0.6, 0.5), informationRates = c(0.1, 0.3, 0.7, 1), + method = "userDefinedAlpha", userAlphaSpending = c(0.01, 0.015, 0.02, 0.025) + ) + + ## Comparison of the results of TrialDesignFisher object 'designFisher12' with expected results + expect_equal(designFisher12$alphaSpent, c(0.01, 0.015, 0.02, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher12$alphaSpent, collapse = ", "), ")")) + expect_equal(designFisher12$criticalValues, c(0.01, 0.00018389153, 2.6484943e-06, 5.2344628e-07), tolerance = 1e-07, label = paste0("c(", paste0(designFisher12$criticalValues, collapse = ", "), ")")) + expect_equal(designFisher12$stageLevels, c(0.01, 0.0073532156, 0.0101804, 0.018500415), tolerance = 1e-07, label = paste0("c(", paste0(designFisher12$stageLevels, collapse = ", "), ")")) + expect_equal(designFisher12$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher12$nonStochasticCurtailment, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(designFisher12), NA))) + expect_output(print(designFisher12)$show()) + invisible(capture.output(expect_error(summary(designFisher12), NA))) + expect_output(summary(designFisher12)$show()) + designFisher12CodeBased <- eval(parse(text = getObjectRCode(designFisher12, stringWrapParagraphWidth = NULL))) + expect_equal(designFisher12CodeBased$alphaSpent, designFisher12$alphaSpent, tolerance = 1e-07) + expect_equal(designFisher12CodeBased$criticalValues, designFisher12$criticalValues, tolerance = 1e-07) + expect_equal(designFisher12CodeBased$stageLevels, designFisher12$stageLevels, tolerance = 1e-07) + expect_equal(designFisher12CodeBased$nonStochasticCurtailment, designFisher12$nonStochasticCurtailment, tolerance = 1e-07) + expect_type(names(designFisher12), "character") + df <- as.data.frame(designFisher12) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(designFisher12) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignFisher': illegal arguments throw exceptions as expected", { + + expect_error(getDesignFisher( + method = C_FISHER_METHOD_USER_DEFINED_ALPHA, + userAlphaSpending = c(0.01, 0.02, 0.023, 0.023, 0.025), kMax = 4 + ), + paste0( + "Conflicting arguments: length of 'userAlphaSpending' (5) ", + "must be equal to 'kMax' (4)" + ), + fixed = TRUE + ) + + expect_error(getDesignFisher( + method = C_FISHER_METHOD_USER_DEFINED_ALPHA, + userAlphaSpending = c(0.01, 0.02, 0.025), informationRates = c(0.5, 1) + ), + paste0( + "Conflicting arguments: length of 'userAlphaSpending' (3) ", + "must be equal to length of 'informationRates' (2)" + ), + fixed = TRUE + ) + + expect_error(getDesignFisher( + method = C_FISHER_METHOD_USER_DEFINED_ALPHA, + userAlphaSpending = c(0.01, 0.02, 0.025), informationRates = c(0.4, 1) + ), + paste0( + "Conflicting arguments: length of 'userAlphaSpending' (3) ", + "must be equal to length of 'informationRates' (2)" + ), + fixed = TRUE + ) + + expect_error(getDesignFisher( + method = C_FISHER_METHOD_USER_DEFINED_ALPHA, + userAlphaSpending = c(0.01, 0.02, 0.023, 0.023, 0.021) + ), + paste0( + "'userAlphaSpending' = c(0.01, 0.02, 0.023, 0.023, 0.021) must be a vector that ", + "satisfies the following condition: 0 <= alpha_1 <= .. <= alpha_5 <= alpha = 0.021" + ), + fixed = TRUE + ) + + expect_error(getDesignFisher( + method = C_FISHER_METHOD_USER_DEFINED_ALPHA, + userAlphaSpending = c(0.01, 0.02, 0.023), alpha = 0.02 + ), + paste0( + "'userAlphaSpending' = c(0.01, 0.02, 0.023) must be a vector that ", + "satisfies the following condition: 0 <= alpha_1 <= .. <= alpha_3 <= alpha = 0.02" + ), + fixed = TRUE + ) + + expect_equal(getDesignFisher( + method = C_FISHER_METHOD_USER_DEFINED_ALPHA, + userAlphaSpending = c(0.01, 0.02, 0.023) + )$alpha, 0.023) + + expect_error(getDesignFisher(method = C_FISHER_METHOD_USER_DEFINED_ALPHA), + "Missing argument: parameter 'userAlphaSpending' must be specified in design", + fixed = TRUE + ) + + expect_error(getDesignFisher(kMax = Inf), + paste0( + "Argument out of bounds: 'kMax' (Inf) is out of bounds [1; ", + C_KMAX_UPPER_BOUND_FISHER, "]" + ), + fixed = TRUE + ) + + expect_error(getDesignFisher(kMax = -Inf), + paste0( + "Argument out of bounds: 'kMax' (-Inf) is out of bounds [1; ", + C_KMAX_UPPER_BOUND_FISHER, "]" + ), + fixed = TRUE + ) + + expect_error(getDesignFisher(kMax = -Inf), "Argument out of bounds: 'kMax' (-Inf) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = -10), "Argument out of bounds: 'kMax' (-10) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = -9), "Argument out of bounds: 'kMax' (-9) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = -8), "Argument out of bounds: 'kMax' (-8) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = -7), "Argument out of bounds: 'kMax' (-7) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = -6), "Argument out of bounds: 'kMax' (-6) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = -5), "Argument out of bounds: 'kMax' (-5) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = -4), "Argument out of bounds: 'kMax' (-4) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = -3), "Argument out of bounds: 'kMax' (-3) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = -2), "Argument out of bounds: 'kMax' (-2) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = -1), "Argument out of bounds: 'kMax' (-1) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = 0), "Argument out of bounds: 'kMax' (0) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = 7), "Argument out of bounds: 'kMax' (7) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = 8), "Argument out of bounds: 'kMax' (8) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = 9), "Argument out of bounds: 'kMax' (9) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = 10), "Argument out of bounds: 'kMax' (10) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = 11), "Argument out of bounds: 'kMax' (11) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = 12), "Argument out of bounds: 'kMax' (12) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = 13), "Argument out of bounds: 'kMax' (13) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = 14), "Argument out of bounds: 'kMax' (14) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = 15), "Argument out of bounds: 'kMax' (15) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = 16), "Argument out of bounds: 'kMax' (16) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = Inf), "Argument out of bounds: 'kMax' (Inf) is out of bounds [1; 6]", fixed = TRUE) + + expect_error(getDesignFisher(kMax = 2, informationRates = c(0.01, 0.02, 0.04, 0.05)), "Conflicting arguments: length of 'informationRates' (4) must be equal to 'kMax' (2)", fixed = TRUE) + expect_error(getDesignFisher(kMax = 3, informationRates = c(0.01, 0.02, 0.04, 0.05)), "Conflicting arguments: length of 'informationRates' (4) must be equal to 'kMax' (3)", fixed = TRUE) + expect_error(getDesignFisher(kMax = 5, informationRates = c(0.01, 0.02, 0.04, 0.05)), "Conflicting arguments: length of 'informationRates' (4) must be equal to 'kMax' (5)", fixed = TRUE) + expect_error(getDesignFisher(kMax = 6, informationRates = c(0.01, 0.02, 0.04, 0.05)), "Conflicting arguments: length of 'informationRates' (4) must be equal to 'kMax' (6)", fixed = TRUE) + + expect_error(getDesignFisher(alpha0Vec = c(0, 1)), + "Argument out of bounds: 'alpha0Vec' (0, 1) is out of bounds (0; 1]", + fixed = TRUE + ) + + expect_error(getDesignFisher(alpha0Vec = c(0.1, 1.01)), + "Argument out of bounds: 'alpha0Vec' (0.1, 1.01) is out of bounds (0; 1]", + fixed = TRUE + ) + +}) + diff --git a/tests/testthat/test-f_design_group_sequential.R b/tests/testthat/test-f_design_group_sequential.R index f9af03ad..f2e07c88 100644 --- a/tests/testthat/test-f_design_group_sequential.R +++ b/tests/testthat/test-f_design_group_sequential.R @@ -1,2108 +1,2109 @@ -## | -## | *Unit tests* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | RPACT package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File name: test-f_design_group_sequential.R -## | Creation date: 08 November 2023, 09:09:43 -## | File version: $Revision$ -## | Last changed: $Date$ -## | Last changed by: $Author$ -## | - -test_plan_section("Testing the Group Sequential and Inverse Normal Design Functionality") - - -test_that("'getGroupSequentialProbabilities' with one and two continuation regions for weighted test statistic", { - # @refFS[Formula]{fs:testStatisticGroupSequentialWeightedAverage} - xa <- getGroupSequentialProbabilities(matrix(c(rep(-qnorm(0.95), 4), rep(qnorm(0.95), 4)), nrow = 2, byrow = TRUE), (1:4) / 4) - - ## Comparison of the results of matrixarray object 'xa' with expected results - expect_equal(xa[1, ], c(0.05, 0.030074925, 0.020961248, 0.01595848), tolerance = 1e-07, label = paste0("c(", paste0(xa[1, ], collapse = ", "), ")")) - expect_equal(xa[2, ], c(0.95, 0.86992507, 0.8188889, 0.78196917), tolerance = 1e-07, label = paste0("c(", paste0(xa[2, ], collapse = ", "), ")")) - expect_equal(xa[3, ], c(1, 0.9, 0.83985015, 0.79792765), tolerance = 1e-07, label = paste0("c(", paste0(xa[3, ], collapse = ", "), ")")) - - xb <- getGroupSequentialProbabilities(matrix(c(rep(-qnorm(0.95), 4), rep(-1, 4), rep(1, 4), rep(qnorm(0.95), 4)), nrow = 4, byrow = TRUE), (1:4) / 4) - - ## Comparison of the results of matrixarray object 'xb' with expected results - expect_equal(xb[1, ], c(0.05, 0.016446517, 0.005264288, 0.0019569508), tolerance = 1e-07, label = paste0("c(", paste0(xb[1, ], collapse = ", "), ")")) - expect_equal(xb[2, ], c(0.15865525, 0.048950554, 0.017478997, 0.0072417024), tolerance = 1e-07, label = paste0("c(", paste0(xb[2, ], collapse = ", "), ")")) - expect_equal(xb[3, ], c(0.84134475, 0.16835995, 0.047529077, 0.017187717), tolerance = 1e-07, label = paste0("c(", paste0(xb[3, ], collapse = ", "), ")")) - expect_equal(xb[4, ], c(0.95, 0.20086399, 0.059743786, 0.022472468), tolerance = 1e-07, label = paste0("c(", paste0(xb[4, ], collapse = ", "), ")")) - expect_equal(xb[5, ], c(1, 0.21731051, 0.065008074, 0.024429419), tolerance = 1e-07, label = paste0("c(", paste0(xb[5, ], collapse = ", "), ")")) - -}) - -test_that("'getDesignInverseNormal' with default parameters: parameters and results are as expected", { - - # @refFS[Tab.]{fs:tab:output:getDesignInverseNormal} - # @refFS[Formula]{fs:criticalValuesOBrienFleming} - x0 <- getDesignInverseNormal() - - ## Comparison of the results of TrialDesignInverseNormal object 'x0' with expected results - expect_equal(x0$alphaSpent, c(0.00025917372, 0.0071600594, 0.02499999), tolerance = 1e-07, label = paste0("c(", paste0(x0$alphaSpent, collapse = ", "), ")")) - expect_equal(x0$criticalValues, c(3.4710914, 2.4544323, 2.0040356), tolerance = 1e-07, label = paste0("c(", paste0(x0$criticalValues, collapse = ", "), ")")) - expect_equal(x0$stageLevels, c(0.00025917372, 0.0070553616, 0.022533125), tolerance = 1e-07, label = paste0("c(", paste0(x0$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x0), NA))) - expect_output(print(x0)$show()) - invisible(capture.output(expect_error(summary(x0), NA))) - expect_output(summary(x0)$show()) - x0CodeBased <- eval(parse(text = getObjectRCode(x0, stringWrapParagraphWidth = NULL))) - expect_equal(x0CodeBased$alphaSpent, x0$alphaSpent, tolerance = 1e-07) - expect_equal(x0CodeBased$criticalValues, x0$criticalValues, tolerance = 1e-07) - expect_equal(x0CodeBased$stageLevels, x0$stageLevels, tolerance = 1e-07) - expect_type(names(x0), "character") - df <- as.data.frame(x0) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x0) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignInverseNormal' with type of design = 'asHSD', 'bsHSD', 'asKD', and 'bsKD'", { - - .skipTestIfDisabled() - - # @refFS[Tab.]{fs:tab:output:getDesignInverseNormal} - # @refFS[Formula]{fs:alphaSpendingConcept} - # @refFS[Formula]{fs:alphaSpendingHwangShiDeCani} - x1 <- getDesignInverseNormal( - kMax = 3, informationRates = c(0.2, 0.4, 1), - alpha = 0.03, sided = 1, beta = 0.14, typeOfDesign = "asHSD", gammaA = 0 - ) - - ## Comparison of the results of TrialDesignInverseNormal object 'x1' with expected results - expect_equal(x1$alphaSpent, c(0.006, 0.012, 0.03), tolerance = 1e-07, label = paste0("c(", paste0(x1$alphaSpent, collapse = ", "), ")")) - expect_equal(x1$criticalValues, c(2.5121443, 2.4228747, 2.0280392), tolerance = 1e-07, label = paste0("c(", paste0(x1$criticalValues, collapse = ", "), ")")) - expect_equal(x1$stageLevels, c(0.006, 0.0076991188, 0.021278125), tolerance = 1e-07, label = paste0("c(", paste0(x1$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x1), NA))) - expect_output(print(x1)$show()) - invisible(capture.output(expect_error(summary(x1), NA))) - expect_output(summary(x1)$show()) - x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) - expect_equal(x1CodeBased$alphaSpent, x1$alphaSpent, tolerance = 1e-07) - expect_equal(x1CodeBased$criticalValues, x1$criticalValues, tolerance = 1e-07) - expect_equal(x1CodeBased$stageLevels, x1$stageLevels, tolerance = 1e-07) - expect_type(names(x1), "character") - df <- as.data.frame(x1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignCharacteristics} - # @refFS[Formula]{fs:inflationFactor} - # @refFS[Formula]{fs:expectedReduction} - y1 <- getDesignCharacteristics(x1) - - ## Comparison of the results of TrialDesignCharacteristics object 'y1' with expected results - expect_equal(y1$nFixed, 8.7681899, tolerance = 1e-07, label = paste0("c(", paste0(y1$nFixed, collapse = ", "), ")")) - expect_equal(y1$shift, 9.4594101, tolerance = 1e-07, label = paste0("c(", paste0(y1$shift, collapse = ", "), ")")) - expect_equal(y1$inflationFactor, 1.0788327, tolerance = 1e-07, label = paste0("c(", paste0(y1$inflationFactor, collapse = ", "), ")")) - expect_equal(y1$information, c(1.891882, 3.7837641, 9.4594101), tolerance = 1e-07, label = paste0("c(", paste0(y1$information, collapse = ", "), ")")) - expect_equal(y1$power, c(0.12783451, 0.34055165, 0.86), tolerance = 1e-07, label = paste0("c(", paste0(y1$power, collapse = ", "), ")")) - expect_equal(y1$rejectionProbabilities, c(0.12783451, 0.21271713, 0.51944835), tolerance = 1e-07, label = paste0("c(", paste0(y1$rejectionProbabilities, collapse = ", "), ")")) - expect_equal(y1$futilityProbabilities, c(0, 0), label = paste0("c(", paste0(y1$futilityProbabilities, collapse = ", "), ")")) - expect_equal(y1$averageSampleNumber1, 0.83081135, tolerance = 1e-07, label = paste0("c(", paste0(y1$averageSampleNumber1, collapse = ", "), ")")) - expect_equal(y1$averageSampleNumber01, 1.0142116, tolerance = 1e-07, label = paste0("c(", paste0(y1$averageSampleNumber01, collapse = ", "), ")")) - expect_equal(y1$averageSampleNumber0, 1.0697705, tolerance = 1e-07, label = paste0("c(", paste0(y1$averageSampleNumber0, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(y1), NA))) - expect_output(print(y1)$show()) - invisible(capture.output(expect_error(summary(y1), NA))) - expect_output(summary(y1)$show()) - y1CodeBased <- eval(parse(text = getObjectRCode(y1, stringWrapParagraphWidth = NULL))) - expect_equal(y1CodeBased$nFixed, y1$nFixed, tolerance = 1e-07) - expect_equal(y1CodeBased$shift, y1$shift, tolerance = 1e-07) - expect_equal(y1CodeBased$inflationFactor, y1$inflationFactor, tolerance = 1e-07) - expect_equal(y1CodeBased$information, y1$information, tolerance = 1e-07) - expect_equal(y1CodeBased$power, y1$power, tolerance = 1e-07) - expect_equal(y1CodeBased$rejectionProbabilities, y1$rejectionProbabilities, tolerance = 1e-07) - expect_equal(y1CodeBased$futilityProbabilities, y1$futilityProbabilities, tolerance = 1e-07) - expect_equal(y1CodeBased$averageSampleNumber1, y1$averageSampleNumber1, tolerance = 1e-07) - expect_equal(y1CodeBased$averageSampleNumber01, y1$averageSampleNumber01, tolerance = 1e-07) - expect_equal(y1CodeBased$averageSampleNumber0, y1$averageSampleNumber0, tolerance = 1e-07) - expect_type(names(y1), "character") - df <- as.data.frame(y1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(y1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignInverseNormal} - # @refFS[Formula]{fs:alphaSpendingConcept} - # @refFS[Formula]{fs:alphaSpendingHwangShiDeCani} - # @refFS[Formula]{fs:betaSpendingApproach} - # @refFS[Formula]{fs:betaSpendingHwangShiDeCani} - x2 <- getDesignInverseNormal( - kMax = 3, informationRates = c(0.2, 0.4, 1), - alpha = 0.07, sided = 1, beta = 0.14, typeOfDesign = "asHSD", gammaA = -1, - typeBetaSpending = "bsHSD", gammaB = -2 - ) - - ## Comparison of the results of TrialDesignInverseNormal object 'x2' with expected results - expect_equal(x2$power, c(0.12038953, 0.32895265, 0.86), tolerance = 1e-07, label = paste0("c(", paste0(x2$power, collapse = ", "), ")")) - expect_equal(x2$futilityBounds, c(-1.1063623, -0.35992439), tolerance = 1e-07, label = paste0("c(", paste0(x2$futilityBounds, collapse = ", "), ")")) - expect_equal(x2$alphaSpent, c(0.0090195874, 0.020036136, 0.07), tolerance = 1e-07, label = paste0("c(", paste0(x2$alphaSpent, collapse = ", "), ")")) - expect_equal(x2$betaSpent, c(0.010777094, 0.026854629, 0.14), tolerance = 1e-07, label = paste0("c(", paste0(x2$betaSpent, collapse = ", "), ")")) - expect_equal(x2$criticalValues, c(2.364813, 2.1928805, 1.5660474), tolerance = 1e-07, label = paste0("c(", paste0(x2$criticalValues, collapse = ", "), ")")) - expect_equal(x2$stageLevels, c(0.0090195874, 0.014157994, 0.058668761), tolerance = 1e-07, label = paste0("c(", paste0(x2$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x2), NA))) - expect_output(print(x2)$show()) - invisible(capture.output(expect_error(summary(x2), NA))) - expect_output(summary(x2)$show()) - x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) - expect_equal(x2CodeBased$power, x2$power, tolerance = 1e-07) - expect_equal(x2CodeBased$futilityBounds, x2$futilityBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$alphaSpent, x2$alphaSpent, tolerance = 1e-07) - expect_equal(x2CodeBased$betaSpent, x2$betaSpent, tolerance = 1e-07) - expect_equal(x2CodeBased$criticalValues, x2$criticalValues, tolerance = 1e-07) - expect_equal(x2CodeBased$stageLevels, x2$stageLevels, tolerance = 1e-07) - expect_type(names(x2), "character") - df <- as.data.frame(x2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignCharacteristics} - # @refFS[Formula]{fs:inflationFactor} - # @refFS[Formula]{fs:expectedReduction} - y2 <- getDesignCharacteristics(x2) - - ## Comparison of the results of TrialDesignCharacteristics object 'y2' with expected results - expect_equal(y2$nFixed, 6.5337002, tolerance = 1e-07, label = paste0("c(", paste0(y2$nFixed, collapse = ", "), ")")) - expect_equal(y2$shift, 7.1015942, tolerance = 1e-07, label = paste0("c(", paste0(y2$shift, collapse = ", "), ")")) - expect_equal(y2$inflationFactor, 1.0869177, tolerance = 1e-07, label = paste0("c(", paste0(y2$inflationFactor, collapse = ", "), ")")) - expect_equal(y2$information, c(1.4203188, 2.8406377, 7.1015942), tolerance = 1e-07, label = paste0("c(", paste0(y2$information, collapse = ", "), ")")) - expect_equal(y2$power, c(0.12038953, 0.32895265, 0.86), tolerance = 1e-07, label = paste0("c(", paste0(y2$power, collapse = ", "), ")")) - expect_equal(y2$rejectionProbabilities, c(0.12038953, 0.20856311, 0.53104735), tolerance = 1e-07, label = paste0("c(", paste0(y2$rejectionProbabilities, collapse = ", "), ")")) - expect_equal(y2$futilityProbabilities, c(0.010777094, 0.016077535), tolerance = 1e-07, label = paste0("c(", paste0(y2$futilityProbabilities, collapse = ", "), ")")) - expect_equal(y2$averageSampleNumber1, 0.82636428, tolerance = 1e-07, label = paste0("c(", paste0(y2$averageSampleNumber1, collapse = ", "), ")")) - expect_equal(y2$averageSampleNumber01, 0.916142, tolerance = 1e-07, label = paste0("c(", paste0(y2$averageSampleNumber01, collapse = ", "), ")")) - expect_equal(y2$averageSampleNumber0, 0.79471657, tolerance = 1e-07, label = paste0("c(", paste0(y2$averageSampleNumber0, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(y2), NA))) - expect_output(print(y2)$show()) - invisible(capture.output(expect_error(summary(y2), NA))) - expect_output(summary(y2)$show()) - y2CodeBased <- eval(parse(text = getObjectRCode(y2, stringWrapParagraphWidth = NULL))) - expect_equal(y2CodeBased$nFixed, y2$nFixed, tolerance = 1e-07) - expect_equal(y2CodeBased$shift, y2$shift, tolerance = 1e-07) - expect_equal(y2CodeBased$inflationFactor, y2$inflationFactor, tolerance = 1e-07) - expect_equal(y2CodeBased$information, y2$information, tolerance = 1e-07) - expect_equal(y2CodeBased$power, y2$power, tolerance = 1e-07) - expect_equal(y2CodeBased$rejectionProbabilities, y2$rejectionProbabilities, tolerance = 1e-07) - expect_equal(y2CodeBased$futilityProbabilities, y2$futilityProbabilities, tolerance = 1e-07) - expect_equal(y2CodeBased$averageSampleNumber1, y2$averageSampleNumber1, tolerance = 1e-07) - expect_equal(y2CodeBased$averageSampleNumber01, y2$averageSampleNumber01, tolerance = 1e-07) - expect_equal(y2CodeBased$averageSampleNumber0, y2$averageSampleNumber0, tolerance = 1e-07) - expect_type(names(y2), "character") - df <- as.data.frame(y2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(y2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignInverseNormal} - # @refFS[Formula]{fs:alphaSpendingConcept} - # @refFS[Formula]{fs:alphaSpendingKimDeMets} - # @refFS[Formula]{fs:betaSpendingApproach} - # @refFS[Formula]{fs:betaSpendingKimDeMets} - x3 <- getDesignInverseNormal( - kMax = 3, informationRates = c(0.3, 0.7, 1), - alpha = 0.03, sided = 1, beta = 0.34, typeOfDesign = "asKD", gammaA = 2.2, - typeBetaSpending = "bsKD", gammaB = 3.2 - ) - - ## Comparison of the results of TrialDesignInverseNormal object 'x3' with expected results - expect_equal(x3$power, c(0.058336437, 0.398246, 0.66), tolerance = 1e-07, label = paste0("c(", paste0(x3$power, collapse = ", "), ")")) - expect_equal(x3$futilityBounds, c(-1.1558435, 0.72836893), tolerance = 1e-07, label = paste0("c(", paste0(x3$futilityBounds, collapse = ", "), ")")) - expect_equal(x3$alphaSpent, c(0.0021222083, 0.013687904, 0.03), tolerance = 1e-07, label = paste0("c(", paste0(x3$alphaSpent, collapse = ", "), ")")) - expect_equal(x3$betaSpent, c(0.0072155083, 0.1085907, 0.34), tolerance = 1e-07, label = paste0("c(", paste0(x3$betaSpent, collapse = ", "), ")")) - expect_equal(x3$criticalValues, c(2.8594012, 2.2435708, 1.9735737), tolerance = 1e-07, label = paste0("c(", paste0(x3$criticalValues, collapse = ", "), ")")) - expect_equal(x3$stageLevels, c(0.0021222083, 0.012430014, 0.02421512), tolerance = 1e-07, label = paste0("c(", paste0(x3$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x3), NA))) - expect_output(print(x3)$show()) - invisible(capture.output(expect_error(summary(x3), NA))) - expect_output(summary(x3)$show()) - x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) - expect_equal(x3CodeBased$power, x3$power, tolerance = 1e-07) - expect_equal(x3CodeBased$futilityBounds, x3$futilityBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$alphaSpent, x3$alphaSpent, tolerance = 1e-07) - expect_equal(x3CodeBased$betaSpent, x3$betaSpent, tolerance = 1e-07) - expect_equal(x3CodeBased$criticalValues, x3$criticalValues, tolerance = 1e-07) - expect_equal(x3CodeBased$stageLevels, x3$stageLevels, tolerance = 1e-07) - expect_type(names(x3), "character") - df <- as.data.frame(x3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignCharacteristics} - # @refFS[Formula]{fs:inflationFactor} - # @refFS[Formula]{fs:expectedReduction} - y3 <- getDesignCharacteristics(x3) - - ## Comparison of the results of TrialDesignCharacteristics object 'y3' with expected results - expect_equal(y3$nFixed, 5.2590265, tolerance = 1e-07, label = paste0("c(", paste0(y3$nFixed, collapse = ", "), ")")) - expect_equal(y3$shift, 5.551371, tolerance = 1e-07, label = paste0("c(", paste0(y3$shift, collapse = ", "), ")")) - expect_equal(y3$inflationFactor, 1.0555891, tolerance = 1e-07, label = paste0("c(", paste0(y3$inflationFactor, collapse = ", "), ")")) - expect_equal(y3$information, c(1.6654113, 3.8859597, 5.551371), tolerance = 1e-07, label = paste0("c(", paste0(y3$information, collapse = ", "), ")")) - expect_equal(y3$power, c(0.058336437, 0.398246, 0.66), tolerance = 1e-07, label = paste0("c(", paste0(y3$power, collapse = ", "), ")")) - expect_equal(y3$rejectionProbabilities, c(0.058336437, 0.33990957, 0.261754), tolerance = 1e-07, label = paste0("c(", paste0(y3$rejectionProbabilities, collapse = ", "), ")")) - expect_equal(y3$futilityProbabilities, c(0.0072155083, 0.1013752), tolerance = 1e-07, label = paste0("c(", paste0(y3$futilityProbabilities, collapse = ", "), ")")) - expect_equal(y3$averageSampleNumber1, 0.86740735, tolerance = 1e-07, label = paste0("c(", paste0(y3$averageSampleNumber1, collapse = ", "), ")")) - expect_equal(y3$averageSampleNumber01, 0.87361707, tolerance = 1e-07, label = paste0("c(", paste0(y3$averageSampleNumber01, collapse = ", "), ")")) - expect_equal(y3$averageSampleNumber0, 0.75480974, tolerance = 1e-07, label = paste0("c(", paste0(y3$averageSampleNumber0, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(y3), NA))) - expect_output(print(y3)$show()) - invisible(capture.output(expect_error(summary(y3), NA))) - expect_output(summary(y3)$show()) - y3CodeBased <- eval(parse(text = getObjectRCode(y3, stringWrapParagraphWidth = NULL))) - expect_equal(y3CodeBased$nFixed, y3$nFixed, tolerance = 1e-07) - expect_equal(y3CodeBased$shift, y3$shift, tolerance = 1e-07) - expect_equal(y3CodeBased$inflationFactor, y3$inflationFactor, tolerance = 1e-07) - expect_equal(y3CodeBased$information, y3$information, tolerance = 1e-07) - expect_equal(y3CodeBased$power, y3$power, tolerance = 1e-07) - expect_equal(y3CodeBased$rejectionProbabilities, y3$rejectionProbabilities, tolerance = 1e-07) - expect_equal(y3CodeBased$futilityProbabilities, y3$futilityProbabilities, tolerance = 1e-07) - expect_equal(y3CodeBased$averageSampleNumber1, y3$averageSampleNumber1, tolerance = 1e-07) - expect_equal(y3CodeBased$averageSampleNumber01, y3$averageSampleNumber01, tolerance = 1e-07) - expect_equal(y3CodeBased$averageSampleNumber0, y3$averageSampleNumber0, tolerance = 1e-07) - expect_type(names(y3), "character") - df <- as.data.frame(y3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(y3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignInverseNormal' with binding futility bounds", { - - # @refFS[Tab.]{fs:tab:output:getDesignInverseNormal} - # @refFS[Formula]{fs:criticalValuesWithFutility} - # @refFS[Formula]{fs:criticalValuesWangTiatis} - x4 <- getDesignInverseNormal( - kMax = 4, alpha = 0.035, futilityBounds = rep(0.5244, 3), - bindingFutility = TRUE, typeOfDesign = "WT", deltaWT = 0.4 - ) - - ## Comparison of the results of TrialDesignInverseNormal object 'x4' with expected results - expect_equal(x4$alphaSpent, c(0.0099446089, 0.020756912, 0.029001537, 0.03499999), tolerance = 1e-07, label = paste0("c(", paste0(x4$alphaSpent, collapse = ", "), ")")) - expect_equal(x4$criticalValues, c(2.3284312, 2.1725031, 2.0861776, 2.0270171), tolerance = 1e-07, label = paste0("c(", paste0(x4$criticalValues, collapse = ", "), ")")) - expect_equal(x4$stageLevels, c(0.0099446089, 0.014908866, 0.018481267, 0.021330332), tolerance = 1e-07, label = paste0("c(", paste0(x4$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x4), NA))) - expect_output(print(x4)$show()) - invisible(capture.output(expect_error(summary(x4), NA))) - expect_output(summary(x4)$show()) - x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) - expect_equal(x4CodeBased$alphaSpent, x4$alphaSpent, tolerance = 1e-07) - expect_equal(x4CodeBased$criticalValues, x4$criticalValues, tolerance = 1e-07) - expect_equal(x4CodeBased$stageLevels, x4$stageLevels, tolerance = 1e-07) - expect_type(names(x4), "character") - df <- as.data.frame(x4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignGroupSequential' with type of design = 'asUser'", { - - .skipTestIfDisabled() - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:alphaSpendingConcept} - x5 <- getDesignGroupSequential( - typeOfDesign = "asUser", - userAlphaSpending = c(0.01, 0.02, 0.03, 0.05) - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x5' with expected results - expect_equal(x5$alphaSpent, c(0.01, 0.02, 0.03, 0.04999999), tolerance = 1e-07, label = paste0("c(", paste0(x5$alphaSpent, collapse = ", "), ")")) - expect_equal(x5$criticalValues, c(2.3263479, 2.2192994, 2.1201347, 1.8189562), tolerance = 1e-07, label = paste0("c(", paste0(x5$criticalValues, collapse = ", "), ")")) - expect_equal(x5$stageLevels, c(0.01, 0.01323318, 0.016997342, 0.034459057), tolerance = 1e-07, label = paste0("c(", paste0(x5$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x5), NA))) - expect_output(print(x5)$show()) - invisible(capture.output(expect_error(summary(x5), NA))) - expect_output(summary(x5)$show()) - x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) - expect_equal(x5CodeBased$alphaSpent, x5$alphaSpent, tolerance = 1e-07) - expect_equal(x5CodeBased$criticalValues, x5$criticalValues, tolerance = 1e-07) - expect_equal(x5CodeBased$stageLevels, x5$stageLevels, tolerance = 1e-07) - expect_type(names(x5), "character") - df <- as.data.frame(x5) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x5) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignGroupSequential' with type of design = 'asP' and 'bsUser' and non-binding futility bounds", { - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:alphaSpendingConcept} - # @refFS[Formula]{fs:alphaSpendingPocock} - # @refFS[Formula]{fs:betaSpendingApproach} - x6a <- getDesignGroupSequential( - kMax = 3, alpha = 0.13, - typeOfDesign = "asP", typeBetaSpending = "bsUser", - informationRates = c(0.35, 0.7, 1), - bindingFutility = FALSE, - userBetaSpending = c(0.01, 0.05, 0.3) - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x6a' with expected results - expect_equal(x6a$power, c(0.31774348, 0.5598179, 0.7), tolerance = 1e-07, label = paste0("c(", paste0(x6a$power, collapse = ", "), ")")) - expect_equal(x6a$futilityBounds, c(-1.2557044, -0.16828659), tolerance = 1e-07, label = paste0("c(", paste0(x6a$futilityBounds, collapse = ", "), ")")) - expect_equal(x6a$alphaSpent, c(0.061214062, 0.10266465, 0.13), tolerance = 1e-07, label = paste0("c(", paste0(x6a$alphaSpent, collapse = ", "), ")")) - expect_equal(x6a$betaSpent, c(0.01, 0.05, 0.3), tolerance = 1e-07, label = paste0("c(", paste0(x6a$betaSpent, collapse = ", "), ")")) - expect_equal(x6a$criticalValues, c(1.5446617, 1.4828682, 1.4620058), tolerance = 1e-07, label = paste0("c(", paste0(x6a$criticalValues, collapse = ", "), ")")) - expect_equal(x6a$stageLevels, c(0.061214062, 0.069054712, 0.071869812), tolerance = 1e-07, label = paste0("c(", paste0(x6a$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x6a), NA))) - expect_output(print(x6a)$show()) - invisible(capture.output(expect_error(summary(x6a), NA))) - expect_output(summary(x6a)$show()) - x6aCodeBased <- eval(parse(text = getObjectRCode(x6a, stringWrapParagraphWidth = NULL))) - expect_equal(x6aCodeBased$power, x6a$power, tolerance = 1e-07) - expect_equal(x6aCodeBased$futilityBounds, x6a$futilityBounds, tolerance = 1e-07) - expect_equal(x6aCodeBased$alphaSpent, x6a$alphaSpent, tolerance = 1e-07) - expect_equal(x6aCodeBased$betaSpent, x6a$betaSpent, tolerance = 1e-07) - expect_equal(x6aCodeBased$criticalValues, x6a$criticalValues, tolerance = 1e-07) - expect_equal(x6aCodeBased$stageLevels, x6a$stageLevels, tolerance = 1e-07) - expect_type(names(x6a), "character") - df <- as.data.frame(x6a) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x6a) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignGroupSequential' with type of design = 'asP' and information rate < 1 at maximum stage", { - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:alphaSpendingConcept} - # @refFS[Formula]{fs:alphaSpendingPocock} - x6b <- getDesignGroupSequential(informationRates = c(0.4, 0.7), typeOfDesign = "asP") - - ## Comparison of the results of TrialDesignGroupSequential object 'x6b' with expected results - expect_equal(x6b$alphaSpent, c(0.013078429, 0.0197432), tolerance = 1e-07, label = paste0("c(", paste0(x6b$alphaSpent, collapse = ", "), ")")) - expect_equal(x6b$criticalValues, c(2.223875, 2.3050796), tolerance = 1e-07, label = paste0("c(", paste0(x6b$criticalValues, collapse = ", "), ")")) - expect_equal(x6b$stageLevels, c(0.013078429, 0.010581057), tolerance = 1e-07, label = paste0("c(", paste0(x6b$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x6b), NA))) - expect_output(print(x6b)$show()) - invisible(capture.output(expect_error(summary(x6b), NA))) - expect_output(summary(x6b)$show()) - x6bCodeBased <- eval(parse(text = getObjectRCode(x6b, stringWrapParagraphWidth = NULL))) - expect_equal(x6bCodeBased$alphaSpent, x6b$alphaSpent, tolerance = 1e-07) - expect_equal(x6bCodeBased$criticalValues, x6b$criticalValues, tolerance = 1e-07) - expect_equal(x6bCodeBased$stageLevels, x6b$stageLevels, tolerance = 1e-07) - expect_type(names(x6b), "character") - df <- as.data.frame(x6b) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x6b) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignGroupSequential' with type of design = 'asOF' and 'bsKD' and non-binding futility bounds (kMax = 3)", { - - .skipTestIfDisabled() - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:alphaSpendingConcept} - # @refFS[Formula]{fs:alphaSpendingOBrienFleming} - # @refFS[Formula]{fs:betaSpendingApproach} - # @refFS[Formula]{fs:betaSpendingKimDeMets} - x7a <- getDesignGroupSequential( - kMax = 3, alpha = 0.13, beta = 0.41, - typeOfDesign = "asOF", typeBetaSpending = "bsKD", - informationRates = c(0.4, 0.75, 1), - gammaB = 2.5, bindingFutility = FALSE - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x7a' with expected results - expect_equal(x7a$power, c(0.10903632, 0.42541278, 0.59), tolerance = 1e-07, label = paste0("c(", paste0(x7a$power, collapse = ", "), ")")) - expect_equal(x7a$futilityBounds, c(-0.83725762, 0.35992547), tolerance = 1e-07, label = paste0("c(", paste0(x7a$futilityBounds, collapse = ", "), ")")) - expect_equal(x7a$alphaSpent, c(0.016665509, 0.080406163, 0.12999999), tolerance = 1e-07, label = paste0("c(", paste0(x7a$alphaSpent, collapse = ", "), ")")) - expect_equal(x7a$betaSpent, c(0.041489083, 0.19972711, 0.41), tolerance = 1e-07, label = paste0("c(", paste0(x7a$betaSpent, collapse = ", "), ")")) - expect_equal(x7a$criticalValues, c(2.1280732, 1.4368565, 1.2468994), tolerance = 1e-07, label = paste0("c(", paste0(x7a$criticalValues, collapse = ", "), ")")) - expect_equal(x7a$stageLevels, c(0.016665509, 0.075379384, 0.1062172), tolerance = 1e-07, label = paste0("c(", paste0(x7a$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x7a), NA))) - expect_output(print(x7a)$show()) - invisible(capture.output(expect_error(summary(x7a), NA))) - expect_output(summary(x7a)$show()) - x7aCodeBased <- eval(parse(text = getObjectRCode(x7a, stringWrapParagraphWidth = NULL))) - expect_equal(x7aCodeBased$power, x7a$power, tolerance = 1e-07) - expect_equal(x7aCodeBased$futilityBounds, x7a$futilityBounds, tolerance = 1e-07) - expect_equal(x7aCodeBased$alphaSpent, x7a$alphaSpent, tolerance = 1e-07) - expect_equal(x7aCodeBased$betaSpent, x7a$betaSpent, tolerance = 1e-07) - expect_equal(x7aCodeBased$criticalValues, x7a$criticalValues, tolerance = 1e-07) - expect_equal(x7aCodeBased$stageLevels, x7a$stageLevels, tolerance = 1e-07) - expect_type(names(x7a), "character") - df <- as.data.frame(x7a) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x7a) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignGroupSequential' with type of design = 'asOF' and 'bsKD' and non-binding futility bounds (kMax = 4)", { - - .skipTestIfDisabled() - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:alphaSpendingConcept} - # @refFS[Formula]{fs:alphaSpendingOBrienFleming} - # @refFS[Formula]{fs:betaSpendingApproach} - # @refFS[Formula]{fs:betaSpendingKimDeMets} - x7a <- getDesignGroupSequential( - kMax = 4, alpha = 0.13, beta = 0.41, - typeOfDesign = "asOF", typeBetaSpending = "bsKD", - informationRates = c(0.4, 0.75, 0.85, 1), - gammaB = 2.5, bindingFutility = FALSE - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x7a' with expected results - expect_equal(x7a$power, c(0.1110095, 0.43099683, 0.50326205, 0.59), tolerance = 1e-07, label = paste0("c(", paste0(x7a$power, collapse = ", "), ")")) - expect_equal(x7a$futilityBounds, c(-0.82676531, 0.3743303, 0.65077266), tolerance = 1e-07, label = paste0("c(", paste0(x7a$futilityBounds, collapse = ", "), ")")) - expect_equal(x7a$alphaSpent, c(0.016665509, 0.080406163, 0.10053322, 0.13), tolerance = 1e-07, label = paste0("c(", paste0(x7a$alphaSpent, collapse = ", "), ")")) - expect_equal(x7a$betaSpent, c(0.041489083, 0.19972711, 0.27310596, 0.41), tolerance = 1e-07, label = paste0("c(", paste0(x7a$betaSpent, collapse = ", "), ")")) - expect_equal(x7a$criticalValues, c(2.1280732, 1.4368565, 1.422873, 1.2970881), tolerance = 1e-07, label = paste0("c(", paste0(x7a$criticalValues, collapse = ", "), ")")) - expect_equal(x7a$stageLevels, c(0.016665509, 0.075379384, 0.077386492, 0.097300444), tolerance = 1e-07, label = paste0("c(", paste0(x7a$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x7a), NA))) - expect_output(print(x7a)$show()) - invisible(capture.output(expect_error(summary(x7a), NA))) - expect_output(summary(x7a)$show()) - x7aCodeBased <- eval(parse(text = getObjectRCode(x7a, stringWrapParagraphWidth = NULL))) - expect_equal(x7aCodeBased$power, x7a$power, tolerance = 1e-07) - expect_equal(x7aCodeBased$futilityBounds, x7a$futilityBounds, tolerance = 1e-07) - expect_equal(x7aCodeBased$alphaSpent, x7a$alphaSpent, tolerance = 1e-07) - expect_equal(x7aCodeBased$betaSpent, x7a$betaSpent, tolerance = 1e-07) - expect_equal(x7aCodeBased$criticalValues, x7a$criticalValues, tolerance = 1e-07) - expect_equal(x7aCodeBased$stageLevels, x7a$stageLevels, tolerance = 1e-07) - expect_type(names(x7a), "character") - df <- as.data.frame(x7a) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x7a) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignGroupSequential' with type of design = 'asP' and 'bsUser' and binding futility bounds", { - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:alphaSpendingConcept} - # @refFS[Formula]{fs:alphaSpendingPocock} - # @refFS[Formula]{fs:betaSpendingApproach} - x6b <- getDesignGroupSequential( - kMax = 3, alpha = 0.13, - typeOfDesign = "asP", typeBetaSpending = "bsUser", - informationRates = c(0.35, 0.7, 1), - bindingFutility = TRUE, - userBetaSpending = c(0.01, 0.05, 0.3) - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x6b' with expected results - expect_equal(x6b$power, c(0.31728597, 0.55917233, 0.7), tolerance = 1e-07, label = paste0("c(", paste0(x6b$power, collapse = ", "), ")")) - expect_equal(x6b$futilityBounds, c(-1.2569879, -0.17011271), tolerance = 1e-07, label = paste0("c(", paste0(x6b$futilityBounds, collapse = ", "), ")")) - expect_equal(x6b$alphaSpent, c(0.061214062, 0.10266465, 0.13), tolerance = 1e-07, label = paste0("c(", paste0(x6b$alphaSpent, collapse = ", "), ")")) - expect_equal(x6b$betaSpent, c(0.01, 0.05, 0.3), tolerance = 1e-07, label = paste0("c(", paste0(x6b$betaSpent, collapse = ", "), ")")) - expect_equal(x6b$criticalValues, c(1.5446617, 1.4827312, 1.4588737), tolerance = 1e-07, label = paste0("c(", paste0(x6b$criticalValues, collapse = ", "), ")")) - expect_equal(x6b$stageLevels, c(0.061214062, 0.069072925, 0.072299935), tolerance = 1e-07, label = paste0("c(", paste0(x6b$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x6b), NA))) - expect_output(print(x6b)$show()) - invisible(capture.output(expect_error(summary(x6b), NA))) - expect_output(summary(x6b)$show()) - x6bCodeBased <- eval(parse(text = getObjectRCode(x6b, stringWrapParagraphWidth = NULL))) - expect_equal(x6bCodeBased$power, x6b$power, tolerance = 1e-07) - expect_equal(x6bCodeBased$futilityBounds, x6b$futilityBounds, tolerance = 1e-07) - expect_equal(x6bCodeBased$alphaSpent, x6b$alphaSpent, tolerance = 1e-07) - expect_equal(x6bCodeBased$betaSpent, x6b$betaSpent, tolerance = 1e-07) - expect_equal(x6bCodeBased$criticalValues, x6b$criticalValues, tolerance = 1e-07) - expect_equal(x6bCodeBased$stageLevels, x6b$stageLevels, tolerance = 1e-07) - expect_type(names(x6b), "character") - df <- as.data.frame(x6b) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x6b) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignGroupSequential' with type of design = 'asOF' and 'bsKD' and binding futility bounds (kMax = 3)", { - - .skipTestIfDisabled() - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:alphaSpendingConcept} - # @refFS[Formula]{fs:alphaSpendingOBrienFleming} - # @refFS[Formula]{fs:betaSpendingApproach} - # @refFS[Formula]{fs:betaSpendingKimDeMets} - x7b <- getDesignGroupSequential( - kMax = 3, alpha = 0.13, beta = 0.41, - typeOfDesign = "asOF", typeBetaSpending = "bsKD", - informationRates = c(0.4, 0.75, 1), - gammaB = 2.5, bindingFutility = TRUE - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x7b' with expected results - expect_equal(x7b$power, c(0.1067887, 0.41918821, 0.59), tolerance = 1e-07, label = paste0("c(", paste0(x7b$power, collapse = ", "), ")")) - expect_equal(x7b$futilityBounds, c(-0.84937686, 0.34328914), tolerance = 1e-07, label = paste0("c(", paste0(x7b$futilityBounds, collapse = ", "), ")")) - expect_equal(x7b$alphaSpent, c(0.016665509, 0.080406163, 0.12999999), tolerance = 1e-07, label = paste0("c(", paste0(x7b$alphaSpent, collapse = ", "), ")")) - expect_equal(x7b$betaSpent, c(0.041489083, 0.19972711, 0.41), tolerance = 1e-07, label = paste0("c(", paste0(x7b$betaSpent, collapse = ", "), ")")) - expect_equal(x7b$criticalValues, c(2.1280732, 1.4362896, 1.2218662), tolerance = 1e-07, label = paste0("c(", paste0(x7b$criticalValues, collapse = ", "), ")")) - expect_equal(x7b$stageLevels, c(0.016665509, 0.075459972, 0.11087911), tolerance = 1e-07, label = paste0("c(", paste0(x7b$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x7b), NA))) - expect_output(print(x7b)$show()) - invisible(capture.output(expect_error(summary(x7b), NA))) - expect_output(summary(x7b)$show()) - x7bCodeBased <- eval(parse(text = getObjectRCode(x7b, stringWrapParagraphWidth = NULL))) - expect_equal(x7bCodeBased$power, x7b$power, tolerance = 1e-07) - expect_equal(x7bCodeBased$futilityBounds, x7b$futilityBounds, tolerance = 1e-07) - expect_equal(x7bCodeBased$alphaSpent, x7b$alphaSpent, tolerance = 1e-07) - expect_equal(x7bCodeBased$betaSpent, x7b$betaSpent, tolerance = 1e-07) - expect_equal(x7bCodeBased$criticalValues, x7b$criticalValues, tolerance = 1e-07) - expect_equal(x7bCodeBased$stageLevels, x7b$stageLevels, tolerance = 1e-07) - expect_type(names(x7b), "character") - df <- as.data.frame(x7b) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x7b) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignGroupSequential' with type of design = 'asOF' and 'bsKD' and binding futility bounds (kMax = 4)", { - - .skipTestIfDisabled() - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:alphaSpendingConcept} - # @refFS[Formula]{fs:alphaSpendingOBrienFleming} - # @refFS[Formula]{fs:betaSpendingApproach} - # @refFS[Formula]{fs:betaSpendingKimDeMets} - x7b <- getDesignGroupSequential( - kMax = 4, alpha = 0.13, beta = 0.41, - typeOfDesign = "asOF", typeBetaSpending = "bsKD", - informationRates = c(0.4, 0.75, 0.85, 1), - gammaB = 2.5, bindingFutility = TRUE - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x7b' with expected results - expect_equal(x7b$power, c(0.10806422, 0.422855, 0.4950578, 0.59), tolerance = 1e-07, label = paste0("c(", paste0(x7b$power, collapse = ", "), ")")) - expect_equal(x7b$futilityBounds, c(-0.84247693, 0.35276055, 0.62744509), tolerance = 1e-07, label = paste0("c(", paste0(x7b$futilityBounds, collapse = ", "), ")")) - expect_equal(x7b$alphaSpent, c(0.016665509, 0.080406163, 0.10053322, 0.13), tolerance = 1e-07, label = paste0("c(", paste0(x7b$alphaSpent, collapse = ", "), ")")) - expect_equal(x7b$betaSpent, c(0.041489083, 0.19972711, 0.27310596, 0.41), tolerance = 1e-07, label = paste0("c(", paste0(x7b$betaSpent, collapse = ", "), ")")) - expect_equal(x7b$criticalValues, c(2.1280732, 1.4362706, 1.4203748, 1.2576258), tolerance = 1e-07, label = paste0("c(", paste0(x7b$criticalValues, collapse = ", "), ")")) - expect_equal(x7b$stageLevels, c(0.016665509, 0.075462674, 0.077749297, 0.10426357), tolerance = 1e-07, label = paste0("c(", paste0(x7b$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x7b), NA))) - expect_output(print(x7b)$show()) - invisible(capture.output(expect_error(summary(x7b), NA))) - expect_output(summary(x7b)$show()) - x7bCodeBased <- eval(parse(text = getObjectRCode(x7b, stringWrapParagraphWidth = NULL))) - expect_equal(x7bCodeBased$power, x7b$power, tolerance = 1e-07) - expect_equal(x7bCodeBased$futilityBounds, x7b$futilityBounds, tolerance = 1e-07) - expect_equal(x7bCodeBased$alphaSpent, x7b$alphaSpent, tolerance = 1e-07) - expect_equal(x7bCodeBased$betaSpent, x7b$betaSpent, tolerance = 1e-07) - expect_equal(x7bCodeBased$criticalValues, x7b$criticalValues, tolerance = 1e-07) - expect_equal(x7bCodeBased$stageLevels, x7b$stageLevels, tolerance = 1e-07) - expect_type(names(x7b), "character") - df <- as.data.frame(x7b) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x7b) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignGroupSequential' with type of design = 'asOF' and 'bsKD' and binding futility bounds, two-sided (kMax = 3)", { - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:alphaSpendingConcept} - # @refFS[Formula]{fs:alphaSpendingOBrienFleming} - # @refFS[Formula]{fs:betaSpendingApproach} - # @refFS[Formula]{fs:betaSpendingKimDeMets} - # @refFS[Formula]{fs:betaSpendingApproachTwoSided} - # @refFS[Formula]{fs:betaSpendingAdjustment} - suppressWarnings(x7c <- getDesignGroupSequential( - kMax = 3, alpha = 0.09, beta = 0.11, sided = 2, - typeOfDesign = "asOF", typeBetaSpending = "bsKD", - informationRates = c(0.2, 0.55, 1), - gammaB = 2.5, bindingFutility = TRUE - )) - - ## Comparison of the results of TrialDesignGroupSequential object 'x7c' with expected results - expect_equal(x7c$power, c(0.0013105743, 0.39377047, 0.889997), tolerance = 1e-07, label = paste0("c(", paste0(x7c$power, collapse = ", "), ")")) - expect_equal(x7c$futilityBounds, c(NA_real_, 0.30419861), tolerance = 1e-07, label = paste0("c(", paste0(x7c$futilityBounds, collapse = ", "), ")")) - expect_equal(x7c$alphaSpent, c(1.475171e-05, 0.013740227, 0.09), tolerance = 1e-07, label = paste0("c(", paste0(x7c$alphaSpent, collapse = ", "), ")")) - expect_equal(x7c$betaSpent, c(0, 0.023123303, 0.11), tolerance = 1e-07, label = paste0("c(", paste0(x7c$betaSpent, collapse = ", "), ")")) - expect_equal(x7c$criticalValues, c(4.3323635, 2.4641251, 1.7013171), tolerance = 1e-07, label = paste0("c(", paste0(x7c$criticalValues, collapse = ", "), ")")) - expect_equal(x7c$stageLevels, c(7.375855e-06, 0.006867409, 0.044441733), tolerance = 1e-07, label = paste0("c(", paste0(x7c$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x7c), NA))) - expect_output(print(x7c)$show()) - invisible(capture.output(expect_error(summary(x7c), NA))) - expect_output(summary(x7c)$show()) - suppressWarnings(x7cCodeBased <- eval(parse(text = getObjectRCode(x7c, stringWrapParagraphWidth = NULL)))) - expect_equal(x7cCodeBased$power, x7c$power, tolerance = 1e-07) - expect_equal(x7cCodeBased$futilityBounds, x7c$futilityBounds, tolerance = 1e-07) - expect_equal(x7cCodeBased$alphaSpent, x7c$alphaSpent, tolerance = 1e-07) - expect_equal(x7cCodeBased$betaSpent, x7c$betaSpent, tolerance = 1e-07) - expect_equal(x7cCodeBased$criticalValues, x7c$criticalValues, tolerance = 1e-07) - expect_equal(x7cCodeBased$stageLevels, x7c$stageLevels, tolerance = 1e-07) - expect_type(names(x7c), "character") - df <- as.data.frame(x7c) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x7c) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - suppressWarnings(x7d <- getDesignGroupSequential( - kMax = 3, alpha = 0.05, beta = 0.2, sided = 2, - typeOfDesign = "asOF", typeBetaSpending = "bsKD", - informationRates = c(0.4, 0.65, 1), - gammaB = 1.5, bindingFutility = TRUE - )) - - ## Comparison of the results of TrialDesignGroupSequential object 'x7d' with expected results - expect_equal(x7d$power, c(0.063122463, 0.41229849, 0.79999885), tolerance = 1e-07, label = paste0("c(", paste0(x7d$power, collapse = ", "), ")")) - expect_equal(x7d$futilityBounds, c(0.32391511, 0.91946811), tolerance = 1e-07, label = paste0("c(", paste0(x7d$futilityBounds, collapse = ", "), ")")) - expect_equal(x7d$alphaSpent, c(0.00078830351, 0.010867832, 0.04999999), tolerance = 1e-07, label = paste0("c(", paste0(x7d$alphaSpent, collapse = ", "), ")")) - expect_equal(x7d$betaSpent, c(0.050596443, 0.10480935, 0.2), tolerance = 1e-07, label = paste0("c(", paste0(x7d$betaSpent, collapse = ", "), ")")) - expect_equal(x7d$criticalValues, c(3.3568694, 2.5549656, 1.9350784), tolerance = 1e-07, label = paste0("c(", paste0(x7d$criticalValues, collapse = ", "), ")")) - expect_equal(x7d$stageLevels, c(0.00039415176, 0.0053099152, 0.026490337), tolerance = 1e-07, label = paste0("c(", paste0(x7d$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x7d), NA))) - expect_output(print(x7d)$show()) - invisible(capture.output(expect_error(summary(x7d), NA))) - expect_output(summary(x7d)$show()) - suppressWarnings(x7dCodeBased <- eval(parse(text = getObjectRCode(x7d, stringWrapParagraphWidth = NULL)))) - expect_equal(x7dCodeBased$power, x7d$power, tolerance = 1e-07) - expect_equal(x7dCodeBased$futilityBounds, x7d$futilityBounds, tolerance = 1e-07) - expect_equal(x7dCodeBased$alphaSpent, x7d$alphaSpent, tolerance = 1e-07) - expect_equal(x7dCodeBased$betaSpent, x7d$betaSpent, tolerance = 1e-07) - expect_equal(x7dCodeBased$criticalValues, x7d$criticalValues, tolerance = 1e-07) - expect_equal(x7dCodeBased$stageLevels, x7d$stageLevels, tolerance = 1e-07) - expect_type(names(x7d), "character") - df <- as.data.frame(x7d) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x7d) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignGroupSequential' with type of design = 'asOF' and 'bsKD' and non-binding futility bounds, no betaAdjustment, two-sided (kMax = 3)", { - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:alphaSpendingConcept} - # @refFS[Formula]{fs:alphaSpendingOBrienFleming} - # @refFS[Formula]{fs:betaSpendingApproach} - # @refFS[Formula]{fs:betaSpendingKimDeMets} - # @refFS[Formula]{fs:betaSpendingApproachTwoSided} - # @refFS[Formula]{fs:betaSpendingAdjustment} - suppressWarnings(x7e <- getDesignGroupSequential( - kMax = 3, alpha = 0.09, beta = 0.11, sided = 2, - typeOfDesign = "asOF", typeBetaSpending = "bsKD", - informationRates = c(0.4, 0.65, 1), - betaAdjustment = FALSE, - gammaB = 2.5, bindingFutility = FALSE - )) - - ## Comparison of the results of TrialDesignGroupSequential object 'x7e' with expected results - expect_equal(x7e$power, c(0.14268064, 0.57037981, 0.88999701), tolerance = 1e-07, label = paste0("c(", paste0(x7e$power, collapse = ", "), ")")) - expect_equal(x7e$futilityBounds, c(NA_real_, 0.64692592), tolerance = 1e-07, label = paste0("c(", paste0(x7e$futilityBounds, collapse = ", "), ")")) - expect_equal(x7e$alphaSpent, c(0.0030525896, 0.025803646, 0.09), tolerance = 1e-07, label = paste0("c(", paste0(x7e$alphaSpent, collapse = ", "), ")")) - expect_equal(x7e$betaSpent, c(0, 0.037469343, 0.11), tolerance = 1e-07, label = paste0("c(", paste0(x7e$betaSpent, collapse = ", "), ")")) - expect_equal(x7e$criticalValues, c(2.9623919, 2.2442359, 1.7391729), tolerance = 1e-07, label = paste0("c(", paste0(x7e$criticalValues, collapse = ", "), ")")) - expect_equal(x7e$stageLevels, c(0.0015262948, 0.012408614, 0.041002179), tolerance = 1e-07, label = paste0("c(", paste0(x7e$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x7e), NA))) - expect_output(print(x7e)$show()) - invisible(capture.output(expect_error(summary(x7e), NA))) - expect_output(summary(x7e)$show()) - suppressWarnings(x7eCodeBased <- eval(parse(text = getObjectRCode(x7e, stringWrapParagraphWidth = NULL)))) - expect_equal(x7eCodeBased$power, x7e$power, tolerance = 1e-07) - expect_equal(x7eCodeBased$futilityBounds, x7e$futilityBounds, tolerance = 1e-07) - expect_equal(x7eCodeBased$alphaSpent, x7e$alphaSpent, tolerance = 1e-07) - expect_equal(x7eCodeBased$betaSpent, x7e$betaSpent, tolerance = 1e-07) - expect_equal(x7eCodeBased$criticalValues, x7e$criticalValues, tolerance = 1e-07) - expect_equal(x7eCodeBased$stageLevels, x7e$stageLevels, tolerance = 1e-07) - expect_type(names(x7e), "character") - df <- as.data.frame(x7e) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x7e) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignGroupSequential' with type of design = 'asOF' and 'bsOF', binding futility bounds and delayed response (kMax = 3)", { - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:alphaSpendingConcept} - # @refFS[Formula]{fs:alphaSpendingOBrienFleming} - # @refFS[Formula]{fs:betaSpendingApproach} - # @refFS[Formula]{fs:betaSpendingOBrienFleming} - # @refFS[Formula]{fs:delayedResponseCondition1} - # @refFS[Formula]{fs:delayedResponseCondition2} - # @refFS[Formula]{fs:delayedResponsePower} - suppressWarnings(dl1 <- getDesignGroupSequential( - kMax = 3, alpha = 0.05, beta = 0.1, sided = 1, - typeOfDesign = "asOF", typeBetaSpending = "bsOF", - informationRates = c(0.4, 0.65, 1), - bindingFutility = TRUE, - delayedInformation = c(0.1, 0.2) - )) - - ## Comparison of the results of TrialDesignGroupSequential object 'dl1' with expected results - expect_equal(dl1$power, c(0.15998522, 0.59313184, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl1$power, collapse = ", "), ")")) - expect_equal(dl1$futilityBounds, c(-0.46043472, 0.64445014), tolerance = 1e-07, label = paste0("c(", paste0(dl1$futilityBounds, collapse = ", "), ")")) - expect_equal(dl1$alphaSpent, c(0.001941913, 0.015055713, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(dl1$alphaSpent, collapse = ", "), ")")) - expect_equal(dl1$betaSpent, c(0.00930224, 0.041331422, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(dl1$betaSpent, collapse = ", "), ")")) - expect_equal(dl1$criticalValues, c(2.8874465, 2.1853011, 1.6575593), tolerance = 1e-07, label = paste0("c(", paste0(dl1$criticalValues, collapse = ", "), ")")) - expect_equal(dl1$stageLevels, c(0.001941913, 0.014433388, 0.048703222), tolerance = 1e-07, label = paste0("c(", paste0(dl1$stageLevels, collapse = ", "), ")")) - expect_equal(dl1$decisionCriticalValues, c(1.3388855, 1.5378695, 1.6575593), tolerance = 1e-07, label = paste0("c(", paste0(dl1$decisionCriticalValues, collapse = ", "), ")")) - expect_equal(dl1$reversalProbabilities, c(1.7563249e-06, 0.0014674026), tolerance = 1e-07, label = paste0("c(", paste0(dl1$reversalProbabilities, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dl1), NA))) - expect_output(print(dl1)$show()) - invisible(capture.output(expect_error(summary(dl1), NA))) - expect_output(summary(dl1)$show()) - suppressWarnings(dl1CodeBased <- eval(parse(text = getObjectRCode(dl1, stringWrapParagraphWidth = NULL)))) - expect_equal(dl1CodeBased$power, dl1$power, tolerance = 1e-07) - expect_equal(dl1CodeBased$futilityBounds, dl1$futilityBounds, tolerance = 1e-07) - expect_equal(dl1CodeBased$alphaSpent, dl1$alphaSpent, tolerance = 1e-07) - expect_equal(dl1CodeBased$betaSpent, dl1$betaSpent, tolerance = 1e-07) - expect_equal(dl1CodeBased$criticalValues, dl1$criticalValues, tolerance = 1e-07) - expect_equal(dl1CodeBased$stageLevels, dl1$stageLevels, tolerance = 1e-07) - expect_equal(dl1CodeBased$decisionCriticalValues, dl1$decisionCriticalValues, tolerance = 1e-07) - expect_equal(dl1CodeBased$reversalProbabilities, dl1$reversalProbabilities, tolerance = 1e-07) - expect_type(names(dl1), "character") - df <- as.data.frame(dl1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dl1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - dl2 <- getDesignCharacteristics(dl1) - - ## Comparison of the results of TrialDesignCharacteristics object 'dl2' with expected results - expect_equal(dl2$nFixed, 8.5638474, tolerance = 1e-07, label = paste0("c(", paste0(dl2$nFixed, collapse = ", "), ")")) - expect_equal(dl2$shift, 8.8633082, tolerance = 1e-07, label = paste0("c(", paste0(dl2$shift, collapse = ", "), ")")) - expect_equal(dl2$inflationFactor, 1.034968, tolerance = 1e-07, label = paste0("c(", paste0(dl2$inflationFactor, collapse = ", "), ")")) - expect_equal(dl2$information, c(3.5453233, 5.7611503, 8.8633082), tolerance = 1e-07, label = paste0("c(", paste0(dl2$information, collapse = ", "), ")")) - expect_equal(dl2$power, c(0.15755984, 0.59089729, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl2$power, collapse = ", "), ")")) - expect_equal(dl2$rejectionProbabilities, c(0.15755984, 0.43333745, 0.30910271), tolerance = 1e-07, label = paste0("c(", paste0(dl2$rejectionProbabilities, collapse = ", "), ")")) - expect_equal(dl2$futilityProbabilities, c(0.0095560402, 0.032904105), tolerance = 1e-07, label = paste0("c(", paste0(dl2$futilityProbabilities, collapse = ", "), ")")) - expect_equal(dl2$averageSampleNumber1, 0.87652961, tolerance = 1e-07, label = paste0("c(", paste0(dl2$averageSampleNumber1, collapse = ", "), ")")) - expect_equal(dl2$averageSampleNumber01, 0.92477729, tolerance = 1e-07, label = paste0("c(", paste0(dl2$averageSampleNumber01, collapse = ", "), ")")) - expect_equal(dl2$averageSampleNumber0, 0.79932679, tolerance = 1e-07, label = paste0("c(", paste0(dl2$averageSampleNumber0, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dl2), NA))) - expect_output(print(dl2)$show()) - invisible(capture.output(expect_error(summary(dl2), NA))) - expect_output(summary(dl2)$show()) - suppressWarnings(dl2CodeBased <- eval(parse(text = getObjectRCode(dl2, stringWrapParagraphWidth = NULL)))) - expect_equal(dl2CodeBased$nFixed, dl2$nFixed, tolerance = 1e-07) - expect_equal(dl2CodeBased$shift, dl2$shift, tolerance = 1e-07) - expect_equal(dl2CodeBased$inflationFactor, dl2$inflationFactor, tolerance = 1e-07) - expect_equal(dl2CodeBased$information, dl2$information, tolerance = 1e-07) - expect_equal(dl2CodeBased$power, dl2$power, tolerance = 1e-07) - expect_equal(dl2CodeBased$rejectionProbabilities, dl2$rejectionProbabilities, tolerance = 1e-07) - expect_equal(dl2CodeBased$futilityProbabilities, dl2$futilityProbabilities, tolerance = 1e-07) - expect_equal(dl2CodeBased$averageSampleNumber1, dl2$averageSampleNumber1, tolerance = 1e-07) - expect_equal(dl2CodeBased$averageSampleNumber01, dl2$averageSampleNumber01, tolerance = 1e-07) - expect_equal(dl2CodeBased$averageSampleNumber0, dl2$averageSampleNumber0, tolerance = 1e-07) - expect_type(names(dl2), "character") - df <- as.data.frame(dl2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dl2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - suppressWarnings(dl3 <- getDesignGroupSequential( - kMax = 3, alpha = 0.05, beta = 0.1, sided = 1, - typeOfDesign = "asOF", typeBetaSpending = "bsOF", - informationRates = c(0.4, 0.65, 1), - bindingFutility = TRUE, - delayedInformation = c(0, 0.2) - )) - - ## Comparison of the results of TrialDesignGroupSequential object 'dl3' with expected results - expect_equal(dl3$power, c(0.15998522, 0.59313184, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl3$power, collapse = ", "), ")")) - expect_equal(dl3$futilityBounds, c(-0.46043472, 0.64445014), tolerance = 1e-07, label = paste0("c(", paste0(dl3$futilityBounds, collapse = ", "), ")")) - expect_equal(dl3$alphaSpent, c(0.001941913, 0.015055713, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(dl3$alphaSpent, collapse = ", "), ")")) - expect_equal(dl3$betaSpent, c(0.00930224, 0.041331422, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(dl3$betaSpent, collapse = ", "), ")")) - expect_equal(dl3$criticalValues, c(2.8874465, 2.1853011, 1.6575593), tolerance = 1e-07, label = paste0("c(", paste0(dl3$criticalValues, collapse = ", "), ")")) - expect_equal(dl3$stageLevels, c(0.001941913, 0.014433388, 0.048703222), tolerance = 1e-07, label = paste0("c(", paste0(dl3$stageLevels, collapse = ", "), ")")) - expect_equal(dl3$decisionCriticalValues, c(NA_real_, 1.5378695, 1.6575593), tolerance = 1e-07, label = paste0("c(", paste0(dl3$decisionCriticalValues, collapse = ", "), ")")) - expect_equal(dl3$reversalProbabilities, c(NA_real_, 0.0014674026), tolerance = 1e-07, label = paste0("c(", paste0(dl3$reversalProbabilities, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dl3), NA))) - expect_output(print(dl3)$show()) - invisible(capture.output(expect_error(summary(dl3), NA))) - expect_output(summary(dl3)$show()) - suppressWarnings(dl3CodeBased <- eval(parse(text = getObjectRCode(dl3, stringWrapParagraphWidth = NULL)))) - expect_equal(dl3CodeBased$power, dl3$power, tolerance = 1e-07) - expect_equal(dl3CodeBased$futilityBounds, dl3$futilityBounds, tolerance = 1e-07) - expect_equal(dl3CodeBased$alphaSpent, dl3$alphaSpent, tolerance = 1e-07) - expect_equal(dl3CodeBased$betaSpent, dl3$betaSpent, tolerance = 1e-07) - expect_equal(dl3CodeBased$criticalValues, dl3$criticalValues, tolerance = 1e-07) - expect_equal(dl3CodeBased$stageLevels, dl3$stageLevels, tolerance = 1e-07) - expect_equal(dl3CodeBased$decisionCriticalValues, dl3$decisionCriticalValues, tolerance = 1e-07) - expect_equal(dl3CodeBased$reversalProbabilities, dl3$reversalProbabilities, tolerance = 1e-07) - expect_type(names(dl3), "character") - df <- as.data.frame(dl3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dl3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - dl4 <- getDesignCharacteristics(dl3) - - ## Comparison of the results of TrialDesignCharacteristics object 'dl4' with expected results - expect_equal(dl4$nFixed, 8.5638474, tolerance = 1e-07, label = paste0("c(", paste0(dl4$nFixed, collapse = ", "), ")")) - expect_equal(dl4$shift, 8.8633608, tolerance = 1e-07, label = paste0("c(", paste0(dl4$shift, collapse = ", "), ")")) - expect_equal(dl4$inflationFactor, 1.0349742, tolerance = 1e-07, label = paste0("c(", paste0(dl4$inflationFactor, collapse = ", "), ")")) - expect_equal(dl4$information, c(3.5453443, 5.7611845, 8.8633608), tolerance = 1e-07, label = paste0("c(", paste0(dl4$information, collapse = ", "), ")")) - expect_equal(dl4$power, c(0.15755967, 0.59089852, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl4$power, collapse = ", "), ")")) - expect_equal(dl4$rejectionProbabilities, c(0.15755967, 0.43333886, 0.30910148), tolerance = 1e-07, label = paste0("c(", paste0(dl4$rejectionProbabilities, collapse = ", "), ")")) - expect_equal(dl4$futilityProbabilities, c(0.0095558971, 0.032903612), tolerance = 1e-07, label = paste0("c(", paste0(dl4$futilityProbabilities, collapse = ", "), ")")) - expect_equal(dl4$averageSampleNumber1, 0.85923802, tolerance = 1e-07, label = paste0("c(", paste0(dl4$averageSampleNumber1, collapse = ", "), ")")) - expect_equal(dl4$averageSampleNumber01, 0.91378094, tolerance = 1e-07, label = paste0("c(", paste0(dl4$averageSampleNumber01, collapse = ", "), ")")) - expect_equal(dl4$averageSampleNumber0, 0.76574207, tolerance = 1e-07, label = paste0("c(", paste0(dl4$averageSampleNumber0, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dl4), NA))) - expect_output(print(dl4)$show()) - invisible(capture.output(expect_error(summary(dl4), NA))) - expect_output(summary(dl4)$show()) - suppressWarnings(dl4CodeBased <- eval(parse(text = getObjectRCode(dl4, stringWrapParagraphWidth = NULL)))) - expect_equal(dl4CodeBased$nFixed, dl4$nFixed, tolerance = 1e-07) - expect_equal(dl4CodeBased$shift, dl4$shift, tolerance = 1e-07) - expect_equal(dl4CodeBased$inflationFactor, dl4$inflationFactor, tolerance = 1e-07) - expect_equal(dl4CodeBased$information, dl4$information, tolerance = 1e-07) - expect_equal(dl4CodeBased$power, dl4$power, tolerance = 1e-07) - expect_equal(dl4CodeBased$rejectionProbabilities, dl4$rejectionProbabilities, tolerance = 1e-07) - expect_equal(dl4CodeBased$futilityProbabilities, dl4$futilityProbabilities, tolerance = 1e-07) - expect_equal(dl4CodeBased$averageSampleNumber1, dl4$averageSampleNumber1, tolerance = 1e-07) - expect_equal(dl4CodeBased$averageSampleNumber01, dl4$averageSampleNumber01, tolerance = 1e-07) - expect_equal(dl4CodeBased$averageSampleNumber0, dl4$averageSampleNumber0, tolerance = 1e-07) - expect_type(names(dl4), "character") - df <- as.data.frame(dl4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dl4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - suppressWarnings(dl5 <- getDesignGroupSequential( - kMax = 3, alpha = 0.05, beta = 0.1, sided = 1, - typeOfDesign = "asOF", typeBetaSpending = "bsOF", - informationRates = c(0.4, 0.65, 1), - bindingFutility = TRUE, - delayedInformation = 0.3 - )) - - ## Comparison of the results of TrialDesignGroupSequential object 'dl5' with expected results - expect_equal(dl5$power, c(0.15998522, 0.59313184, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl5$power, collapse = ", "), ")")) - expect_equal(dl5$futilityBounds, c(-0.46043472, 0.64445014), tolerance = 1e-07, label = paste0("c(", paste0(dl5$futilityBounds, collapse = ", "), ")")) - expect_equal(dl5$alphaSpent, c(0.001941913, 0.015055713, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(dl5$alphaSpent, collapse = ", "), ")")) - expect_equal(dl5$betaSpent, c(0.00930224, 0.041331422, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(dl5$betaSpent, collapse = ", "), ")")) - expect_equal(dl5$criticalValues, c(2.8874465, 2.1853011, 1.6575593), tolerance = 1e-07, label = paste0("c(", paste0(dl5$criticalValues, collapse = ", "), ")")) - expect_equal(dl5$stageLevels, c(0.001941913, 0.014433388, 0.048703222), tolerance = 1e-07, label = paste0("c(", paste0(dl5$stageLevels, collapse = ", "), ")")) - expect_equal(dl5$decisionCriticalValues, c(1.505831, 1.5735979, 1.6575593), tolerance = 1e-07, label = paste0("c(", paste0(dl5$decisionCriticalValues, collapse = ", "), ")")) - expect_equal(dl5$reversalProbabilities, c(0.00018341474, 0.0027022502), tolerance = 1e-07, label = paste0("c(", paste0(dl5$reversalProbabilities, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dl5), NA))) - expect_output(print(dl5)$show()) - invisible(capture.output(expect_error(summary(dl5), NA))) - expect_output(summary(dl5)$show()) - suppressWarnings(dl5CodeBased <- eval(parse(text = getObjectRCode(dl5, stringWrapParagraphWidth = NULL)))) - expect_equal(dl5CodeBased$power, dl5$power, tolerance = 1e-07) - expect_equal(dl5CodeBased$futilityBounds, dl5$futilityBounds, tolerance = 1e-07) - expect_equal(dl5CodeBased$alphaSpent, dl5$alphaSpent, tolerance = 1e-07) - expect_equal(dl5CodeBased$betaSpent, dl5$betaSpent, tolerance = 1e-07) - expect_equal(dl5CodeBased$criticalValues, dl5$criticalValues, tolerance = 1e-07) - expect_equal(dl5CodeBased$stageLevels, dl5$stageLevels, tolerance = 1e-07) - expect_equal(dl5CodeBased$decisionCriticalValues, dl5$decisionCriticalValues, tolerance = 1e-07) - expect_equal(dl5CodeBased$reversalProbabilities, dl5$reversalProbabilities, tolerance = 1e-07) - expect_type(names(dl5), "character") - df <- as.data.frame(dl5) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dl5) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - dl6 <- getDesignCharacteristics(dl5) - - ## Comparison of the results of TrialDesignCharacteristics object 'dl6' with expected results - expect_equal(dl6$nFixed, 8.5638474, tolerance = 1e-07, label = paste0("c(", paste0(dl6$nFixed, collapse = ", "), ")")) - expect_equal(dl6$shift, 8.7180222, tolerance = 1e-07, label = paste0("c(", paste0(dl6$shift, collapse = ", "), ")")) - expect_equal(dl6$inflationFactor, 1.018003, tolerance = 1e-07, label = paste0("c(", paste0(dl6$inflationFactor, collapse = ", "), ")")) - expect_equal(dl6$information, c(3.4872089, 5.6667144, 8.7180222), tolerance = 1e-07, label = paste0("c(", paste0(dl6$information, collapse = ", "), ")")) - expect_equal(dl6$power, c(0.15429254, 0.58752252, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl6$power, collapse = ", "), ")")) - expect_equal(dl6$rejectionProbabilities, c(0.15429254, 0.43322998, 0.31247748), tolerance = 1e-07, label = paste0("c(", paste0(dl6$rejectionProbabilities, collapse = ", "), ")")) - expect_equal(dl6$futilityProbabilities, c(0.0099602552, 0.03429374), tolerance = 1e-07, label = paste0("c(", paste0(dl6$futilityProbabilities, collapse = ", "), ")")) - expect_equal(dl6$averageSampleNumber1, 0.94451255, tolerance = 1e-07, label = paste0("c(", paste0(dl6$averageSampleNumber1, collapse = ", "), ")")) - expect_equal(dl6$averageSampleNumber01, 0.96721799, tolerance = 1e-07, label = paste0("c(", paste0(dl6$averageSampleNumber01, collapse = ", "), ")")) - expect_equal(dl6$averageSampleNumber0, 0.89669187, tolerance = 1e-07, label = paste0("c(", paste0(dl6$averageSampleNumber0, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dl6), NA))) - expect_output(print(dl6)$show()) - invisible(capture.output(expect_error(summary(dl6), NA))) - expect_output(summary(dl6)$show()) - suppressWarnings(dl6CodeBased <- eval(parse(text = getObjectRCode(dl6, stringWrapParagraphWidth = NULL)))) - expect_equal(dl6CodeBased$nFixed, dl6$nFixed, tolerance = 1e-07) - expect_equal(dl6CodeBased$shift, dl6$shift, tolerance = 1e-07) - expect_equal(dl6CodeBased$inflationFactor, dl6$inflationFactor, tolerance = 1e-07) - expect_equal(dl6CodeBased$information, dl6$information, tolerance = 1e-07) - expect_equal(dl6CodeBased$power, dl6$power, tolerance = 1e-07) - expect_equal(dl6CodeBased$rejectionProbabilities, dl6$rejectionProbabilities, tolerance = 1e-07) - expect_equal(dl6CodeBased$futilityProbabilities, dl6$futilityProbabilities, tolerance = 1e-07) - expect_equal(dl6CodeBased$averageSampleNumber1, dl6$averageSampleNumber1, tolerance = 1e-07) - expect_equal(dl6CodeBased$averageSampleNumber01, dl6$averageSampleNumber01, tolerance = 1e-07) - expect_equal(dl6CodeBased$averageSampleNumber0, dl6$averageSampleNumber0, tolerance = 1e-07) - expect_type(names(dl6), "character") - df <- as.data.frame(dl6) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dl6) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignGroupSequential' with type of design = 'asP' and 'bsP', non-binding futility bounds and delayed response (kMax = 3)", { - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:alphaSpendingConcept} - # @refFS[Formula]{fs:alphaSpendingOBrienFleming} - # @refFS[Formula]{fs:betaSpendingApproach} - # @refFS[Formula]{fs:betaSpendingOBrienFleming} - # @refFS[Formula]{fs:delayedResponseCondition1} - # @refFS[Formula]{fs:delayedResponseCondition2} - # @refFS[Formula]{fs:delayedResponsePower} - suppressWarnings(dl1 <- getDesignGroupSequential( - kMax = 3, alpha = 0.05, beta = 0.1, sided = 1, - typeOfDesign = "asP", typeBetaSpending = "bsP", - informationRates = c(0.4, 0.65, 1), - bindingFutility = FALSE, - delayedInformation = c(0.1, 0.2) - )) - - ## Comparison of the results of TrialDesignGroupSequential object 'dl1' with expected results - expect_equal(dl1$power, c(0.58983431, 0.79279807, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl1$power, collapse = ", "), ")")) - expect_equal(dl1$futilityBounds, c(0.5448398, 1.0899149), tolerance = 1e-07, label = paste0("c(", paste0(dl1$futilityBounds, collapse = ", "), ")")) - expect_equal(dl1$alphaSpent, c(0.026156858, 0.037497241, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(dl1$alphaSpent, collapse = ", "), ")")) - expect_equal(dl1$betaSpent, c(0.052313716, 0.074994481, 0.099999999), tolerance = 1e-07, label = paste0("c(", paste0(dl1$betaSpent, collapse = ", "), ")")) - expect_equal(dl1$criticalValues, c(1.9405431, 2.0327662, 1.9734104), tolerance = 1e-07, label = paste0("c(", paste0(dl1$criticalValues, collapse = ", "), ")")) - expect_equal(dl1$stageLevels, c(0.026156858, 0.021038075, 0.02422441), tolerance = 1e-07, label = paste0("c(", paste0(dl1$stageLevels, collapse = ", "), ")")) - expect_equal(dl1$decisionCriticalValues, c(1.3362296, 1.657468, 1.9734104), tolerance = 1e-07, label = paste0("c(", paste0(dl1$decisionCriticalValues, collapse = ", "), ")")) - expect_equal(dl1$reversalProbabilities, c(0.0020439695, 0.0026967589), tolerance = 1e-07, label = paste0("c(", paste0(dl1$reversalProbabilities, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dl1), NA))) - expect_output(print(dl1)$show()) - invisible(capture.output(expect_error(summary(dl1), NA))) - expect_output(summary(dl1)$show()) - suppressWarnings(dl1CodeBased <- eval(parse(text = getObjectRCode(dl1, stringWrapParagraphWidth = NULL)))) - expect_equal(dl1CodeBased$power, dl1$power, tolerance = 1e-07) - expect_equal(dl1CodeBased$futilityBounds, dl1$futilityBounds, tolerance = 1e-07) - expect_equal(dl1CodeBased$alphaSpent, dl1$alphaSpent, tolerance = 1e-07) - expect_equal(dl1CodeBased$betaSpent, dl1$betaSpent, tolerance = 1e-07) - expect_equal(dl1CodeBased$criticalValues, dl1$criticalValues, tolerance = 1e-07) - expect_equal(dl1CodeBased$stageLevels, dl1$stageLevels, tolerance = 1e-07) - expect_equal(dl1CodeBased$decisionCriticalValues, dl1$decisionCriticalValues, tolerance = 1e-07) - expect_equal(dl1CodeBased$reversalProbabilities, dl1$reversalProbabilities, tolerance = 1e-07) - expect_type(names(dl1), "character") - df <- as.data.frame(dl1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dl1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - dl2 <- getDesignCharacteristics(dl1) - - ## Comparison of the results of TrialDesignCharacteristics object 'dl2' with expected results - expect_equal(dl2$nFixed, 8.5638474, tolerance = 1e-07, label = paste0("c(", paste0(dl2$nFixed, collapse = ", "), ")")) - expect_equal(dl2$shift, 11.345796, tolerance = 1e-07, label = paste0("c(", paste0(dl2$shift, collapse = ", "), ")")) - expect_equal(dl2$inflationFactor, 1.324848, tolerance = 1e-07, label = paste0("c(", paste0(dl2$inflationFactor, collapse = ", "), ")")) - expect_equal(dl2$information, c(4.5383183, 7.3747672, 11.345796), tolerance = 1e-07, label = paste0("c(", paste0(dl2$information, collapse = ", "), ")")) - expect_equal(dl2$power, c(0.57788702, 0.78847934, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl2$power, collapse = ", "), ")")) - expect_equal(dl2$rejectionProbabilities, c(0.57788702, 0.21059232, 0.11152066), tolerance = 1e-07, label = paste0("c(", paste0(dl2$rejectionProbabilities, collapse = ", "), ")")) - expect_equal(dl2$futilityProbabilities, c(0.056427171, 0.024888086), tolerance = 1e-07, label = paste0("c(", paste0(dl2$futilityProbabilities, collapse = ", "), ")")) - expect_equal(dl2$averageSampleNumber1, 0.86088771, tolerance = 1e-07, label = paste0("c(", paste0(dl2$averageSampleNumber1, collapse = ", "), ")")) - expect_equal(dl2$averageSampleNumber01, 0.9483049, tolerance = 1e-07, label = paste0("c(", paste0(dl2$averageSampleNumber01, collapse = ", "), ")")) - expect_equal(dl2$averageSampleNumber0, 0.80259202, tolerance = 1e-07, label = paste0("c(", paste0(dl2$averageSampleNumber0, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dl2), NA))) - expect_output(print(dl2)$show()) - invisible(capture.output(expect_error(summary(dl2), NA))) - expect_output(summary(dl2)$show()) - suppressWarnings(dl2CodeBased <- eval(parse(text = getObjectRCode(dl2, stringWrapParagraphWidth = NULL)))) - expect_equal(dl2CodeBased$nFixed, dl2$nFixed, tolerance = 1e-07) - expect_equal(dl2CodeBased$shift, dl2$shift, tolerance = 1e-07) - expect_equal(dl2CodeBased$inflationFactor, dl2$inflationFactor, tolerance = 1e-07) - expect_equal(dl2CodeBased$information, dl2$information, tolerance = 1e-07) - expect_equal(dl2CodeBased$power, dl2$power, tolerance = 1e-07) - expect_equal(dl2CodeBased$rejectionProbabilities, dl2$rejectionProbabilities, tolerance = 1e-07) - expect_equal(dl2CodeBased$futilityProbabilities, dl2$futilityProbabilities, tolerance = 1e-07) - expect_equal(dl2CodeBased$averageSampleNumber1, dl2$averageSampleNumber1, tolerance = 1e-07) - expect_equal(dl2CodeBased$averageSampleNumber01, dl2$averageSampleNumber01, tolerance = 1e-07) - expect_equal(dl2CodeBased$averageSampleNumber0, dl2$averageSampleNumber0, tolerance = 1e-07) - expect_type(names(dl2), "character") - df <- as.data.frame(dl2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dl2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - suppressWarnings(dl3 <- getDesignGroupSequential( - kMax = 3, alpha = 0.05, beta = 0.1, sided = 1, - typeOfDesign = "asP", typeBetaSpending = "bsP", - informationRates = c(0.4, 0.65, 1), - bindingFutility = FALSE, - delayedInformation = c(0, 0.2) - )) - - ## Comparison of the results of TrialDesignGroupSequential object 'dl3' with expected results - expect_equal(dl3$power, c(0.58983431, 0.79279807, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl3$power, collapse = ", "), ")")) - expect_equal(dl3$futilityBounds, c(0.5448398, 1.0899149), tolerance = 1e-07, label = paste0("c(", paste0(dl3$futilityBounds, collapse = ", "), ")")) - expect_equal(dl3$alphaSpent, c(0.026156858, 0.037497241, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(dl3$alphaSpent, collapse = ", "), ")")) - expect_equal(dl3$betaSpent, c(0.052313716, 0.074994481, 0.099999999), tolerance = 1e-07, label = paste0("c(", paste0(dl3$betaSpent, collapse = ", "), ")")) - expect_equal(dl3$criticalValues, c(1.9405431, 2.0327662, 1.9734104), tolerance = 1e-07, label = paste0("c(", paste0(dl3$criticalValues, collapse = ", "), ")")) - expect_equal(dl3$stageLevels, c(0.026156858, 0.021038075, 0.02422441), tolerance = 1e-07, label = paste0("c(", paste0(dl3$stageLevels, collapse = ", "), ")")) - expect_equal(dl3$decisionCriticalValues, c(NA_real_, 1.657468, 1.9734104), tolerance = 1e-07, label = paste0("c(", paste0(dl3$decisionCriticalValues, collapse = ", "), ")")) - expect_equal(dl3$reversalProbabilities, c(NA_real_, 0.0026967589), tolerance = 1e-07, label = paste0("c(", paste0(dl3$reversalProbabilities, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dl3), NA))) - expect_output(print(dl3)$show()) - invisible(capture.output(expect_error(summary(dl3), NA))) - expect_output(summary(dl3)$show()) - suppressWarnings(dl3CodeBased <- eval(parse(text = getObjectRCode(dl3, stringWrapParagraphWidth = NULL)))) - expect_equal(dl3CodeBased$power, dl3$power, tolerance = 1e-07) - expect_equal(dl3CodeBased$futilityBounds, dl3$futilityBounds, tolerance = 1e-07) - expect_equal(dl3CodeBased$alphaSpent, dl3$alphaSpent, tolerance = 1e-07) - expect_equal(dl3CodeBased$betaSpent, dl3$betaSpent, tolerance = 1e-07) - expect_equal(dl3CodeBased$criticalValues, dl3$criticalValues, tolerance = 1e-07) - expect_equal(dl3CodeBased$stageLevels, dl3$stageLevels, tolerance = 1e-07) - expect_equal(dl3CodeBased$decisionCriticalValues, dl3$decisionCriticalValues, tolerance = 1e-07) - expect_equal(dl3CodeBased$reversalProbabilities, dl3$reversalProbabilities, tolerance = 1e-07) - expect_type(names(dl3), "character") - df <- as.data.frame(dl3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dl3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - dl4 <- getDesignCharacteristics(dl3) - - ## Comparison of the results of TrialDesignCharacteristics object 'dl4' with expected results - expect_equal(dl4$nFixed, 8.5638474, tolerance = 1e-07, label = paste0("c(", paste0(dl4$nFixed, collapse = ", "), ")")) - expect_equal(dl4$shift, 11.462579, tolerance = 1e-07, label = paste0("c(", paste0(dl4$shift, collapse = ", "), ")")) - expect_equal(dl4$inflationFactor, 1.3384848, tolerance = 1e-07, label = paste0("c(", paste0(dl4$inflationFactor, collapse = ", "), ")")) - expect_equal(dl4$information, c(4.5850317, 7.4506765, 11.462579), tolerance = 1e-07, label = paste0("c(", paste0(dl4$information, collapse = ", "), ")")) - expect_equal(dl4$power, c(0.57954342, 0.78973163, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl4$power, collapse = ", "), ")")) - expect_equal(dl4$rejectionProbabilities, c(0.57954342, 0.21018821, 0.11026837), tolerance = 1e-07, label = paste0("c(", paste0(dl4$rejectionProbabilities, collapse = ", "), ")")) - expect_equal(dl4$futilityProbabilities, c(0.055196532, 0.024225352), tolerance = 1e-07, label = paste0("c(", paste0(dl4$futilityProbabilities, collapse = ", "), ")")) - expect_equal(dl4$averageSampleNumber1, 0.7829433, tolerance = 1e-07, label = paste0("c(", paste0(dl4$averageSampleNumber1, collapse = ", "), ")")) - expect_equal(dl4$averageSampleNumber01, 0.89251343, tolerance = 1e-07, label = paste0("c(", paste0(dl4$averageSampleNumber01, collapse = ", "), ")")) - expect_equal(dl4$averageSampleNumber0, 0.71271214, tolerance = 1e-07, label = paste0("c(", paste0(dl4$averageSampleNumber0, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dl4), NA))) - expect_output(print(dl4)$show()) - invisible(capture.output(expect_error(summary(dl4), NA))) - expect_output(summary(dl4)$show()) - suppressWarnings(dl4CodeBased <- eval(parse(text = getObjectRCode(dl4, stringWrapParagraphWidth = NULL)))) - expect_equal(dl4CodeBased$nFixed, dl4$nFixed, tolerance = 1e-07) - expect_equal(dl4CodeBased$shift, dl4$shift, tolerance = 1e-07) - expect_equal(dl4CodeBased$inflationFactor, dl4$inflationFactor, tolerance = 1e-07) - expect_equal(dl4CodeBased$information, dl4$information, tolerance = 1e-07) - expect_equal(dl4CodeBased$power, dl4$power, tolerance = 1e-07) - expect_equal(dl4CodeBased$rejectionProbabilities, dl4$rejectionProbabilities, tolerance = 1e-07) - expect_equal(dl4CodeBased$futilityProbabilities, dl4$futilityProbabilities, tolerance = 1e-07) - expect_equal(dl4CodeBased$averageSampleNumber1, dl4$averageSampleNumber1, tolerance = 1e-07) - expect_equal(dl4CodeBased$averageSampleNumber01, dl4$averageSampleNumber01, tolerance = 1e-07) - expect_equal(dl4CodeBased$averageSampleNumber0, dl4$averageSampleNumber0, tolerance = 1e-07) - expect_type(names(dl4), "character") - df <- as.data.frame(dl4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dl4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - expect_warning( - dl5 <- getDesignGroupSequential( - kMax = 3, alpha = 0.05, beta = 0.1, sided = 1, - typeOfDesign = "asP", typeBetaSpending = "bsP", - informationRates = c(0.4, 0.65, 1), - bindingFutility = FALSE, - delayedInformation = 0 - ) - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'dl5' with expected results - expect_equal(dl5$power, c(0.58983431, 0.79279807, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl5$power, collapse = ", "), ")")) - expect_equal(dl5$futilityBounds, c(0.5448398, 1.0899149), tolerance = 1e-07, label = paste0("c(", paste0(dl5$futilityBounds, collapse = ", "), ")")) - expect_equal(dl5$alphaSpent, c(0.026156858, 0.037497241, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(dl5$alphaSpent, collapse = ", "), ")")) - expect_equal(dl5$betaSpent, c(0.052313716, 0.074994481, 0.099999999), tolerance = 1e-07, label = paste0("c(", paste0(dl5$betaSpent, collapse = ", "), ")")) - expect_equal(dl5$criticalValues, c(1.9405431, 2.0327662, 1.9734104), tolerance = 1e-07, label = paste0("c(", paste0(dl5$criticalValues, collapse = ", "), ")")) - expect_equal(dl5$stageLevels, c(0.026156858, 0.021038075, 0.02422441), tolerance = 1e-07, label = paste0("c(", paste0(dl5$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dl5), NA))) - expect_output(print(dl5)$show()) - invisible(capture.output(expect_error(summary(dl5), NA))) - expect_output(summary(dl5)$show()) - suppressWarnings(dl5CodeBased <- eval(parse(text = getObjectRCode(dl5, stringWrapParagraphWidth = NULL)))) - expect_equal(dl5CodeBased$power, dl5$power, tolerance = 1e-07) - expect_equal(dl5CodeBased$futilityBounds, dl5$futilityBounds, tolerance = 1e-07) - expect_equal(dl5CodeBased$alphaSpent, dl5$alphaSpent, tolerance = 1e-07) - expect_equal(dl5CodeBased$betaSpent, dl5$betaSpent, tolerance = 1e-07) - expect_equal(dl5CodeBased$criticalValues, dl5$criticalValues, tolerance = 1e-07) - expect_equal(dl5CodeBased$stageLevels, dl5$stageLevels, tolerance = 1e-07) - expect_type(names(dl5), "character") - df <- as.data.frame(dl5) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dl5) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - dl6 <- getDesignCharacteristics(dl5) - - ## Comparison of the results of TrialDesignCharacteristics object 'dl6' with expected results - expect_equal(dl6$nFixed, 8.5638474, tolerance = 1e-07, label = paste0("c(", paste0(dl6$nFixed, collapse = ", "), ")")) - expect_equal(dl6$shift, 11.746896, tolerance = 1e-07, label = paste0("c(", paste0(dl6$shift, collapse = ", "), ")")) - expect_equal(dl6$inflationFactor, 1.3716844, tolerance = 1e-07, label = paste0("c(", paste0(dl6$inflationFactor, collapse = ", "), ")")) - expect_equal(dl6$information, c(4.6987583, 7.6354822, 11.746896), tolerance = 1e-07, label = paste0("c(", paste0(dl6$information, collapse = ", "), ")")) - expect_equal(dl6$power, c(0.58983431, 0.79279807, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl6$power, collapse = ", "), ")")) - expect_equal(dl6$rejectionProbabilities, c(0.58983431, 0.20296375, 0.10720193), tolerance = 1e-07, label = paste0("c(", paste0(dl6$rejectionProbabilities, collapse = ", "), ")")) - expect_equal(dl6$futilityProbabilities, c(0.052313716, 0.022680765), tolerance = 1e-07, label = paste0("c(", paste0(dl6$futilityProbabilities, collapse = ", "), ")")) - expect_equal(dl6$averageSampleNumber1, 0.73486016, tolerance = 1e-07, label = paste0("c(", paste0(dl6$averageSampleNumber1, collapse = ", "), ")")) - expect_equal(dl6$averageSampleNumber01, 0.8455149, tolerance = 1e-07, label = paste0("c(", paste0(dl6$averageSampleNumber01, collapse = ", "), ")")) - expect_equal(dl6$averageSampleNumber0, 0.67993383, tolerance = 1e-07, label = paste0("c(", paste0(dl6$averageSampleNumber0, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dl6), NA))) - expect_output(print(dl6)$show()) - invisible(capture.output(expect_error(summary(dl6), NA))) - expect_output(summary(dl6)$show()) - suppressWarnings(dl6CodeBased <- eval(parse(text = getObjectRCode(dl6, stringWrapParagraphWidth = NULL)))) - expect_equal(dl6CodeBased$nFixed, dl6$nFixed, tolerance = 1e-07) - expect_equal(dl6CodeBased$shift, dl6$shift, tolerance = 1e-07) - expect_equal(dl6CodeBased$inflationFactor, dl6$inflationFactor, tolerance = 1e-07) - expect_equal(dl6CodeBased$information, dl6$information, tolerance = 1e-07) - expect_equal(dl6CodeBased$power, dl6$power, tolerance = 1e-07) - expect_equal(dl6CodeBased$rejectionProbabilities, dl6$rejectionProbabilities, tolerance = 1e-07) - expect_equal(dl6CodeBased$futilityProbabilities, dl6$futilityProbabilities, tolerance = 1e-07) - expect_equal(dl6CodeBased$averageSampleNumber1, dl6$averageSampleNumber1, tolerance = 1e-07) - expect_equal(dl6CodeBased$averageSampleNumber01, dl6$averageSampleNumber01, tolerance = 1e-07) - expect_equal(dl6CodeBased$averageSampleNumber0, dl6$averageSampleNumber0, tolerance = 1e-07) - expect_type(names(dl6), "character") - df <- as.data.frame(dl6) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dl6) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignGroupSequential' with binding futility bounds", { - - .skipTestIfDisabled() - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:criticalValuesWithFutility} - # @refFS[Formula]{fs:criticalValuesWangTiatis} - x8a <- getDesignGroupSequential( - kMax = 4, alpha = 0.025, futilityBounds = rep(0.5244, 3), - bindingFutility = TRUE, typeOfDesign = "WT", deltaWT = 0.4 - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x8a' with expected results - expect_equal(x8a$alphaSpent, c(0.0062828133, 0.013876673, 0.02015684, 0.02499999), tolerance = 1e-07, label = paste0("c(", paste0(x8a$alphaSpent, collapse = ", "), ")")) - expect_equal(x8a$criticalValues, c(2.4958485, 2.328709, 2.2361766, 2.1727623), tolerance = 1e-07, label = paste0("c(", paste0(x8a$criticalValues, collapse = ", "), ")")) - expect_equal(x8a$stageLevels, c(0.0062828133, 0.0099372444, 0.012670104, 0.014899106), tolerance = 1e-07, label = paste0("c(", paste0(x8a$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x8a), NA))) - expect_output(print(x8a)$show()) - invisible(capture.output(expect_error(summary(x8a), NA))) - expect_output(summary(x8a)$show()) - x8aCodeBased <- eval(parse(text = getObjectRCode(x8a, stringWrapParagraphWidth = NULL))) - expect_equal(x8aCodeBased$alphaSpent, x8a$alphaSpent, tolerance = 1e-07) - expect_equal(x8aCodeBased$criticalValues, x8a$criticalValues, tolerance = 1e-07) - expect_equal(x8aCodeBased$stageLevels, x8a$stageLevels, tolerance = 1e-07) - expect_type(names(x8a), "character") - df <- as.data.frame(x8a) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x8a) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:criticalValuesWangTiatis} - x8b <- getDesignGroupSequential( - kMax = 3, alpha = 0.025, sided = 2, informationRates = c(0.3, 0.8, 1), - typeOfDesign = "WT", deltaWT = 0.24 - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x8b' with expected results - expect_equal(x8b$alphaSpent, c(0.0013603353, 0.013978861, 0.02499999), tolerance = 1e-07, label = paste0("c(", paste0(x8b$alphaSpent, collapse = ", "), ")")) - expect_equal(x8b$criticalValues, c(3.2029374, 2.4819703, 2.3420706), tolerance = 1e-07, label = paste0("c(", paste0(x8b$criticalValues, collapse = ", "), ")")) - expect_equal(x8b$stageLevels, c(0.00068016766, 0.0065329078, 0.0095885436), tolerance = 1e-07, label = paste0("c(", paste0(x8b$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x8b), NA))) - expect_output(print(x8b)$show()) - invisible(capture.output(expect_error(summary(x8b), NA))) - expect_output(summary(x8b)$show()) - x8bCodeBased <- eval(parse(text = getObjectRCode(x8b, stringWrapParagraphWidth = NULL))) - expect_equal(x8bCodeBased$alphaSpent, x8b$alphaSpent, tolerance = 1e-07) - expect_equal(x8bCodeBased$criticalValues, x8b$criticalValues, tolerance = 1e-07) - expect_equal(x8bCodeBased$stageLevels, x8b$stageLevels, tolerance = 1e-07) - expect_type(names(x8b), "character") - df <- as.data.frame(x8b) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x8b) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:criticalValuesWangTiatis} - x8c <- getDesignGroupSequential( - kMax = 3, alpha = 0.025, sided = 1, informationRates = c(0.3, 0.8, 1), - typeOfDesign = "WToptimum", beta = 0.23 - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x8c' with expected results - expect_equal(x8c$power, c(0.17785982, 0.63184407, 0.77), tolerance = 1e-07, label = paste0("c(", paste0(x8c$power, collapse = ", "), ")")) - expect_equal(x8c$deltaWT, 0.393, tolerance = 1e-07, label = paste0("c(", paste0(x8c$deltaWT, collapse = ", "), ")")) - expect_equal(x8c$alphaSpent, c(0.0067542296, 0.01805085, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(x8c$alphaSpent, collapse = ", "), ")")) - expect_equal(x8c$criticalValues, c(2.4700754, 2.2239834, 2.1715117), tolerance = 1e-07, label = paste0("c(", paste0(x8c$criticalValues, collapse = ", "), ")")) - expect_equal(x8c$stageLevels, c(0.0067542296, 0.013074779, 0.014946256), tolerance = 1e-07, label = paste0("c(", paste0(x8c$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x8c), NA))) - expect_output(print(x8c)$show()) - invisible(capture.output(expect_error(summary(x8c), NA))) - expect_output(summary(x8c)$show()) - x8cCodeBased <- eval(parse(text = getObjectRCode(x8c, stringWrapParagraphWidth = NULL))) - expect_equal(x8cCodeBased$power, x8c$power, tolerance = 1e-07) - expect_equal(x8cCodeBased$deltaWT, x8c$deltaWT, tolerance = 1e-07) - expect_equal(x8cCodeBased$alphaSpent, x8c$alphaSpent, tolerance = 1e-07) - expect_equal(x8cCodeBased$criticalValues, x8c$criticalValues, tolerance = 1e-07) - expect_equal(x8cCodeBased$stageLevels, x8c$stageLevels, tolerance = 1e-07) - expect_type(names(x8c), "character") - df <- as.data.frame(x8c) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x8c) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:criticalValuesWangTiatis} - x8d <- getDesignGroupSequential( - kMax = 4, alpha = 0.025, sided = 2, informationRates = c(0.3, 0.6, 0.8, 1), - typeOfDesign = "WToptimum", beta = 0.1, optimizationCriterion = "ASNH1" - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x8d' with expected results - expect_equal(x8d$power, c(0.27905065, 0.63899817, 0.80432197, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(x8d$power, collapse = ", "), ")")) - expect_equal(x8d$deltaWT, 0.479, tolerance = 1e-07, label = paste0("c(", paste0(x8d$deltaWT, collapse = ", "), ")")) - expect_equal(x8d$alphaSpent, c(0.0082066211, 0.015417447, 0.020576899, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(x8d$alphaSpent, collapse = ", "), ")")) - expect_equal(x8d$criticalValues, c(2.6434487, 2.6052491, 2.5895574, 2.577451), tolerance = 1e-07, label = paste0("c(", paste0(x8d$criticalValues, collapse = ", "), ")")) - expect_equal(x8d$stageLevels, c(0.0041033106, 0.0045903747, 0.0048049705, 0.0049765989), tolerance = 1e-07, label = paste0("c(", paste0(x8d$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x8d), NA))) - expect_output(print(x8d)$show()) - invisible(capture.output(expect_error(summary(x8d), NA))) - expect_output(summary(x8d)$show()) - x8dCodeBased <- eval(parse(text = getObjectRCode(x8d, stringWrapParagraphWidth = NULL))) - expect_equal(x8dCodeBased$power, x8d$power, tolerance = 1e-07) - expect_equal(x8dCodeBased$deltaWT, x8d$deltaWT, tolerance = 1e-07) - expect_equal(x8dCodeBased$alphaSpent, x8d$alphaSpent, tolerance = 1e-07) - expect_equal(x8dCodeBased$criticalValues, x8d$criticalValues, tolerance = 1e-07) - expect_equal(x8dCodeBased$stageLevels, x8d$stageLevels, tolerance = 1e-07) - expect_type(names(x8d), "character") - df <- as.data.frame(x8d) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x8d) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:criticalValuesWangTiatis} - x8e <- getDesignGroupSequential( - kMax = 4, alpha = 0.025, sided = 2, informationRates = c(0.3, 0.6, 0.8, 1), - typeOfDesign = "WToptimum", beta = 0.1, optimizationCriterion = "ASNsum" - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x8e' with expected results - expect_equal(x8e$power, c(0.068425642, 0.50677837, 0.76253381, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(x8e$power, collapse = ", "), ")")) - expect_equal(x8e$deltaWT, 0.181, tolerance = 1e-07, label = paste0("c(", paste0(x8e$deltaWT, collapse = ", "), ")")) - expect_equal(x8e$alphaSpent, c(0.00055484217, 0.0059655413, 0.01417086, 0.02499999), tolerance = 1e-07, label = paste0("c(", paste0(x8e$alphaSpent, collapse = ", "), ")")) - expect_equal(x8e$criticalValues, c(3.4527796, 2.7678356, 2.5251363, 2.3516384), tolerance = 1e-07, label = paste0("c(", paste0(x8e$criticalValues, collapse = ", "), ")")) - expect_equal(x8e$stageLevels, c(0.00027742108, 0.0028214959, 0.0057826708, 0.0093454685), tolerance = 1e-07, label = paste0("c(", paste0(x8e$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x8e), NA))) - expect_output(print(x8e)$show()) - invisible(capture.output(expect_error(summary(x8e), NA))) - expect_output(summary(x8e)$show()) - x8eCodeBased <- eval(parse(text = getObjectRCode(x8e, stringWrapParagraphWidth = NULL))) - expect_equal(x8eCodeBased$power, x8e$power, tolerance = 1e-07) - expect_equal(x8eCodeBased$deltaWT, x8e$deltaWT, tolerance = 1e-07) - expect_equal(x8eCodeBased$alphaSpent, x8e$alphaSpent, tolerance = 1e-07) - expect_equal(x8eCodeBased$criticalValues, x8e$criticalValues, tolerance = 1e-07) - expect_equal(x8eCodeBased$stageLevels, x8e$stageLevels, tolerance = 1e-07) - expect_type(names(x8e), "character") - df <- as.data.frame(x8e) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x8e) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignGroupSequential' with Haybittle Peto boundaries", { - - .skipTestIfDisabled() - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:criticalValuesHaybittlePeto} - x9 <- getDesignGroupSequential(kMax = 4, alpha = 0.025, typeOfDesign = "HP") - - ## Comparison of the results of TrialDesignGroupSequential object 'x9' with expected results - expect_equal(x9$alphaSpent, c(0.001349898, 0.0024617416, 0.0033695882, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(x9$alphaSpent, collapse = ", "), ")")) - expect_equal(x9$criticalValues, c(3, 3, 3, 1.9827514), tolerance = 1e-07, label = paste0("c(", paste0(x9$criticalValues, collapse = ", "), ")")) - expect_equal(x9$stageLevels, c(0.001349898, 0.001349898, 0.001349898, 0.023697604), tolerance = 1e-07, label = paste0("c(", paste0(x9$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x9), NA))) - expect_output(print(x9)$show()) - invisible(capture.output(expect_error(summary(x9), NA))) - expect_output(summary(x9)$show()) - x9CodeBased <- eval(parse(text = getObjectRCode(x9, stringWrapParagraphWidth = NULL))) - expect_equal(x9CodeBased$alphaSpent, x9$alphaSpent, tolerance = 1e-07) - expect_equal(x9CodeBased$criticalValues, x9$criticalValues, tolerance = 1e-07) - expect_equal(x9CodeBased$stageLevels, x9$stageLevels, tolerance = 1e-07) - expect_type(names(x9), "character") - df <- as.data.frame(x9) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x9) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignGroupSequential' with Pampallona Tsiatis boundaries, binding and non-binding futility bounds", { - - .skipTestIfDisabled() - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:criticalValuesPampallonaTiatis} - x10 <- getDesignGroupSequential( - kMax = 3, alpha = 0.035, beta = 0.1, - informationRates = c(0.3, 0.8, 1), typeOfDesign = "PT", sided = 1, - bindingFutility = TRUE, deltaPT1 = 0.2, deltaPT0 = 0.3 - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x10' with expected results - expect_equal(x10$power, c(0.19834666, 0.83001122, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(x10$power, collapse = ", "), ")")) - expect_equal(x10$futilityBounds, c(-0.042079545, 1.4407359), tolerance = 1e-07, label = paste0("c(", paste0(x10$futilityBounds, collapse = ", "), ")")) - expect_equal(x10$alphaSpent, c(0.0038332428, 0.024917169, 0.035), tolerance = 1e-07, label = paste0("c(", paste0(x10$alphaSpent, collapse = ", "), ")")) - expect_equal(x10$betaSpent, c(0.031375368, 0.080734151, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(x10$betaSpent, collapse = ", "), ")")) - expect_equal(x10$criticalValues, c(2.6664156, 1.9867225, 1.8580792), tolerance = 1e-07, label = paste0("c(", paste0(x10$criticalValues, collapse = ", "), ")")) - expect_equal(x10$stageLevels, c(0.0038332428, 0.023476576, 0.031578886), tolerance = 1e-07, label = paste0("c(", paste0(x10$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x10), NA))) - expect_output(print(x10)$show()) - invisible(capture.output(expect_error(summary(x10), NA))) - expect_output(summary(x10)$show()) - x10CodeBased <- eval(parse(text = getObjectRCode(x10, stringWrapParagraphWidth = NULL))) - expect_equal(x10CodeBased$power, x10$power, tolerance = 1e-07) - expect_equal(x10CodeBased$futilityBounds, x10$futilityBounds, tolerance = 1e-07) - expect_equal(x10CodeBased$alphaSpent, x10$alphaSpent, tolerance = 1e-07) - expect_equal(x10CodeBased$betaSpent, x10$betaSpent, tolerance = 1e-07) - expect_equal(x10CodeBased$criticalValues, x10$criticalValues, tolerance = 1e-07) - expect_equal(x10CodeBased$stageLevels, x10$stageLevels, tolerance = 1e-07) - expect_type(names(x10), "character") - df <- as.data.frame(x10) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x10) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:criticalValuesPampallonaTiatis} - x11 <- getDesignGroupSequential( - kMax = 3, alpha = 0.035, beta = 0.05, - informationRates = c(0.3, 0.8, 1), typeOfDesign = "PT", sided = 2, - bindingFutility = TRUE, deltaPT1 = 0.2, deltaPT0 = 0.3 - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x11' with expected results - expect_equal(x11$power, c(0.16615376, 0.88013007, 0.94999991), tolerance = 1e-07, label = paste0("c(", paste0(x11$power, collapse = ", "), ")")) - expect_equal(x11$futilityBounds, c(NA_real_, 1.671433), tolerance = 1e-07, label = paste0("c(", paste0(x11$futilityBounds, collapse = ", "), ")")) - expect_equal(x11$alphaSpent, c(0.0019236202, 0.022017713, 0.035), tolerance = 1e-07, label = paste0("c(", paste0(x11$alphaSpent, collapse = ", "), ")")) - expect_equal(x11$betaSpent, c(0, 0.035025978, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(x11$betaSpent, collapse = ", "), ")")) - expect_equal(x11$criticalValues, c(3.1017782, 2.3111074, 2.1614596), tolerance = 1e-07, label = paste0("c(", paste0(x11$criticalValues, collapse = ", "), ")")) - expect_equal(x11$stageLevels, c(0.00096181012, 0.010413463, 0.015329928), tolerance = 1e-07, label = paste0("c(", paste0(x11$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x11), NA))) - expect_output(print(x11)$show()) - invisible(capture.output(expect_error(summary(x11), NA))) - expect_output(summary(x11)$show()) - x11CodeBased <- eval(parse(text = getObjectRCode(x11, stringWrapParagraphWidth = NULL))) - expect_equal(x11CodeBased$power, x11$power, tolerance = 1e-07) - expect_equal(x11CodeBased$futilityBounds, x11$futilityBounds, tolerance = 1e-07) - expect_equal(x11CodeBased$alphaSpent, x11$alphaSpent, tolerance = 1e-07) - expect_equal(x11CodeBased$betaSpent, x11$betaSpent, tolerance = 1e-07) - expect_equal(x11CodeBased$criticalValues, x11$criticalValues, tolerance = 1e-07) - expect_equal(x11CodeBased$stageLevels, x11$stageLevels, tolerance = 1e-07) - expect_type(names(x11), "character") - df <- as.data.frame(x11) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x11) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:criticalValuesPampallonaTiatis} - x12 <- getDesignGroupSequential( - kMax = 3, alpha = 0.035, beta = 0.05, - informationRates = c(0.3, 0.8, 1), typeOfDesign = "PT", sided = 2, - bindingFutility = FALSE, deltaPT1 = 0.2, deltaPT0 = 0.3 - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x12' with expected results - expect_equal(x12$power, c(0.15712278, 0.87874666, 0.94999994), tolerance = 1e-07, label = paste0("c(", paste0(x12$power, collapse = ", "), ")")) - expect_equal(x12$futilityBounds, c(NA_real_, 1.7090472), tolerance = 1e-07, label = paste0("c(", paste0(x12$futilityBounds, collapse = ", "), ")")) - expect_equal(x12$alphaSpent, c(0.0015647742, 0.019435851, 0.035), tolerance = 1e-07, label = paste0("c(", paste0(x12$alphaSpent, collapse = ", "), ")")) - expect_equal(x12$betaSpent, c(0, 0.034947415, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(x12$betaSpent, collapse = ", "), ")")) - expect_equal(x12$criticalValues, c(3.1623945, 2.356272, 2.2036998), tolerance = 1e-07, label = paste0("c(", paste0(x12$criticalValues, collapse = ", "), ")")) - expect_equal(x12$stageLevels, c(0.00078238709, 0.0092296971, 0.013772733), tolerance = 1e-07, label = paste0("c(", paste0(x12$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x12), NA))) - expect_output(print(x12)$show()) - invisible(capture.output(expect_error(summary(x12), NA))) - expect_output(summary(x12)$show()) - x12CodeBased <- eval(parse(text = getObjectRCode(x12, stringWrapParagraphWidth = NULL))) - expect_equal(x12CodeBased$power, x12$power, tolerance = 1e-07) - expect_equal(x12CodeBased$futilityBounds, x12$futilityBounds, tolerance = 1e-07) - expect_equal(x12CodeBased$alphaSpent, x12$alphaSpent, tolerance = 1e-07) - expect_equal(x12CodeBased$betaSpent, x12$betaSpent, tolerance = 1e-07) - expect_equal(x12CodeBased$criticalValues, x12$criticalValues, tolerance = 1e-07) - expect_equal(x12CodeBased$stageLevels, x12$stageLevels, tolerance = 1e-07) - expect_type(names(x12), "character") - df <- as.data.frame(x12) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x12) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:criticalValuesPampallonaTiatis} - x13 <- getDesignGroupSequential( - kMax = 4, alpha = 0.035, beta = 0.05, - informationRates = c(0.2, 0.4, 0.8, 1), typeOfDesign = "PT", sided = 1, - bindingFutility = FALSE, deltaPT1 = 0.1, deltaPT0 = 0.45 - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x13' with expected results - expect_equal(x13$power, c(0.029518378, 0.38853658, 0.90760886, 0.95), tolerance = 1e-07, label = paste0("c(", paste0(x13$power, collapse = ", "), ")")) - expect_equal(x13$futilityBounds, c(-0.41499566, 0.38106631, 1.4738957), tolerance = 1e-07, label = paste0("c(", paste0(x13$futilityBounds, collapse = ", "), ")")) - expect_equal(x13$alphaSpent, c(0.00014050218, 0.0030266381, 0.0199021, 0.035), tolerance = 1e-07, label = paste0("c(", paste0(x13$alphaSpent, collapse = ", "), ")")) - expect_equal(x13$betaSpent, c(0.015413989, 0.028721092, 0.043215976, 0.049999999), tolerance = 1e-07, label = paste0("c(", paste0(x13$betaSpent, collapse = ", "), ")")) - expect_equal(x13$criticalValues, c(3.6322099, 2.7527004, 2.0861568, 1.9080201), tolerance = 1e-07, label = paste0("c(", paste0(x13$criticalValues, collapse = ", "), ")")) - expect_equal(x13$stageLevels, c(0.00014050218, 0.002955298, 0.018482211, 0.02819431), tolerance = 1e-07, label = paste0("c(", paste0(x13$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x13), NA))) - expect_output(print(x13)$show()) - invisible(capture.output(expect_error(summary(x13), NA))) - expect_output(summary(x13)$show()) - x13CodeBased <- eval(parse(text = getObjectRCode(x13, stringWrapParagraphWidth = NULL))) - expect_equal(x13CodeBased$power, x13$power, tolerance = 1e-07) - expect_equal(x13CodeBased$futilityBounds, x13$futilityBounds, tolerance = 1e-07) - expect_equal(x13CodeBased$alphaSpent, x13$alphaSpent, tolerance = 1e-07) - expect_equal(x13CodeBased$betaSpent, x13$betaSpent, tolerance = 1e-07) - expect_equal(x13CodeBased$criticalValues, x13$criticalValues, tolerance = 1e-07) - expect_equal(x13CodeBased$stageLevels, x13$stageLevels, tolerance = 1e-07) - expect_type(names(x13), "character") - df <- as.data.frame(x13) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x13) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:criticalValuesPampallonaTiatis} - x14 <- getDesignGroupSequential( - kMax = 6, alpha = 0.25, beta = 0.01, - typeOfDesign = "PT", sided = 2, - bindingFutility = TRUE, deltaPT1 = 0.02, deltaPT0 = 0.49, twoSidedPower = TRUE - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x14' with expected results - expect_equal(x14$power, c(0.076493626, 0.52863814, 0.83456395, 0.94950066, 0.98346861, 0.99), tolerance = 1e-07, label = paste0("c(", paste0(x14$power, collapse = ", "), ")")) - expect_equal(x14$futilityBounds, c(NA_real_, NA_real_, 0.12661836, 0.55308248, 0.92800873), tolerance = 1e-07, label = paste0("c(", paste0(x14$futilityBounds, collapse = ", "), ")")) - expect_equal(x14$alphaSpent, c(0.0027626806, 0.03301126, 0.088857236, 0.15440485, 0.2156594, 0.25), tolerance = 1e-07, label = paste0("c(", paste0(x14$alphaSpent, collapse = ", "), ")")) - expect_equal(x14$betaSpent, c(0, 0, 0.0026196848, 0.0066701046, 0.0089493411, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(x14$betaSpent, collapse = ", "), ")")) - expect_equal(x14$criticalValues, c(2.9929798, 2.1458995, 1.7663859, 1.5385619, 1.3822869, 1.2664591), tolerance = 1e-07, label = paste0("c(", paste0(x14$criticalValues, collapse = ", "), ")")) - expect_equal(x14$stageLevels, c(0.0013813403, 0.015940498, 0.038665568, 0.061955638, 0.08344182, 0.10267438), tolerance = 1e-07, label = paste0("c(", paste0(x14$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x14), NA))) - expect_output(print(x14)$show()) - invisible(capture.output(expect_error(summary(x14), NA))) - expect_output(summary(x14)$show()) - x14CodeBased <- eval(parse(text = getObjectRCode(x14, stringWrapParagraphWidth = NULL))) - expect_equal(x14CodeBased$power, x14$power, tolerance = 1e-07) - expect_equal(x14CodeBased$futilityBounds, x14$futilityBounds, tolerance = 1e-07) - expect_equal(x14CodeBased$alphaSpent, x14$alphaSpent, tolerance = 1e-07) - expect_equal(x14CodeBased$betaSpent, x14$betaSpent, tolerance = 1e-07) - expect_equal(x14CodeBased$criticalValues, x14$criticalValues, tolerance = 1e-07) - expect_equal(x14CodeBased$stageLevels, x14$stageLevels, tolerance = 1e-07) - expect_type(names(x14), "character") - df <- as.data.frame(x14) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x14) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignGroupSequential' with type of design = 'noEarlyEfficacy'", { - - .skipTestIfDisabled() - - # @refFS[Tab.]{fs:tab:output:getDesignInverseNormal} - # @refFS[Formula]{fs:alphaSpendingConcept} - x15 <- getDesignGroupSequential( - typeOfDesign = "noEarlyEfficacy", - futilityBounds = c(0, 0.5) - ) - - - ## Comparison of the results of TrialDesignGroupSequential object 'x15' with expected results - expect_equal(x15$alphaSpent, c(6.6613381e-16, -1.3145041e-13, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(x15$alphaSpent, collapse = ", "), ")")) - expect_equal(x15$criticalValues, c(Inf, Inf, 1.959964), tolerance = 1e-07, label = paste0("c(", paste0(x15$criticalValues, collapse = ", "), ")")) - expect_equal(x15$stageLevels, c(0, 0, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(x15$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x15), NA))) - expect_output(print(x15)$show()) - invisible(capture.output(expect_error(summary(x15), NA))) - expect_output(summary(x15)$show()) - x15CodeBased <- eval(parse(text = getObjectRCode(x15, stringWrapParagraphWidth = NULL))) - expect_equal(x15CodeBased$alphaSpent, x15$alphaSpent, tolerance = 1e-07) - expect_equal(x15CodeBased$criticalValues, x15$criticalValues, tolerance = 1e-07) - expect_equal(x15CodeBased$stageLevels, x15$stageLevels, tolerance = 1e-07) - expect_type(names(x15), "character") - df <- as.data.frame(x15) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x15) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - x16 <- getDesignGroupSequential( - typeOfDesign = "noEarlyEfficacy", - futilityBounds = c(0, 0.5, 1), - bindingFutility = TRUE - ) - - - ## Comparison of the results of TrialDesignGroupSequential object 'x16' with expected results - expect_equal(x16$alphaSpent, c(6.6613381e-16, 1.110223e-15, 4.8067383e-11, 0.02499999), tolerance = 1e-07, label = paste0("c(", paste0(x16$alphaSpent, collapse = ", "), ")")) - expect_equal(x16$criticalValues, c(Inf, Inf, Inf, 1.8848634), tolerance = 1e-07, label = paste0("c(", paste0(x16$criticalValues, collapse = ", "), ")")) - expect_equal(x16$stageLevels, c(0, 0, 0, 0.029724142), tolerance = 1e-07, label = paste0("c(", paste0(x16$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x16), NA))) - expect_output(print(x16)$show()) - invisible(capture.output(expect_error(summary(x16), NA))) - expect_output(summary(x16)$show()) - x16CodeBased <- eval(parse(text = getObjectRCode(x16, stringWrapParagraphWidth = NULL))) - expect_equal(x16CodeBased$alphaSpent, x16$alphaSpent, tolerance = 1e-07) - expect_equal(x16CodeBased$criticalValues, x16$criticalValues, tolerance = 1e-07) - expect_equal(x16CodeBased$stageLevels, x16$stageLevels, tolerance = 1e-07) - expect_type(names(x16), "character") - df <- as.data.frame(x16) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x16) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } -}) - -test_that("'getDesignInverseNormal': illegal arguments throw exceptions as expected", { - - expect_error(getDesignInverseNormal( - typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, - userAlphaSpending = c(0.01, 0.02, 0.023, 0.023, 0.025), kMax = 4 - ), - paste0( - "Conflicting arguments: length of 'userAlphaSpending' (5) ", - "must be equal to 'kMax' (4)" - ), - fixed = TRUE - ) - - expect_error(getDesignInverseNormal( - typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, - userAlphaSpending = c(0.01, 0.02, 0.023, 0.023, 0.021) - ), - paste0( - "'userAlphaSpending' = c(0.01, 0.02, 0.023, 0.023, 0.021) must be a vector that ", - "satisfies the following condition: 0 <= alpha_1 <= .. <= alpha_5 <= alpha = 0.021" - ), - fixed = TRUE - ) - - expect_error(getDesignInverseNormal( - typeOfDesign = "asUser", - userAlphaSpending = c(0.01, 0.02, 0.023), alpha = 0.02 - ), - paste0( - "'userAlphaSpending' = c(0.01, 0.02, 0.023) must be a vector that ", - "satisfies the following condition: 0 <= alpha_1 <= .. <= alpha_3 <= alpha = 0.02" - ), - fixed = TRUE - ) - - expect_error(getDesignInverseNormal(typeOfDesign = C_TYPE_OF_DESIGN_WT, deltaWT = NA_real_), - "Missing argument: parameter 'deltaWT' must be specified in design", - fixed = TRUE - ) - - expect_error(getDesignInverseNormal( - typeOfDesign = C_TYPE_OF_DESIGN_WT_OPTIMUM, - optimizationCriterion = "x" - ), - "Illegal argument: optimization criterion must be one of the following: 'ASNH1', 'ASNIFH1', 'ASNsum'", - fixed = TRUE - ) - - expect_error(getDesignInverseNormal(typeOfDesign = C_TYPE_OF_DESIGN_AS_KD, gammaA = NA_real_), - "Missing argument: parameter 'gammaA' must be specified in design", - fixed = TRUE - ) - - expect_error(getDesignInverseNormal(typeOfDesign = C_TYPE_OF_DESIGN_AS_HSD, gammaA = NA_real_), - "Missing argument: parameter 'gammaA' must be specified in design", - fixed = TRUE - ) - - expect_error(getDesignInverseNormal(typeOfDesign = C_TYPE_OF_DESIGN_AS_USER), - "Missing argument: parameter 'userAlphaSpending' must be specified in design", - fixed = TRUE - ) - - expect_error(getDesignInverseNormal( - typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, - userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = "x" - ), - "Illegal argument: type of beta spending must be one of the following: 'none', 'bsP', 'bsOF', 'bsKD', 'bsHSD', 'bsUser'", - fixed = TRUE - ) - - expect_error(getDesignInverseNormal( - typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, - userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER - ), - "Missing argument: parameter 'userBetaSpending' must be specified in design", - fixed = TRUE - ) - - expect_error(getDesignInverseNormal( - typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, - userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER, - userBetaSpending = c(0.1, 0.2) - ), - paste0( - "Conflicting arguments: length of 'userBetaSpending' (2) must ", - "be equal to length of 'informationRates' (3)" - ), - fixed = TRUE - ) - - expect_error(getDesignInverseNormal( - typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, - userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER, - userBetaSpending = c(0.2, 0.1, 0.05) - ), - paste0( - "'userBetaSpending' = c(0.2, 0.1, 0.05) must be a vector that satisfies the ", - "following condition: 0 <= beta_1 <= .. <= beta_3 <= beta = 0.05" - ), - fixed = TRUE - ) - - expect_error(getDesignInverseNormal( - typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, - userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER, - userBetaSpending = c(0.1, 0.2, 0.3), beta = 0.2 - ), - paste0( - "'userBetaSpending' = c(0.1, 0.2, 0.3) must be a vector that satisfies the ", - "following condition: 0 <= beta_1 <= .. <= beta_3 <= beta = 0.2" - ), - fixed = TRUE - ) - - expect_error(getDesignInverseNormal(kMax = Inf), - paste0( - "Argument out of bounds: 'kMax' (Inf) is out of bounds [1; ", - C_KMAX_UPPER_BOUND, "]" - ), - fixed = TRUE - ) - - expect_error(getDesignInverseNormal(kMax = -Inf), - paste0( - "Argument out of bounds: 'kMax' (-Inf) is out of bounds [1; ", - C_KMAX_UPPER_BOUND, "]" - ), - fixed = TRUE - ) - - expect_error(getDesignInverseNormal(kMax = -Inf), "Argument out of bounds: 'kMax' (-Inf) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = -10), "Argument out of bounds: 'kMax' (-10) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = -9), "Argument out of bounds: 'kMax' (-9) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = -8), "Argument out of bounds: 'kMax' (-8) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = -7), "Argument out of bounds: 'kMax' (-7) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = -6), "Argument out of bounds: 'kMax' (-6) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = -5), "Argument out of bounds: 'kMax' (-5) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = -4), "Argument out of bounds: 'kMax' (-4) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = -3), "Argument out of bounds: 'kMax' (-3) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = -2), "Argument out of bounds: 'kMax' (-2) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = -1), "Argument out of bounds: 'kMax' (-1) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 0), "Argument out of bounds: 'kMax' (0) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 21), "Argument out of bounds: 'kMax' (21) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 22), "Argument out of bounds: 'kMax' (22) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 23), "Argument out of bounds: 'kMax' (23) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 24), "Argument out of bounds: 'kMax' (24) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 25), "Argument out of bounds: 'kMax' (25) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 26), "Argument out of bounds: 'kMax' (26) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 27), "Argument out of bounds: 'kMax' (27) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 28), "Argument out of bounds: 'kMax' (28) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 29), "Argument out of bounds: 'kMax' (29) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 30), "Argument out of bounds: 'kMax' (30) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = Inf), "Argument out of bounds: 'kMax' (Inf) is out of bounds [1; 20]", fixed = TRUE) - - expect_error(getDesignInverseNormal(kMax = 2, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (2) - 1", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 3, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (3) - 1", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 4, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (4) - 1", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 6, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (6) - 1", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 7, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (7) - 1", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 8, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (8) - 1", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 9, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (9) - 1", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 10, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (10) - 1", fixed = TRUE) - - expect_warning(expect_error(getDesignInverseNormal(kMax = 11, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (11) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 12, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (12) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 13, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (13) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 14, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (14) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 15, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (15) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 16, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (16) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 17, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (17) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 18, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (18) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 19, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (19) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 20, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (20) - 1", fixed = TRUE)) - - expect_error(getDesignInverseNormal(futilityBounds = c(-7, 5)), - "Illegal argument: 'futilityBounds' (-7, 5) too extreme for this situation", - fixed = TRUE - ) - - expect_error(getDesignInverseNormal(futilityBounds = c(1, 7)), - "Argument out of bounds: 'futilityBounds' (1, 7) is out of bounds [-Inf; 6]", - fixed = TRUE - ) - -}) - -test_that("'getDesignGroupSequential': illegal arguments throw exceptions as expected", { - - expect_error(getDesignGroupSequential( - typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, - userAlphaSpending = c(0.01, 0.02, 0.023, 0.023, 0.025), kMax = 4 - ), - paste0( - "Conflicting arguments: length of 'userAlphaSpending' (5) ", - "must be equal to 'kMax' (4)" - ), - fixed = TRUE - ) - - expect_error(getDesignGroupSequential( - typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, - userAlphaSpending = c(0.01, 0.02, 0.023, 0.023, 0.021) - ), - paste0( - "'userAlphaSpending' = c(0.01, 0.02, 0.023, 0.023, 0.021) must be a vector that ", - "satisfies the following condition: 0 <= alpha_1 <= .. <= alpha_5 <= alpha = 0.021" - ), - fixed = TRUE - ) - - expect_error(getDesignGroupSequential( - typeOfDesign = "asUser", - userAlphaSpending = c(0.01, 0.02, 0.023), alpha = 0.02 - ), - paste0( - "'userAlphaSpending' = c(0.01, 0.02, 0.023) must be a vector that ", - "satisfies the following condition: 0 <= alpha_1 <= .. <= alpha_3 <= alpha = 0.02" - ), - fixed = TRUE - ) - - expect_equal(getDesignGroupSequential( - typeOfDesign = "asUser", - userAlphaSpending = c(0.01, 0.02, 0.023) - )$alpha, 0.023) - - expect_error(getDesignGroupSequential(typeOfDesign = C_TYPE_OF_DESIGN_WT, deltaWT = NA_real_), - "Missing argument: parameter 'deltaWT' must be specified in design", - fixed = TRUE - ) - - expect_error(getDesignGroupSequential( - typeOfDesign = C_TYPE_OF_DESIGN_WT_OPTIMUM, - optimizationCriterion = "x" - ), - "Illegal argument: optimization criterion must be one of the following: 'ASNH1', 'ASNIFH1', 'ASNsum'", - fixed = TRUE - ) - - expect_error(getDesignGroupSequential(typeOfDesign = C_TYPE_OF_DESIGN_AS_KD, gammaA = NA_real_), - "Missing argument: parameter 'gammaA' must be specified in design", - fixed = TRUE - ) - - expect_error(getDesignGroupSequential(typeOfDesign = C_TYPE_OF_DESIGN_AS_HSD, gammaA = NA_real_), - "Missing argument: parameter 'gammaA' must be specified in design", - fixed = TRUE - ) - - expect_error(getDesignGroupSequential(typeOfDesign = C_TYPE_OF_DESIGN_AS_USER), - "Missing argument: parameter 'userAlphaSpending' must be specified in design", - fixed = TRUE - ) - - expect_error(getDesignGroupSequential( - typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, - userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = "x" - ), - paste0( - "Illegal argument: type of beta spending must be one of the following: ", - "'none', 'bsP', 'bsOF', 'bsKD', 'bsHSD', 'bsUser'" - ), - fixed = TRUE - ) - - expect_error(getDesignGroupSequential( - typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, - userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER - ), - "Missing argument: parameter 'userBetaSpending' must be specified in design", - fixed = TRUE - ) - - expect_error(getDesignGroupSequential( - typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, - userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER, - userBetaSpending = c(0.1, 0.2) - ), - paste0( - "Conflicting arguments: length of 'userBetaSpending' (2) must ", - "be equal to length of 'informationRates' (3)" - ), - fixed = TRUE - ) - - expect_error(getDesignGroupSequential( - typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, - userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER, - userBetaSpending = c(0.2, 0.1, 0.05) - ), - paste0( - "'userBetaSpending' = c(0.2, 0.1, 0.05) must be a vector that satisfies the ", - "following condition: 0 <= beta_1 <= .. <= beta_3 <= beta = 0.05" - ), - fixed = TRUE - ) - - expect_error(getDesignGroupSequential( - typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, - userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER, - userBetaSpending = c(0.1, 0.2, 0.3), beta = 0.2 - ), - paste0( - "'userBetaSpending' = c(0.1, 0.2, 0.3) must be a vector that satisfies the ", - "following condition: 0 <= beta_1 <= .. <= beta_3 <= beta = 0.2" - ), - fixed = TRUE - ) - - expect_error(getDesignGroupSequential(kMax = Inf), - paste0( - "Argument out of bounds: 'kMax' (Inf) is out of bounds [1; ", - C_KMAX_UPPER_BOUND, "]" - ), - fixed = TRUE - ) - - expect_error(getDesignGroupSequential(kMax = -Inf), - paste0( - "Argument out of bounds: 'kMax' (-Inf) is out of bounds [1; ", - C_KMAX_UPPER_BOUND, "]" - ), - fixed = TRUE - ) - - expect_error(getDesignInverseNormal(kMax = -5), "Argument out of bounds: 'kMax' (-5) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 0), "Argument out of bounds: 'kMax' (0) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 21), "Argument out of bounds: 'kMax' (21) is out of bounds [1; 20]", fixed = TRUE) - - expect_error(getDesignInverseNormal(kMax = 2, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (2) - 1", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 3, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (3) - 1", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 4, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (4) - 1", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 6, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (6) - 1", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 7, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (7) - 1", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 8, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (8) - 1", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 9, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (9) - 1", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 10, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (10) - 1", fixed = TRUE) - - expect_warning(expect_error(getDesignInverseNormal(kMax = 11, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (11) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 12, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (12) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 13, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (13) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 14, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (14) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 15, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (15) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 16, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (16) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 17, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (17) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 18, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (18) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 19, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (19) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 20, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (20) - 1", fixed = TRUE)) - - expect_error(getDesignGroupSequential(futilityBounds = c(-7, 5)), - "Illegal argument: 'futilityBounds' (-7, 5) too extreme for this situation", - fixed = TRUE - ) - - expect_error(getDesignGroupSequential(futilityBounds = c(1, 7)), - "Argument out of bounds: 'futilityBounds' (1, 7) is out of bounds [-Inf; 6]", - fixed = TRUE - ) -}) - +## | +## | *Unit tests* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | RPACT package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File name: test-f_design_group_sequential.R +## | Creation date: 08 November 2023, 09:09:43 +## | File version: $Revision$ +## | Last changed: $Date$ +## | Last changed by: $Author$ +## | + +test_plan_section("Testing the Group Sequential and Inverse Normal Design Functionality") + + +test_that("'getGroupSequentialProbabilities' with one and two continuation regions for weighted test statistic", { + # @refFS[Formula]{fs:testStatisticGroupSequentialWeightedAverage} + xa <- getGroupSequentialProbabilities(matrix(c(rep(-qnorm(0.95), 4), rep(qnorm(0.95), 4)), nrow = 2, byrow = TRUE), (1:4) / 4) + + ## Comparison of the results of matrixarray object 'xa' with expected results + expect_equal(xa[1, ], c(0.05, 0.030074925, 0.020961248, 0.01595848), tolerance = 1e-07, label = paste0("c(", paste0(xa[1, ], collapse = ", "), ")")) + expect_equal(xa[2, ], c(0.95, 0.86992507, 0.8188889, 0.78196917), tolerance = 1e-07, label = paste0("c(", paste0(xa[2, ], collapse = ", "), ")")) + expect_equal(xa[3, ], c(1, 0.9, 0.83985015, 0.79792765), tolerance = 1e-07, label = paste0("c(", paste0(xa[3, ], collapse = ", "), ")")) + + xb <- getGroupSequentialProbabilities(matrix(c(rep(-qnorm(0.95), 4), rep(-1, 4), rep(1, 4), rep(qnorm(0.95), 4)), nrow = 4, byrow = TRUE), (1:4) / 4) + + ## Comparison of the results of matrixarray object 'xb' with expected results + expect_equal(xb[1, ], c(0.05, 0.016446517, 0.005264288, 0.0019569508), tolerance = 1e-07, label = paste0("c(", paste0(xb[1, ], collapse = ", "), ")")) + expect_equal(xb[2, ], c(0.15865525, 0.048950554, 0.017478997, 0.0072417024), tolerance = 1e-07, label = paste0("c(", paste0(xb[2, ], collapse = ", "), ")")) + expect_equal(xb[3, ], c(0.84134475, 0.16835995, 0.047529077, 0.017187717), tolerance = 1e-07, label = paste0("c(", paste0(xb[3, ], collapse = ", "), ")")) + expect_equal(xb[4, ], c(0.95, 0.20086399, 0.059743786, 0.022472468), tolerance = 1e-07, label = paste0("c(", paste0(xb[4, ], collapse = ", "), ")")) + expect_equal(xb[5, ], c(1, 0.21731051, 0.065008074, 0.024429419), tolerance = 1e-07, label = paste0("c(", paste0(xb[5, ], collapse = ", "), ")")) + +}) + +test_that("'getDesignInverseNormal' with default parameters: parameters and results are as expected", { + + # @refFS[Tab.]{fs:tab:output:getDesignInverseNormal} + # @refFS[Formula]{fs:criticalValuesOBrienFleming} + x0 <- getDesignInverseNormal() + + ## Comparison of the results of TrialDesignInverseNormal object 'x0' with expected results + expect_equal(x0$alphaSpent, c(0.00025917372, 0.0071600594, 0.02499999), tolerance = 1e-07, label = paste0("c(", paste0(x0$alphaSpent, collapse = ", "), ")")) + expect_equal(x0$criticalValues, c(3.4710914, 2.4544323, 2.0040356), tolerance = 1e-07, label = paste0("c(", paste0(x0$criticalValues, collapse = ", "), ")")) + expect_equal(x0$stageLevels, c(0.00025917372, 0.0070553616, 0.022533125), tolerance = 1e-07, label = paste0("c(", paste0(x0$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x0), NA))) + expect_output(print(x0)$show()) + invisible(capture.output(expect_error(summary(x0), NA))) + expect_output(summary(x0)$show()) + x0CodeBased <- eval(parse(text = getObjectRCode(x0, stringWrapParagraphWidth = NULL))) + expect_equal(x0CodeBased$alphaSpent, x0$alphaSpent, tolerance = 1e-07) + expect_equal(x0CodeBased$criticalValues, x0$criticalValues, tolerance = 1e-07) + expect_equal(x0CodeBased$stageLevels, x0$stageLevels, tolerance = 1e-07) + expect_type(names(x0), "character") + df <- as.data.frame(x0) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x0) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignInverseNormal' with type of design = 'asHSD', 'bsHSD', 'asKD', and 'bsKD'", { + + .skipTestIfDisabled() + + # @refFS[Tab.]{fs:tab:output:getDesignInverseNormal} + # @refFS[Formula]{fs:alphaSpendingConcept} + # @refFS[Formula]{fs:alphaSpendingHwangShiDeCani} + x1 <- getDesignInverseNormal( + kMax = 3, informationRates = c(0.2, 0.4, 1), + alpha = 0.03, sided = 1, beta = 0.14, typeOfDesign = "asHSD", gammaA = 0 + ) + + ## Comparison of the results of TrialDesignInverseNormal object 'x1' with expected results + expect_equal(x1$alphaSpent, c(0.006, 0.012, 0.03), tolerance = 1e-07, label = paste0("c(", paste0(x1$alphaSpent, collapse = ", "), ")")) + expect_equal(x1$criticalValues, c(2.5121443, 2.4228747, 2.0280392), tolerance = 1e-07, label = paste0("c(", paste0(x1$criticalValues, collapse = ", "), ")")) + expect_equal(x1$stageLevels, c(0.006, 0.0076991188, 0.021278125), tolerance = 1e-07, label = paste0("c(", paste0(x1$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x1), NA))) + expect_output(print(x1)$show()) + invisible(capture.output(expect_error(summary(x1), NA))) + expect_output(summary(x1)$show()) + x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) + expect_equal(x1CodeBased$alphaSpent, x1$alphaSpent, tolerance = 1e-07) + expect_equal(x1CodeBased$criticalValues, x1$criticalValues, tolerance = 1e-07) + expect_equal(x1CodeBased$stageLevels, x1$stageLevels, tolerance = 1e-07) + expect_type(names(x1), "character") + df <- as.data.frame(x1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignCharacteristics} + # @refFS[Formula]{fs:inflationFactor} + # @refFS[Formula]{fs:expectedReduction} + y1 <- getDesignCharacteristics(x1) + + ## Comparison of the results of TrialDesignCharacteristics object 'y1' with expected results + expect_equal(y1$nFixed, 8.7681899, tolerance = 1e-07, label = paste0("c(", paste0(y1$nFixed, collapse = ", "), ")")) + expect_equal(y1$shift, 9.4594101, tolerance = 1e-07, label = paste0("c(", paste0(y1$shift, collapse = ", "), ")")) + expect_equal(y1$inflationFactor, 1.0788327, tolerance = 1e-07, label = paste0("c(", paste0(y1$inflationFactor, collapse = ", "), ")")) + expect_equal(y1$information, c(1.891882, 3.7837641, 9.4594101), tolerance = 1e-07, label = paste0("c(", paste0(y1$information, collapse = ", "), ")")) + expect_equal(y1$power, c(0.12783451, 0.34055165, 0.86), tolerance = 1e-07, label = paste0("c(", paste0(y1$power, collapse = ", "), ")")) + expect_equal(y1$rejectionProbabilities, c(0.12783451, 0.21271713, 0.51944835), tolerance = 1e-07, label = paste0("c(", paste0(y1$rejectionProbabilities, collapse = ", "), ")")) + expect_equal(y1$futilityProbabilities, c(0, 0), label = paste0("c(", paste0(y1$futilityProbabilities, collapse = ", "), ")")) + expect_equal(y1$averageSampleNumber1, 0.83081135, tolerance = 1e-07, label = paste0("c(", paste0(y1$averageSampleNumber1, collapse = ", "), ")")) + expect_equal(y1$averageSampleNumber01, 1.0142116, tolerance = 1e-07, label = paste0("c(", paste0(y1$averageSampleNumber01, collapse = ", "), ")")) + expect_equal(y1$averageSampleNumber0, 1.0697705, tolerance = 1e-07, label = paste0("c(", paste0(y1$averageSampleNumber0, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(y1), NA))) + expect_output(print(y1)$show()) + invisible(capture.output(expect_error(summary(y1), NA))) + expect_output(summary(y1)$show()) + y1CodeBased <- eval(parse(text = getObjectRCode(y1, stringWrapParagraphWidth = NULL))) + expect_equal(y1CodeBased$nFixed, y1$nFixed, tolerance = 1e-07) + expect_equal(y1CodeBased$shift, y1$shift, tolerance = 1e-07) + expect_equal(y1CodeBased$inflationFactor, y1$inflationFactor, tolerance = 1e-07) + expect_equal(y1CodeBased$information, y1$information, tolerance = 1e-07) + expect_equal(y1CodeBased$power, y1$power, tolerance = 1e-07) + expect_equal(y1CodeBased$rejectionProbabilities, y1$rejectionProbabilities, tolerance = 1e-07) + expect_equal(y1CodeBased$futilityProbabilities, y1$futilityProbabilities, tolerance = 1e-07) + expect_equal(y1CodeBased$averageSampleNumber1, y1$averageSampleNumber1, tolerance = 1e-07) + expect_equal(y1CodeBased$averageSampleNumber01, y1$averageSampleNumber01, tolerance = 1e-07) + expect_equal(y1CodeBased$averageSampleNumber0, y1$averageSampleNumber0, tolerance = 1e-07) + expect_type(names(y1), "character") + df <- as.data.frame(y1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(y1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignInverseNormal} + # @refFS[Formula]{fs:alphaSpendingConcept} + # @refFS[Formula]{fs:alphaSpendingHwangShiDeCani} + # @refFS[Formula]{fs:betaSpendingApproach} + # @refFS[Formula]{fs:betaSpendingHwangShiDeCani} + x2 <- getDesignInverseNormal( + kMax = 3, informationRates = c(0.2, 0.4, 1), + alpha = 0.07, sided = 1, beta = 0.14, typeOfDesign = "asHSD", gammaA = -1, + typeBetaSpending = "bsHSD", gammaB = -2 + ) + + ## Comparison of the results of TrialDesignInverseNormal object 'x2' with expected results + expect_equal(x2$power, c(0.12038953, 0.32895265, 0.86), tolerance = 1e-07, label = paste0("c(", paste0(x2$power, collapse = ", "), ")")) + expect_equal(x2$futilityBounds, c(-1.1063623, -0.35992439), tolerance = 1e-07, label = paste0("c(", paste0(x2$futilityBounds, collapse = ", "), ")")) + expect_equal(x2$alphaSpent, c(0.0090195874, 0.020036136, 0.07), tolerance = 1e-07, label = paste0("c(", paste0(x2$alphaSpent, collapse = ", "), ")")) + expect_equal(x2$betaSpent, c(0.010777094, 0.026854629, 0.14), tolerance = 1e-07, label = paste0("c(", paste0(x2$betaSpent, collapse = ", "), ")")) + expect_equal(x2$criticalValues, c(2.364813, 2.1928805, 1.5660474), tolerance = 1e-07, label = paste0("c(", paste0(x2$criticalValues, collapse = ", "), ")")) + expect_equal(x2$stageLevels, c(0.0090195874, 0.014157994, 0.058668761), tolerance = 1e-07, label = paste0("c(", paste0(x2$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x2), NA))) + expect_output(print(x2)$show()) + invisible(capture.output(expect_error(summary(x2), NA))) + expect_output(summary(x2)$show()) + x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) + expect_equal(x2CodeBased$power, x2$power, tolerance = 1e-07) + expect_equal(x2CodeBased$futilityBounds, x2$futilityBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$alphaSpent, x2$alphaSpent, tolerance = 1e-07) + expect_equal(x2CodeBased$betaSpent, x2$betaSpent, tolerance = 1e-07) + expect_equal(x2CodeBased$criticalValues, x2$criticalValues, tolerance = 1e-07) + expect_equal(x2CodeBased$stageLevels, x2$stageLevels, tolerance = 1e-07) + expect_type(names(x2), "character") + df <- as.data.frame(x2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignCharacteristics} + # @refFS[Formula]{fs:inflationFactor} + # @refFS[Formula]{fs:expectedReduction} + y2 <- getDesignCharacteristics(x2) + + ## Comparison of the results of TrialDesignCharacteristics object 'y2' with expected results + expect_equal(y2$nFixed, 6.5337002, tolerance = 1e-07, label = paste0("c(", paste0(y2$nFixed, collapse = ", "), ")")) + expect_equal(y2$shift, 7.1015942, tolerance = 1e-07, label = paste0("c(", paste0(y2$shift, collapse = ", "), ")")) + expect_equal(y2$inflationFactor, 1.0869177, tolerance = 1e-07, label = paste0("c(", paste0(y2$inflationFactor, collapse = ", "), ")")) + expect_equal(y2$information, c(1.4203188, 2.8406377, 7.1015942), tolerance = 1e-07, label = paste0("c(", paste0(y2$information, collapse = ", "), ")")) + expect_equal(y2$power, c(0.12038953, 0.32895265, 0.86), tolerance = 1e-07, label = paste0("c(", paste0(y2$power, collapse = ", "), ")")) + expect_equal(y2$rejectionProbabilities, c(0.12038953, 0.20856311, 0.53104735), tolerance = 1e-07, label = paste0("c(", paste0(y2$rejectionProbabilities, collapse = ", "), ")")) + expect_equal(y2$futilityProbabilities, c(0.010777094, 0.016077535), tolerance = 1e-07, label = paste0("c(", paste0(y2$futilityProbabilities, collapse = ", "), ")")) + expect_equal(y2$averageSampleNumber1, 0.82636428, tolerance = 1e-07, label = paste0("c(", paste0(y2$averageSampleNumber1, collapse = ", "), ")")) + expect_equal(y2$averageSampleNumber01, 0.916142, tolerance = 1e-07, label = paste0("c(", paste0(y2$averageSampleNumber01, collapse = ", "), ")")) + expect_equal(y2$averageSampleNumber0, 0.79471657, tolerance = 1e-07, label = paste0("c(", paste0(y2$averageSampleNumber0, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(y2), NA))) + expect_output(print(y2)$show()) + invisible(capture.output(expect_error(summary(y2), NA))) + expect_output(summary(y2)$show()) + y2CodeBased <- eval(parse(text = getObjectRCode(y2, stringWrapParagraphWidth = NULL))) + expect_equal(y2CodeBased$nFixed, y2$nFixed, tolerance = 1e-07) + expect_equal(y2CodeBased$shift, y2$shift, tolerance = 1e-07) + expect_equal(y2CodeBased$inflationFactor, y2$inflationFactor, tolerance = 1e-07) + expect_equal(y2CodeBased$information, y2$information, tolerance = 1e-07) + expect_equal(y2CodeBased$power, y2$power, tolerance = 1e-07) + expect_equal(y2CodeBased$rejectionProbabilities, y2$rejectionProbabilities, tolerance = 1e-07) + expect_equal(y2CodeBased$futilityProbabilities, y2$futilityProbabilities, tolerance = 1e-07) + expect_equal(y2CodeBased$averageSampleNumber1, y2$averageSampleNumber1, tolerance = 1e-07) + expect_equal(y2CodeBased$averageSampleNumber01, y2$averageSampleNumber01, tolerance = 1e-07) + expect_equal(y2CodeBased$averageSampleNumber0, y2$averageSampleNumber0, tolerance = 1e-07) + expect_type(names(y2), "character") + df <- as.data.frame(y2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(y2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignInverseNormal} + # @refFS[Formula]{fs:alphaSpendingConcept} + # @refFS[Formula]{fs:alphaSpendingKimDeMets} + # @refFS[Formula]{fs:betaSpendingApproach} + # @refFS[Formula]{fs:betaSpendingKimDeMets} + x3 <- getDesignInverseNormal( + kMax = 3, informationRates = c(0.3, 0.7, 1), + alpha = 0.03, sided = 1, beta = 0.34, typeOfDesign = "asKD", gammaA = 2.2, + typeBetaSpending = "bsKD", gammaB = 3.2 + ) + + ## Comparison of the results of TrialDesignInverseNormal object 'x3' with expected results + expect_equal(x3$power, c(0.058336437, 0.398246, 0.66), tolerance = 1e-07, label = paste0("c(", paste0(x3$power, collapse = ", "), ")")) + expect_equal(x3$futilityBounds, c(-1.1558435, 0.72836893), tolerance = 1e-07, label = paste0("c(", paste0(x3$futilityBounds, collapse = ", "), ")")) + expect_equal(x3$alphaSpent, c(0.0021222083, 0.013687904, 0.03), tolerance = 1e-07, label = paste0("c(", paste0(x3$alphaSpent, collapse = ", "), ")")) + expect_equal(x3$betaSpent, c(0.0072155083, 0.1085907, 0.34), tolerance = 1e-07, label = paste0("c(", paste0(x3$betaSpent, collapse = ", "), ")")) + expect_equal(x3$criticalValues, c(2.8594012, 2.2435708, 1.9735737), tolerance = 1e-07, label = paste0("c(", paste0(x3$criticalValues, collapse = ", "), ")")) + expect_equal(x3$stageLevels, c(0.0021222083, 0.012430014, 0.02421512), tolerance = 1e-07, label = paste0("c(", paste0(x3$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x3), NA))) + expect_output(print(x3)$show()) + invisible(capture.output(expect_error(summary(x3), NA))) + expect_output(summary(x3)$show()) + x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) + expect_equal(x3CodeBased$power, x3$power, tolerance = 1e-07) + expect_equal(x3CodeBased$futilityBounds, x3$futilityBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$alphaSpent, x3$alphaSpent, tolerance = 1e-07) + expect_equal(x3CodeBased$betaSpent, x3$betaSpent, tolerance = 1e-07) + expect_equal(x3CodeBased$criticalValues, x3$criticalValues, tolerance = 1e-07) + expect_equal(x3CodeBased$stageLevels, x3$stageLevels, tolerance = 1e-07) + expect_type(names(x3), "character") + df <- as.data.frame(x3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignCharacteristics} + # @refFS[Formula]{fs:inflationFactor} + # @refFS[Formula]{fs:expectedReduction} + y3 <- getDesignCharacteristics(x3) + + ## Comparison of the results of TrialDesignCharacteristics object 'y3' with expected results + expect_equal(y3$nFixed, 5.2590265, tolerance = 1e-07, label = paste0("c(", paste0(y3$nFixed, collapse = ", "), ")")) + expect_equal(y3$shift, 5.551371, tolerance = 1e-07, label = paste0("c(", paste0(y3$shift, collapse = ", "), ")")) + expect_equal(y3$inflationFactor, 1.0555891, tolerance = 1e-07, label = paste0("c(", paste0(y3$inflationFactor, collapse = ", "), ")")) + expect_equal(y3$information, c(1.6654113, 3.8859597, 5.551371), tolerance = 1e-07, label = paste0("c(", paste0(y3$information, collapse = ", "), ")")) + expect_equal(y3$power, c(0.058336437, 0.398246, 0.66), tolerance = 1e-07, label = paste0("c(", paste0(y3$power, collapse = ", "), ")")) + expect_equal(y3$rejectionProbabilities, c(0.058336437, 0.33990957, 0.261754), tolerance = 1e-07, label = paste0("c(", paste0(y3$rejectionProbabilities, collapse = ", "), ")")) + expect_equal(y3$futilityProbabilities, c(0.0072155083, 0.1013752), tolerance = 1e-07, label = paste0("c(", paste0(y3$futilityProbabilities, collapse = ", "), ")")) + expect_equal(y3$averageSampleNumber1, 0.86740735, tolerance = 1e-07, label = paste0("c(", paste0(y3$averageSampleNumber1, collapse = ", "), ")")) + expect_equal(y3$averageSampleNumber01, 0.87361707, tolerance = 1e-07, label = paste0("c(", paste0(y3$averageSampleNumber01, collapse = ", "), ")")) + expect_equal(y3$averageSampleNumber0, 0.75480974, tolerance = 1e-07, label = paste0("c(", paste0(y3$averageSampleNumber0, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(y3), NA))) + expect_output(print(y3)$show()) + invisible(capture.output(expect_error(summary(y3), NA))) + expect_output(summary(y3)$show()) + y3CodeBased <- eval(parse(text = getObjectRCode(y3, stringWrapParagraphWidth = NULL))) + expect_equal(y3CodeBased$nFixed, y3$nFixed, tolerance = 1e-07) + expect_equal(y3CodeBased$shift, y3$shift, tolerance = 1e-07) + expect_equal(y3CodeBased$inflationFactor, y3$inflationFactor, tolerance = 1e-07) + expect_equal(y3CodeBased$information, y3$information, tolerance = 1e-07) + expect_equal(y3CodeBased$power, y3$power, tolerance = 1e-07) + expect_equal(y3CodeBased$rejectionProbabilities, y3$rejectionProbabilities, tolerance = 1e-07) + expect_equal(y3CodeBased$futilityProbabilities, y3$futilityProbabilities, tolerance = 1e-07) + expect_equal(y3CodeBased$averageSampleNumber1, y3$averageSampleNumber1, tolerance = 1e-07) + expect_equal(y3CodeBased$averageSampleNumber01, y3$averageSampleNumber01, tolerance = 1e-07) + expect_equal(y3CodeBased$averageSampleNumber0, y3$averageSampleNumber0, tolerance = 1e-07) + expect_type(names(y3), "character") + df <- as.data.frame(y3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(y3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignInverseNormal' with binding futility bounds", { + + # @refFS[Tab.]{fs:tab:output:getDesignInverseNormal} + # @refFS[Formula]{fs:criticalValuesWithFutility} + # @refFS[Formula]{fs:criticalValuesWangTiatis} + x4 <- getDesignInverseNormal( + kMax = 4, alpha = 0.035, futilityBounds = rep(0.5244, 3), + bindingFutility = TRUE, typeOfDesign = "WT", deltaWT = 0.4 + ) + + ## Comparison of the results of TrialDesignInverseNormal object 'x4' with expected results + expect_equal(x4$alphaSpent, c(0.0099446089, 0.020756912, 0.029001537, 0.03499999), tolerance = 1e-07, label = paste0("c(", paste0(x4$alphaSpent, collapse = ", "), ")")) + expect_equal(x4$criticalValues, c(2.3284312, 2.1725031, 2.0861776, 2.0270171), tolerance = 1e-07, label = paste0("c(", paste0(x4$criticalValues, collapse = ", "), ")")) + expect_equal(x4$stageLevels, c(0.0099446089, 0.014908866, 0.018481267, 0.021330332), tolerance = 1e-07, label = paste0("c(", paste0(x4$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x4), NA))) + expect_output(print(x4)$show()) + invisible(capture.output(expect_error(summary(x4), NA))) + expect_output(summary(x4)$show()) + x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) + expect_equal(x4CodeBased$alphaSpent, x4$alphaSpent, tolerance = 1e-07) + expect_equal(x4CodeBased$criticalValues, x4$criticalValues, tolerance = 1e-07) + expect_equal(x4CodeBased$stageLevels, x4$stageLevels, tolerance = 1e-07) + expect_type(names(x4), "character") + df <- as.data.frame(x4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignGroupSequential' with type of design = 'asUser'", { + + .skipTestIfDisabled() + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:alphaSpendingConcept} + x5 <- getDesignGroupSequential( + typeOfDesign = "asUser", + userAlphaSpending = c(0.01, 0.02, 0.03, 0.05) + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x5' with expected results + expect_equal(x5$alphaSpent, c(0.01, 0.02, 0.03, 0.04999999), tolerance = 1e-07, label = paste0("c(", paste0(x5$alphaSpent, collapse = ", "), ")")) + expect_equal(x5$criticalValues, c(2.3263479, 2.2192994, 2.1201347, 1.8189562), tolerance = 1e-07, label = paste0("c(", paste0(x5$criticalValues, collapse = ", "), ")")) + expect_equal(x5$stageLevels, c(0.01, 0.01323318, 0.016997342, 0.034459057), tolerance = 1e-07, label = paste0("c(", paste0(x5$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x5), NA))) + expect_output(print(x5)$show()) + invisible(capture.output(expect_error(summary(x5), NA))) + expect_output(summary(x5)$show()) + x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) + expect_equal(x5CodeBased$alphaSpent, x5$alphaSpent, tolerance = 1e-07) + expect_equal(x5CodeBased$criticalValues, x5$criticalValues, tolerance = 1e-07) + expect_equal(x5CodeBased$stageLevels, x5$stageLevels, tolerance = 1e-07) + expect_type(names(x5), "character") + df <- as.data.frame(x5) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x5) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignGroupSequential' with type of design = 'asP' and 'bsUser' and non-binding futility bounds", { + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:alphaSpendingConcept} + # @refFS[Formula]{fs:alphaSpendingPocock} + # @refFS[Formula]{fs:betaSpendingApproach} + x6a <- getDesignGroupSequential( + kMax = 3, alpha = 0.13, + typeOfDesign = "asP", typeBetaSpending = "bsUser", + informationRates = c(0.35, 0.7, 1), + bindingFutility = FALSE, + userBetaSpending = c(0.01, 0.05, 0.3) + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x6a' with expected results + expect_equal(x6a$power, c(0.31774348, 0.5598179, 0.7), tolerance = 1e-07, label = paste0("c(", paste0(x6a$power, collapse = ", "), ")")) + expect_equal(x6a$futilityBounds, c(-1.2557044, -0.16828659), tolerance = 1e-07, label = paste0("c(", paste0(x6a$futilityBounds, collapse = ", "), ")")) + expect_equal(x6a$alphaSpent, c(0.061214062, 0.10266465, 0.13), tolerance = 1e-07, label = paste0("c(", paste0(x6a$alphaSpent, collapse = ", "), ")")) + expect_equal(x6a$betaSpent, c(0.01, 0.05, 0.3), tolerance = 1e-07, label = paste0("c(", paste0(x6a$betaSpent, collapse = ", "), ")")) + expect_equal(x6a$criticalValues, c(1.5446617, 1.4828682, 1.4620058), tolerance = 1e-07, label = paste0("c(", paste0(x6a$criticalValues, collapse = ", "), ")")) + expect_equal(x6a$stageLevels, c(0.061214062, 0.069054712, 0.071869812), tolerance = 1e-07, label = paste0("c(", paste0(x6a$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x6a), NA))) + expect_output(print(x6a)$show()) + invisible(capture.output(expect_error(summary(x6a), NA))) + expect_output(summary(x6a)$show()) + x6aCodeBased <- eval(parse(text = getObjectRCode(x6a, stringWrapParagraphWidth = NULL))) + expect_equal(x6aCodeBased$power, x6a$power, tolerance = 1e-07) + expect_equal(x6aCodeBased$futilityBounds, x6a$futilityBounds, tolerance = 1e-07) + expect_equal(x6aCodeBased$alphaSpent, x6a$alphaSpent, tolerance = 1e-07) + expect_equal(x6aCodeBased$betaSpent, x6a$betaSpent, tolerance = 1e-07) + expect_equal(x6aCodeBased$criticalValues, x6a$criticalValues, tolerance = 1e-07) + expect_equal(x6aCodeBased$stageLevels, x6a$stageLevels, tolerance = 1e-07) + expect_type(names(x6a), "character") + df <- as.data.frame(x6a) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x6a) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignGroupSequential' with type of design = 'asP' and information rate < 1 at maximum stage", { + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:alphaSpendingConcept} + # @refFS[Formula]{fs:alphaSpendingPocock} + x6b <- getDesignGroupSequential(informationRates = c(0.4, 0.7), typeOfDesign = "asP") + + ## Comparison of the results of TrialDesignGroupSequential object 'x6b' with expected results + expect_equal(x6b$alphaSpent, c(0.013078429, 0.0197432), tolerance = 1e-07, label = paste0("c(", paste0(x6b$alphaSpent, collapse = ", "), ")")) + expect_equal(x6b$criticalValues, c(2.223875, 2.3050796), tolerance = 1e-07, label = paste0("c(", paste0(x6b$criticalValues, collapse = ", "), ")")) + expect_equal(x6b$stageLevels, c(0.013078429, 0.010581057), tolerance = 1e-07, label = paste0("c(", paste0(x6b$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x6b), NA))) + expect_output(print(x6b)$show()) + invisible(capture.output(expect_error(summary(x6b), NA))) + expect_output(summary(x6b)$show()) + x6bCodeBased <- eval(parse(text = getObjectRCode(x6b, stringWrapParagraphWidth = NULL))) + expect_equal(x6bCodeBased$alphaSpent, x6b$alphaSpent, tolerance = 1e-07) + expect_equal(x6bCodeBased$criticalValues, x6b$criticalValues, tolerance = 1e-07) + expect_equal(x6bCodeBased$stageLevels, x6b$stageLevels, tolerance = 1e-07) + expect_type(names(x6b), "character") + df <- as.data.frame(x6b) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x6b) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignGroupSequential' with type of design = 'asOF' and 'bsKD' and non-binding futility bounds (kMax = 3)", { + + .skipTestIfDisabled() + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:alphaSpendingConcept} + # @refFS[Formula]{fs:alphaSpendingOBrienFleming} + # @refFS[Formula]{fs:betaSpendingApproach} + # @refFS[Formula]{fs:betaSpendingKimDeMets} + x7a <- getDesignGroupSequential( + kMax = 3, alpha = 0.13, beta = 0.41, + typeOfDesign = "asOF", typeBetaSpending = "bsKD", + informationRates = c(0.4, 0.75, 1), + gammaB = 2.5, bindingFutility = FALSE + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x7a' with expected results + expect_equal(x7a$power, c(0.10903632, 0.42541278, 0.59), tolerance = 1e-07, label = paste0("c(", paste0(x7a$power, collapse = ", "), ")")) + expect_equal(x7a$futilityBounds, c(-0.83725762, 0.35992547), tolerance = 1e-07, label = paste0("c(", paste0(x7a$futilityBounds, collapse = ", "), ")")) + expect_equal(x7a$alphaSpent, c(0.016665509, 0.080406163, 0.12999999), tolerance = 1e-07, label = paste0("c(", paste0(x7a$alphaSpent, collapse = ", "), ")")) + expect_equal(x7a$betaSpent, c(0.041489083, 0.19972711, 0.41), tolerance = 1e-07, label = paste0("c(", paste0(x7a$betaSpent, collapse = ", "), ")")) + expect_equal(x7a$criticalValues, c(2.1280732, 1.4368565, 1.2468994), tolerance = 1e-07, label = paste0("c(", paste0(x7a$criticalValues, collapse = ", "), ")")) + expect_equal(x7a$stageLevels, c(0.016665509, 0.075379384, 0.1062172), tolerance = 1e-07, label = paste0("c(", paste0(x7a$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x7a), NA))) + expect_output(print(x7a)$show()) + invisible(capture.output(expect_error(summary(x7a), NA))) + expect_output(summary(x7a)$show()) + x7aCodeBased <- eval(parse(text = getObjectRCode(x7a, stringWrapParagraphWidth = NULL))) + expect_equal(x7aCodeBased$power, x7a$power, tolerance = 1e-07) + expect_equal(x7aCodeBased$futilityBounds, x7a$futilityBounds, tolerance = 1e-07) + expect_equal(x7aCodeBased$alphaSpent, x7a$alphaSpent, tolerance = 1e-07) + expect_equal(x7aCodeBased$betaSpent, x7a$betaSpent, tolerance = 1e-07) + expect_equal(x7aCodeBased$criticalValues, x7a$criticalValues, tolerance = 1e-07) + expect_equal(x7aCodeBased$stageLevels, x7a$stageLevels, tolerance = 1e-07) + expect_type(names(x7a), "character") + df <- as.data.frame(x7a) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x7a) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignGroupSequential' with type of design = 'asOF' and 'bsKD' and non-binding futility bounds (kMax = 4)", { + + .skipTestIfDisabled() + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:alphaSpendingConcept} + # @refFS[Formula]{fs:alphaSpendingOBrienFleming} + # @refFS[Formula]{fs:betaSpendingApproach} + # @refFS[Formula]{fs:betaSpendingKimDeMets} + x7a <- getDesignGroupSequential( + kMax = 4, alpha = 0.13, beta = 0.41, + typeOfDesign = "asOF", typeBetaSpending = "bsKD", + informationRates = c(0.4, 0.75, 0.85, 1), + gammaB = 2.5, bindingFutility = FALSE + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x7a' with expected results + expect_equal(x7a$power, c(0.1110095, 0.43099683, 0.50326205, 0.59), tolerance = 1e-07, label = paste0("c(", paste0(x7a$power, collapse = ", "), ")")) + expect_equal(x7a$futilityBounds, c(-0.82676531, 0.3743303, 0.65077266), tolerance = 1e-07, label = paste0("c(", paste0(x7a$futilityBounds, collapse = ", "), ")")) + expect_equal(x7a$alphaSpent, c(0.016665509, 0.080406163, 0.10053322, 0.13), tolerance = 1e-07, label = paste0("c(", paste0(x7a$alphaSpent, collapse = ", "), ")")) + expect_equal(x7a$betaSpent, c(0.041489083, 0.19972711, 0.27310596, 0.41), tolerance = 1e-07, label = paste0("c(", paste0(x7a$betaSpent, collapse = ", "), ")")) + expect_equal(x7a$criticalValues, c(2.1280732, 1.4368565, 1.422873, 1.2970881), tolerance = 1e-07, label = paste0("c(", paste0(x7a$criticalValues, collapse = ", "), ")")) + expect_equal(x7a$stageLevels, c(0.016665509, 0.075379384, 0.077386492, 0.097300444), tolerance = 1e-07, label = paste0("c(", paste0(x7a$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x7a), NA))) + expect_output(print(x7a)$show()) + invisible(capture.output(expect_error(summary(x7a), NA))) + expect_output(summary(x7a)$show()) + x7aCodeBased <- eval(parse(text = getObjectRCode(x7a, stringWrapParagraphWidth = NULL))) + expect_equal(x7aCodeBased$power, x7a$power, tolerance = 1e-07) + expect_equal(x7aCodeBased$futilityBounds, x7a$futilityBounds, tolerance = 1e-07) + expect_equal(x7aCodeBased$alphaSpent, x7a$alphaSpent, tolerance = 1e-07) + expect_equal(x7aCodeBased$betaSpent, x7a$betaSpent, tolerance = 1e-07) + expect_equal(x7aCodeBased$criticalValues, x7a$criticalValues, tolerance = 1e-07) + expect_equal(x7aCodeBased$stageLevels, x7a$stageLevels, tolerance = 1e-07) + expect_type(names(x7a), "character") + df <- as.data.frame(x7a) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x7a) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignGroupSequential' with type of design = 'asP' and 'bsUser' and binding futility bounds", { + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:alphaSpendingConcept} + # @refFS[Formula]{fs:alphaSpendingPocock} + # @refFS[Formula]{fs:betaSpendingApproach} + x6b <- getDesignGroupSequential( + kMax = 3, alpha = 0.13, + typeOfDesign = "asP", typeBetaSpending = "bsUser", + informationRates = c(0.35, 0.7, 1), + bindingFutility = TRUE, + userBetaSpending = c(0.01, 0.05, 0.3) + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x6b' with expected results + expect_equal(x6b$power, c(0.31728597, 0.55917233, 0.7), tolerance = 1e-07, label = paste0("c(", paste0(x6b$power, collapse = ", "), ")")) + expect_equal(x6b$futilityBounds, c(-1.2569879, -0.17011271), tolerance = 1e-07, label = paste0("c(", paste0(x6b$futilityBounds, collapse = ", "), ")")) + expect_equal(x6b$alphaSpent, c(0.061214062, 0.10266465, 0.13), tolerance = 1e-07, label = paste0("c(", paste0(x6b$alphaSpent, collapse = ", "), ")")) + expect_equal(x6b$betaSpent, c(0.01, 0.05, 0.3), tolerance = 1e-07, label = paste0("c(", paste0(x6b$betaSpent, collapse = ", "), ")")) + expect_equal(x6b$criticalValues, c(1.5446617, 1.4827312, 1.4588737), tolerance = 1e-07, label = paste0("c(", paste0(x6b$criticalValues, collapse = ", "), ")")) + expect_equal(x6b$stageLevels, c(0.061214062, 0.069072925, 0.072299935), tolerance = 1e-07, label = paste0("c(", paste0(x6b$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x6b), NA))) + expect_output(print(x6b)$show()) + invisible(capture.output(expect_error(summary(x6b), NA))) + expect_output(summary(x6b)$show()) + x6bCodeBased <- eval(parse(text = getObjectRCode(x6b, stringWrapParagraphWidth = NULL))) + expect_equal(x6bCodeBased$power, x6b$power, tolerance = 1e-07) + expect_equal(x6bCodeBased$futilityBounds, x6b$futilityBounds, tolerance = 1e-07) + expect_equal(x6bCodeBased$alphaSpent, x6b$alphaSpent, tolerance = 1e-07) + expect_equal(x6bCodeBased$betaSpent, x6b$betaSpent, tolerance = 1e-07) + expect_equal(x6bCodeBased$criticalValues, x6b$criticalValues, tolerance = 1e-07) + expect_equal(x6bCodeBased$stageLevels, x6b$stageLevels, tolerance = 1e-07) + expect_type(names(x6b), "character") + df <- as.data.frame(x6b) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x6b) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignGroupSequential' with type of design = 'asOF' and 'bsKD' and binding futility bounds (kMax = 3)", { + + .skipTestIfDisabled() + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:alphaSpendingConcept} + # @refFS[Formula]{fs:alphaSpendingOBrienFleming} + # @refFS[Formula]{fs:betaSpendingApproach} + # @refFS[Formula]{fs:betaSpendingKimDeMets} + x7b <- getDesignGroupSequential( + kMax = 3, alpha = 0.13, beta = 0.41, + typeOfDesign = "asOF", typeBetaSpending = "bsKD", + informationRates = c(0.4, 0.75, 1), + gammaB = 2.5, bindingFutility = TRUE + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x7b' with expected results + expect_equal(x7b$power, c(0.1067887, 0.41918821, 0.59), tolerance = 1e-07, label = paste0("c(", paste0(x7b$power, collapse = ", "), ")")) + expect_equal(x7b$futilityBounds, c(-0.84937686, 0.34328914), tolerance = 1e-07, label = paste0("c(", paste0(x7b$futilityBounds, collapse = ", "), ")")) + expect_equal(x7b$alphaSpent, c(0.016665509, 0.080406163, 0.12999999), tolerance = 1e-07, label = paste0("c(", paste0(x7b$alphaSpent, collapse = ", "), ")")) + expect_equal(x7b$betaSpent, c(0.041489083, 0.19972711, 0.41), tolerance = 1e-07, label = paste0("c(", paste0(x7b$betaSpent, collapse = ", "), ")")) + expect_equal(x7b$criticalValues, c(2.1280732, 1.4362896, 1.2218662), tolerance = 1e-07, label = paste0("c(", paste0(x7b$criticalValues, collapse = ", "), ")")) + expect_equal(x7b$stageLevels, c(0.016665509, 0.075459972, 0.11087911), tolerance = 1e-07, label = paste0("c(", paste0(x7b$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x7b), NA))) + expect_output(print(x7b)$show()) + invisible(capture.output(expect_error(summary(x7b), NA))) + expect_output(summary(x7b)$show()) + x7bCodeBased <- eval(parse(text = getObjectRCode(x7b, stringWrapParagraphWidth = NULL))) + expect_equal(x7bCodeBased$power, x7b$power, tolerance = 1e-07) + expect_equal(x7bCodeBased$futilityBounds, x7b$futilityBounds, tolerance = 1e-07) + expect_equal(x7bCodeBased$alphaSpent, x7b$alphaSpent, tolerance = 1e-07) + expect_equal(x7bCodeBased$betaSpent, x7b$betaSpent, tolerance = 1e-07) + expect_equal(x7bCodeBased$criticalValues, x7b$criticalValues, tolerance = 1e-07) + expect_equal(x7bCodeBased$stageLevels, x7b$stageLevels, tolerance = 1e-07) + expect_type(names(x7b), "character") + df <- as.data.frame(x7b) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x7b) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignGroupSequential' with type of design = 'asOF' and 'bsKD' and binding futility bounds (kMax = 4)", { + + .skipTestIfDisabled() + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:alphaSpendingConcept} + # @refFS[Formula]{fs:alphaSpendingOBrienFleming} + # @refFS[Formula]{fs:betaSpendingApproach} + # @refFS[Formula]{fs:betaSpendingKimDeMets} + x7b <- getDesignGroupSequential( + kMax = 4, alpha = 0.13, beta = 0.41, + typeOfDesign = "asOF", typeBetaSpending = "bsKD", + informationRates = c(0.4, 0.75, 0.85, 1), + gammaB = 2.5, bindingFutility = TRUE + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x7b' with expected results + expect_equal(x7b$power, c(0.10806422, 0.422855, 0.4950578, 0.59), tolerance = 1e-07, label = paste0("c(", paste0(x7b$power, collapse = ", "), ")")) + expect_equal(x7b$futilityBounds, c(-0.84247693, 0.35276055, 0.62744509), tolerance = 1e-07, label = paste0("c(", paste0(x7b$futilityBounds, collapse = ", "), ")")) + expect_equal(x7b$alphaSpent, c(0.016665509, 0.080406163, 0.10053322, 0.13), tolerance = 1e-07, label = paste0("c(", paste0(x7b$alphaSpent, collapse = ", "), ")")) + expect_equal(x7b$betaSpent, c(0.041489083, 0.19972711, 0.27310596, 0.41), tolerance = 1e-07, label = paste0("c(", paste0(x7b$betaSpent, collapse = ", "), ")")) + expect_equal(x7b$criticalValues, c(2.1280732, 1.4362706, 1.4203748, 1.2576258), tolerance = 1e-07, label = paste0("c(", paste0(x7b$criticalValues, collapse = ", "), ")")) + expect_equal(x7b$stageLevels, c(0.016665509, 0.075462674, 0.077749297, 0.10426357), tolerance = 1e-07, label = paste0("c(", paste0(x7b$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x7b), NA))) + expect_output(print(x7b)$show()) + invisible(capture.output(expect_error(summary(x7b), NA))) + expect_output(summary(x7b)$show()) + x7bCodeBased <- eval(parse(text = getObjectRCode(x7b, stringWrapParagraphWidth = NULL))) + expect_equal(x7bCodeBased$power, x7b$power, tolerance = 1e-07) + expect_equal(x7bCodeBased$futilityBounds, x7b$futilityBounds, tolerance = 1e-07) + expect_equal(x7bCodeBased$alphaSpent, x7b$alphaSpent, tolerance = 1e-07) + expect_equal(x7bCodeBased$betaSpent, x7b$betaSpent, tolerance = 1e-07) + expect_equal(x7bCodeBased$criticalValues, x7b$criticalValues, tolerance = 1e-07) + expect_equal(x7bCodeBased$stageLevels, x7b$stageLevels, tolerance = 1e-07) + expect_type(names(x7b), "character") + df <- as.data.frame(x7b) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x7b) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignGroupSequential' with type of design = 'asOF' and 'bsKD' and binding futility bounds, two-sided (kMax = 3)", { + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:alphaSpendingConcept} + # @refFS[Formula]{fs:alphaSpendingOBrienFleming} + # @refFS[Formula]{fs:betaSpendingApproach} + # @refFS[Formula]{fs:betaSpendingKimDeMets} + # @refFS[Formula]{fs:betaSpendingApproachTwoSided} + # @refFS[Formula]{fs:betaSpendingAdjustment} + suppressWarnings(x7c <- getDesignGroupSequential( + kMax = 3, alpha = 0.09, beta = 0.11, sided = 2, + typeOfDesign = "asOF", typeBetaSpending = "bsKD", + informationRates = c(0.2, 0.55, 1), + gammaB = 2.5, bindingFutility = TRUE + )) + + ## Comparison of the results of TrialDesignGroupSequential object 'x7c' with expected results + expect_equal(x7c$power, c(0.0013105743, 0.39377047, 0.889997), tolerance = 1e-07, label = paste0("c(", paste0(x7c$power, collapse = ", "), ")")) + expect_equal(x7c$futilityBounds, c(NA_real_, 0.30419861), tolerance = 1e-07, label = paste0("c(", paste0(x7c$futilityBounds, collapse = ", "), ")")) + expect_equal(x7c$alphaSpent, c(1.475171e-05, 0.013740227, 0.09), tolerance = 1e-07, label = paste0("c(", paste0(x7c$alphaSpent, collapse = ", "), ")")) + expect_equal(x7c$betaSpent, c(0, 0.023123303, 0.11), tolerance = 1e-07, label = paste0("c(", paste0(x7c$betaSpent, collapse = ", "), ")")) + expect_equal(x7c$criticalValues, c(4.3323635, 2.4641251, 1.7013171), tolerance = 1e-07, label = paste0("c(", paste0(x7c$criticalValues, collapse = ", "), ")")) + expect_equal(x7c$stageLevels, c(7.375855e-06, 0.006867409, 0.044441733), tolerance = 1e-07, label = paste0("c(", paste0(x7c$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x7c), NA))) + expect_output(print(x7c)$show()) + invisible(capture.output(expect_error(summary(x7c), NA))) + expect_output(summary(x7c)$show()) + suppressWarnings(x7cCodeBased <- eval(parse(text = getObjectRCode(x7c, stringWrapParagraphWidth = NULL)))) + expect_equal(x7cCodeBased$power, x7c$power, tolerance = 1e-07) + expect_equal(x7cCodeBased$futilityBounds, x7c$futilityBounds, tolerance = 1e-07) + expect_equal(x7cCodeBased$alphaSpent, x7c$alphaSpent, tolerance = 1e-07) + expect_equal(x7cCodeBased$betaSpent, x7c$betaSpent, tolerance = 1e-07) + expect_equal(x7cCodeBased$criticalValues, x7c$criticalValues, tolerance = 1e-07) + expect_equal(x7cCodeBased$stageLevels, x7c$stageLevels, tolerance = 1e-07) + expect_type(names(x7c), "character") + df <- as.data.frame(x7c) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x7c) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + suppressWarnings(x7d <- getDesignGroupSequential( + kMax = 3, alpha = 0.05, beta = 0.2, sided = 2, + typeOfDesign = "asOF", typeBetaSpending = "bsKD", + informationRates = c(0.4, 0.65, 1), + gammaB = 1.5, bindingFutility = TRUE + )) + + ## Comparison of the results of TrialDesignGroupSequential object 'x7d' with expected results + expect_equal(x7d$power, c(0.063122463, 0.41229849, 0.79999885), tolerance = 1e-07, label = paste0("c(", paste0(x7d$power, collapse = ", "), ")")) + expect_equal(x7d$futilityBounds, c(0.32391511, 0.91946811), tolerance = 1e-07, label = paste0("c(", paste0(x7d$futilityBounds, collapse = ", "), ")")) + expect_equal(x7d$alphaSpent, c(0.00078830351, 0.010867832, 0.04999999), tolerance = 1e-07, label = paste0("c(", paste0(x7d$alphaSpent, collapse = ", "), ")")) + expect_equal(x7d$betaSpent, c(0.050596443, 0.10480935, 0.2), tolerance = 1e-07, label = paste0("c(", paste0(x7d$betaSpent, collapse = ", "), ")")) + expect_equal(x7d$criticalValues, c(3.3568694, 2.5549656, 1.9350784), tolerance = 1e-07, label = paste0("c(", paste0(x7d$criticalValues, collapse = ", "), ")")) + expect_equal(x7d$stageLevels, c(0.00039415176, 0.0053099152, 0.026490337), tolerance = 1e-07, label = paste0("c(", paste0(x7d$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x7d), NA))) + expect_output(print(x7d)$show()) + invisible(capture.output(expect_error(summary(x7d), NA))) + expect_output(summary(x7d)$show()) + suppressWarnings(x7dCodeBased <- eval(parse(text = getObjectRCode(x7d, stringWrapParagraphWidth = NULL)))) + expect_equal(x7dCodeBased$power, x7d$power, tolerance = 1e-07) + expect_equal(x7dCodeBased$futilityBounds, x7d$futilityBounds, tolerance = 1e-07) + expect_equal(x7dCodeBased$alphaSpent, x7d$alphaSpent, tolerance = 1e-07) + expect_equal(x7dCodeBased$betaSpent, x7d$betaSpent, tolerance = 1e-07) + expect_equal(x7dCodeBased$criticalValues, x7d$criticalValues, tolerance = 1e-07) + expect_equal(x7dCodeBased$stageLevels, x7d$stageLevels, tolerance = 1e-07) + expect_type(names(x7d), "character") + df <- as.data.frame(x7d) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x7d) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignGroupSequential' with type of design = 'asOF' and 'bsKD' and non-binding futility bounds, no betaAdjustment, two-sided (kMax = 3)", { + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:alphaSpendingConcept} + # @refFS[Formula]{fs:alphaSpendingOBrienFleming} + # @refFS[Formula]{fs:betaSpendingApproach} + # @refFS[Formula]{fs:betaSpendingKimDeMets} + # @refFS[Formula]{fs:betaSpendingApproachTwoSided} + # @refFS[Formula]{fs:betaSpendingAdjustment} + suppressWarnings(x7e <- getDesignGroupSequential( + kMax = 3, alpha = 0.09, beta = 0.11, sided = 2, + typeOfDesign = "asOF", typeBetaSpending = "bsKD", + informationRates = c(0.4, 0.65, 1), + betaAdjustment = FALSE, + gammaB = 2.5, bindingFutility = FALSE + )) + + ## Comparison of the results of TrialDesignGroupSequential object 'x7e' with expected results + expect_equal(x7e$power, c(0.14268064, 0.57037981, 0.88999701), tolerance = 1e-07, label = paste0("c(", paste0(x7e$power, collapse = ", "), ")")) + expect_equal(x7e$futilityBounds, c(NA_real_, 0.64692592), tolerance = 1e-07, label = paste0("c(", paste0(x7e$futilityBounds, collapse = ", "), ")")) + expect_equal(x7e$alphaSpent, c(0.0030525896, 0.025803646, 0.09), tolerance = 1e-07, label = paste0("c(", paste0(x7e$alphaSpent, collapse = ", "), ")")) + expect_equal(x7e$betaSpent, c(0, 0.037469343, 0.11), tolerance = 1e-07, label = paste0("c(", paste0(x7e$betaSpent, collapse = ", "), ")")) + expect_equal(x7e$criticalValues, c(2.9623919, 2.2442359, 1.7391729), tolerance = 1e-07, label = paste0("c(", paste0(x7e$criticalValues, collapse = ", "), ")")) + expect_equal(x7e$stageLevels, c(0.0015262948, 0.012408614, 0.041002179), tolerance = 1e-07, label = paste0("c(", paste0(x7e$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x7e), NA))) + expect_output(print(x7e)$show()) + invisible(capture.output(expect_error(summary(x7e), NA))) + expect_output(summary(x7e)$show()) + suppressWarnings(x7eCodeBased <- eval(parse(text = getObjectRCode(x7e, stringWrapParagraphWidth = NULL)))) + expect_equal(x7eCodeBased$power, x7e$power, tolerance = 1e-07) + expect_equal(x7eCodeBased$futilityBounds, x7e$futilityBounds, tolerance = 1e-07) + expect_equal(x7eCodeBased$alphaSpent, x7e$alphaSpent, tolerance = 1e-07) + expect_equal(x7eCodeBased$betaSpent, x7e$betaSpent, tolerance = 1e-07) + expect_equal(x7eCodeBased$criticalValues, x7e$criticalValues, tolerance = 1e-07) + expect_equal(x7eCodeBased$stageLevels, x7e$stageLevels, tolerance = 1e-07) + expect_type(names(x7e), "character") + df <- as.data.frame(x7e) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x7e) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignGroupSequential' with type of design = 'asOF' and 'bsOF', binding futility bounds and delayed response (kMax = 3)", { + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:alphaSpendingConcept} + # @refFS[Formula]{fs:alphaSpendingOBrienFleming} + # @refFS[Formula]{fs:betaSpendingApproach} + # @refFS[Formula]{fs:betaSpendingOBrienFleming} + # @refFS[Formula]{fs:delayedResponseCondition1} + # @refFS[Formula]{fs:delayedResponseCondition2} + # @refFS[Formula]{fs:delayedResponsePower} + suppressWarnings(dl1 <- getDesignGroupSequential( + kMax = 3, alpha = 0.05, beta = 0.1, sided = 1, + typeOfDesign = "asOF", typeBetaSpending = "bsOF", + informationRates = c(0.4, 0.65, 1), + bindingFutility = TRUE, + delayedInformation = c(0.1, 0.2) + )) + + ## Comparison of the results of TrialDesignGroupSequential object 'dl1' with expected results + expect_equal(dl1$power, c(0.15998522, 0.59313184, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl1$power, collapse = ", "), ")")) + expect_equal(dl1$futilityBounds, c(-0.46043472, 0.64445014), tolerance = 1e-07, label = paste0("c(", paste0(dl1$futilityBounds, collapse = ", "), ")")) + expect_equal(dl1$alphaSpent, c(0.001941913, 0.015055713, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(dl1$alphaSpent, collapse = ", "), ")")) + expect_equal(dl1$betaSpent, c(0.00930224, 0.041331422, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(dl1$betaSpent, collapse = ", "), ")")) + expect_equal(dl1$criticalValues, c(2.8874465, 2.1853011, 1.6575593), tolerance = 1e-07, label = paste0("c(", paste0(dl1$criticalValues, collapse = ", "), ")")) + expect_equal(dl1$stageLevels, c(0.001941913, 0.014433388, 0.048703222), tolerance = 1e-07, label = paste0("c(", paste0(dl1$stageLevels, collapse = ", "), ")")) + expect_equal(dl1$decisionCriticalValues, c(1.3388855, 1.5378695, 1.6575593), tolerance = 1e-07, label = paste0("c(", paste0(dl1$decisionCriticalValues, collapse = ", "), ")")) + expect_equal(dl1$reversalProbabilities, c(1.7563249e-06, 0.0014674026), tolerance = 1e-07, label = paste0("c(", paste0(dl1$reversalProbabilities, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dl1), NA))) + expect_output(print(dl1)$show()) + invisible(capture.output(expect_error(summary(dl1), NA))) + expect_output(summary(dl1)$show()) + suppressWarnings(dl1CodeBased <- eval(parse(text = getObjectRCode(dl1, stringWrapParagraphWidth = NULL)))) + expect_equal(dl1CodeBased$power, dl1$power, tolerance = 1e-07) + expect_equal(dl1CodeBased$futilityBounds, dl1$futilityBounds, tolerance = 1e-07) + expect_equal(dl1CodeBased$alphaSpent, dl1$alphaSpent, tolerance = 1e-07) + expect_equal(dl1CodeBased$betaSpent, dl1$betaSpent, tolerance = 1e-07) + expect_equal(dl1CodeBased$criticalValues, dl1$criticalValues, tolerance = 1e-07) + expect_equal(dl1CodeBased$stageLevels, dl1$stageLevels, tolerance = 1e-07) + expect_equal(dl1CodeBased$decisionCriticalValues, dl1$decisionCriticalValues, tolerance = 1e-07) + expect_equal(dl1CodeBased$reversalProbabilities, dl1$reversalProbabilities, tolerance = 1e-07) + expect_type(names(dl1), "character") + df <- as.data.frame(dl1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dl1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + dl2 <- getDesignCharacteristics(dl1) + + ## Comparison of the results of TrialDesignCharacteristics object 'dl2' with expected results + expect_equal(dl2$nFixed, 8.5638474, tolerance = 1e-07, label = paste0("c(", paste0(dl2$nFixed, collapse = ", "), ")")) + expect_equal(dl2$shift, 8.8633082, tolerance = 1e-07, label = paste0("c(", paste0(dl2$shift, collapse = ", "), ")")) + expect_equal(dl2$inflationFactor, 1.034968, tolerance = 1e-07, label = paste0("c(", paste0(dl2$inflationFactor, collapse = ", "), ")")) + expect_equal(dl2$information, c(3.5453233, 5.7611503, 8.8633082), tolerance = 1e-07, label = paste0("c(", paste0(dl2$information, collapse = ", "), ")")) + expect_equal(dl2$power, c(0.15755984, 0.59089729, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl2$power, collapse = ", "), ")")) + expect_equal(dl2$rejectionProbabilities, c(0.15755984, 0.43333745, 0.30910271), tolerance = 1e-07, label = paste0("c(", paste0(dl2$rejectionProbabilities, collapse = ", "), ")")) + expect_equal(dl2$futilityProbabilities, c(0.0095560402, 0.032904105), tolerance = 1e-07, label = paste0("c(", paste0(dl2$futilityProbabilities, collapse = ", "), ")")) + expect_equal(dl2$averageSampleNumber1, 0.87652961, tolerance = 1e-07, label = paste0("c(", paste0(dl2$averageSampleNumber1, collapse = ", "), ")")) + expect_equal(dl2$averageSampleNumber01, 0.92477729, tolerance = 1e-07, label = paste0("c(", paste0(dl2$averageSampleNumber01, collapse = ", "), ")")) + expect_equal(dl2$averageSampleNumber0, 0.79932679, tolerance = 1e-07, label = paste0("c(", paste0(dl2$averageSampleNumber0, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dl2), NA))) + expect_output(print(dl2)$show()) + invisible(capture.output(expect_error(summary(dl2), NA))) + expect_output(summary(dl2)$show()) + suppressWarnings(dl2CodeBased <- eval(parse(text = getObjectRCode(dl2, stringWrapParagraphWidth = NULL)))) + expect_equal(dl2CodeBased$nFixed, dl2$nFixed, tolerance = 1e-07) + expect_equal(dl2CodeBased$shift, dl2$shift, tolerance = 1e-07) + expect_equal(dl2CodeBased$inflationFactor, dl2$inflationFactor, tolerance = 1e-07) + expect_equal(dl2CodeBased$information, dl2$information, tolerance = 1e-07) + expect_equal(dl2CodeBased$power, dl2$power, tolerance = 1e-07) + expect_equal(dl2CodeBased$rejectionProbabilities, dl2$rejectionProbabilities, tolerance = 1e-07) + expect_equal(dl2CodeBased$futilityProbabilities, dl2$futilityProbabilities, tolerance = 1e-07) + expect_equal(dl2CodeBased$averageSampleNumber1, dl2$averageSampleNumber1, tolerance = 1e-07) + expect_equal(dl2CodeBased$averageSampleNumber01, dl2$averageSampleNumber01, tolerance = 1e-07) + expect_equal(dl2CodeBased$averageSampleNumber0, dl2$averageSampleNumber0, tolerance = 1e-07) + expect_type(names(dl2), "character") + df <- as.data.frame(dl2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dl2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + suppressWarnings(dl3 <- getDesignGroupSequential( + kMax = 3, alpha = 0.05, beta = 0.1, sided = 1, + typeOfDesign = "asOF", typeBetaSpending = "bsOF", + informationRates = c(0.4, 0.65, 1), + bindingFutility = TRUE, + delayedInformation = c(0, 0.2) + )) + + ## Comparison of the results of TrialDesignGroupSequential object 'dl3' with expected results + expect_equal(dl3$power, c(0.15998522, 0.59313184, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl3$power, collapse = ", "), ")")) + expect_equal(dl3$futilityBounds, c(-0.46043472, 0.64445014), tolerance = 1e-07, label = paste0("c(", paste0(dl3$futilityBounds, collapse = ", "), ")")) + expect_equal(dl3$alphaSpent, c(0.001941913, 0.015055713, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(dl3$alphaSpent, collapse = ", "), ")")) + expect_equal(dl3$betaSpent, c(0.00930224, 0.041331422, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(dl3$betaSpent, collapse = ", "), ")")) + expect_equal(dl3$criticalValues, c(2.8874465, 2.1853011, 1.6575593), tolerance = 1e-07, label = paste0("c(", paste0(dl3$criticalValues, collapse = ", "), ")")) + expect_equal(dl3$stageLevels, c(0.001941913, 0.014433388, 0.048703222), tolerance = 1e-07, label = paste0("c(", paste0(dl3$stageLevels, collapse = ", "), ")")) + expect_equal(dl3$decisionCriticalValues, c(NA_real_, 1.5378695, 1.6575593), tolerance = 1e-07, label = paste0("c(", paste0(dl3$decisionCriticalValues, collapse = ", "), ")")) + expect_equal(dl3$reversalProbabilities, c(NA_real_, 0.0014674026), tolerance = 1e-07, label = paste0("c(", paste0(dl3$reversalProbabilities, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dl3), NA))) + expect_output(print(dl3)$show()) + invisible(capture.output(expect_error(summary(dl3), NA))) + expect_output(summary(dl3)$show()) + suppressWarnings(dl3CodeBased <- eval(parse(text = getObjectRCode(dl3, stringWrapParagraphWidth = NULL)))) + expect_equal(dl3CodeBased$power, dl3$power, tolerance = 1e-07) + expect_equal(dl3CodeBased$futilityBounds, dl3$futilityBounds, tolerance = 1e-07) + expect_equal(dl3CodeBased$alphaSpent, dl3$alphaSpent, tolerance = 1e-07) + expect_equal(dl3CodeBased$betaSpent, dl3$betaSpent, tolerance = 1e-07) + expect_equal(dl3CodeBased$criticalValues, dl3$criticalValues, tolerance = 1e-07) + expect_equal(dl3CodeBased$stageLevels, dl3$stageLevels, tolerance = 1e-07) + expect_equal(dl3CodeBased$decisionCriticalValues, dl3$decisionCriticalValues, tolerance = 1e-07) + expect_equal(dl3CodeBased$reversalProbabilities, dl3$reversalProbabilities, tolerance = 1e-07) + expect_type(names(dl3), "character") + df <- as.data.frame(dl3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dl3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + dl4 <- getDesignCharacteristics(dl3) + + ## Comparison of the results of TrialDesignCharacteristics object 'dl4' with expected results + expect_equal(dl4$nFixed, 8.5638474, tolerance = 1e-07, label = paste0("c(", paste0(dl4$nFixed, collapse = ", "), ")")) + expect_equal(dl4$shift, 8.8633608, tolerance = 1e-07, label = paste0("c(", paste0(dl4$shift, collapse = ", "), ")")) + expect_equal(dl4$inflationFactor, 1.0349742, tolerance = 1e-07, label = paste0("c(", paste0(dl4$inflationFactor, collapse = ", "), ")")) + expect_equal(dl4$information, c(3.5453443, 5.7611845, 8.8633608), tolerance = 1e-07, label = paste0("c(", paste0(dl4$information, collapse = ", "), ")")) + expect_equal(dl4$power, c(0.15755967, 0.59089852, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl4$power, collapse = ", "), ")")) + expect_equal(dl4$rejectionProbabilities, c(0.15755967, 0.43333886, 0.30910148), tolerance = 1e-07, label = paste0("c(", paste0(dl4$rejectionProbabilities, collapse = ", "), ")")) + expect_equal(dl4$futilityProbabilities, c(0.0095558971, 0.032903612), tolerance = 1e-07, label = paste0("c(", paste0(dl4$futilityProbabilities, collapse = ", "), ")")) + expect_equal(dl4$averageSampleNumber1, 0.85923802, tolerance = 1e-07, label = paste0("c(", paste0(dl4$averageSampleNumber1, collapse = ", "), ")")) + expect_equal(dl4$averageSampleNumber01, 0.91378094, tolerance = 1e-07, label = paste0("c(", paste0(dl4$averageSampleNumber01, collapse = ", "), ")")) + expect_equal(dl4$averageSampleNumber0, 0.76574207, tolerance = 1e-07, label = paste0("c(", paste0(dl4$averageSampleNumber0, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dl4), NA))) + expect_output(print(dl4)$show()) + invisible(capture.output(expect_error(summary(dl4), NA))) + expect_output(summary(dl4)$show()) + suppressWarnings(dl4CodeBased <- eval(parse(text = getObjectRCode(dl4, stringWrapParagraphWidth = NULL)))) + expect_equal(dl4CodeBased$nFixed, dl4$nFixed, tolerance = 1e-07) + expect_equal(dl4CodeBased$shift, dl4$shift, tolerance = 1e-07) + expect_equal(dl4CodeBased$inflationFactor, dl4$inflationFactor, tolerance = 1e-07) + expect_equal(dl4CodeBased$information, dl4$information, tolerance = 1e-07) + expect_equal(dl4CodeBased$power, dl4$power, tolerance = 1e-07) + expect_equal(dl4CodeBased$rejectionProbabilities, dl4$rejectionProbabilities, tolerance = 1e-07) + expect_equal(dl4CodeBased$futilityProbabilities, dl4$futilityProbabilities, tolerance = 1e-07) + expect_equal(dl4CodeBased$averageSampleNumber1, dl4$averageSampleNumber1, tolerance = 1e-07) + expect_equal(dl4CodeBased$averageSampleNumber01, dl4$averageSampleNumber01, tolerance = 1e-07) + expect_equal(dl4CodeBased$averageSampleNumber0, dl4$averageSampleNumber0, tolerance = 1e-07) + expect_type(names(dl4), "character") + df <- as.data.frame(dl4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dl4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + suppressWarnings(dl5 <- getDesignGroupSequential( + kMax = 3, alpha = 0.05, beta = 0.1, sided = 1, + typeOfDesign = "asOF", typeBetaSpending = "bsOF", + informationRates = c(0.4, 0.65, 1), + bindingFutility = TRUE, + delayedInformation = 0.3 + )) + + ## Comparison of the results of TrialDesignGroupSequential object 'dl5' with expected results + expect_equal(dl5$power, c(0.15998522, 0.59313184, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl5$power, collapse = ", "), ")")) + expect_equal(dl5$futilityBounds, c(-0.46043472, 0.64445014), tolerance = 1e-07, label = paste0("c(", paste0(dl5$futilityBounds, collapse = ", "), ")")) + expect_equal(dl5$alphaSpent, c(0.001941913, 0.015055713, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(dl5$alphaSpent, collapse = ", "), ")")) + expect_equal(dl5$betaSpent, c(0.00930224, 0.041331422, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(dl5$betaSpent, collapse = ", "), ")")) + expect_equal(dl5$criticalValues, c(2.8874465, 2.1853011, 1.6575593), tolerance = 1e-07, label = paste0("c(", paste0(dl5$criticalValues, collapse = ", "), ")")) + expect_equal(dl5$stageLevels, c(0.001941913, 0.014433388, 0.048703222), tolerance = 1e-07, label = paste0("c(", paste0(dl5$stageLevels, collapse = ", "), ")")) + expect_equal(dl5$decisionCriticalValues, c(1.505831, 1.5735979, 1.6575593), tolerance = 1e-07, label = paste0("c(", paste0(dl5$decisionCriticalValues, collapse = ", "), ")")) + expect_equal(dl5$reversalProbabilities, c(0.00018341474, 0.0027022502), tolerance = 1e-07, label = paste0("c(", paste0(dl5$reversalProbabilities, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dl5), NA))) + expect_output(print(dl5)$show()) + invisible(capture.output(expect_error(summary(dl5), NA))) + expect_output(summary(dl5)$show()) + suppressWarnings(dl5CodeBased <- eval(parse(text = getObjectRCode(dl5, stringWrapParagraphWidth = NULL)))) + expect_equal(dl5CodeBased$power, dl5$power, tolerance = 1e-07) + expect_equal(dl5CodeBased$futilityBounds, dl5$futilityBounds, tolerance = 1e-07) + expect_equal(dl5CodeBased$alphaSpent, dl5$alphaSpent, tolerance = 1e-07) + expect_equal(dl5CodeBased$betaSpent, dl5$betaSpent, tolerance = 1e-07) + expect_equal(dl5CodeBased$criticalValues, dl5$criticalValues, tolerance = 1e-07) + expect_equal(dl5CodeBased$stageLevels, dl5$stageLevels, tolerance = 1e-07) + expect_equal(dl5CodeBased$decisionCriticalValues, dl5$decisionCriticalValues, tolerance = 1e-07) + expect_equal(dl5CodeBased$reversalProbabilities, dl5$reversalProbabilities, tolerance = 1e-07) + expect_type(names(dl5), "character") + df <- as.data.frame(dl5) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dl5) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + dl6 <- getDesignCharacteristics(dl5) + + ## Comparison of the results of TrialDesignCharacteristics object 'dl6' with expected results + expect_equal(dl6$nFixed, 8.5638474, tolerance = 1e-07, label = paste0("c(", paste0(dl6$nFixed, collapse = ", "), ")")) + expect_equal(dl6$shift, 8.7180222, tolerance = 1e-07, label = paste0("c(", paste0(dl6$shift, collapse = ", "), ")")) + expect_equal(dl6$inflationFactor, 1.018003, tolerance = 1e-07, label = paste0("c(", paste0(dl6$inflationFactor, collapse = ", "), ")")) + expect_equal(dl6$information, c(3.4872089, 5.6667144, 8.7180222), tolerance = 1e-07, label = paste0("c(", paste0(dl6$information, collapse = ", "), ")")) + expect_equal(dl6$power, c(0.15429254, 0.58752252, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl6$power, collapse = ", "), ")")) + expect_equal(dl6$rejectionProbabilities, c(0.15429254, 0.43322998, 0.31247748), tolerance = 1e-07, label = paste0("c(", paste0(dl6$rejectionProbabilities, collapse = ", "), ")")) + expect_equal(dl6$futilityProbabilities, c(0.0099602552, 0.03429374), tolerance = 1e-07, label = paste0("c(", paste0(dl6$futilityProbabilities, collapse = ", "), ")")) + expect_equal(dl6$averageSampleNumber1, 0.94451255, tolerance = 1e-07, label = paste0("c(", paste0(dl6$averageSampleNumber1, collapse = ", "), ")")) + expect_equal(dl6$averageSampleNumber01, 0.96721799, tolerance = 1e-07, label = paste0("c(", paste0(dl6$averageSampleNumber01, collapse = ", "), ")")) + expect_equal(dl6$averageSampleNumber0, 0.89669187, tolerance = 1e-07, label = paste0("c(", paste0(dl6$averageSampleNumber0, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dl6), NA))) + expect_output(print(dl6)$show()) + invisible(capture.output(expect_error(summary(dl6), NA))) + expect_output(summary(dl6)$show()) + suppressWarnings(dl6CodeBased <- eval(parse(text = getObjectRCode(dl6, stringWrapParagraphWidth = NULL)))) + expect_equal(dl6CodeBased$nFixed, dl6$nFixed, tolerance = 1e-07) + expect_equal(dl6CodeBased$shift, dl6$shift, tolerance = 1e-07) + expect_equal(dl6CodeBased$inflationFactor, dl6$inflationFactor, tolerance = 1e-07) + expect_equal(dl6CodeBased$information, dl6$information, tolerance = 1e-07) + expect_equal(dl6CodeBased$power, dl6$power, tolerance = 1e-07) + expect_equal(dl6CodeBased$rejectionProbabilities, dl6$rejectionProbabilities, tolerance = 1e-07) + expect_equal(dl6CodeBased$futilityProbabilities, dl6$futilityProbabilities, tolerance = 1e-07) + expect_equal(dl6CodeBased$averageSampleNumber1, dl6$averageSampleNumber1, tolerance = 1e-07) + expect_equal(dl6CodeBased$averageSampleNumber01, dl6$averageSampleNumber01, tolerance = 1e-07) + expect_equal(dl6CodeBased$averageSampleNumber0, dl6$averageSampleNumber0, tolerance = 1e-07) + expect_type(names(dl6), "character") + df <- as.data.frame(dl6) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dl6) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignGroupSequential' with type of design = 'asP' and 'bsP', non-binding futility bounds and delayed response (kMax = 3)", { + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:alphaSpendingConcept} + # @refFS[Formula]{fs:alphaSpendingOBrienFleming} + # @refFS[Formula]{fs:betaSpendingApproach} + # @refFS[Formula]{fs:betaSpendingOBrienFleming} + # @refFS[Formula]{fs:delayedResponseCondition1} + # @refFS[Formula]{fs:delayedResponseCondition2} + # @refFS[Formula]{fs:delayedResponsePower} + suppressWarnings(dl1 <- getDesignGroupSequential( + kMax = 3, alpha = 0.05, beta = 0.1, sided = 1, + typeOfDesign = "asP", typeBetaSpending = "bsP", + informationRates = c(0.4, 0.65, 1), + bindingFutility = FALSE, + delayedInformation = c(0.1, 0.2) + )) + + ## Comparison of the results of TrialDesignGroupSequential object 'dl1' with expected results + expect_equal(dl1$power, c(0.58983431, 0.79279807, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl1$power, collapse = ", "), ")")) + expect_equal(dl1$futilityBounds, c(0.5448398, 1.0899149), tolerance = 1e-07, label = paste0("c(", paste0(dl1$futilityBounds, collapse = ", "), ")")) + expect_equal(dl1$alphaSpent, c(0.026156858, 0.037497241, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(dl1$alphaSpent, collapse = ", "), ")")) + expect_equal(dl1$betaSpent, c(0.052313716, 0.074994481, 0.099999999), tolerance = 1e-07, label = paste0("c(", paste0(dl1$betaSpent, collapse = ", "), ")")) + expect_equal(dl1$criticalValues, c(1.9405431, 2.0327662, 1.9734104), tolerance = 1e-07, label = paste0("c(", paste0(dl1$criticalValues, collapse = ", "), ")")) + expect_equal(dl1$stageLevels, c(0.026156858, 0.021038075, 0.02422441), tolerance = 1e-07, label = paste0("c(", paste0(dl1$stageLevels, collapse = ", "), ")")) + expect_equal(dl1$decisionCriticalValues, c(1.3362296, 1.657468, 1.9734104), tolerance = 1e-07, label = paste0("c(", paste0(dl1$decisionCriticalValues, collapse = ", "), ")")) + expect_equal(dl1$reversalProbabilities, c(0.0020439695, 0.0026967589), tolerance = 1e-07, label = paste0("c(", paste0(dl1$reversalProbabilities, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dl1), NA))) + expect_output(print(dl1)$show()) + invisible(capture.output(expect_error(summary(dl1), NA))) + expect_output(summary(dl1)$show()) + suppressWarnings(dl1CodeBased <- eval(parse(text = getObjectRCode(dl1, stringWrapParagraphWidth = NULL)))) + expect_equal(dl1CodeBased$power, dl1$power, tolerance = 1e-07) + expect_equal(dl1CodeBased$futilityBounds, dl1$futilityBounds, tolerance = 1e-07) + expect_equal(dl1CodeBased$alphaSpent, dl1$alphaSpent, tolerance = 1e-07) + expect_equal(dl1CodeBased$betaSpent, dl1$betaSpent, tolerance = 1e-07) + expect_equal(dl1CodeBased$criticalValues, dl1$criticalValues, tolerance = 1e-07) + expect_equal(dl1CodeBased$stageLevels, dl1$stageLevels, tolerance = 1e-07) + expect_equal(dl1CodeBased$decisionCriticalValues, dl1$decisionCriticalValues, tolerance = 1e-07) + expect_equal(dl1CodeBased$reversalProbabilities, dl1$reversalProbabilities, tolerance = 1e-07) + expect_type(names(dl1), "character") + df <- as.data.frame(dl1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dl1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + dl2 <- getDesignCharacteristics(dl1) + + ## Comparison of the results of TrialDesignCharacteristics object 'dl2' with expected results + expect_equal(dl2$nFixed, 8.5638474, tolerance = 1e-07, label = paste0("c(", paste0(dl2$nFixed, collapse = ", "), ")")) + expect_equal(dl2$shift, 11.345796, tolerance = 1e-07, label = paste0("c(", paste0(dl2$shift, collapse = ", "), ")")) + expect_equal(dl2$inflationFactor, 1.324848, tolerance = 1e-07, label = paste0("c(", paste0(dl2$inflationFactor, collapse = ", "), ")")) + expect_equal(dl2$information, c(4.5383183, 7.3747672, 11.345796), tolerance = 1e-07, label = paste0("c(", paste0(dl2$information, collapse = ", "), ")")) + expect_equal(dl2$power, c(0.57788702, 0.78847934, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl2$power, collapse = ", "), ")")) + expect_equal(dl2$rejectionProbabilities, c(0.57788702, 0.21059232, 0.11152066), tolerance = 1e-07, label = paste0("c(", paste0(dl2$rejectionProbabilities, collapse = ", "), ")")) + expect_equal(dl2$futilityProbabilities, c(0.056427171, 0.024888086), tolerance = 1e-07, label = paste0("c(", paste0(dl2$futilityProbabilities, collapse = ", "), ")")) + expect_equal(dl2$averageSampleNumber1, 0.86088771, tolerance = 1e-07, label = paste0("c(", paste0(dl2$averageSampleNumber1, collapse = ", "), ")")) + expect_equal(dl2$averageSampleNumber01, 0.9483049, tolerance = 1e-07, label = paste0("c(", paste0(dl2$averageSampleNumber01, collapse = ", "), ")")) + expect_equal(dl2$averageSampleNumber0, 0.80259202, tolerance = 1e-07, label = paste0("c(", paste0(dl2$averageSampleNumber0, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dl2), NA))) + expect_output(print(dl2)$show()) + invisible(capture.output(expect_error(summary(dl2), NA))) + expect_output(summary(dl2)$show()) + suppressWarnings(dl2CodeBased <- eval(parse(text = getObjectRCode(dl2, stringWrapParagraphWidth = NULL)))) + expect_equal(dl2CodeBased$nFixed, dl2$nFixed, tolerance = 1e-07) + expect_equal(dl2CodeBased$shift, dl2$shift, tolerance = 1e-07) + expect_equal(dl2CodeBased$inflationFactor, dl2$inflationFactor, tolerance = 1e-07) + expect_equal(dl2CodeBased$information, dl2$information, tolerance = 1e-07) + expect_equal(dl2CodeBased$power, dl2$power, tolerance = 1e-07) + expect_equal(dl2CodeBased$rejectionProbabilities, dl2$rejectionProbabilities, tolerance = 1e-07) + expect_equal(dl2CodeBased$futilityProbabilities, dl2$futilityProbabilities, tolerance = 1e-07) + expect_equal(dl2CodeBased$averageSampleNumber1, dl2$averageSampleNumber1, tolerance = 1e-07) + expect_equal(dl2CodeBased$averageSampleNumber01, dl2$averageSampleNumber01, tolerance = 1e-07) + expect_equal(dl2CodeBased$averageSampleNumber0, dl2$averageSampleNumber0, tolerance = 1e-07) + expect_type(names(dl2), "character") + df <- as.data.frame(dl2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dl2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + suppressWarnings(dl3 <- getDesignGroupSequential( + kMax = 3, alpha = 0.05, beta = 0.1, sided = 1, + typeOfDesign = "asP", typeBetaSpending = "bsP", + informationRates = c(0.4, 0.65, 1), + bindingFutility = FALSE, + delayedInformation = c(0, 0.2) + )) + + ## Comparison of the results of TrialDesignGroupSequential object 'dl3' with expected results + expect_equal(dl3$power, c(0.58983431, 0.79279807, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl3$power, collapse = ", "), ")")) + expect_equal(dl3$futilityBounds, c(0.5448398, 1.0899149), tolerance = 1e-07, label = paste0("c(", paste0(dl3$futilityBounds, collapse = ", "), ")")) + expect_equal(dl3$alphaSpent, c(0.026156858, 0.037497241, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(dl3$alphaSpent, collapse = ", "), ")")) + expect_equal(dl3$betaSpent, c(0.052313716, 0.074994481, 0.099999999), tolerance = 1e-07, label = paste0("c(", paste0(dl3$betaSpent, collapse = ", "), ")")) + expect_equal(dl3$criticalValues, c(1.9405431, 2.0327662, 1.9734104), tolerance = 1e-07, label = paste0("c(", paste0(dl3$criticalValues, collapse = ", "), ")")) + expect_equal(dl3$stageLevels, c(0.026156858, 0.021038075, 0.02422441), tolerance = 1e-07, label = paste0("c(", paste0(dl3$stageLevels, collapse = ", "), ")")) + expect_equal(dl3$decisionCriticalValues, c(NA_real_, 1.657468, 1.9734104), tolerance = 1e-07, label = paste0("c(", paste0(dl3$decisionCriticalValues, collapse = ", "), ")")) + expect_equal(dl3$reversalProbabilities, c(NA_real_, 0.0026967589), tolerance = 1e-07, label = paste0("c(", paste0(dl3$reversalProbabilities, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dl3), NA))) + expect_output(print(dl3)$show()) + invisible(capture.output(expect_error(summary(dl3), NA))) + expect_output(summary(dl3)$show()) + suppressWarnings(dl3CodeBased <- eval(parse(text = getObjectRCode(dl3, stringWrapParagraphWidth = NULL)))) + expect_equal(dl3CodeBased$power, dl3$power, tolerance = 1e-07) + expect_equal(dl3CodeBased$futilityBounds, dl3$futilityBounds, tolerance = 1e-07) + expect_equal(dl3CodeBased$alphaSpent, dl3$alphaSpent, tolerance = 1e-07) + expect_equal(dl3CodeBased$betaSpent, dl3$betaSpent, tolerance = 1e-07) + expect_equal(dl3CodeBased$criticalValues, dl3$criticalValues, tolerance = 1e-07) + expect_equal(dl3CodeBased$stageLevels, dl3$stageLevels, tolerance = 1e-07) + expect_equal(dl3CodeBased$decisionCriticalValues, dl3$decisionCriticalValues, tolerance = 1e-07) + expect_equal(dl3CodeBased$reversalProbabilities, dl3$reversalProbabilities, tolerance = 1e-07) + expect_type(names(dl3), "character") + df <- as.data.frame(dl3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dl3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + dl4 <- getDesignCharacteristics(dl3) + + ## Comparison of the results of TrialDesignCharacteristics object 'dl4' with expected results + expect_equal(dl4$nFixed, 8.5638474, tolerance = 1e-07, label = paste0("c(", paste0(dl4$nFixed, collapse = ", "), ")")) + expect_equal(dl4$shift, 11.462579, tolerance = 1e-07, label = paste0("c(", paste0(dl4$shift, collapse = ", "), ")")) + expect_equal(dl4$inflationFactor, 1.3384848, tolerance = 1e-07, label = paste0("c(", paste0(dl4$inflationFactor, collapse = ", "), ")")) + expect_equal(dl4$information, c(4.5850317, 7.4506765, 11.462579), tolerance = 1e-07, label = paste0("c(", paste0(dl4$information, collapse = ", "), ")")) + expect_equal(dl4$power, c(0.57954342, 0.78973163, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl4$power, collapse = ", "), ")")) + expect_equal(dl4$rejectionProbabilities, c(0.57954342, 0.21018821, 0.11026837), tolerance = 1e-07, label = paste0("c(", paste0(dl4$rejectionProbabilities, collapse = ", "), ")")) + expect_equal(dl4$futilityProbabilities, c(0.055196532, 0.024225352), tolerance = 1e-07, label = paste0("c(", paste0(dl4$futilityProbabilities, collapse = ", "), ")")) + expect_equal(dl4$averageSampleNumber1, 0.7829433, tolerance = 1e-07, label = paste0("c(", paste0(dl4$averageSampleNumber1, collapse = ", "), ")")) + expect_equal(dl4$averageSampleNumber01, 0.89251343, tolerance = 1e-07, label = paste0("c(", paste0(dl4$averageSampleNumber01, collapse = ", "), ")")) + expect_equal(dl4$averageSampleNumber0, 0.71271214, tolerance = 1e-07, label = paste0("c(", paste0(dl4$averageSampleNumber0, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dl4), NA))) + expect_output(print(dl4)$show()) + invisible(capture.output(expect_error(summary(dl4), NA))) + expect_output(summary(dl4)$show()) + suppressWarnings(dl4CodeBased <- eval(parse(text = getObjectRCode(dl4, stringWrapParagraphWidth = NULL)))) + expect_equal(dl4CodeBased$nFixed, dl4$nFixed, tolerance = 1e-07) + expect_equal(dl4CodeBased$shift, dl4$shift, tolerance = 1e-07) + expect_equal(dl4CodeBased$inflationFactor, dl4$inflationFactor, tolerance = 1e-07) + expect_equal(dl4CodeBased$information, dl4$information, tolerance = 1e-07) + expect_equal(dl4CodeBased$power, dl4$power, tolerance = 1e-07) + expect_equal(dl4CodeBased$rejectionProbabilities, dl4$rejectionProbabilities, tolerance = 1e-07) + expect_equal(dl4CodeBased$futilityProbabilities, dl4$futilityProbabilities, tolerance = 1e-07) + expect_equal(dl4CodeBased$averageSampleNumber1, dl4$averageSampleNumber1, tolerance = 1e-07) + expect_equal(dl4CodeBased$averageSampleNumber01, dl4$averageSampleNumber01, tolerance = 1e-07) + expect_equal(dl4CodeBased$averageSampleNumber0, dl4$averageSampleNumber0, tolerance = 1e-07) + expect_type(names(dl4), "character") + df <- as.data.frame(dl4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dl4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + expect_warning( + dl5 <- getDesignGroupSequential( + kMax = 3, alpha = 0.05, beta = 0.1, sided = 1, + typeOfDesign = "asP", typeBetaSpending = "bsP", + informationRates = c(0.4, 0.65, 1), + bindingFutility = FALSE, + delayedInformation = 0 + ) + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'dl5' with expected results + expect_equal(dl5$power, c(0.58983431, 0.79279807, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl5$power, collapse = ", "), ")")) + expect_equal(dl5$futilityBounds, c(0.5448398, 1.0899149), tolerance = 1e-07, label = paste0("c(", paste0(dl5$futilityBounds, collapse = ", "), ")")) + expect_equal(dl5$alphaSpent, c(0.026156858, 0.037497241, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(dl5$alphaSpent, collapse = ", "), ")")) + expect_equal(dl5$betaSpent, c(0.052313716, 0.074994481, 0.099999999), tolerance = 1e-07, label = paste0("c(", paste0(dl5$betaSpent, collapse = ", "), ")")) + expect_equal(dl5$criticalValues, c(1.9405431, 2.0327662, 1.9734104), tolerance = 1e-07, label = paste0("c(", paste0(dl5$criticalValues, collapse = ", "), ")")) + expect_equal(dl5$stageLevels, c(0.026156858, 0.021038075, 0.02422441), tolerance = 1e-07, label = paste0("c(", paste0(dl5$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dl5), NA))) + expect_output(print(dl5)$show()) + invisible(capture.output(expect_error(summary(dl5), NA))) + expect_output(summary(dl5)$show()) + suppressWarnings(dl5CodeBased <- eval(parse(text = getObjectRCode(dl5, stringWrapParagraphWidth = NULL)))) + expect_equal(dl5CodeBased$power, dl5$power, tolerance = 1e-07) + expect_equal(dl5CodeBased$futilityBounds, dl5$futilityBounds, tolerance = 1e-07) + expect_equal(dl5CodeBased$alphaSpent, dl5$alphaSpent, tolerance = 1e-07) + expect_equal(dl5CodeBased$betaSpent, dl5$betaSpent, tolerance = 1e-07) + expect_equal(dl5CodeBased$criticalValues, dl5$criticalValues, tolerance = 1e-07) + expect_equal(dl5CodeBased$stageLevels, dl5$stageLevels, tolerance = 1e-07) + expect_type(names(dl5), "character") + df <- as.data.frame(dl5) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dl5) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + dl6 <- getDesignCharacteristics(dl5) + + ## Comparison of the results of TrialDesignCharacteristics object 'dl6' with expected results + expect_equal(dl6$nFixed, 8.5638474, tolerance = 1e-07, label = paste0("c(", paste0(dl6$nFixed, collapse = ", "), ")")) + expect_equal(dl6$shift, 11.746896, tolerance = 1e-07, label = paste0("c(", paste0(dl6$shift, collapse = ", "), ")")) + expect_equal(dl6$inflationFactor, 1.3716844, tolerance = 1e-07, label = paste0("c(", paste0(dl6$inflationFactor, collapse = ", "), ")")) + expect_equal(dl6$information, c(4.6987583, 7.6354822, 11.746896), tolerance = 1e-07, label = paste0("c(", paste0(dl6$information, collapse = ", "), ")")) + expect_equal(dl6$power, c(0.58983431, 0.79279807, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl6$power, collapse = ", "), ")")) + expect_equal(dl6$rejectionProbabilities, c(0.58983431, 0.20296375, 0.10720193), tolerance = 1e-07, label = paste0("c(", paste0(dl6$rejectionProbabilities, collapse = ", "), ")")) + expect_equal(dl6$futilityProbabilities, c(0.052313716, 0.022680765), tolerance = 1e-07, label = paste0("c(", paste0(dl6$futilityProbabilities, collapse = ", "), ")")) + expect_equal(dl6$averageSampleNumber1, 0.73486016, tolerance = 1e-07, label = paste0("c(", paste0(dl6$averageSampleNumber1, collapse = ", "), ")")) + expect_equal(dl6$averageSampleNumber01, 0.8455149, tolerance = 1e-07, label = paste0("c(", paste0(dl6$averageSampleNumber01, collapse = ", "), ")")) + expect_equal(dl6$averageSampleNumber0, 0.67993383, tolerance = 1e-07, label = paste0("c(", paste0(dl6$averageSampleNumber0, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dl6), NA))) + expect_output(print(dl6)$show()) + invisible(capture.output(expect_error(summary(dl6), NA))) + expect_output(summary(dl6)$show()) + suppressWarnings(dl6CodeBased <- eval(parse(text = getObjectRCode(dl6, stringWrapParagraphWidth = NULL)))) + expect_equal(dl6CodeBased$nFixed, dl6$nFixed, tolerance = 1e-07) + expect_equal(dl6CodeBased$shift, dl6$shift, tolerance = 1e-07) + expect_equal(dl6CodeBased$inflationFactor, dl6$inflationFactor, tolerance = 1e-07) + expect_equal(dl6CodeBased$information, dl6$information, tolerance = 1e-07) + expect_equal(dl6CodeBased$power, dl6$power, tolerance = 1e-07) + expect_equal(dl6CodeBased$rejectionProbabilities, dl6$rejectionProbabilities, tolerance = 1e-07) + expect_equal(dl6CodeBased$futilityProbabilities, dl6$futilityProbabilities, tolerance = 1e-07) + expect_equal(dl6CodeBased$averageSampleNumber1, dl6$averageSampleNumber1, tolerance = 1e-07) + expect_equal(dl6CodeBased$averageSampleNumber01, dl6$averageSampleNumber01, tolerance = 1e-07) + expect_equal(dl6CodeBased$averageSampleNumber0, dl6$averageSampleNumber0, tolerance = 1e-07) + expect_type(names(dl6), "character") + df <- as.data.frame(dl6) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dl6) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignGroupSequential' with binding futility bounds", { + + .skipTestIfDisabled() + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:criticalValuesWithFutility} + # @refFS[Formula]{fs:criticalValuesWangTiatis} + x8a <- getDesignGroupSequential( + kMax = 4, alpha = 0.025, futilityBounds = rep(0.5244, 3), + bindingFutility = TRUE, typeOfDesign = "WT", deltaWT = 0.4 + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x8a' with expected results + expect_equal(x8a$alphaSpent, c(0.0062828133, 0.013876673, 0.02015684, 0.02499999), tolerance = 1e-07, label = paste0("c(", paste0(x8a$alphaSpent, collapse = ", "), ")")) + expect_equal(x8a$criticalValues, c(2.4958485, 2.328709, 2.2361766, 2.1727623), tolerance = 1e-07, label = paste0("c(", paste0(x8a$criticalValues, collapse = ", "), ")")) + expect_equal(x8a$stageLevels, c(0.0062828133, 0.0099372444, 0.012670104, 0.014899106), tolerance = 1e-07, label = paste0("c(", paste0(x8a$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x8a), NA))) + expect_output(print(x8a)$show()) + invisible(capture.output(expect_error(summary(x8a), NA))) + expect_output(summary(x8a)$show()) + x8aCodeBased <- eval(parse(text = getObjectRCode(x8a, stringWrapParagraphWidth = NULL))) + expect_equal(x8aCodeBased$alphaSpent, x8a$alphaSpent, tolerance = 1e-07) + expect_equal(x8aCodeBased$criticalValues, x8a$criticalValues, tolerance = 1e-07) + expect_equal(x8aCodeBased$stageLevels, x8a$stageLevels, tolerance = 1e-07) + expect_type(names(x8a), "character") + df <- as.data.frame(x8a) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x8a) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:criticalValuesWangTiatis} + x8b <- getDesignGroupSequential( + kMax = 3, alpha = 0.025, sided = 2, informationRates = c(0.3, 0.8, 1), + typeOfDesign = "WT", deltaWT = 0.24 + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x8b' with expected results + expect_equal(x8b$alphaSpent, c(0.0013603353, 0.013978861, 0.02499999), tolerance = 1e-07, label = paste0("c(", paste0(x8b$alphaSpent, collapse = ", "), ")")) + expect_equal(x8b$criticalValues, c(3.2029374, 2.4819703, 2.3420706), tolerance = 1e-07, label = paste0("c(", paste0(x8b$criticalValues, collapse = ", "), ")")) + expect_equal(x8b$stageLevels, c(0.00068016766, 0.0065329078, 0.0095885436), tolerance = 1e-07, label = paste0("c(", paste0(x8b$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x8b), NA))) + expect_output(print(x8b)$show()) + invisible(capture.output(expect_error(summary(x8b), NA))) + expect_output(summary(x8b)$show()) + x8bCodeBased <- eval(parse(text = getObjectRCode(x8b, stringWrapParagraphWidth = NULL))) + expect_equal(x8bCodeBased$alphaSpent, x8b$alphaSpent, tolerance = 1e-07) + expect_equal(x8bCodeBased$criticalValues, x8b$criticalValues, tolerance = 1e-07) + expect_equal(x8bCodeBased$stageLevels, x8b$stageLevels, tolerance = 1e-07) + expect_type(names(x8b), "character") + df <- as.data.frame(x8b) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x8b) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:criticalValuesWangTiatis} + x8c <- getDesignGroupSequential( + kMax = 3, alpha = 0.025, sided = 1, informationRates = c(0.3, 0.8, 1), + typeOfDesign = "WToptimum", beta = 0.23 + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x8c' with expected results + expect_equal(x8c$power, c(0.17785982, 0.63184407, 0.77), tolerance = 1e-07, label = paste0("c(", paste0(x8c$power, collapse = ", "), ")")) + expect_equal(x8c$deltaWT, 0.393, tolerance = 1e-07, label = paste0("c(", paste0(x8c$deltaWT, collapse = ", "), ")")) + expect_equal(x8c$alphaSpent, c(0.0067542296, 0.01805085, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(x8c$alphaSpent, collapse = ", "), ")")) + expect_equal(x8c$criticalValues, c(2.4700754, 2.2239834, 2.1715117), tolerance = 1e-07, label = paste0("c(", paste0(x8c$criticalValues, collapse = ", "), ")")) + expect_equal(x8c$stageLevels, c(0.0067542296, 0.013074779, 0.014946256), tolerance = 1e-07, label = paste0("c(", paste0(x8c$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x8c), NA))) + expect_output(print(x8c)$show()) + invisible(capture.output(expect_error(summary(x8c), NA))) + expect_output(summary(x8c)$show()) + x8cCodeBased <- eval(parse(text = getObjectRCode(x8c, stringWrapParagraphWidth = NULL))) + expect_equal(x8cCodeBased$power, x8c$power, tolerance = 1e-07) + expect_equal(x8cCodeBased$deltaWT, x8c$deltaWT, tolerance = 1e-07) + expect_equal(x8cCodeBased$alphaSpent, x8c$alphaSpent, tolerance = 1e-07) + expect_equal(x8cCodeBased$criticalValues, x8c$criticalValues, tolerance = 1e-07) + expect_equal(x8cCodeBased$stageLevels, x8c$stageLevels, tolerance = 1e-07) + expect_type(names(x8c), "character") + df <- as.data.frame(x8c) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x8c) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:criticalValuesWangTiatis} + x8d <- getDesignGroupSequential( + kMax = 4, alpha = 0.025, sided = 2, informationRates = c(0.3, 0.6, 0.8, 1), + typeOfDesign = "WToptimum", beta = 0.1, optimizationCriterion = "ASNH1" + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x8d' with expected results + expect_equal(x8d$power, c(0.27905065, 0.63899817, 0.80432197, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(x8d$power, collapse = ", "), ")")) + expect_equal(x8d$deltaWT, 0.479, tolerance = 1e-07, label = paste0("c(", paste0(x8d$deltaWT, collapse = ", "), ")")) + expect_equal(x8d$alphaSpent, c(0.0082066211, 0.015417447, 0.020576899, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(x8d$alphaSpent, collapse = ", "), ")")) + expect_equal(x8d$criticalValues, c(2.6434487, 2.6052491, 2.5895574, 2.577451), tolerance = 1e-07, label = paste0("c(", paste0(x8d$criticalValues, collapse = ", "), ")")) + expect_equal(x8d$stageLevels, c(0.0041033106, 0.0045903747, 0.0048049705, 0.0049765989), tolerance = 1e-07, label = paste0("c(", paste0(x8d$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x8d), NA))) + expect_output(print(x8d)$show()) + invisible(capture.output(expect_error(summary(x8d), NA))) + expect_output(summary(x8d)$show()) + x8dCodeBased <- eval(parse(text = getObjectRCode(x8d, stringWrapParagraphWidth = NULL))) + expect_equal(x8dCodeBased$power, x8d$power, tolerance = 1e-07) + expect_equal(x8dCodeBased$deltaWT, x8d$deltaWT, tolerance = 1e-07) + expect_equal(x8dCodeBased$alphaSpent, x8d$alphaSpent, tolerance = 1e-07) + expect_equal(x8dCodeBased$criticalValues, x8d$criticalValues, tolerance = 1e-07) + expect_equal(x8dCodeBased$stageLevels, x8d$stageLevels, tolerance = 1e-07) + expect_type(names(x8d), "character") + df <- as.data.frame(x8d) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x8d) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:criticalValuesWangTiatis} + x8e <- getDesignGroupSequential( + kMax = 4, alpha = 0.025, sided = 2, informationRates = c(0.3, 0.6, 0.8, 1), + typeOfDesign = "WToptimum", beta = 0.1, optimizationCriterion = "ASNsum" + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x8e' with expected results + expect_equal(x8e$power, c(0.068425642, 0.50677837, 0.76253381, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(x8e$power, collapse = ", "), ")")) + expect_equal(x8e$deltaWT, 0.181, tolerance = 1e-07, label = paste0("c(", paste0(x8e$deltaWT, collapse = ", "), ")")) + expect_equal(x8e$alphaSpent, c(0.00055484217, 0.0059655413, 0.01417086, 0.02499999), tolerance = 1e-07, label = paste0("c(", paste0(x8e$alphaSpent, collapse = ", "), ")")) + expect_equal(x8e$criticalValues, c(3.4527796, 2.7678356, 2.5251363, 2.3516384), tolerance = 1e-07, label = paste0("c(", paste0(x8e$criticalValues, collapse = ", "), ")")) + expect_equal(x8e$stageLevels, c(0.00027742108, 0.0028214959, 0.0057826708, 0.0093454685), tolerance = 1e-07, label = paste0("c(", paste0(x8e$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x8e), NA))) + expect_output(print(x8e)$show()) + invisible(capture.output(expect_error(summary(x8e), NA))) + expect_output(summary(x8e)$show()) + x8eCodeBased <- eval(parse(text = getObjectRCode(x8e, stringWrapParagraphWidth = NULL))) + expect_equal(x8eCodeBased$power, x8e$power, tolerance = 1e-07) + expect_equal(x8eCodeBased$deltaWT, x8e$deltaWT, tolerance = 1e-07) + expect_equal(x8eCodeBased$alphaSpent, x8e$alphaSpent, tolerance = 1e-07) + expect_equal(x8eCodeBased$criticalValues, x8e$criticalValues, tolerance = 1e-07) + expect_equal(x8eCodeBased$stageLevels, x8e$stageLevels, tolerance = 1e-07) + expect_type(names(x8e), "character") + df <- as.data.frame(x8e) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x8e) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignGroupSequential' with Haybittle Peto boundaries", { + + .skipTestIfDisabled() + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:criticalValuesHaybittlePeto} + x9 <- getDesignGroupSequential(kMax = 4, alpha = 0.025, typeOfDesign = "HP") + + ## Comparison of the results of TrialDesignGroupSequential object 'x9' with expected results + expect_equal(x9$alphaSpent, c(0.001349898, 0.0024617416, 0.0033695882, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(x9$alphaSpent, collapse = ", "), ")")) + expect_equal(x9$criticalValues, c(3, 3, 3, 1.9827514), tolerance = 1e-07, label = paste0("c(", paste0(x9$criticalValues, collapse = ", "), ")")) + expect_equal(x9$stageLevels, c(0.001349898, 0.001349898, 0.001349898, 0.023697604), tolerance = 1e-07, label = paste0("c(", paste0(x9$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x9), NA))) + expect_output(print(x9)$show()) + invisible(capture.output(expect_error(summary(x9), NA))) + expect_output(summary(x9)$show()) + x9CodeBased <- eval(parse(text = getObjectRCode(x9, stringWrapParagraphWidth = NULL))) + expect_equal(x9CodeBased$alphaSpent, x9$alphaSpent, tolerance = 1e-07) + expect_equal(x9CodeBased$criticalValues, x9$criticalValues, tolerance = 1e-07) + expect_equal(x9CodeBased$stageLevels, x9$stageLevels, tolerance = 1e-07) + expect_type(names(x9), "character") + df <- as.data.frame(x9) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x9) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignGroupSequential' with Pampallona Tsiatis boundaries, binding and non-binding futility bounds", { + + .skipTestIfDisabled() + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:criticalValuesPampallonaTiatis} + x10 <- getDesignGroupSequential( + kMax = 3, alpha = 0.035, beta = 0.1, + informationRates = c(0.3, 0.8, 1), typeOfDesign = "PT", sided = 1, + bindingFutility = TRUE, deltaPT1 = 0.2, deltaPT0 = 0.3 + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x10' with expected results + expect_equal(x10$power, c(0.19834666, 0.83001122, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(x10$power, collapse = ", "), ")")) + expect_equal(x10$futilityBounds, c(-0.042079545, 1.4407359), tolerance = 1e-07, label = paste0("c(", paste0(x10$futilityBounds, collapse = ", "), ")")) + expect_equal(x10$alphaSpent, c(0.0038332428, 0.024917169, 0.035), tolerance = 1e-07, label = paste0("c(", paste0(x10$alphaSpent, collapse = ", "), ")")) + expect_equal(x10$betaSpent, c(0.031375368, 0.080734151, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(x10$betaSpent, collapse = ", "), ")")) + expect_equal(x10$criticalValues, c(2.6664156, 1.9867225, 1.8580792), tolerance = 1e-07, label = paste0("c(", paste0(x10$criticalValues, collapse = ", "), ")")) + expect_equal(x10$stageLevels, c(0.0038332428, 0.023476576, 0.031578886), tolerance = 1e-07, label = paste0("c(", paste0(x10$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x10), NA))) + expect_output(print(x10)$show()) + invisible(capture.output(expect_error(summary(x10), NA))) + expect_output(summary(x10)$show()) + x10CodeBased <- eval(parse(text = getObjectRCode(x10, stringWrapParagraphWidth = NULL))) + expect_equal(x10CodeBased$power, x10$power, tolerance = 1e-07) + expect_equal(x10CodeBased$futilityBounds, x10$futilityBounds, tolerance = 1e-07) + expect_equal(x10CodeBased$alphaSpent, x10$alphaSpent, tolerance = 1e-07) + expect_equal(x10CodeBased$betaSpent, x10$betaSpent, tolerance = 1e-07) + expect_equal(x10CodeBased$criticalValues, x10$criticalValues, tolerance = 1e-07) + expect_equal(x10CodeBased$stageLevels, x10$stageLevels, tolerance = 1e-07) + expect_type(names(x10), "character") + df <- as.data.frame(x10) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x10) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:criticalValuesPampallonaTiatis} + x11 <- getDesignGroupSequential( + kMax = 3, alpha = 0.035, beta = 0.05, + informationRates = c(0.3, 0.8, 1), typeOfDesign = "PT", sided = 2, + bindingFutility = TRUE, deltaPT1 = 0.2, deltaPT0 = 0.3 + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x11' with expected results + expect_equal(x11$power, c(0.16615376, 0.88013007, 0.94999991), tolerance = 1e-07, label = paste0("c(", paste0(x11$power, collapse = ", "), ")")) + expect_equal(x11$futilityBounds, c(NA_real_, 1.671433), tolerance = 1e-07, label = paste0("c(", paste0(x11$futilityBounds, collapse = ", "), ")")) + expect_equal(x11$alphaSpent, c(0.0019236202, 0.022017713, 0.035), tolerance = 1e-07, label = paste0("c(", paste0(x11$alphaSpent, collapse = ", "), ")")) + expect_equal(x11$betaSpent, c(0, 0.035025978, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(x11$betaSpent, collapse = ", "), ")")) + expect_equal(x11$criticalValues, c(3.1017782, 2.3111074, 2.1614596), tolerance = 1e-07, label = paste0("c(", paste0(x11$criticalValues, collapse = ", "), ")")) + expect_equal(x11$stageLevels, c(0.00096181012, 0.010413463, 0.015329928), tolerance = 1e-07, label = paste0("c(", paste0(x11$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x11), NA))) + expect_output(print(x11)$show()) + invisible(capture.output(expect_error(summary(x11), NA))) + expect_output(summary(x11)$show()) + x11CodeBased <- eval(parse(text = getObjectRCode(x11, stringWrapParagraphWidth = NULL))) + expect_equal(x11CodeBased$power, x11$power, tolerance = 1e-07) + expect_equal(x11CodeBased$futilityBounds, x11$futilityBounds, tolerance = 1e-07) + expect_equal(x11CodeBased$alphaSpent, x11$alphaSpent, tolerance = 1e-07) + expect_equal(x11CodeBased$betaSpent, x11$betaSpent, tolerance = 1e-07) + expect_equal(x11CodeBased$criticalValues, x11$criticalValues, tolerance = 1e-07) + expect_equal(x11CodeBased$stageLevels, x11$stageLevels, tolerance = 1e-07) + expect_type(names(x11), "character") + df <- as.data.frame(x11) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x11) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:criticalValuesPampallonaTiatis} + x12 <- getDesignGroupSequential( + kMax = 3, alpha = 0.035, beta = 0.05, + informationRates = c(0.3, 0.8, 1), typeOfDesign = "PT", sided = 2, + bindingFutility = FALSE, deltaPT1 = 0.2, deltaPT0 = 0.3 + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x12' with expected results + expect_equal(x12$power, c(0.15712278, 0.87874666, 0.94999994), tolerance = 1e-07, label = paste0("c(", paste0(x12$power, collapse = ", "), ")")) + expect_equal(x12$futilityBounds, c(NA_real_, 1.7090472), tolerance = 1e-07, label = paste0("c(", paste0(x12$futilityBounds, collapse = ", "), ")")) + expect_equal(x12$alphaSpent, c(0.0015647742, 0.019435851, 0.035), tolerance = 1e-07, label = paste0("c(", paste0(x12$alphaSpent, collapse = ", "), ")")) + expect_equal(x12$betaSpent, c(0, 0.034947415, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(x12$betaSpent, collapse = ", "), ")")) + expect_equal(x12$criticalValues, c(3.1623945, 2.356272, 2.2036998), tolerance = 1e-07, label = paste0("c(", paste0(x12$criticalValues, collapse = ", "), ")")) + expect_equal(x12$stageLevels, c(0.00078238709, 0.0092296971, 0.013772733), tolerance = 1e-07, label = paste0("c(", paste0(x12$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x12), NA))) + expect_output(print(x12)$show()) + invisible(capture.output(expect_error(summary(x12), NA))) + expect_output(summary(x12)$show()) + x12CodeBased <- eval(parse(text = getObjectRCode(x12, stringWrapParagraphWidth = NULL))) + expect_equal(x12CodeBased$power, x12$power, tolerance = 1e-07) + expect_equal(x12CodeBased$futilityBounds, x12$futilityBounds, tolerance = 1e-07) + expect_equal(x12CodeBased$alphaSpent, x12$alphaSpent, tolerance = 1e-07) + expect_equal(x12CodeBased$betaSpent, x12$betaSpent, tolerance = 1e-07) + expect_equal(x12CodeBased$criticalValues, x12$criticalValues, tolerance = 1e-07) + expect_equal(x12CodeBased$stageLevels, x12$stageLevels, tolerance = 1e-07) + expect_type(names(x12), "character") + df <- as.data.frame(x12) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x12) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:criticalValuesPampallonaTiatis} + x13 <- getDesignGroupSequential( + kMax = 4, alpha = 0.035, beta = 0.05, + informationRates = c(0.2, 0.4, 0.8, 1), typeOfDesign = "PT", sided = 1, + bindingFutility = FALSE, deltaPT1 = 0.1, deltaPT0 = 0.45 + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x13' with expected results + expect_equal(x13$power, c(0.029518378, 0.38853658, 0.90760886, 0.95), tolerance = 1e-07, label = paste0("c(", paste0(x13$power, collapse = ", "), ")")) + expect_equal(x13$futilityBounds, c(-0.41499566, 0.38106631, 1.4738957), tolerance = 1e-07, label = paste0("c(", paste0(x13$futilityBounds, collapse = ", "), ")")) + expect_equal(x13$alphaSpent, c(0.00014050218, 0.0030266381, 0.0199021, 0.035), tolerance = 1e-07, label = paste0("c(", paste0(x13$alphaSpent, collapse = ", "), ")")) + expect_equal(x13$betaSpent, c(0.015413989, 0.028721092, 0.043215976, 0.049999999), tolerance = 1e-07, label = paste0("c(", paste0(x13$betaSpent, collapse = ", "), ")")) + expect_equal(x13$criticalValues, c(3.6322099, 2.7527004, 2.0861568, 1.9080201), tolerance = 1e-07, label = paste0("c(", paste0(x13$criticalValues, collapse = ", "), ")")) + expect_equal(x13$stageLevels, c(0.00014050218, 0.002955298, 0.018482211, 0.02819431), tolerance = 1e-07, label = paste0("c(", paste0(x13$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x13), NA))) + expect_output(print(x13)$show()) + invisible(capture.output(expect_error(summary(x13), NA))) + expect_output(summary(x13)$show()) + x13CodeBased <- eval(parse(text = getObjectRCode(x13, stringWrapParagraphWidth = NULL))) + expect_equal(x13CodeBased$power, x13$power, tolerance = 1e-07) + expect_equal(x13CodeBased$futilityBounds, x13$futilityBounds, tolerance = 1e-07) + expect_equal(x13CodeBased$alphaSpent, x13$alphaSpent, tolerance = 1e-07) + expect_equal(x13CodeBased$betaSpent, x13$betaSpent, tolerance = 1e-07) + expect_equal(x13CodeBased$criticalValues, x13$criticalValues, tolerance = 1e-07) + expect_equal(x13CodeBased$stageLevels, x13$stageLevels, tolerance = 1e-07) + expect_type(names(x13), "character") + df <- as.data.frame(x13) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x13) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:criticalValuesPampallonaTiatis} + x14 <- getDesignGroupSequential( + kMax = 6, alpha = 0.25, beta = 0.01, + typeOfDesign = "PT", sided = 2, + bindingFutility = TRUE, deltaPT1 = 0.02, deltaPT0 = 0.49, twoSidedPower = TRUE + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x14' with expected results + expect_equal(x14$power, c(0.076493626, 0.52863814, 0.83456395, 0.94950066, 0.98346861, 0.99), tolerance = 1e-07, label = paste0("c(", paste0(x14$power, collapse = ", "), ")")) + expect_equal(x14$futilityBounds, c(NA_real_, NA_real_, 0.12661836, 0.55308248, 0.92800873), tolerance = 1e-07, label = paste0("c(", paste0(x14$futilityBounds, collapse = ", "), ")")) + expect_equal(x14$alphaSpent, c(0.0027626806, 0.03301126, 0.088857236, 0.15440485, 0.2156594, 0.25), tolerance = 1e-07, label = paste0("c(", paste0(x14$alphaSpent, collapse = ", "), ")")) + expect_equal(x14$betaSpent, c(0, 0, 0.0026196848, 0.0066701046, 0.0089493411, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(x14$betaSpent, collapse = ", "), ")")) + expect_equal(x14$criticalValues, c(2.9929798, 2.1458995, 1.7663859, 1.5385619, 1.3822869, 1.2664591), tolerance = 1e-07, label = paste0("c(", paste0(x14$criticalValues, collapse = ", "), ")")) + expect_equal(x14$stageLevels, c(0.0013813403, 0.015940498, 0.038665568, 0.061955638, 0.08344182, 0.10267438), tolerance = 1e-07, label = paste0("c(", paste0(x14$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x14), NA))) + expect_output(print(x14)$show()) + invisible(capture.output(expect_error(summary(x14), NA))) + expect_output(summary(x14)$show()) + x14CodeBased <- eval(parse(text = getObjectRCode(x14, stringWrapParagraphWidth = NULL))) + expect_equal(x14CodeBased$power, x14$power, tolerance = 1e-07) + expect_equal(x14CodeBased$futilityBounds, x14$futilityBounds, tolerance = 1e-07) + expect_equal(x14CodeBased$alphaSpent, x14$alphaSpent, tolerance = 1e-07) + expect_equal(x14CodeBased$betaSpent, x14$betaSpent, tolerance = 1e-07) + expect_equal(x14CodeBased$criticalValues, x14$criticalValues, tolerance = 1e-07) + expect_equal(x14CodeBased$stageLevels, x14$stageLevels, tolerance = 1e-07) + expect_type(names(x14), "character") + df <- as.data.frame(x14) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x14) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignGroupSequential' with type of design = 'noEarlyEfficacy'", { + + .skipTestIfDisabled() + + # @refFS[Tab.]{fs:tab:output:getDesignInverseNormal} + # @refFS[Formula]{fs:alphaSpendingConcept} + x15 <- getDesignGroupSequential( + typeOfDesign = "noEarlyEfficacy", + futilityBounds = c(0, 0.5) + ) + + + ## Comparison of the results of TrialDesignGroupSequential object 'x15' with expected results + expect_equal(x15$alphaSpent, c(6.6613381e-16, -1.3145041e-13, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(x15$alphaSpent, collapse = ", "), ")")) + expect_equal(x15$criticalValues, c(Inf, Inf, 1.959964), tolerance = 1e-07, label = paste0("c(", paste0(x15$criticalValues, collapse = ", "), ")")) + expect_equal(x15$stageLevels, c(0, 0, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(x15$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x15), NA))) + expect_output(print(x15)$show()) + invisible(capture.output(expect_error(summary(x15), NA))) + expect_output(summary(x15)$show()) + x15CodeBased <- eval(parse(text = getObjectRCode(x15, stringWrapParagraphWidth = NULL))) + expect_equal(x15CodeBased$alphaSpent, x15$alphaSpent, tolerance = 1e-07) + expect_equal(x15CodeBased$criticalValues, x15$criticalValues, tolerance = 1e-07) + expect_equal(x15CodeBased$stageLevels, x15$stageLevels, tolerance = 1e-07) + expect_type(names(x15), "character") + df <- as.data.frame(x15) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x15) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + x16 <- getDesignGroupSequential( + typeOfDesign = "noEarlyEfficacy", + futilityBounds = c(0, 0.5, 1), + bindingFutility = TRUE + ) + + + ## Comparison of the results of TrialDesignGroupSequential object 'x16' with expected results + expect_equal(x16$alphaSpent, c(6.6613381e-16, 1.110223e-15, 4.8067383e-11, 0.02499999), tolerance = 1e-07, label = paste0("c(", paste0(x16$alphaSpent, collapse = ", "), ")")) + expect_equal(x16$criticalValues, c(Inf, Inf, Inf, 1.8848634), tolerance = 1e-07, label = paste0("c(", paste0(x16$criticalValues, collapse = ", "), ")")) + expect_equal(x16$stageLevels, c(0, 0, 0, 0.029724142), tolerance = 1e-07, label = paste0("c(", paste0(x16$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x16), NA))) + expect_output(print(x16)$show()) + invisible(capture.output(expect_error(summary(x16), NA))) + expect_output(summary(x16)$show()) + x16CodeBased <- eval(parse(text = getObjectRCode(x16, stringWrapParagraphWidth = NULL))) + expect_equal(x16CodeBased$alphaSpent, x16$alphaSpent, tolerance = 1e-07) + expect_equal(x16CodeBased$criticalValues, x16$criticalValues, tolerance = 1e-07) + expect_equal(x16CodeBased$stageLevels, x16$stageLevels, tolerance = 1e-07) + expect_type(names(x16), "character") + df <- as.data.frame(x16) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x16) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } +}) + +test_that("'getDesignInverseNormal': illegal arguments throw exceptions as expected", { + + expect_error(getDesignInverseNormal( + typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, + userAlphaSpending = c(0.01, 0.02, 0.023, 0.023, 0.025), kMax = 4 + ), + paste0( + "Conflicting arguments: length of 'userAlphaSpending' (5) ", + "must be equal to 'kMax' (4)" + ), + fixed = TRUE + ) + + expect_error(getDesignInverseNormal( + typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, + userAlphaSpending = c(0.01, 0.02, 0.023, 0.023, 0.021) + ), + paste0( + "'userAlphaSpending' = c(0.01, 0.02, 0.023, 0.023, 0.021) must be a vector that ", + "satisfies the following condition: 0 <= alpha_1 <= .. <= alpha_5 <= alpha = 0.021" + ), + fixed = TRUE + ) + + expect_error(getDesignInverseNormal( + typeOfDesign = "asUser", + userAlphaSpending = c(0.01, 0.02, 0.023), alpha = 0.02 + ), + paste0( + "'userAlphaSpending' = c(0.01, 0.02, 0.023) must be a vector that ", + "satisfies the following condition: 0 <= alpha_1 <= .. <= alpha_3 <= alpha = 0.02" + ), + fixed = TRUE + ) + + expect_error(getDesignInverseNormal(typeOfDesign = C_TYPE_OF_DESIGN_WT, deltaWT = NA_real_), + "Missing argument: parameter 'deltaWT' must be specified in design", + fixed = TRUE + ) + + expect_error(getDesignInverseNormal( + typeOfDesign = C_TYPE_OF_DESIGN_WT_OPTIMUM, + optimizationCriterion = "x" + ), + "Illegal argument: optimization criterion must be one of the following: 'ASNH1', 'ASNIFH1', 'ASNsum'", + fixed = TRUE + ) + + expect_error(getDesignInverseNormal(typeOfDesign = C_TYPE_OF_DESIGN_AS_KD, gammaA = NA_real_), + "Missing argument: parameter 'gammaA' must be specified in design", + fixed = TRUE + ) + + expect_error(getDesignInverseNormal(typeOfDesign = C_TYPE_OF_DESIGN_AS_HSD, gammaA = NA_real_), + "Missing argument: parameter 'gammaA' must be specified in design", + fixed = TRUE + ) + + expect_error(getDesignInverseNormal(typeOfDesign = C_TYPE_OF_DESIGN_AS_USER), + "Missing argument: parameter 'userAlphaSpending' must be specified in design", + fixed = TRUE + ) + + expect_error(getDesignInverseNormal( + typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, + userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = "x" + ), + "Illegal argument: type of beta spending must be one of the following: 'none', 'bsP', 'bsOF', 'bsKD', 'bsHSD', 'bsUser'", + fixed = TRUE + ) + + expect_error(getDesignInverseNormal( + typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, + userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER + ), + "Missing argument: parameter 'userBetaSpending' must be specified in design", + fixed = TRUE + ) + + expect_error(getDesignInverseNormal( + typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, + userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER, + userBetaSpending = c(0.1, 0.2) + ), + paste0( + "Conflicting arguments: length of 'userBetaSpending' (2) must ", + "be equal to length of 'informationRates' (3)" + ), + fixed = TRUE + ) + + expect_error(getDesignInverseNormal( + typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, + userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER, + userBetaSpending = c(0.2, 0.1, 0.05) + ), + paste0( + "'userBetaSpending' = c(0.2, 0.1, 0.05) must be a vector that satisfies the ", + "following condition: 0 <= beta_1 <= .. <= beta_3 <= beta = 0.05" + ), + fixed = TRUE + ) + + expect_error(getDesignInverseNormal( + typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, + userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER, + userBetaSpending = c(0.1, 0.2, 0.3), beta = 0.2 + ), + paste0( + "'userBetaSpending' = c(0.1, 0.2, 0.3) must be a vector that satisfies the ", + "following condition: 0 <= beta_1 <= .. <= beta_3 <= beta = 0.2" + ), + fixed = TRUE + ) + + expect_error(getDesignInverseNormal(kMax = Inf), + paste0( + "Argument out of bounds: 'kMax' (Inf) is out of bounds [1; ", + C_KMAX_UPPER_BOUND, "]" + ), + fixed = TRUE + ) + + expect_error(getDesignInverseNormal(kMax = -Inf), + paste0( + "Argument out of bounds: 'kMax' (-Inf) is out of bounds [1; ", + C_KMAX_UPPER_BOUND, "]" + ), + fixed = TRUE + ) + + expect_error(getDesignInverseNormal(kMax = -Inf), "Argument out of bounds: 'kMax' (-Inf) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = -10), "Argument out of bounds: 'kMax' (-10) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = -9), "Argument out of bounds: 'kMax' (-9) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = -8), "Argument out of bounds: 'kMax' (-8) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = -7), "Argument out of bounds: 'kMax' (-7) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = -6), "Argument out of bounds: 'kMax' (-6) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = -5), "Argument out of bounds: 'kMax' (-5) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = -4), "Argument out of bounds: 'kMax' (-4) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = -3), "Argument out of bounds: 'kMax' (-3) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = -2), "Argument out of bounds: 'kMax' (-2) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = -1), "Argument out of bounds: 'kMax' (-1) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 0), "Argument out of bounds: 'kMax' (0) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 21), "Argument out of bounds: 'kMax' (21) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 22), "Argument out of bounds: 'kMax' (22) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 23), "Argument out of bounds: 'kMax' (23) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 24), "Argument out of bounds: 'kMax' (24) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 25), "Argument out of bounds: 'kMax' (25) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 26), "Argument out of bounds: 'kMax' (26) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 27), "Argument out of bounds: 'kMax' (27) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 28), "Argument out of bounds: 'kMax' (28) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 29), "Argument out of bounds: 'kMax' (29) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 30), "Argument out of bounds: 'kMax' (30) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = Inf), "Argument out of bounds: 'kMax' (Inf) is out of bounds [1; 20]", fixed = TRUE) + + expect_error(getDesignInverseNormal(kMax = 2, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (2) - 1", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 3, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (3) - 1", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 4, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (4) - 1", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 6, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (6) - 1", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 7, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (7) - 1", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 8, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (8) - 1", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 9, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (9) - 1", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 10, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (10) - 1", fixed = TRUE) + + expect_warning(expect_error(getDesignInverseNormal(kMax = 11, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (11) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 12, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (12) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 13, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (13) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 14, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (14) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 15, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (15) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 16, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (16) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 17, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (17) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 18, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (18) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 19, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (19) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 20, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (20) - 1", fixed = TRUE)) + + expect_error(getDesignInverseNormal(futilityBounds = c(-7, 5)), + "Illegal argument: 'futilityBounds' (-7, 5) too extreme for this situation", + fixed = TRUE + ) + + expect_error(getDesignInverseNormal(futilityBounds = c(1, 7)), + "Argument out of bounds: 'futilityBounds' (1, 7) is out of bounds [-Inf; 6]", + fixed = TRUE + ) + +}) + +test_that("'getDesignGroupSequential': illegal arguments throw exceptions as expected", { + + expect_error(getDesignGroupSequential( + typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, + userAlphaSpending = c(0.01, 0.02, 0.023, 0.023, 0.025), kMax = 4 + ), + paste0( + "Conflicting arguments: length of 'userAlphaSpending' (5) ", + "must be equal to 'kMax' (4)" + ), + fixed = TRUE + ) + + expect_error(getDesignGroupSequential( + typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, + userAlphaSpending = c(0.01, 0.02, 0.023, 0.023, 0.021) + ), + paste0( + "'userAlphaSpending' = c(0.01, 0.02, 0.023, 0.023, 0.021) must be a vector that ", + "satisfies the following condition: 0 <= alpha_1 <= .. <= alpha_5 <= alpha = 0.021" + ), + fixed = TRUE + ) + + expect_error(getDesignGroupSequential( + typeOfDesign = "asUser", + userAlphaSpending = c(0.01, 0.02, 0.023), alpha = 0.02 + ), + paste0( + "'userAlphaSpending' = c(0.01, 0.02, 0.023) must be a vector that ", + "satisfies the following condition: 0 <= alpha_1 <= .. <= alpha_3 <= alpha = 0.02" + ), + fixed = TRUE + ) + + expect_equal(getDesignGroupSequential( + typeOfDesign = "asUser", + userAlphaSpending = c(0.01, 0.02, 0.023) + )$alpha, 0.023) + + expect_error(getDesignGroupSequential(typeOfDesign = C_TYPE_OF_DESIGN_WT, deltaWT = NA_real_), + "Missing argument: parameter 'deltaWT' must be specified in design", + fixed = TRUE + ) + + expect_error(getDesignGroupSequential( + typeOfDesign = C_TYPE_OF_DESIGN_WT_OPTIMUM, + optimizationCriterion = "x" + ), + "Illegal argument: optimization criterion must be one of the following: 'ASNH1', 'ASNIFH1', 'ASNsum'", + fixed = TRUE + ) + + expect_error(getDesignGroupSequential(typeOfDesign = C_TYPE_OF_DESIGN_AS_KD, gammaA = NA_real_), + "Missing argument: parameter 'gammaA' must be specified in design", + fixed = TRUE + ) + + expect_error(getDesignGroupSequential(typeOfDesign = C_TYPE_OF_DESIGN_AS_HSD, gammaA = NA_real_), + "Missing argument: parameter 'gammaA' must be specified in design", + fixed = TRUE + ) + + expect_error(getDesignGroupSequential(typeOfDesign = C_TYPE_OF_DESIGN_AS_USER), + "Missing argument: parameter 'userAlphaSpending' must be specified in design", + fixed = TRUE + ) + + expect_error(getDesignGroupSequential( + typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, + userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = "x" + ), + paste0( + "Illegal argument: type of beta spending must be one of the following: ", + "'none', 'bsP', 'bsOF', 'bsKD', 'bsHSD', 'bsUser'" + ), + fixed = TRUE + ) + + expect_error(getDesignGroupSequential( + typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, + userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER + ), + "Missing argument: parameter 'userBetaSpending' must be specified in design", + fixed = TRUE + ) + + expect_error(getDesignGroupSequential( + typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, + userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER, + userBetaSpending = c(0.1, 0.2) + ), + paste0( + "Conflicting arguments: length of 'userBetaSpending' (2) must ", + "be equal to length of 'informationRates' (3)" + ), + fixed = TRUE + ) + + expect_error(getDesignGroupSequential( + typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, + userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER, + userBetaSpending = c(0.2, 0.1, 0.05) + ), + paste0( + "'userBetaSpending' = c(0.2, 0.1, 0.05) must be a vector that satisfies the ", + "following condition: 0 <= beta_1 <= .. <= beta_3 <= beta = 0.05" + ), + fixed = TRUE + ) + + expect_error(getDesignGroupSequential( + typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, + userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER, + userBetaSpending = c(0.1, 0.2, 0.3), beta = 0.2 + ), + paste0( + "'userBetaSpending' = c(0.1, 0.2, 0.3) must be a vector that satisfies the ", + "following condition: 0 <= beta_1 <= .. <= beta_3 <= beta = 0.2" + ), + fixed = TRUE + ) + + expect_error(getDesignGroupSequential(kMax = Inf), + paste0( + "Argument out of bounds: 'kMax' (Inf) is out of bounds [1; ", + C_KMAX_UPPER_BOUND, "]" + ), + fixed = TRUE + ) + + expect_error(getDesignGroupSequential(kMax = -Inf), + paste0( + "Argument out of bounds: 'kMax' (-Inf) is out of bounds [1; ", + C_KMAX_UPPER_BOUND, "]" + ), + fixed = TRUE + ) + + expect_error(getDesignInverseNormal(kMax = -5), "Argument out of bounds: 'kMax' (-5) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 0), "Argument out of bounds: 'kMax' (0) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 21), "Argument out of bounds: 'kMax' (21) is out of bounds [1; 20]", fixed = TRUE) + + expect_error(getDesignInverseNormal(kMax = 2, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (2) - 1", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 3, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (3) - 1", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 4, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (4) - 1", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 6, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (6) - 1", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 7, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (7) - 1", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 8, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (8) - 1", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 9, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (9) - 1", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 10, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (10) - 1", fixed = TRUE) + + expect_warning(expect_error(getDesignInverseNormal(kMax = 11, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (11) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 12, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (12) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 13, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (13) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 14, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (14) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 15, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (15) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 16, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (16) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 17, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (17) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 18, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (18) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 19, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (19) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 20, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (20) - 1", fixed = TRUE)) + + expect_error(getDesignGroupSequential(futilityBounds = c(-7, 5)), + "Illegal argument: 'futilityBounds' (-7, 5) too extreme for this situation", + fixed = TRUE + ) + + expect_error(getDesignGroupSequential(futilityBounds = c(1, 7)), + "Argument out of bounds: 'futilityBounds' (1, 7) is out of bounds [-Inf; 6]", + fixed = TRUE + ) + +}) + diff --git a/tests/testthat/test-f_design_plan_plot.R b/tests/testthat/test-f_design_plan_plot.R index 5c4af35e..47f98dbd 100644 --- a/tests/testthat/test-f_design_plan_plot.R +++ b/tests/testthat/test-f_design_plan_plot.R @@ -15,8 +15,8 @@ ## | ## | File name: test-f_design_plan_means.R ## | Creation date: 21 December 2023, 08:52:45 -## | File version: $Revision: 7560 $ -## | Last changed: $Date: 2024-01-15 14:20:32 +0100 (Mo, 15 Jan 2024) $ +## | File version: $Revision: 7682 $ +## | Last changed: $Date: 2024-03-05 07:53:40 +0100 (Di, 05 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -67,87 +67,47 @@ test_that(".getTrialDesignPlanTheta function works as expected", { # Test case for .plotTrialDesignPlan function test_that(".plotTrialDesignPlan function works as expected", { .skipTestIfDisabled() - designGS1 <- getDesignGroupSequential(informationRates = c(0.2, 0.5, 1), - sided = 1, beta = 0.1, typeOfDesign = "WT", deltaWT = 0.3) - survivalDesignPlanEnabled <- .isTrialDesignPlanSurvival(getDesignGroupSequential( - informationRates = c(0.2, 0.5, 1), sided = 1, - beta = 0.1, typeOfDesign = "WT", deltaWT = 0.3 - )) - designPlan <- getDesignInverseNormal( + design <- getDesignInverseNormal( typeOfDesign = "OF", kMax = 2, alpha = 0.025, beta = 0.2, sided = 1, tolerance = 1e-08 ) - designPlan <- getSampleSizeMeans(designPlan, + sampleSizeMeansResult <- getSampleSizeMeans(design, meanRatio = FALSE, thetaH0 = 0, normalApproximation = FALSE, alternative = 0.2, stDev = 1, groups = 2, allocationRatioPlanned = 1 ) - - designPlan_power <- getDesignInverseNormal( - typeOfDesign = "OF", kMax = 2, alpha = - 0.025, beta = 0.2, sided = 1, tolerance = 1e-08 - ) - designPlan_power <- getPowerMeans(designPlan_power, + powerMeansResult <- getPowerMeans(design, meanRatio = FALSE, thetaH0 = 0, normalApproximation = FALSE, alternative = 0.2, stDev = 1, groups = 2, allocationRatioPlanned = 1, directionUpper = TRUE, maxNumberOfSubjects = 200 ) - - designPlan_surv <- getDesignInverseNormal( - typeOfDesign = "OF", kMax = 2, alpha = - 0.025, beta = 0.2, sided = 1, tolerance = 1e-08 - ) - designPlan_surv <- getSampleSizeSurvival(designPlan_surv, + sampleSizeSurvivalResult <- getSampleSizeSurvival(design, thetaH0 = 1, typeOfComputation = "Schoenfeld", pi1 = 0.4, pi2 = 0.2, allocationRatioPlanned = 1, eventTime = 12, accrualTime = c(0, 12), kappa = 1, followUpTime = 6, dropoutRate1 = 0, dropoutRate2 = 0, dropoutTime = 12, accrualIntensity = NA_real_ ) - - designPlan_surv_pwr <- getDesignInverseNormal( - typeOfDesign = "OF", kMax = 2, alpha = - 0.025, beta = 0.2, sided = 1, tolerance = 1e-08 - ) - designPlan_surv_pwr <- getPowerSurvival(designPlan_surv_pwr, + powerSurvivalResult <- getPowerSurvival(design, thetaH0 = 1, typeOfComputation = "Schoenfeld", directionUpper = TRUE, pi1 = 0.4, pi2 = 0.2, maxNumberOfSubjects = 200, maxNumberOfEvents = 100, allocationRatioPlanned = 1, eventTime = 12, accrualTime = c(0, 12), kappa = 1, dropoutRate1 = 0, dropoutRate2 = 0, dropoutTime = 12, accrualIntensity = NA_real_ ) - designPlan_rates <- getDesignInverseNormal( - typeOfDesign = "OF", kMax = 2, alpha = - 0.025, beta = 0.2, sided = 1, tolerance = 1e-08 - ) - designPlan_rates <- getSampleSizeRates(designPlan_rates, + sampleSizeRatesResult <- getSampleSizeRates(design, riskRatio = FALSE, thetaH0 = 0, pi1 = 0.4, pi2 = 0.2, groups = 2, allocationRatioPlanned = 1 ) - designPlan_rates_pwr <- getDesignInverseNormal( - typeOfDesign = "OF", kMax = 2, alpha = - 0.025, beta = 0.2, sided = 1, tolerance = 1e-08 - ) - designPlan_rates_pwr <- getPowerRates(designPlan_rates_pwr, + powerRatesResult <- getPowerRates(design, riskRatio = FALSE, thetaH0 = 0, pi1 = 0.4, pi2 = 0.2, groups = 2, allocationRatioPlanned = 1, directionUpper = TRUE, maxNumberOfSubjects = 200 ) - - designPlan_2 <- getDesignInverseNormal( - typeOfDesign = "OF", kMax = 2, alpha = - 0.025, beta = 0.2, sided = 1, tolerance = 1e-08 - ) - designPlan_2 <- getSampleSizeMeans(designPlan_2, - meanRatio = FALSE, thetaH0 = 0, - normalApproximation = FALSE, alternative = 0.2, stDev = 1, groups = - 2, allocationRatioPlanned = 1 - ) - designPlan_2$`.design`$sided <- as.integer(1) - type <- c(1:4) + sampleSizeMeansResult$.design$sided <- as.integer(1) main <- NA_character_ xlab <- NA_character_ ylab <- NA_character_ @@ -158,36 +118,55 @@ test_that(".plotTrialDesignPlan function works as expected", { showSource <- FALSE designPlanName <- NA_character_ plotSettings <- NULL - for (i in type) { - result <- .plotTrialDesignPlan(designPlan, type[i], main, xlab, ylab, palette, theta, - plotPointsEnabled, legendPosition, showSource, designPlanName, plotSettings) - result_2 <- .plotTrialDesignPlan(designPlan_2, type[i], main, xlab, ylab, palette, theta, - plotPointsEnabled, legendPosition, showSource, designPlanName, plotSettings) - result_pwr <- .plotTrialDesignPlan(designPlan_power, type[i], main, xlab, ylab, palette, theta, - plotPointsEnabled, legendPosition, showSource, designPlanName, plotSettings) - result_surv <- .plotTrialDesignPlan(designPlan_surv, type[i], main, xlab, ylab, palette, theta, - plotPointsEnabled, legendPosition, showSource, designPlanName, plotSettings) - result_surv_pwr <- .plotTrialDesignPlan(designPlan_surv_pwr, type[i], main, xlab, ylab, palette, theta, - plotPointsEnabled, legendPosition, showSource, designPlanName, plotSettings) - result_rates <- .plotTrialDesignPlan(designPlan_rates, type[i], main, xlab, ylab, palette, theta, - plotPointsEnabled, legendPosition, showSource, designPlanName, plotSettings) - result_rates_pwr <- .plotTrialDesignPlan(designPlan_rates_pwr, type[i], main, xlab, ylab, palette, theta, - plotPointsEnabled, legendPosition, showSource, designPlanName, plotSettings) - expect_type(result, "list") - expect_type(result_2, "list") - expect_type(result_pwr, "list") - expect_type(result_surv, "list") - expect_type(result_surv_pwr, "list") - expect_type(result_rates, "list") - expect_type(result_rates_pwr, "list") + for (type in c(1:4)) { + result1 <- .plotTrialDesignPlan( + sampleSizeMeansResult, type, main, xlab, ylab, palette, theta, + plotPointsEnabled, legendPosition, showSource, designPlanName, plotSettings + ) + result2 <- .plotTrialDesignPlan( + powerMeansResult, type, main, xlab, ylab, palette, theta, + plotPointsEnabled, legendPosition, showSource, designPlanName, plotSettings + ) + result3 <- .plotTrialDesignPlan( + sampleSizeSurvivalResult, type, main, xlab, ylab, palette, theta, + plotPointsEnabled, legendPosition, showSource, designPlanName, plotSettings + ) + result4 <- .plotTrialDesignPlan( + powerSurvivalResult, type, main, xlab, ylab, palette, theta, + plotPointsEnabled, legendPosition, showSource, designPlanName, plotSettings + ) + result5 <- .plotTrialDesignPlan( + sampleSizeRatesResult, type, main, xlab, ylab, palette, theta, + plotPointsEnabled, legendPosition, showSource, designPlanName, plotSettings + ) + result6 <- .plotTrialDesignPlan( + powerRatesResult, type, main, xlab, ylab, palette, theta, + plotPointsEnabled, legendPosition, showSource, designPlanName, plotSettings + ) + expect_type(result1, "list") + expect_type(result2, "list") + expect_type(result3, "list") + expect_type(result4, "list") + expect_type(result5, "list") + expect_type(result6, "list") } - type_bad <- c(5, 8, 10, 11, 12, 13, 14) - for (i in type_bad) { - expect_error(.plotTrialDesignPlan(designPlan_power, type_bad[i], main, xlab, ylab, palette, theta, - plotPointsEnabled, legendPosition, showSource, designPlanName, plotSettings)) + + for (illegalType in c(5, 8, 10, 11, 12, 13, 14)) { + expect_error(.plotTrialDesignPlan( + designPlan_power, illegalType, main, xlab, ylab, palette, theta, + plotPointsEnabled, legendPosition, showSource, designPlanName, plotSettings + )) } + expect_error(.plotTrialDesignPlan()) - expect_error(.plotTrialDesignPlan(designGS1)) + + designGS <- getDesignGroupSequential( + informationRates = c(0.2, 0.5, 1), + sided = 1, beta = 0.1, typeOfDesign = "WT", deltaWT = 0.3 + ) + expect_equal(.isTrialDesignPlanSurvival(designGS), FALSE) + + expect_error(.plotTrialDesignPlan(designGS)) expect_error(.warnInCaseOfUnusedValuesForPlottingMeans()) expect_error(.warnInCaseOfUnusedValuesForPlottingRates()) diff --git a/tests/testthat/test-f_parameter_set_utilities.R b/tests/testthat/test-f_parameter_set_utilities.R index 1de0caff..d5d433e3 100644 --- a/tests/testthat/test-f_parameter_set_utilities.R +++ b/tests/testthat/test-f_parameter_set_utilities.R @@ -1,86 +1,87 @@ -## | -## | *Unit tests* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | RPACT package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File name: test-f_parameter_set_utilities.R -## | Creation date: 08 November 2023, 09:10:53 -## | File version: $Revision$ -## | Last changed: $Date$ -## | Last changed by: $Author$ -## | - -test_plan_section("Testing Parameter Set Utility Functions") - - -test_that("'.getParameterValueFormatted' produce correct results if parameter is an array", { - x1 <- getSimulationMultiArmMeans(getDesignInverseNormal(kMax = 2), plannedSubjects = c(30, 60), muMaxVector = 0, seed = 123, maxNumberOfIterations = 50L) - y1 <- .getParameterValueFormatted(x1, "sampleSizes") - - expect_equal("sampleSizes", y1$paramName) - expect_equal(c(x1$.design$kMax, length(x1$muMaxVector), x1$activeArms + 1), dim(y1$paramValue)) - expect_equal(length(as.vector(y1$paramValue)), length(y1$paramValueFormatted)) - expect_equal("character", class(y1$paramValueFormatted)[1]) - expect_equal("array", y1$type) - - x2 <- getSimulationMultiArmMeans(getDesignInverseNormal(kMax = 2), plannedSubjects = c(50, 100), muMaxVector = c(0, 1), seed = 123, maxNumberOfIterations = 50L) - lines2a <- capture.output(print(x2)) - lines2 <- lines2a[grepl("Sample sizes ", lines2a)] - expect_match(lines2[1], "^ *Sample sizes \\(1\\) \\[1\\] *: 50, 50 *$") - expect_match(lines2[2], "^ *Sample sizes \\(1\\) \\[2\\] *: 17, 0 *$") - expect_match(lines2[3], "^ *Sample sizes \\(2\\) \\[1\\] *: 50, 50 *$") - expect_match(lines2[4], "^ *Sample sizes \\(2\\) \\[2\\] *: 17, 3.3 *$") - expect_match(lines2[5], "^ *Sample sizes \\(3\\) \\[1\\] *: 50, 50 *$") - expect_match(lines2[6], "^ *Sample sizes \\(3\\) \\[2\\] *: 16, 46.7 *$") - expect_match(lines2[7], "^ *Sample sizes \\(4\\) \\[1\\] *: 50, 50 *$") - expect_match(lines2[8], "^ *Sample sizes \\(4\\) \\[2\\] *: 50, 50 *$") - - x3 <- getSimulationMultiArmMeans(getDesignInverseNormal(kMax = 1), plannedSubjects = 50, muMaxVector = c(0, 1), seed = 123, maxNumberOfIterations = 50L) - - y3 <- .getParameterValueFormatted(x3, "sampleSizes") - - expect_equal("sampleSizes", y3$paramName) - expect_equal(c(x3$.design$kMax, length(x3$muMaxVector), x3$activeArms + 1), dim(y3$paramValue)) - expect_equal(length(as.vector(y3$paramValue)), length(y3$paramValueFormatted) * 2) - expect_equal("character", class(y3$paramValueFormatted)[1]) - expect_equal("array", y3$type) - - lines3a <- capture.output(print(x3)) - lines3 <- lines3a[grepl("Sample sizes ", lines3a)] - expect_match(lines3[1], "^ *Sample sizes \\(1\\) *: 50, 50 *$") - expect_match(lines3[2], "^ *Sample sizes \\(2\\) *: 50, 50 *$") - expect_match(lines3[3], "^ *Sample sizes \\(3\\) *: 50, 50 *$") - expect_match(lines3[4], "^ *Sample sizes \\(4\\) *: 50, 50 *$") - - x4 <- getSimulationMultiArmMeans(getDesignInverseNormal(kMax = 2), plannedSubjects = c(50, 100), muMaxVector = 0, seed = 123, maxNumberOfIterations = 50L) - - y4 <- .getParameterValueFormatted(x4, "sampleSizes") - - expect_equal("sampleSizes", y4$paramName) - expect_equal(c(x4$.design$kMax, length(x4$muMaxVector), x4$activeArms + 1), dim(y4$paramValue)) - expect_equal(length(as.vector(y4$paramValue)), length(y4$paramValueFormatted)) - expect_equal("character", class(y4$paramValueFormatted)[1]) - expect_equal("array", y4$type) - - lines4a <- capture.output(print(x4)) - lines4 <- lines4a[grepl("Sample sizes ", lines4a)] - expect_match(lines4[1], "^ *Sample sizes \\(1\\) \\[1\\] *: 50 *$") - expect_match(lines4[2], "^ *Sample sizes \\(1\\) \\[2\\] *: 17 *$") - expect_match(lines4[3], "^ *Sample sizes \\(2\\) \\[1\\] *: 50 *$") - expect_match(lines4[4], "^ *Sample sizes \\(2\\) \\[2\\] *: 17 *$") - expect_match(lines4[5], "^ *Sample sizes \\(3\\) \\[1\\] *: 50 *$") - expect_match(lines4[6], "^ *Sample sizes \\(3\\) \\[2\\] *: 16 *$") - expect_match(lines4[7], "^ *Sample sizes \\(4\\) \\[1\\] *: 50 *$") - expect_match(lines4[8], "^ *Sample sizes \\(4\\) \\[2\\] *: 50 *$") -}) - +## | +## | *Unit tests* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | RPACT package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File name: test-f_parameter_set_utilities.R +## | Creation date: 08 November 2023, 09:10:53 +## | File version: $Revision$ +## | Last changed: $Date$ +## | Last changed by: $Author$ +## | + +test_plan_section("Testing Parameter Set Utility Functions") + + +test_that("'.getParameterValueFormatted' produce correct results if parameter is an array", { + x1 <- getSimulationMultiArmMeans(getDesignInverseNormal(kMax = 2), plannedSubjects = c(30, 60), muMaxVector = 0, seed = 123, maxNumberOfIterations = 50L) + y1 <- .getParameterValueFormatted(x1, "sampleSizes") + + expect_equal("sampleSizes", y1$paramName) + expect_equal(c(x1$.design$kMax, length(x1$muMaxVector), x1$activeArms + 1), dim(y1$paramValue)) + expect_equal(length(as.vector(y1$paramValue)), length(y1$paramValueFormatted)) + expect_equal("character", class(y1$paramValueFormatted)[1]) + expect_equal("array", y1$type) + + x2 <- getSimulationMultiArmMeans(getDesignInverseNormal(kMax = 2), plannedSubjects = c(50, 100), muMaxVector = c(0, 1), seed = 123, maxNumberOfIterations = 50L) + lines2a <- capture.output(print(x2)) + lines2 <- lines2a[grepl("Sample sizes ", lines2a)] + expect_match(lines2[1], "^ *Sample sizes \\(1\\) \\[1\\] *: 50, 50 *$") + expect_match(lines2[2], "^ *Sample sizes \\(1\\) \\[2\\] *: 17, 0 *$") + expect_match(lines2[3], "^ *Sample sizes \\(2\\) \\[1\\] *: 50, 50 *$") + expect_match(lines2[4], "^ *Sample sizes \\(2\\) \\[2\\] *: 17, 3.3 *$") + expect_match(lines2[5], "^ *Sample sizes \\(3\\) \\[1\\] *: 50, 50 *$") + expect_match(lines2[6], "^ *Sample sizes \\(3\\) \\[2\\] *: 16, 46.7 *$") + expect_match(lines2[7], "^ *Sample sizes \\(4\\) \\[1\\] *: 50, 50 *$") + expect_match(lines2[8], "^ *Sample sizes \\(4\\) \\[2\\] *: 50, 50 *$") + + x3 <- getSimulationMultiArmMeans(getDesignInverseNormal(kMax = 1), plannedSubjects = 50, muMaxVector = c(0, 1), seed = 123, maxNumberOfIterations = 50L) + + y3 <- .getParameterValueFormatted(x3, "sampleSizes") + + expect_equal("sampleSizes", y3$paramName) + expect_equal(c(x3$.design$kMax, length(x3$muMaxVector), x3$activeArms + 1), dim(y3$paramValue)) + expect_equal(length(as.vector(y3$paramValue)), length(y3$paramValueFormatted) * 2) + expect_equal("character", class(y3$paramValueFormatted)[1]) + expect_equal("array", y3$type) + + lines3a <- capture.output(print(x3)) + lines3 <- lines3a[grepl("Sample sizes ", lines3a)] + expect_match(lines3[1], "^ *Sample sizes \\(1\\) *: 50, 50 *$") + expect_match(lines3[2], "^ *Sample sizes \\(2\\) *: 50, 50 *$") + expect_match(lines3[3], "^ *Sample sizes \\(3\\) *: 50, 50 *$") + expect_match(lines3[4], "^ *Sample sizes \\(4\\) *: 50, 50 *$") + + x4 <- getSimulationMultiArmMeans(getDesignInverseNormal(kMax = 2), plannedSubjects = c(50, 100), muMaxVector = 0, seed = 123, maxNumberOfIterations = 50L) + + y4 <- .getParameterValueFormatted(x4, "sampleSizes") + + expect_equal("sampleSizes", y4$paramName) + expect_equal(c(x4$.design$kMax, length(x4$muMaxVector), x4$activeArms + 1), dim(y4$paramValue)) + expect_equal(length(as.vector(y4$paramValue)), length(y4$paramValueFormatted)) + expect_equal("character", class(y4$paramValueFormatted)[1]) + expect_equal("array", y4$type) + + lines4a <- capture.output(print(x4)) + lines4 <- lines4a[grepl("Sample sizes ", lines4a)] + expect_match(lines4[1], "^ *Sample sizes \\(1\\) \\[1\\] *: 50 *$") + expect_match(lines4[2], "^ *Sample sizes \\(1\\) \\[2\\] *: 17 *$") + expect_match(lines4[3], "^ *Sample sizes \\(2\\) \\[1\\] *: 50 *$") + expect_match(lines4[4], "^ *Sample sizes \\(2\\) \\[2\\] *: 17 *$") + expect_match(lines4[5], "^ *Sample sizes \\(3\\) \\[1\\] *: 50 *$") + expect_match(lines4[6], "^ *Sample sizes \\(3\\) \\[2\\] *: 16 *$") + expect_match(lines4[7], "^ *Sample sizes \\(4\\) \\[1\\] *: 50 *$") + expect_match(lines4[8], "^ *Sample sizes \\(4\\) \\[2\\] *: 50 *$") + +}) + diff --git a/tests/testthat/test-f_simulation_base_means.R b/tests/testthat/test-f_simulation_base_means.R index dc2d38b0..c7ee5ce7 100644 --- a/tests/testthat/test-f_simulation_base_means.R +++ b/tests/testthat/test-f_simulation_base_means.R @@ -1,2448 +1,2437 @@ -## | +## | ## | *Unit tests* -## | +## | ## | This file is part of the R package rpact: ## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | +## | ## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD ## | Licensed under "GNU Lesser General Public License" version 3 ## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | +## | ## | RPACT company website: https://www.rpact.com ## | RPACT package website: https://www.rpact.org -## | +## | ## | Contact us for information about our services: info@rpact.com -## | +## | ## | File name: test-f_simulation_base_means.R -## | Creation date: 08 November 2023, 09:10:53 -## | File version: $Revision$ -## | Last changed: $Date$ -## | Last changed by: $Author$ -## | +## | Creation date: 07 March 2024, 13:13:26 +## | File version: $Revision: 7702 $ +## | Last changed: $Date: 2024-03-07 13:30:30 +0100 (Do, 07 Mrz 2024) $ +## | Last changed by: $Author: pahlke $ +## | test_plan_section("Testing Simulation Means Function") test_that("'getSimulationMeans': several configurations", { - # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} - # @refFS[Sec.]{fs:sec:simulatingTestingOneHypothesis} - # @refFS[Tab.]{fs:tab:output:getSimulationMeans} - # @refFS[Formula]{fs:simulationOneArmMeansTestStatistics} - # @refFS[Formula]{fs:simulationTwoArmMeansTestStatisticsDiff} - # @refFS[Formula]{fs:simulationTwoArmMeansTestStatisticsRatio} - # @refFS[Formula]{fs:testStatisticGroupSequentialWeightedAverage} - # @refFS[Formula]{fs:testStatisticNormalCombinationTest} - # @refFS[Formula]{fs:testStatisticFisherCombinationTest} - maxNumberOfIterations <- 100 - seed <- 99123 - options(width = 180) - maxNumberOfSubjects <- 90 - informationRates <- c(0.2, 0.5, 1) - plannedSubjects <- round(informationRates * maxNumberOfSubjects) - - x1 <- getSimulationMeans( - design = getDesignInverseNormal( - futilityBounds = c(-0.5, 0.5), - informationRates = c(0.2, 0.5, 1) - ), groups = 2, meanRatio = TRUE, thetaH0 = 0.4, - plannedSubjects = plannedSubjects, maxNumberOfIterations = maxNumberOfIterations, - allocationRatioPlanned = 3, stDev = 1.5, seed = seed - ) - - ## Comparison of the results of SimulationResultsMeans object 'x1' with expected results - expect_equal(x1$effect, c(0.6, 0.8, 1, 1.2, 1.4, 1.6), tolerance = 1e-07, label = paste0("c(", paste0(x1$effect, collapse = ", "), ")")) - expect_equal(x1$iterations[1, ], c(100, 100, 100, 100, 100, 100), label = paste0("c(", paste0(x1$iterations[1, ], collapse = ", "), ")")) - expect_equal(x1$iterations[2, ], c(96, 100, 100, 94, 97, 95), label = paste0("c(", paste0(x1$iterations[2, ], collapse = ", "), ")")) - expect_equal(x1$iterations[3, ], c(72, 68, 37, 16, 2, 2), label = paste0("c(", paste0(x1$iterations[3, ], collapse = ", "), ")")) - expect_equal(x1$overallReject, c(0.81, 0.93, 0.99, 0.99, 1, 1), tolerance = 1e-07, label = paste0("c(", paste0(x1$overallReject, collapse = ", "), ")")) - expect_equal(x1$rejectPerStage[1, ], c(0, 0, 0, 0.05, 0.03, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(x1$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x1$rejectPerStage[2, ], c(0.2, 0.29, 0.62, 0.78, 0.95, 0.93), tolerance = 1e-07, label = paste0("c(", paste0(x1$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x1$rejectPerStage[3, ], c(0.61, 0.64, 0.37, 0.16, 0.02, 0.02), tolerance = 1e-07, label = paste0("c(", paste0(x1$rejectPerStage[3, ], collapse = ", "), ")")) - expect_equal(x1$futilityStop, c(0.08, 0.03, 0.01, 0.01, 0, 0), tolerance = 1e-07, label = paste0("c(", paste0(x1$futilityStop, collapse = ", "), ")")) - expect_equal(x1$futilityPerStage[1, ], c(0.04, 0, 0, 0.01, 0, 0), tolerance = 1e-07, label = paste0("c(", paste0(x1$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x1$futilityPerStage[2, ], c(0.04, 0.03, 0.01, 0, 0, 0), tolerance = 1e-07, label = paste0("c(", paste0(x1$futilityPerStage[2, ], collapse = ", "), ")")) - expect_equal(x1$earlyStop, c(0.28, 0.32, 0.63, 0.84, 0.98, 0.98), tolerance = 1e-07, label = paste0("c(", paste0(x1$earlyStop, collapse = ", "), ")")) - expect_equal(x1$expectedNumberOfSubjects, c(76.32, 75.6, 61.65, 50.58, 45.09, 44.55), tolerance = 1e-07, label = paste0("c(", paste0(x1$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x1$sampleSizes[1, ], c(18, 18, 18, 18, 18, 18), label = paste0("c(", paste0(x1$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x1$sampleSizes[2, ], c(27, 27, 27, 27, 27, 27), label = paste0("c(", paste0(x1$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x1$sampleSizes[3, ], c(45, 45, 45, 45, 45, 45), label = paste0("c(", paste0(x1$sampleSizes[3, ], collapse = ", "), ")")) - expect_equal(x1$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x1$conditionalPowerAchieved[2, ], c(0.26405311, 0.35839614, 0.48830732, 0.63603264, 0.77682482, 0.82707873), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - expect_equal(x1$conditionalPowerAchieved[3, ], c(0.60511343, 0.74281632, 0.84083206, 0.87094401, 0.89751119, 0.97110806), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPowerAchieved[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x1), NA))) - expect_output(print(x1)$show()) - invisible(capture.output(expect_error(summary(x1), NA))) - expect_output(summary(x1)$show()) - x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) - expect_equal(x1CodeBased$effect, x1$effect, tolerance = 1e-07) - expect_equal(x1CodeBased$iterations, x1$iterations, tolerance = 1e-07) - expect_equal(x1CodeBased$overallReject, x1$overallReject, tolerance = 1e-07) - expect_equal(x1CodeBased$rejectPerStage, x1$rejectPerStage, tolerance = 1e-07) - expect_equal(x1CodeBased$futilityStop, x1$futilityStop, tolerance = 1e-07) - expect_equal(x1CodeBased$futilityPerStage, x1$futilityPerStage, tolerance = 1e-07) - expect_equal(x1CodeBased$earlyStop, x1$earlyStop, tolerance = 1e-07) - expect_equal(x1CodeBased$expectedNumberOfSubjects, x1$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x1CodeBased$sampleSizes, x1$sampleSizes, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalPowerAchieved, x1$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x1), "character") - df <- as.data.frame(x1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - .skipTestIfDisabled() - - x2 <- getSimulationMeans( - design = getDesignInverseNormal( - futilityBounds = c(-0.5, 0.5), - informationRates = c(0.2, 0.5, 1) - ), groups = 2, meanRatio = FALSE, thetaH0 = 0.2, - plannedSubjects = plannedSubjects, maxNumberOfIterations = maxNumberOfIterations, - allocationRatioPlanned = 3, stDev = 1.5, seed = seed - ) - - ## Comparison of the results of SimulationResultsMeans object 'x2' with expected results - expect_equal(x2$effect, c(-0.2, 0, 0.2, 0.4, 0.6, 0.8), tolerance = 1e-07, label = paste0("c(", paste0(x2$effect, collapse = ", "), ")")) - expect_equal(x2$iterations[1, ], c(100, 100, 100, 100, 100, 100), label = paste0("c(", paste0(x2$iterations[1, ], collapse = ", "), ")")) - expect_equal(x2$iterations[2, ], c(63, 73, 84, 83, 89, 96), label = paste0("c(", paste0(x2$iterations[2, ], collapse = ", "), ")")) - expect_equal(x2$iterations[3, ], c(15, 24, 42, 53, 69, 76), label = paste0("c(", paste0(x2$iterations[3, ], collapse = ", "), ")")) - expect_equal(x2$overallReject, c(0, 0.02, 0.07, 0.18, 0.33, 0.53), tolerance = 1e-07, label = paste0("c(", paste0(x2$overallReject, collapse = ", "), ")")) - expect_equal(x2$rejectPerStage[1, ], c(0, 0, 0, 0, 0, 0), label = paste0("c(", paste0(x2$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x2$rejectPerStage[2, ], c(0, 0, 0.02, 0.03, 0.06, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(x2$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x2$rejectPerStage[3, ], c(0, 0.02, 0.05, 0.15, 0.27, 0.43), tolerance = 1e-07, label = paste0("c(", paste0(x2$rejectPerStage[3, ], collapse = ", "), ")")) - expect_equal(x2$futilityStop, c(0.85, 0.76, 0.56, 0.44, 0.25, 0.14), tolerance = 1e-07, label = paste0("c(", paste0(x2$futilityStop, collapse = ", "), ")")) - expect_equal(x2$futilityPerStage[1, ], c(0.37, 0.27, 0.16, 0.17, 0.11, 0.04), tolerance = 1e-07, label = paste0("c(", paste0(x2$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x2$futilityPerStage[2, ], c(0.48, 0.49, 0.4, 0.27, 0.14, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(x2$futilityPerStage[2, ], collapse = ", "), ")")) - expect_equal(x2$earlyStop, c(0.85, 0.76, 0.58, 0.47, 0.31, 0.24), tolerance = 1e-07, label = paste0("c(", paste0(x2$earlyStop, collapse = ", "), ")")) - expect_equal(x2$expectedNumberOfSubjects, c(41.76, 48.51, 59.58, 64.26, 73.08, 78.12), tolerance = 1e-07, label = paste0("c(", paste0(x2$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x2$sampleSizes[1, ], c(18, 18, 18, 18, 18, 18), label = paste0("c(", paste0(x2$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x2$sampleSizes[2, ], c(27, 27, 27, 27, 27, 27), label = paste0("c(", paste0(x2$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x2$sampleSizes[3, ], c(45, 45, 45, 45, 45, 45), label = paste0("c(", paste0(x2$sampleSizes[3, ], collapse = ", "), ")")) - expect_equal(x2$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x2$conditionalPowerAchieved[2, ], c(0.056595809, 0.082243527, 0.1171868, 0.14183443, 0.20192022, 0.18371302), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - expect_equal(x2$conditionalPowerAchieved[3, ], c(0.36165449, 0.31543938, 0.36771185, 0.4758946, 0.54527876, 0.61204049), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalPowerAchieved[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x2), NA))) - expect_output(print(x2)$show()) - invisible(capture.output(expect_error(summary(x2), NA))) - expect_output(summary(x2)$show()) - x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) - expect_equal(x2CodeBased$effect, x2$effect, tolerance = 1e-07) - expect_equal(x2CodeBased$iterations, x2$iterations, tolerance = 1e-07) - expect_equal(x2CodeBased$overallReject, x2$overallReject, tolerance = 1e-07) - expect_equal(x2CodeBased$rejectPerStage, x2$rejectPerStage, tolerance = 1e-07) - expect_equal(x2CodeBased$futilityStop, x2$futilityStop, tolerance = 1e-07) - expect_equal(x2CodeBased$futilityPerStage, x2$futilityPerStage, tolerance = 1e-07) - expect_equal(x2CodeBased$earlyStop, x2$earlyStop, tolerance = 1e-07) - expect_equal(x2CodeBased$expectedNumberOfSubjects, x2$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x2CodeBased$sampleSizes, x2$sampleSizes, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalPowerAchieved, x2$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x2), "character") - df <- as.data.frame(x2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x3 <- getSimulationMeans( - design = getDesignInverseNormal( - futilityBounds = c(-0.5, 0.5), - informationRates = c(0.2, 0.5, 1) - ), groups = 1, thetaH0 = 0.2, - plannedSubjects = plannedSubjects, maxNumberOfIterations = maxNumberOfIterations, - stDev = 1.5, seed = seed - ) - - ## Comparison of the results of SimulationResultsMeans object 'x3' with expected results - expect_equal(x3$effect, c(-0.2, 0, 0.2, 0.4, 0.6, 0.8), tolerance = 1e-07, label = paste0("c(", paste0(x3$effect, collapse = ", "), ")")) - expect_equal(x3$iterations[1, ], c(100, 100, 100, 100, 100, 100), label = paste0("c(", paste0(x3$iterations[1, ], collapse = ", "), ")")) - expect_equal(x3$iterations[2, ], c(50, 71, 87, 96, 97, 99), label = paste0("c(", paste0(x3$iterations[2, ], collapse = ", "), ")")) - expect_equal(x3$iterations[3, ], c(9, 21, 63, 67, 49, 29), label = paste0("c(", paste0(x3$iterations[3, ], collapse = ", "), ")")) - expect_equal(x3$overallReject, c(0, 0.02, 0.21, 0.59, 0.94, 1), tolerance = 1e-07, label = paste0("c(", paste0(x3$overallReject, collapse = ", "), ")")) - expect_equal(x3$rejectPerStage[1, ], c(0, 0, 0, 0, 0, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(x3$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x3$rejectPerStage[2, ], c(0, 0, 0.03, 0.21, 0.47, 0.7), tolerance = 1e-07, label = paste0("c(", paste0(x3$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x3$rejectPerStage[3, ], c(0, 0.02, 0.18, 0.38, 0.47, 0.29), tolerance = 1e-07, label = paste0("c(", paste0(x3$rejectPerStage[3, ], collapse = ", "), ")")) - expect_equal(x3$futilityStop, c(0.91, 0.79, 0.34, 0.12, 0.04, 0), tolerance = 1e-07, label = paste0("c(", paste0(x3$futilityStop, collapse = ", "), ")")) - expect_equal(x3$futilityPerStage[1, ], c(0.5, 0.29, 0.13, 0.04, 0.03, 0), tolerance = 1e-07, label = paste0("c(", paste0(x3$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x3$futilityPerStage[2, ], c(0.41, 0.5, 0.21, 0.08, 0.01, 0), tolerance = 1e-07, label = paste0("c(", paste0(x3$futilityPerStage[2, ], collapse = ", "), ")")) - expect_equal(x3$earlyStop, c(0.91, 0.79, 0.37, 0.33, 0.51, 0.71), tolerance = 1e-07, label = paste0("c(", paste0(x3$earlyStop, collapse = ", "), ")")) - expect_equal(x3$expectedNumberOfSubjects, c(35.55, 46.62, 69.84, 74.07, 66.24, 57.78), tolerance = 1e-07, label = paste0("c(", paste0(x3$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x3$sampleSizes[1, ], c(18, 18, 18, 18, 18, 18), label = paste0("c(", paste0(x3$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x3$sampleSizes[2, ], c(27, 27, 27, 27, 27, 27), label = paste0("c(", paste0(x3$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x3$sampleSizes[3, ], c(45, 45, 45, 45, 45, 45), label = paste0("c(", paste0(x3$sampleSizes[3, ], collapse = ", "), ")")) - expect_equal(x3$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x3$conditionalPowerAchieved[2, ], c(0.047252355, 0.074094582, 0.18424333, 0.30402818, 0.54078356, 0.67131653), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - expect_equal(x3$conditionalPowerAchieved[3, ], c(0.27249296, 0.30454177, 0.45212728, 0.62638376, 0.84307565, 0.91215549), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalPowerAchieved[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x3), NA))) - expect_output(print(x3)$show()) - invisible(capture.output(expect_error(summary(x3), NA))) - expect_output(summary(x3)$show()) - x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) - expect_equal(x3CodeBased$effect, x3$effect, tolerance = 1e-07) - expect_equal(x3CodeBased$iterations, x3$iterations, tolerance = 1e-07) - expect_equal(x3CodeBased$overallReject, x3$overallReject, tolerance = 1e-07) - expect_equal(x3CodeBased$rejectPerStage, x3$rejectPerStage, tolerance = 1e-07) - expect_equal(x3CodeBased$futilityStop, x3$futilityStop, tolerance = 1e-07) - expect_equal(x3CodeBased$futilityPerStage, x3$futilityPerStage, tolerance = 1e-07) - expect_equal(x3CodeBased$earlyStop, x3$earlyStop, tolerance = 1e-07) - expect_equal(x3CodeBased$expectedNumberOfSubjects, x3$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x3CodeBased$sampleSizes, x3$sampleSizes, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalPowerAchieved, x3$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x3), "character") - df <- as.data.frame(x3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x4 <- getSimulationMeans( - design = getDesignInverseNormal( - futilityBounds = c(-0.5, 0.5), - informationRates = c(0.2, 0.5, 1) - ), groups = 2, meanRatio = TRUE, thetaH0 = 1.1, - plannedSubjects = plannedSubjects, maxNumberOfIterations = maxNumberOfIterations, - allocationRatioPlanned = 3, stDev = 1.5, directionUpper = FALSE, seed = seed - ) - - ## Comparison of the results of SimulationResultsMeans object 'x4' with expected results - expect_equal(x4$effect, c(-0.1, 0.1, 0.3, 0.5, 0.7, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(x4$effect, collapse = ", "), ")")) - expect_equal(x4$iterations[1, ], c(100, 100, 100, 100, 100, 100), label = paste0("c(", paste0(x4$iterations[1, ], collapse = ", "), ")")) - expect_equal(x4$iterations[2, ], c(76, 71, 52, 52, 45, 23), label = paste0("c(", paste0(x4$iterations[2, ], collapse = ", "), ")")) - expect_equal(x4$iterations[3, ], c(31, 27, 10, 12, 3, 3), label = paste0("c(", paste0(x4$iterations[3, ], collapse = ", "), ")")) - expect_equal(x4$overallReject, c(0.01, 0.02, 0, 0, 0, 0), tolerance = 1e-07, label = paste0("c(", paste0(x4$overallReject, collapse = ", "), ")")) - expect_equal(x4$rejectPerStage[1, ], c(0, 0, 0, 0, 0, 0), label = paste0("c(", paste0(x4$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x4$rejectPerStage[2, ], c(0, 0, 0, 0, 0, 0), label = paste0("c(", paste0(x4$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x4$rejectPerStage[3, ], c(0.01, 0.02, 0, 0, 0, 0), tolerance = 1e-07, label = paste0("c(", paste0(x4$rejectPerStage[3, ], collapse = ", "), ")")) - expect_equal(x4$futilityStop, c(0.69, 0.73, 0.9, 0.88, 0.97, 0.97), tolerance = 1e-07, label = paste0("c(", paste0(x4$futilityStop, collapse = ", "), ")")) - expect_equal(x4$futilityPerStage[1, ], c(0.24, 0.29, 0.48, 0.48, 0.55, 0.77), tolerance = 1e-07, label = paste0("c(", paste0(x4$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x4$futilityPerStage[2, ], c(0.45, 0.44, 0.42, 0.4, 0.42, 0.2), tolerance = 1e-07, label = paste0("c(", paste0(x4$futilityPerStage[2, ], collapse = ", "), ")")) - expect_equal(x4$earlyStop, c(0.69, 0.73, 0.9, 0.88, 0.97, 0.97), tolerance = 1e-07, label = paste0("c(", paste0(x4$earlyStop, collapse = ", "), ")")) - expect_equal(x4$expectedNumberOfSubjects, c(52.47, 49.32, 36.54, 37.44, 31.5, 25.56), tolerance = 1e-07, label = paste0("c(", paste0(x4$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x4$sampleSizes[1, ], c(18, 18, 18, 18, 18, 18), label = paste0("c(", paste0(x4$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x4$sampleSizes[2, ], c(27, 27, 27, 27, 27, 27), label = paste0("c(", paste0(x4$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x4$sampleSizes[3, ], c(45, 45, 45, 45, 45, 45), label = paste0("c(", paste0(x4$sampleSizes[3, ], collapse = ", "), ")")) - expect_equal(x4$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x4$conditionalPowerAchieved[2, ], c(0.088210955, 0.073662665, 0.032364394, 0.040456333, 0.047760081, 0.047799584), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - expect_equal(x4$conditionalPowerAchieved[3, ], c(0.34802745, 0.34204022, 0.18915629, 0.18461746, 0.36492317, 0.12863193), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalPowerAchieved[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x4), NA))) - expect_output(print(x4)$show()) - invisible(capture.output(expect_error(summary(x4), NA))) - expect_output(summary(x4)$show()) - x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) - expect_equal(x4CodeBased$effect, x4$effect, tolerance = 1e-07) - expect_equal(x4CodeBased$iterations, x4$iterations, tolerance = 1e-07) - expect_equal(x4CodeBased$overallReject, x4$overallReject, tolerance = 1e-07) - expect_equal(x4CodeBased$rejectPerStage, x4$rejectPerStage, tolerance = 1e-07) - expect_equal(x4CodeBased$futilityStop, x4$futilityStop, tolerance = 1e-07) - expect_equal(x4CodeBased$futilityPerStage, x4$futilityPerStage, tolerance = 1e-07) - expect_equal(x4CodeBased$earlyStop, x4$earlyStop, tolerance = 1e-07) - expect_equal(x4CodeBased$expectedNumberOfSubjects, x4$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x4CodeBased$sampleSizes, x4$sampleSizes, tolerance = 1e-07) - expect_equal(x4CodeBased$conditionalPowerAchieved, x4$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x4), "character") - df <- as.data.frame(x4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x5 <- getSimulationMeans( - design = getDesignInverseNormal( - futilityBounds = c(-0.5, 0.5), - informationRates = c(0.2, 0.5, 1) - ), groups = 2, meanRatio = FALSE, thetaH0 = 1.1, - plannedSubjects = plannedSubjects, maxNumberOfIterations = maxNumberOfIterations, - allocationRatioPlanned = 3, stDev = 1.5, directionUpper = FALSE, seed = seed - ) - - ## Comparison of the results of SimulationResultsMeans object 'x5' with expected results - expect_equal(x5$effect, c(-1.1, -0.9, -0.7, -0.5, -0.3, -0.1), tolerance = 1e-07, label = paste0("c(", paste0(x5$effect, collapse = ", "), ")")) - expect_equal(x5$iterations[1, ], c(100, 100, 100, 100, 100, 100), label = paste0("c(", paste0(x5$iterations[1, ], collapse = ", "), ")")) - expect_equal(x5$iterations[2, ], c(98, 96, 88, 84, 82, 79), label = paste0("c(", paste0(x5$iterations[2, ], collapse = ", "), ")")) - expect_equal(x5$iterations[3, ], c(77, 74, 69, 58, 54, 43), label = paste0("c(", paste0(x5$iterations[3, ], collapse = ", "), ")")) - expect_equal(x5$overallReject, c(0.78, 0.71, 0.51, 0.27, 0.13, 0.04), tolerance = 1e-07, label = paste0("c(", paste0(x5$overallReject, collapse = ", "), ")")) - expect_equal(x5$rejectPerStage[1, ], c(0, 0, 0, 0, 0, 0), label = paste0("c(", paste0(x5$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x5$rejectPerStage[2, ], c(0.19, 0.14, 0.08, 0.06, 0, 0), tolerance = 1e-07, label = paste0("c(", paste0(x5$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x5$rejectPerStage[3, ], c(0.59, 0.57, 0.43, 0.21, 0.13, 0.04), tolerance = 1e-07, label = paste0("c(", paste0(x5$rejectPerStage[3, ], collapse = ", "), ")")) - expect_equal(x5$futilityStop, c(0.04, 0.12, 0.23, 0.36, 0.46, 0.57), tolerance = 1e-07, label = paste0("c(", paste0(x5$futilityStop, collapse = ", "), ")")) - expect_equal(x5$futilityPerStage[1, ], c(0.02, 0.04, 0.12, 0.16, 0.18, 0.21), tolerance = 1e-07, label = paste0("c(", paste0(x5$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x5$futilityPerStage[2, ], c(0.02, 0.08, 0.11, 0.2, 0.28, 0.36), tolerance = 1e-07, label = paste0("c(", paste0(x5$futilityPerStage[2, ], collapse = ", "), ")")) - expect_equal(x5$earlyStop, c(0.23, 0.26, 0.31, 0.42, 0.46, 0.57), tolerance = 1e-07, label = paste0("c(", paste0(x5$earlyStop, collapse = ", "), ")")) - expect_equal(x5$expectedNumberOfSubjects, c(79.11, 77.22, 72.81, 66.78, 64.44, 58.68), tolerance = 1e-07, label = paste0("c(", paste0(x5$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x5$sampleSizes[1, ], c(18, 18, 18, 18, 18, 18), label = paste0("c(", paste0(x5$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x5$sampleSizes[2, ], c(27, 27, 27, 27, 27, 27), label = paste0("c(", paste0(x5$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x5$sampleSizes[3, ], c(45, 45, 45, 45, 45, 45), label = paste0("c(", paste0(x5$sampleSizes[3, ], collapse = ", "), ")")) - expect_equal(x5$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x5$conditionalPowerAchieved[2, ], c(0.33588936, 0.25194744, 0.19824827, 0.19178721, 0.11444971, 0.092566355), tolerance = 1e-07, label = paste0("c(", paste0(x5$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - expect_equal(x5$conditionalPowerAchieved[3, ], c(0.74226501, 0.69902839, 0.55641803, 0.50033698, 0.45636572, 0.33236099), tolerance = 1e-07, label = paste0("c(", paste0(x5$conditionalPowerAchieved[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x5), NA))) - expect_output(print(x5)$show()) - invisible(capture.output(expect_error(summary(x5), NA))) - expect_output(summary(x5)$show()) - x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) - expect_equal(x5CodeBased$effect, x5$effect, tolerance = 1e-07) - expect_equal(x5CodeBased$iterations, x5$iterations, tolerance = 1e-07) - expect_equal(x5CodeBased$overallReject, x5$overallReject, tolerance = 1e-07) - expect_equal(x5CodeBased$rejectPerStage, x5$rejectPerStage, tolerance = 1e-07) - expect_equal(x5CodeBased$futilityStop, x5$futilityStop, tolerance = 1e-07) - expect_equal(x5CodeBased$futilityPerStage, x5$futilityPerStage, tolerance = 1e-07) - expect_equal(x5CodeBased$earlyStop, x5$earlyStop, tolerance = 1e-07) - expect_equal(x5CodeBased$expectedNumberOfSubjects, x5$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x5CodeBased$sampleSizes, x5$sampleSizes, tolerance = 1e-07) - expect_equal(x5CodeBased$conditionalPowerAchieved, x5$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x5), "character") - df <- as.data.frame(x5) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x5) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x6 <- getSimulationMeans( - design = getDesignInverseNormal( - futilityBounds = c(-0.5, 0.5), - informationRates = c(0.2, 0.5, 1) - ), groups = 1, thetaH0 = 0.8, - plannedSubjects = plannedSubjects, maxNumberOfIterations = maxNumberOfIterations, - stDev = 1.5, directionUpper = FALSE, seed = seed - ) - - ## Comparison of the results of SimulationResultsMeans object 'x6' with expected results - expect_equal(x6$effect, c(-0.8, -0.6, -0.4, -0.2, 0, 0.2), tolerance = 1e-07, label = paste0("c(", paste0(x6$effect, collapse = ", "), ")")) - expect_equal(x6$iterations[1, ], c(100, 100, 100, 100, 100, 100), label = paste0("c(", paste0(x6$iterations[1, ], collapse = ", "), ")")) - expect_equal(x6$iterations[2, ], c(100, 99, 96, 81, 70, 49), label = paste0("c(", paste0(x6$iterations[2, ], collapse = ", "), ")")) - expect_equal(x6$iterations[3, ], c(22, 43, 75, 57, 27, 7), label = paste0("c(", paste0(x6$iterations[3, ], collapse = ", "), ")")) - expect_equal(x6$overallReject, c(1, 0.96, 0.66, 0.26, 0.02, 0), tolerance = 1e-07, label = paste0("c(", paste0(x6$overallReject, collapse = ", "), ")")) - expect_equal(x6$rejectPerStage[1, ], c(0, 0, 0, 0, 0, 0), label = paste0("c(", paste0(x6$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x6$rejectPerStage[2, ], c(0.78, 0.56, 0.13, 0.05, 0, 0), tolerance = 1e-07, label = paste0("c(", paste0(x6$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x6$rejectPerStage[3, ], c(0.22, 0.4, 0.53, 0.21, 0.02, 0), tolerance = 1e-07, label = paste0("c(", paste0(x6$rejectPerStage[3, ], collapse = ", "), ")")) - expect_equal(x6$futilityStop, c(0, 0.01, 0.12, 0.38, 0.73, 0.93), tolerance = 1e-07, label = paste0("c(", paste0(x6$futilityStop, collapse = ", "), ")")) - expect_equal(x6$futilityPerStage[1, ], c(0, 0.01, 0.04, 0.19, 0.3, 0.51), tolerance = 1e-07, label = paste0("c(", paste0(x6$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x6$futilityPerStage[2, ], c(0, 0, 0.08, 0.19, 0.43, 0.42), tolerance = 1e-07, label = paste0("c(", paste0(x6$futilityPerStage[2, ], collapse = ", "), ")")) - expect_equal(x6$earlyStop, c(0.78, 0.57, 0.25, 0.43, 0.73, 0.93), tolerance = 1e-07, label = paste0("c(", paste0(x6$earlyStop, collapse = ", "), ")")) - expect_equal(x6$expectedNumberOfSubjects, c(54.9, 64.08, 77.67, 65.52, 49.05, 34.38), tolerance = 1e-07, label = paste0("c(", paste0(x6$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x6$sampleSizes[1, ], c(18, 18, 18, 18, 18, 18), label = paste0("c(", paste0(x6$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x6$sampleSizes[2, ], c(27, 27, 27, 27, 27, 27), label = paste0("c(", paste0(x6$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x6$sampleSizes[3, ], c(45, 45, 45, 45, 45, 45), label = paste0("c(", paste0(x6$sampleSizes[3, ], collapse = ", "), ")")) - expect_equal(x6$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x6$conditionalPowerAchieved[2, ], c(0.67267344, 0.52857476, 0.27194206, 0.18361852, 0.064769395, 0.04670856), tolerance = 1e-07, label = paste0("c(", paste0(x6$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - expect_equal(x6$conditionalPowerAchieved[3, ], c(0.81011604, 0.77276452, 0.65795757, 0.50391481, 0.35327029, 0.24591214), tolerance = 1e-07, label = paste0("c(", paste0(x6$conditionalPowerAchieved[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x6), NA))) - expect_output(print(x6)$show()) - invisible(capture.output(expect_error(summary(x6), NA))) - expect_output(summary(x6)$show()) - x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) - expect_equal(x6CodeBased$effect, x6$effect, tolerance = 1e-07) - expect_equal(x6CodeBased$iterations, x6$iterations, tolerance = 1e-07) - expect_equal(x6CodeBased$overallReject, x6$overallReject, tolerance = 1e-07) - expect_equal(x6CodeBased$rejectPerStage, x6$rejectPerStage, tolerance = 1e-07) - expect_equal(x6CodeBased$futilityStop, x6$futilityStop, tolerance = 1e-07) - expect_equal(x6CodeBased$futilityPerStage, x6$futilityPerStage, tolerance = 1e-07) - expect_equal(x6CodeBased$earlyStop, x6$earlyStop, tolerance = 1e-07) - expect_equal(x6CodeBased$expectedNumberOfSubjects, x6$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x6CodeBased$sampleSizes, x6$sampleSizes, tolerance = 1e-07) - expect_equal(x6CodeBased$conditionalPowerAchieved, x6$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x6), "character") - df <- as.data.frame(x6) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x6) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x7 <- getSimulationMeans( - design = getDesignInverseNormal( - futilityBounds = c(-0.5, 0.5), - informationRates = c(0.2, 0.5, 1) - ), groups = 1, thetaH0 = -0.2, - plannedSubjects = plannedSubjects, maxNumberOfIterations = maxNumberOfIterations, - stDev = 3.5, alternative = seq(-1.2, -0.2, 0.2), - conditionalPower = 0.8, - minNumberOfSubjectsPerStage = c(NA, 10, 10), maxNumberOfSubjectsPerStage = c(NA, 100, 100), - directionUpper = FALSE, seed = seed - ) - - ## Comparison of the results of SimulationResultsMeans object 'x7' with expected results - expect_equal(x7$effect, c(-1, -0.8, -0.6, -0.4, -0.2, 0), tolerance = 1e-07, label = paste0("c(", paste0(x7$effect, collapse = ", "), ")")) - expect_equal(x7$iterations[1, ], c(100, 100, 100, 100, 100, 100), label = paste0("c(", paste0(x7$iterations[1, ], collapse = ", "), ")")) - expect_equal(x7$iterations[2, ], c(93, 97, 88, 78, 78, 74), label = paste0("c(", paste0(x7$iterations[2, ], collapse = ", "), ")")) - expect_equal(x7$iterations[3, ], c(52, 77, 69, 57, 51, 35), label = paste0("c(", paste0(x7$iterations[3, ], collapse = ", "), ")")) - expect_equal(x7$overallReject, c(0.81, 0.82, 0.59, 0.32, 0.12, 0.03), tolerance = 1e-07, label = paste0("c(", paste0(x7$overallReject, collapse = ", "), ")")) - expect_equal(x7$rejectPerStage[1, ], c(0, 0, 0, 0, 0, 0), label = paste0("c(", paste0(x7$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x7$rejectPerStage[2, ], c(0.4, 0.19, 0.12, 0.07, 0, 0), tolerance = 1e-07, label = paste0("c(", paste0(x7$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x7$rejectPerStage[3, ], c(0.41, 0.63, 0.47, 0.25, 0.12, 0.03), tolerance = 1e-07, label = paste0("c(", paste0(x7$rejectPerStage[3, ], collapse = ", "), ")")) - expect_equal(x7$futilityStop, c(0.08, 0.04, 0.19, 0.36, 0.49, 0.65), tolerance = 1e-07, label = paste0("c(", paste0(x7$futilityStop, collapse = ", "), ")")) - expect_equal(x7$futilityPerStage[1, ], c(0.07, 0.03, 0.12, 0.22, 0.22, 0.26), tolerance = 1e-07, label = paste0("c(", paste0(x7$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x7$futilityPerStage[2, ], c(0.01, 0.01, 0.07, 0.14, 0.27, 0.39), tolerance = 1e-07, label = paste0("c(", paste0(x7$futilityPerStage[2, ], collapse = ", "), ")")) - expect_equal(x7$earlyStop, c(0.48, 0.23, 0.31, 0.43, 0.49, 0.65), tolerance = 1e-07, label = paste0("c(", paste0(x7$earlyStop, collapse = ", "), ")")) - expect_equal(x7$expectedNumberOfSubjects, c(105.75972, 141.87769, 144.85789, 134.64079, 139.03875, 121.42333), tolerance = 1e-07, label = paste0("c(", paste0(x7$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x7$sampleSizes[1, ], c(18, 18, 18, 18, 18, 18), label = paste0("c(", paste0(x7$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x7$sampleSizes[2, ], c(74.918717, 83.151367, 90.734126, 88.517379, 94.605927, 95.502536), tolerance = 1e-07, label = paste0("c(", paste0(x7$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x7$sampleSizes[3, ], c(34.779445, 56.130993, 68.133125, 83.503922, 92.63947, 93.575595), tolerance = 1e-07, label = paste0("c(", paste0(x7$sampleSizes[3, ], collapse = ", "), ")")) - expect_equal(x7$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x7$conditionalPowerAchieved[2, ], c(0.48960058, 0.35501907, 0.33230293, 0.3239724, 0.20164899, 0.17099815), tolerance = 1e-07, label = paste0("c(", paste0(x7$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - expect_equal(x7$conditionalPowerAchieved[3, ], c(0.75975737, 0.70067902, 0.61722401, 0.51061814, 0.40378864, 0.28388391), tolerance = 1e-07, label = paste0("c(", paste0(x7$conditionalPowerAchieved[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x7), NA))) - expect_output(print(x7)$show()) - invisible(capture.output(expect_error(summary(x7), NA))) - expect_output(summary(x7)$show()) - x7CodeBased <- eval(parse(text = getObjectRCode(x7, stringWrapParagraphWidth = NULL))) - expect_equal(x7CodeBased$effect, x7$effect, tolerance = 1e-07) - expect_equal(x7CodeBased$iterations, x7$iterations, tolerance = 1e-07) - expect_equal(x7CodeBased$overallReject, x7$overallReject, tolerance = 1e-07) - expect_equal(x7CodeBased$rejectPerStage, x7$rejectPerStage, tolerance = 1e-07) - expect_equal(x7CodeBased$futilityStop, x7$futilityStop, tolerance = 1e-07) - expect_equal(x7CodeBased$futilityPerStage, x7$futilityPerStage, tolerance = 1e-07) - expect_equal(x7CodeBased$earlyStop, x7$earlyStop, tolerance = 1e-07) - expect_equal(x7CodeBased$expectedNumberOfSubjects, x7$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x7CodeBased$sampleSizes, x7$sampleSizes, tolerance = 1e-07) - expect_equal(x7CodeBased$conditionalPowerAchieved, x7$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x7), "character") - df <- as.data.frame(x7) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x7) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x8 <- getSimulationMeans( - design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5)), - groups = 2, meanRatio = FALSE, thetaH0 = -0.1, plannedSubjects = plannedSubjects, - maxNumberOfIterations = maxNumberOfIterations, allocationRatioPlanned = 3, stDev = 3.5, - conditionalPower = 0.8, - minNumberOfSubjectsPerStage = c(NA, 10, 10), maxNumberOfSubjectsPerStage = c(NA, 100, 100), - seed = seed - ) - - ## Comparison of the results of SimulationResultsMeans object 'x8' with expected results - expect_equal(x8$effect, c(0.1, 0.3, 0.5, 0.7, 0.9, 1.1), tolerance = 1e-07, label = paste0("c(", paste0(x8$effect, collapse = ", "), ")")) - expect_equal(x8$iterations[1, ], c(100, 100, 100, 100, 100, 100), label = paste0("c(", paste0(x8$iterations[1, ], collapse = ", "), ")")) - expect_equal(x8$iterations[2, ], c(74, 78, 81, 81, 90, 86), label = paste0("c(", paste0(x8$iterations[2, ], collapse = ", "), ")")) - expect_equal(x8$iterations[3, ], c(30, 33, 52, 55, 67, 65), label = paste0("c(", paste0(x8$iterations[3, ], collapse = ", "), ")")) - expect_equal(x8$overallReject, c(0.04, 0.03, 0.09, 0.19, 0.35, 0.32), tolerance = 1e-07, label = paste0("c(", paste0(x8$overallReject, collapse = ", "), ")")) - expect_equal(x8$rejectPerStage[1, ], c(0, 0, 0, 0.01, 0, 0), tolerance = 1e-07, label = paste0("c(", paste0(x8$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x8$rejectPerStage[2, ], c(0.02, 0.01, 0.02, 0.06, 0.1, 0.07), tolerance = 1e-07, label = paste0("c(", paste0(x8$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x8$rejectPerStage[3, ], c(0.02, 0.02, 0.07, 0.12, 0.25, 0.25), tolerance = 1e-07, label = paste0("c(", paste0(x8$rejectPerStage[3, ], collapse = ", "), ")")) - expect_equal(x8$futilityStop, c(0.68, 0.66, 0.46, 0.38, 0.23, 0.28), tolerance = 1e-07, label = paste0("c(", paste0(x8$futilityStop, collapse = ", "), ")")) - expect_equal(x8$futilityPerStage[1, ], c(0.26, 0.22, 0.19, 0.18, 0.1, 0.14), tolerance = 1e-07, label = paste0("c(", paste0(x8$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x8$futilityPerStage[2, ], c(0.42, 0.44, 0.27, 0.2, 0.13, 0.14), tolerance = 1e-07, label = paste0("c(", paste0(x8$futilityPerStage[2, ], collapse = ", "), ")")) - expect_equal(x8$earlyStop, c(0.7, 0.67, 0.48, 0.45, 0.33, 0.35), tolerance = 1e-07, label = paste0("c(", paste0(x8$earlyStop, collapse = ", "), ")")) - expect_equal(x8$expectedNumberOfSubjects, c(111.53284, 119.9607, 137.10925, 136.56279, 151.62676, 145.91552), tolerance = 1e-07, label = paste0("c(", paste0(x8$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x8$sampleSizes[1, ], c(18, 18, 18, 18, 18, 18), label = paste0("c(", paste0(x8$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x8$sampleSizes[2, ], c(89.604753, 93.952606, 89.473054, 86.745314, 84.630171, 89.414885), tolerance = 1e-07, label = paste0("c(", paste0(x8$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x8$sampleSizes[3, ], c(90.75107, 86.902014, 89.684764, 87.816529, 85.760605, 78.490341), tolerance = 1e-07, label = paste0("c(", paste0(x8$sampleSizes[3, ], collapse = ", "), ")")) - expect_equal(x8$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x8$conditionalPowerAchieved[2, ], c(0.22129636, 0.2212372, 0.27604385, 0.2610371, 0.30108411, 0.26964038), tolerance = 1e-07, label = paste0("c(", paste0(x8$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - expect_equal(x8$conditionalPowerAchieved[3, ], c(0.30043836, 0.34051211, 0.31802231, 0.36816554, 0.50585406, 0.52804861), tolerance = 1e-07, label = paste0("c(", paste0(x8$conditionalPowerAchieved[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x8), NA))) - expect_output(print(x8)$show()) - invisible(capture.output(expect_error(summary(x8), NA))) - expect_output(summary(x8)$show()) - x8CodeBased <- eval(parse(text = getObjectRCode(x8, stringWrapParagraphWidth = NULL))) - expect_equal(x8CodeBased$effect, x8$effect, tolerance = 1e-07) - expect_equal(x8CodeBased$iterations, x8$iterations, tolerance = 1e-07) - expect_equal(x8CodeBased$overallReject, x8$overallReject, tolerance = 1e-07) - expect_equal(x8CodeBased$rejectPerStage, x8$rejectPerStage, tolerance = 1e-07) - expect_equal(x8CodeBased$futilityStop, x8$futilityStop, tolerance = 1e-07) - expect_equal(x8CodeBased$futilityPerStage, x8$futilityPerStage, tolerance = 1e-07) - expect_equal(x8CodeBased$earlyStop, x8$earlyStop, tolerance = 1e-07) - expect_equal(x8CodeBased$expectedNumberOfSubjects, x8$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x8CodeBased$sampleSizes, x8$sampleSizes, tolerance = 1e-07) - expect_equal(x8CodeBased$conditionalPowerAchieved, x8$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x8), "character") - df <- as.data.frame(x8) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x8) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x9 <- getSimulationMeans( - design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5)), - groups = 2, meanRatio = TRUE, thetaH0 = 1.6, plannedSubjects = plannedSubjects, - maxNumberOfIterations = maxNumberOfIterations, allocationRatioPlanned = c(1, 3, 3), stDev = 1.5, - alternative = seq(0.8, 1.6, 0.2), conditionalPower = 0.8, - minNumberOfSubjectsPerStage = c(NA, 10, 10), maxNumberOfSubjectsPerStage = c(NA, 100, 100), - directionUpper = FALSE, seed = seed - ) - - ## Comparison of the results of SimulationResultsMeans object 'x9' with expected results - expect_equal(x9$effect, c(-0.8, -0.6, -0.4, -0.2, 0), tolerance = 1e-07, label = paste0("c(", paste0(x9$effect, collapse = ", "), ")")) - expect_equal(x9$iterations[1, ], c(100, 100, 100, 100, 100), label = paste0("c(", paste0(x9$iterations[1, ], collapse = ", "), ")")) - expect_equal(x9$iterations[2, ], c(95, 90, 82, 75, 68), label = paste0("c(", paste0(x9$iterations[2, ], collapse = ", "), ")")) - expect_equal(x9$iterations[3, ], c(73, 68, 53, 48, 26), label = paste0("c(", paste0(x9$iterations[3, ], collapse = ", "), ")")) - expect_equal(x9$overallReject, c(0.55, 0.37, 0.22, 0.1, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(x9$overallReject, collapse = ", "), ")")) - expect_equal(x9$rejectPerStage[1, ], c(0, 0, 0, 0, 0), label = paste0("c(", paste0(x9$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x9$rejectPerStage[2, ], c(0.13, 0.08, 0.06, 0.04, 0), tolerance = 1e-07, label = paste0("c(", paste0(x9$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x9$rejectPerStage[3, ], c(0.42, 0.29, 0.16, 0.06, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(x9$rejectPerStage[3, ], collapse = ", "), ")")) - expect_equal(x9$futilityStop, c(0.14, 0.24, 0.41, 0.48, 0.74), tolerance = 1e-07, label = paste0("c(", paste0(x9$futilityStop, collapse = ", "), ")")) - expect_equal(x9$futilityPerStage[1, ], c(0.05, 0.1, 0.18, 0.25, 0.32), tolerance = 1e-07, label = paste0("c(", paste0(x9$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x9$futilityPerStage[2, ], c(0.09, 0.14, 0.23, 0.23, 0.42), tolerance = 1e-07, label = paste0("c(", paste0(x9$futilityPerStage[2, ], collapse = ", "), ")")) - expect_equal(x9$earlyStop, c(0.27, 0.32, 0.47, 0.52, 0.74), tolerance = 1e-07, label = paste0("c(", paste0(x9$earlyStop, collapse = ", "), ")")) - expect_equal(x9$expectedNumberOfSubjects, c(159.13638, 155.22411, 142.49895, 133.05841, 108.89569), tolerance = 1e-07, label = paste0("c(", paste0(x9$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x9$sampleSizes[1, ], c(18, 18, 18, 18, 18), label = paste0("c(", paste0(x9$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x9$sampleSizes[2, ], c(85.987506, 91.370107, 92.601585, 94.55466, 96.567372), tolerance = 1e-07, label = paste0("c(", paste0(x9$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x9$sampleSizes[3, ], c(81.435959, 80.869134, 91.633298, 91.963359, 97.037972), tolerance = 1e-07, label = paste0("c(", paste0(x9$sampleSizes[3, ], collapse = ", "), ")")) - expect_equal(x9$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x9$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x9$conditionalPowerAchieved[2, ], c(0.43130186, 0.31089581, 0.32119313, 0.2350347, 0.16563188), tolerance = 1e-07, label = paste0("c(", paste0(x9$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - expect_equal(x9$conditionalPowerAchieved[3, ], c(0.64594535, 0.57199764, 0.39418023, 0.33812857, 0.31423783), tolerance = 1e-07, label = paste0("c(", paste0(x9$conditionalPowerAchieved[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x9), NA))) - expect_output(print(x9)$show()) - invisible(capture.output(expect_error(summary(x9), NA))) - expect_output(summary(x9)$show()) - x9CodeBased <- eval(parse(text = getObjectRCode(x9, stringWrapParagraphWidth = NULL))) - expect_equal(x9CodeBased$effect, x9$effect, tolerance = 1e-07) - expect_equal(x9CodeBased$iterations, x9$iterations, tolerance = 1e-07) - expect_equal(x9CodeBased$overallReject, x9$overallReject, tolerance = 1e-07) - expect_equal(x9CodeBased$rejectPerStage, x9$rejectPerStage, tolerance = 1e-07) - expect_equal(x9CodeBased$futilityStop, x9$futilityStop, tolerance = 1e-07) - expect_equal(x9CodeBased$futilityPerStage, x9$futilityPerStage, tolerance = 1e-07) - expect_equal(x9CodeBased$earlyStop, x9$earlyStop, tolerance = 1e-07) - expect_equal(x9CodeBased$expectedNumberOfSubjects, x9$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x9CodeBased$sampleSizes, x9$sampleSizes, tolerance = 1e-07) - expect_equal(x9CodeBased$conditionalPowerAchieved, x9$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x9), "character") - df <- as.data.frame(x9) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x9) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - calcSubjectsFunctionSimulationBaseMeans <- function(..., stage, thetaH0, allocationRatioPlanned, - minNumberOfSubjectsPerStage, maxNumberOfSubjectsPerStage, - sampleSizesPerStage, thetaH1, conditionalPower, conditionalCriticalValue) { - mult <- 1 - if (stage == 2) { - stageSubjects <- (1 + 1 / allocationRatioPlanned + thetaH0^2 * (1 + allocationRatioPlanned)) * - (max(0, conditionalCriticalValue + stats::qnorm(conditionalPower)))^2 * mult / - (max(1e-12, thetaH1))^2 - stageSubjects <- min( - max(minNumberOfSubjectsPerStage[stage], stageSubjects), - maxNumberOfSubjectsPerStage[stage] - ) - } else { - stageSubjects <- sampleSizesPerStage[stage - 1] - } - return(stageSubjects) - } - x10 <- getSimulationMeans( - design = getDesignInverseNormal(futilityBounds = c(0.5, 0.5)), groups = 2, meanRatio = TRUE, thetaH0 = 1.6, - plannedSubjects = c(80, 160, 240), maxNumberOfIterations = maxNumberOfIterations, stDev = 1.5, alternative = seq(0.8, 1.6, 0.2), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(NA, 40, 40), maxNumberOfSubjectsPerStage = c(NA, 400, 400), - allocationRatioPlanned = 3, directionUpper = FALSE, seed = seed, calcSubjectsFunction = calcSubjectsFunctionSimulationBaseMeans - ) - - ## Comparison of the results of SimulationResultsMeans object 'x10' with expected results - expect_equal(x10$effect, c(-0.8, -0.6, -0.4, -0.2, 0), tolerance = 1e-07, label = paste0("c(", paste0(x10$effect, collapse = ", "), ")")) - expect_equal(x10$iterations[1, ], c(100, 100, 100, 100, 100), label = paste0("c(", paste0(x10$iterations[1, ], collapse = ", "), ")")) - expect_equal(x10$iterations[2, ], c(80, 73, 59, 46, 29), label = paste0("c(", paste0(x10$iterations[2, ], collapse = ", "), ")")) - expect_equal(x10$iterations[3, ], c(47, 49, 53, 37, 23), label = paste0("c(", paste0(x10$iterations[3, ], collapse = ", "), ")")) - expect_equal(x10$overallReject, c(0.71, 0.59, 0.3, 0.16, 0.03), tolerance = 1e-07, label = paste0("c(", paste0(x10$overallReject, collapse = ", "), ")")) - expect_equal(x10$rejectPerStage[1, ], c(0.01, 0, 0, 0, 0), tolerance = 1e-07, label = paste0("c(", paste0(x10$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x10$rejectPerStage[2, ], c(0.33, 0.24, 0.05, 0.03, 0.02), tolerance = 1e-07, label = paste0("c(", paste0(x10$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x10$rejectPerStage[3, ], c(0.37, 0.35, 0.25, 0.13, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(x10$rejectPerStage[3, ], collapse = ", "), ")")) - expect_equal(x10$futilityStop, c(0.19, 0.27, 0.42, 0.6, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(x10$futilityStop, collapse = ", "), ")")) - expect_equal(x10$futilityPerStage[1, ], c(0.19, 0.27, 0.41, 0.54, 0.71), tolerance = 1e-07, label = paste0("c(", paste0(x10$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x10$futilityPerStage[2, ], c(0, 0, 0.01, 0.06, 0.04), tolerance = 1e-07, label = paste0("c(", paste0(x10$futilityPerStage[2, ], collapse = ", "), ")")) - expect_equal(x10$earlyStop, c(0.53, 0.51, 0.47, 0.63, 0.77), tolerance = 1e-07, label = paste0("c(", paste0(x10$earlyStop, collapse = ", "), ")")) - expect_equal(x10$expectedNumberOfSubjects, c(275.20455, 279.99813, 331.87372, 312.93302, 202.36219), tolerance = 1e-07, label = paste0("c(", paste0(x10$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x10$sampleSizes[1, ], c(80, 80, 80, 80, 80), label = paste0("c(", paste0(x10$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x10$sampleSizes[2, ], c(160.20991, 162.95615, 228.62104, 285.92049, 236.43279), tolerance = 1e-07, label = paste0("c(", paste0(x10$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x10$sampleSizes[3, ], c(142.63111, 165.38805, 220.73076, 274.07999, 233.89861), tolerance = 1e-07, label = paste0("c(", paste0(x10$sampleSizes[3, ], collapse = ", "), ")")) - expect_equal(x10$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x10$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x10$conditionalPowerAchieved[2, ], c(0.61849372, 0.63239423, 0.52503669, 0.48190934, 0.5387573), tolerance = 1e-07, label = paste0("c(", paste0(x10$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - expect_equal(x10$conditionalPowerAchieved[3, ], c(0.77627313, 0.69241344, 0.58084669, 0.41531587, 0.35026151), tolerance = 1e-07, label = paste0("c(", paste0(x10$conditionalPowerAchieved[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x10), NA))) - expect_output(print(x10)$show()) - invisible(capture.output(expect_error(summary(x10), NA))) - expect_output(summary(x10)$show()) - x10CodeBased <- eval(parse(text = getObjectRCode(x10, stringWrapParagraphWidth = NULL))) - expect_equal(x10CodeBased$effect, x10$effect, tolerance = 1e-07) - expect_equal(x10CodeBased$iterations, x10$iterations, tolerance = 1e-07) - expect_equal(x10CodeBased$overallReject, x10$overallReject, tolerance = 1e-07) - expect_equal(x10CodeBased$rejectPerStage, x10$rejectPerStage, tolerance = 1e-07) - expect_equal(x10CodeBased$futilityStop, x10$futilityStop, tolerance = 1e-07) - expect_equal(x10CodeBased$futilityPerStage, x10$futilityPerStage, tolerance = 1e-07) - expect_equal(x10CodeBased$earlyStop, x10$earlyStop, tolerance = 1e-07) - expect_equal(x10CodeBased$expectedNumberOfSubjects, x10$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x10CodeBased$sampleSizes, x10$sampleSizes, tolerance = 1e-07) - expect_equal(x10CodeBased$conditionalPowerAchieved, x10$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x10), "character") - df <- as.data.frame(x10) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x10) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - + # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} + # @refFS[Sec.]{fs:sec:simulatingTestingOneHypothesis} + # @refFS[Tab.]{fs:tab:output:getSimulationMeans} + # @refFS[Formula]{fs:simulationOneArmMeansTestStatistics} + # @refFS[Formula]{fs:simulationTwoArmMeansTestStatisticsDiff} + # @refFS[Formula]{fs:simulationTwoArmMeansTestStatisticsRatio} + # @refFS[Formula]{fs:testStatisticGroupSequentialWeightedAverage} + # @refFS[Formula]{fs:testStatisticNormalCombinationTest} + # @refFS[Formula]{fs:testStatisticFisherCombinationTest} + maxNumberOfIterations <- 100 + seed <- 99123 + options(width = 180) + maxNumberOfSubjects <- 90 + informationRates <- c(0.2, 0.5, 1) + plannedSubjects <- round(informationRates * maxNumberOfSubjects) + + x1 <- getSimulationMeans( + design = getDesignInverseNormal( + futilityBounds = c(-0.5, 0.5), + informationRates = c(0.2, 0.5, 1) + ), groups = 2, meanRatio = TRUE, thetaH0 = 0.4, + plannedSubjects = plannedSubjects, maxNumberOfIterations = maxNumberOfIterations, + allocationRatioPlanned = 3, stDev = 1.5, seed = seed + ) + + ## Comparison of the results of SimulationResultsMeans object 'x1' with expected results + expect_equal(x1$effect, c(0.6, 0.8, 1, 1.2, 1.4, 1.6), tolerance = 1e-07, label = paste0(x1$effect)) + expect_equal(x1$iterations[1, ], c(100, 100, 100, 100, 100, 100), label = paste0(x1$iterations[1, ])) + expect_equal(x1$iterations[2, ], c(96, 100, 100, 94, 97, 95), label = paste0(x1$iterations[2, ])) + expect_equal(x1$iterations[3, ], c(72, 68, 37, 16, 2, 2), label = paste0(x1$iterations[3, ])) + expect_equal(x1$overallReject, c(0.81, 0.93, 0.99, 0.99, 1, 1), tolerance = 1e-07, label = paste0(x1$overallReject)) + expect_equal(x1$rejectPerStage[1, ], c(0, 0, 0, 0.05, 0.03, 0.05), tolerance = 1e-07, label = paste0(x1$rejectPerStage[1, ])) + expect_equal(x1$rejectPerStage[2, ], c(0.2, 0.29, 0.62, 0.78, 0.95, 0.93), tolerance = 1e-07, label = paste0(x1$rejectPerStage[2, ])) + expect_equal(x1$rejectPerStage[3, ], c(0.61, 0.64, 0.37, 0.16, 0.02, 0.02), tolerance = 1e-07, label = paste0(x1$rejectPerStage[3, ])) + expect_equal(x1$futilityStop, c(0.08, 0.03, 0.01, 0.01, 0, 0), tolerance = 1e-07, label = paste0(x1$futilityStop)) + expect_equal(x1$futilityPerStage[1, ], c(0.04, 0, 0, 0.01, 0, 0), tolerance = 1e-07, label = paste0(x1$futilityPerStage[1, ])) + expect_equal(x1$futilityPerStage[2, ], c(0.04, 0.03, 0.01, 0, 0, 0), tolerance = 1e-07, label = paste0(x1$futilityPerStage[2, ])) + expect_equal(x1$earlyStop, c(0.28, 0.32, 0.63, 0.84, 0.98, 0.98), tolerance = 1e-07, label = paste0(x1$earlyStop)) + expect_equal(x1$expectedNumberOfSubjects, c(76.32, 75.6, 61.65, 50.58, 45.09, 44.55), tolerance = 1e-07, label = paste0(x1$expectedNumberOfSubjects)) + expect_equal(x1$sampleSizes[1, ], c(18, 18, 18, 18, 18, 18), label = paste0(x1$sampleSizes[1, ])) + expect_equal(x1$sampleSizes[2, ], c(27, 27, 27, 27, 27, 27), label = paste0(x1$sampleSizes[2, ])) + expect_equal(x1$sampleSizes[3, ], c(45, 45, 45, 45, 45, 45), label = paste0(x1$sampleSizes[3, ])) + expect_equal(x1$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), label = paste0(x1$conditionalPowerAchieved[1, ])) + expect_equal(x1$conditionalPowerAchieved[2, ], c(0.32327194, 0.42656874, 0.56362086, 0.71189791, 0.83073101, 0.87942249), tolerance = 1e-07, label = paste0(x1$conditionalPowerAchieved[2, ])) + expect_equal(x1$conditionalPowerAchieved[3, ], c(0.67642116, 0.80313655, 0.88763923, 0.9128047, 0.94791028, 0.99081651), tolerance = 1e-07, label = paste0(x1$conditionalPowerAchieved[3, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x1), NA))) + expect_output(print(x1)$show()) + invisible(capture.output(expect_error(summary(x1), NA))) + expect_output(summary(x1)$show()) + x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) + expect_equal(x1CodeBased$effect, x1$effect, tolerance = 1e-07) + expect_equal(x1CodeBased$iterations, x1$iterations, tolerance = 1e-07) + expect_equal(x1CodeBased$overallReject, x1$overallReject, tolerance = 1e-07) + expect_equal(x1CodeBased$rejectPerStage, x1$rejectPerStage, tolerance = 1e-07) + expect_equal(x1CodeBased$futilityStop, x1$futilityStop, tolerance = 1e-07) + expect_equal(x1CodeBased$futilityPerStage, x1$futilityPerStage, tolerance = 1e-07) + expect_equal(x1CodeBased$earlyStop, x1$earlyStop, tolerance = 1e-07) + expect_equal(x1CodeBased$expectedNumberOfSubjects, x1$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x1CodeBased$sampleSizes, x1$sampleSizes, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalPowerAchieved, x1$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x1), "character") + df <- as.data.frame(x1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + .skipTestIfDisabled() + + x2 <- getSimulationMeans( + design = getDesignInverseNormal( + futilityBounds = c(-0.5, 0.5), + informationRates = c(0.2, 0.5, 1) + ), groups = 2, meanRatio = FALSE, thetaH0 = 0.2, + plannedSubjects = plannedSubjects, maxNumberOfIterations = maxNumberOfIterations, + allocationRatioPlanned = 3, stDev = 1.5, seed = seed + ) + + ## Comparison of the results of SimulationResultsMeans object 'x2' with expected results + expect_equal(x2$effect, c(-0.2, 0, 0.2, 0.4, 0.6, 0.8), tolerance = 1e-07, label = paste0(x2$effect)) + expect_equal(x2$iterations[1, ], c(100, 100, 100, 100, 100, 100), label = paste0(x2$iterations[1, ])) + expect_equal(x2$iterations[2, ], c(63, 73, 84, 83, 89, 96), label = paste0(x2$iterations[2, ])) + expect_equal(x2$iterations[3, ], c(15, 24, 42, 53, 69, 76), label = paste0(x2$iterations[3, ])) + expect_equal(x2$overallReject, c(0, 0.02, 0.07, 0.18, 0.33, 0.53), tolerance = 1e-07, label = paste0(x2$overallReject)) + expect_equal(x2$rejectPerStage[1, ], c(0, 0, 0, 0, 0, 0), label = paste0(x2$rejectPerStage[1, ])) + expect_equal(x2$rejectPerStage[2, ], c(0, 0, 0.02, 0.03, 0.06, 0.1), tolerance = 1e-07, label = paste0(x2$rejectPerStage[2, ])) + expect_equal(x2$rejectPerStage[3, ], c(0, 0.02, 0.05, 0.15, 0.27, 0.43), tolerance = 1e-07, label = paste0(x2$rejectPerStage[3, ])) + expect_equal(x2$futilityStop, c(0.85, 0.76, 0.56, 0.44, 0.25, 0.14), tolerance = 1e-07, label = paste0(x2$futilityStop)) + expect_equal(x2$futilityPerStage[1, ], c(0.37, 0.27, 0.16, 0.17, 0.11, 0.04), tolerance = 1e-07, label = paste0(x2$futilityPerStage[1, ])) + expect_equal(x2$futilityPerStage[2, ], c(0.48, 0.49, 0.4, 0.27, 0.14, 0.1), tolerance = 1e-07, label = paste0(x2$futilityPerStage[2, ])) + expect_equal(x2$earlyStop, c(0.85, 0.76, 0.58, 0.47, 0.31, 0.24), tolerance = 1e-07, label = paste0(x2$earlyStop)) + expect_equal(x2$expectedNumberOfSubjects, c(41.76, 48.51, 59.58, 64.26, 73.08, 78.12), tolerance = 1e-07, label = paste0(x2$expectedNumberOfSubjects)) + expect_equal(x2$sampleSizes[1, ], c(18, 18, 18, 18, 18, 18), label = paste0(x2$sampleSizes[1, ])) + expect_equal(x2$sampleSizes[2, ], c(27, 27, 27, 27, 27, 27), label = paste0(x2$sampleSizes[2, ])) + expect_equal(x2$sampleSizes[3, ], c(45, 45, 45, 45, 45, 45), label = paste0(x2$sampleSizes[3, ])) + expect_equal(x2$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), label = paste0(x2$conditionalPowerAchieved[1, ])) + expect_equal(x2$conditionalPowerAchieved[2, ], c(0.056595809, 0.082243527, 0.1171868, 0.14183443, 0.20192022, 0.18371302), tolerance = 1e-07, label = paste0(x2$conditionalPowerAchieved[2, ])) + expect_equal(x2$conditionalPowerAchieved[3, ], c(0.36165449, 0.31543938, 0.36771185, 0.4758946, 0.54527876, 0.61204049), tolerance = 1e-07, label = paste0(x2$conditionalPowerAchieved[3, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x2), NA))) + expect_output(print(x2)$show()) + invisible(capture.output(expect_error(summary(x2), NA))) + expect_output(summary(x2)$show()) + x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) + expect_equal(x2CodeBased$effect, x2$effect, tolerance = 1e-07) + expect_equal(x2CodeBased$iterations, x2$iterations, tolerance = 1e-07) + expect_equal(x2CodeBased$overallReject, x2$overallReject, tolerance = 1e-07) + expect_equal(x2CodeBased$rejectPerStage, x2$rejectPerStage, tolerance = 1e-07) + expect_equal(x2CodeBased$futilityStop, x2$futilityStop, tolerance = 1e-07) + expect_equal(x2CodeBased$futilityPerStage, x2$futilityPerStage, tolerance = 1e-07) + expect_equal(x2CodeBased$earlyStop, x2$earlyStop, tolerance = 1e-07) + expect_equal(x2CodeBased$expectedNumberOfSubjects, x2$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x2CodeBased$sampleSizes, x2$sampleSizes, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalPowerAchieved, x2$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x2), "character") + df <- as.data.frame(x2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x3 <- getSimulationMeans( + design = getDesignInverseNormal( + futilityBounds = c(-0.5, 0.5), + informationRates = c(0.2, 0.5, 1) + ), groups = 1, thetaH0 = 0.2, + plannedSubjects = plannedSubjects, maxNumberOfIterations = maxNumberOfIterations, + stDev = 1.5, seed = seed + ) + + ## Comparison of the results of SimulationResultsMeans object 'x3' with expected results + expect_equal(x3$effect, c(-0.2, 0, 0.2, 0.4, 0.6, 0.8), tolerance = 1e-07, label = paste0(x3$effect)) + expect_equal(x3$iterations[1, ], c(100, 100, 100, 100, 100, 100), label = paste0(x3$iterations[1, ])) + expect_equal(x3$iterations[2, ], c(50, 71, 87, 96, 97, 99), label = paste0(x3$iterations[2, ])) + expect_equal(x3$iterations[3, ], c(9, 21, 63, 67, 49, 29), label = paste0(x3$iterations[3, ])) + expect_equal(x3$overallReject, c(0, 0.02, 0.21, 0.59, 0.94, 1), tolerance = 1e-07, label = paste0(x3$overallReject)) + expect_equal(x3$rejectPerStage[1, ], c(0, 0, 0, 0, 0, 0.01), tolerance = 1e-07, label = paste0(x3$rejectPerStage[1, ])) + expect_equal(x3$rejectPerStage[2, ], c(0, 0, 0.03, 0.21, 0.47, 0.7), tolerance = 1e-07, label = paste0(x3$rejectPerStage[2, ])) + expect_equal(x3$rejectPerStage[3, ], c(0, 0.02, 0.18, 0.38, 0.47, 0.29), tolerance = 1e-07, label = paste0(x3$rejectPerStage[3, ])) + expect_equal(x3$futilityStop, c(0.91, 0.79, 0.34, 0.12, 0.04, 0), tolerance = 1e-07, label = paste0(x3$futilityStop)) + expect_equal(x3$futilityPerStage[1, ], c(0.5, 0.29, 0.13, 0.04, 0.03, 0), tolerance = 1e-07, label = paste0(x3$futilityPerStage[1, ])) + expect_equal(x3$futilityPerStage[2, ], c(0.41, 0.5, 0.21, 0.08, 0.01, 0), tolerance = 1e-07, label = paste0(x3$futilityPerStage[2, ])) + expect_equal(x3$earlyStop, c(0.91, 0.79, 0.37, 0.33, 0.51, 0.71), tolerance = 1e-07, label = paste0(x3$earlyStop)) + expect_equal(x3$expectedNumberOfSubjects, c(35.55, 46.62, 69.84, 74.07, 66.24, 57.78), tolerance = 1e-07, label = paste0(x3$expectedNumberOfSubjects)) + expect_equal(x3$sampleSizes[1, ], c(18, 18, 18, 18, 18, 18), label = paste0(x3$sampleSizes[1, ])) + expect_equal(x3$sampleSizes[2, ], c(27, 27, 27, 27, 27, 27), label = paste0(x3$sampleSizes[2, ])) + expect_equal(x3$sampleSizes[3, ], c(45, 45, 45, 45, 45, 45), label = paste0(x3$sampleSizes[3, ])) + expect_equal(x3$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), label = paste0(x3$conditionalPowerAchieved[1, ])) + expect_equal(x3$conditionalPowerAchieved[2, ], c(0.047252355, 0.074094582, 0.18424333, 0.30402818, 0.54078356, 0.67131653), tolerance = 1e-07, label = paste0(x3$conditionalPowerAchieved[2, ])) + expect_equal(x3$conditionalPowerAchieved[3, ], c(0.27249296, 0.30454177, 0.45212728, 0.62638376, 0.84307565, 0.91215549), tolerance = 1e-07, label = paste0(x3$conditionalPowerAchieved[3, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x3), NA))) + expect_output(print(x3)$show()) + invisible(capture.output(expect_error(summary(x3), NA))) + expect_output(summary(x3)$show()) + x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) + expect_equal(x3CodeBased$effect, x3$effect, tolerance = 1e-07) + expect_equal(x3CodeBased$iterations, x3$iterations, tolerance = 1e-07) + expect_equal(x3CodeBased$overallReject, x3$overallReject, tolerance = 1e-07) + expect_equal(x3CodeBased$rejectPerStage, x3$rejectPerStage, tolerance = 1e-07) + expect_equal(x3CodeBased$futilityStop, x3$futilityStop, tolerance = 1e-07) + expect_equal(x3CodeBased$futilityPerStage, x3$futilityPerStage, tolerance = 1e-07) + expect_equal(x3CodeBased$earlyStop, x3$earlyStop, tolerance = 1e-07) + expect_equal(x3CodeBased$expectedNumberOfSubjects, x3$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x3CodeBased$sampleSizes, x3$sampleSizes, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalPowerAchieved, x3$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x3), "character") + df <- as.data.frame(x3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x4 <- getSimulationMeans( + design = getDesignInverseNormal( + futilityBounds = c(-0.5, 0.5), + informationRates = c(0.2, 0.5, 1) + ), groups = 2, meanRatio = TRUE, thetaH0 = 1.1, + plannedSubjects = plannedSubjects, maxNumberOfIterations = maxNumberOfIterations, + allocationRatioPlanned = 3, stDev = 1.5, directionUpper = FALSE, seed = seed + ) + + ## Comparison of the results of SimulationResultsMeans object 'x4' with expected results + expect_equal(x4$effect, c(-0.1, 0.1, 0.3, 0.5, 0.7, 0.9), tolerance = 1e-07, label = paste0(x4$effect)) + expect_equal(x4$iterations[1, ], c(100, 100, 100, 100, 100, 100), label = paste0(x4$iterations[1, ])) + expect_equal(x4$iterations[2, ], c(76, 71, 52, 52, 45, 23), label = paste0(x4$iterations[2, ])) + expect_equal(x4$iterations[3, ], c(31, 27, 10, 12, 3, 3), label = paste0(x4$iterations[3, ])) + expect_equal(x4$overallReject, c(0.01, 0.02, 0, 0, 0, 0), tolerance = 1e-07, label = paste0(x4$overallReject)) + expect_equal(x4$rejectPerStage[1, ], c(0, 0, 0, 0, 0, 0), label = paste0(x4$rejectPerStage[1, ])) + expect_equal(x4$rejectPerStage[2, ], c(0, 0, 0, 0, 0, 0), label = paste0(x4$rejectPerStage[2, ])) + expect_equal(x4$rejectPerStage[3, ], c(0.01, 0.02, 0, 0, 0, 0), tolerance = 1e-07, label = paste0(x4$rejectPerStage[3, ])) + expect_equal(x4$futilityStop, c(0.69, 0.73, 0.9, 0.88, 0.97, 0.97), tolerance = 1e-07, label = paste0(x4$futilityStop)) + expect_equal(x4$futilityPerStage[1, ], c(0.24, 0.29, 0.48, 0.48, 0.55, 0.77), tolerance = 1e-07, label = paste0(x4$futilityPerStage[1, ])) + expect_equal(x4$futilityPerStage[2, ], c(0.45, 0.44, 0.42, 0.4, 0.42, 0.2), tolerance = 1e-07, label = paste0(x4$futilityPerStage[2, ])) + expect_equal(x4$earlyStop, c(0.69, 0.73, 0.9, 0.88, 0.97, 0.97), tolerance = 1e-07, label = paste0(x4$earlyStop)) + expect_equal(x4$expectedNumberOfSubjects, c(52.47, 49.32, 36.54, 37.44, 31.5, 25.56), tolerance = 1e-07, label = paste0(x4$expectedNumberOfSubjects)) + expect_equal(x4$sampleSizes[1, ], c(18, 18, 18, 18, 18, 18), label = paste0(x4$sampleSizes[1, ])) + expect_equal(x4$sampleSizes[2, ], c(27, 27, 27, 27, 27, 27), label = paste0(x4$sampleSizes[2, ])) + expect_equal(x4$sampleSizes[3, ], c(45, 45, 45, 45, 45, 45), label = paste0(x4$sampleSizes[3, ])) + expect_equal(x4$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), label = paste0(x4$conditionalPowerAchieved[1, ])) + expect_equal(x4$conditionalPowerAchieved[2, ], c(0.082605877, 0.068056178, 0.029778467, 0.03773137, 0.045472187, 0.044215071), tolerance = 1e-07, label = paste0(x4$conditionalPowerAchieved[2, ])) + expect_equal(x4$conditionalPowerAchieved[3, ], c(0.33703993, 0.33169504, 0.18033338, 0.17601168, 0.34932431, 0.12232555), tolerance = 1e-07, label = paste0(x4$conditionalPowerAchieved[3, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x4), NA))) + expect_output(print(x4)$show()) + invisible(capture.output(expect_error(summary(x4), NA))) + expect_output(summary(x4)$show()) + x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) + expect_equal(x4CodeBased$effect, x4$effect, tolerance = 1e-07) + expect_equal(x4CodeBased$iterations, x4$iterations, tolerance = 1e-07) + expect_equal(x4CodeBased$overallReject, x4$overallReject, tolerance = 1e-07) + expect_equal(x4CodeBased$rejectPerStage, x4$rejectPerStage, tolerance = 1e-07) + expect_equal(x4CodeBased$futilityStop, x4$futilityStop, tolerance = 1e-07) + expect_equal(x4CodeBased$futilityPerStage, x4$futilityPerStage, tolerance = 1e-07) + expect_equal(x4CodeBased$earlyStop, x4$earlyStop, tolerance = 1e-07) + expect_equal(x4CodeBased$expectedNumberOfSubjects, x4$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x4CodeBased$sampleSizes, x4$sampleSizes, tolerance = 1e-07) + expect_equal(x4CodeBased$conditionalPowerAchieved, x4$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x4), "character") + df <- as.data.frame(x4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x5 <- getSimulationMeans( + design = getDesignInverseNormal( + futilityBounds = c(-0.5, 0.5), + informationRates = c(0.2, 0.5, 1) + ), groups = 2, meanRatio = FALSE, thetaH0 = 1.1, + plannedSubjects = plannedSubjects, maxNumberOfIterations = maxNumberOfIterations, + allocationRatioPlanned = 3, stDev = 1.5, directionUpper = FALSE, seed = seed + ) + + ## Comparison of the results of SimulationResultsMeans object 'x5' with expected results + expect_equal(x5$effect, c(-1.1, -0.9, -0.7, -0.5, -0.3, -0.1), tolerance = 1e-07, label = paste0(x5$effect)) + expect_equal(x5$iterations[1, ], c(100, 100, 100, 100, 100, 100), label = paste0(x5$iterations[1, ])) + expect_equal(x5$iterations[2, ], c(98, 96, 88, 84, 82, 79), label = paste0(x5$iterations[2, ])) + expect_equal(x5$iterations[3, ], c(77, 74, 69, 58, 54, 43), label = paste0(x5$iterations[3, ])) + expect_equal(x5$overallReject, c(0.78, 0.71, 0.51, 0.27, 0.13, 0.04), tolerance = 1e-07, label = paste0(x5$overallReject)) + expect_equal(x5$rejectPerStage[1, ], c(0, 0, 0, 0, 0, 0), label = paste0(x5$rejectPerStage[1, ])) + expect_equal(x5$rejectPerStage[2, ], c(0.19, 0.14, 0.08, 0.06, 0, 0), tolerance = 1e-07, label = paste0(x5$rejectPerStage[2, ])) + expect_equal(x5$rejectPerStage[3, ], c(0.59, 0.57, 0.43, 0.21, 0.13, 0.04), tolerance = 1e-07, label = paste0(x5$rejectPerStage[3, ])) + expect_equal(x5$futilityStop, c(0.04, 0.12, 0.23, 0.36, 0.46, 0.57), tolerance = 1e-07, label = paste0(x5$futilityStop)) + expect_equal(x5$futilityPerStage[1, ], c(0.02, 0.04, 0.12, 0.16, 0.18, 0.21), tolerance = 1e-07, label = paste0(x5$futilityPerStage[1, ])) + expect_equal(x5$futilityPerStage[2, ], c(0.02, 0.08, 0.11, 0.2, 0.28, 0.36), tolerance = 1e-07, label = paste0(x5$futilityPerStage[2, ])) + expect_equal(x5$earlyStop, c(0.23, 0.26, 0.31, 0.42, 0.46, 0.57), tolerance = 1e-07, label = paste0(x5$earlyStop)) + expect_equal(x5$expectedNumberOfSubjects, c(79.11, 77.22, 72.81, 66.78, 64.44, 58.68), tolerance = 1e-07, label = paste0(x5$expectedNumberOfSubjects)) + expect_equal(x5$sampleSizes[1, ], c(18, 18, 18, 18, 18, 18), label = paste0(x5$sampleSizes[1, ])) + expect_equal(x5$sampleSizes[2, ], c(27, 27, 27, 27, 27, 27), label = paste0(x5$sampleSizes[2, ])) + expect_equal(x5$sampleSizes[3, ], c(45, 45, 45, 45, 45, 45), label = paste0(x5$sampleSizes[3, ])) + expect_equal(x5$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), label = paste0(x5$conditionalPowerAchieved[1, ])) + expect_equal(x5$conditionalPowerAchieved[2, ], c(0.33588936, 0.25194744, 0.19824827, 0.19178721, 0.11444971, 0.092566355), tolerance = 1e-07, label = paste0(x5$conditionalPowerAchieved[2, ])) + expect_equal(x5$conditionalPowerAchieved[3, ], c(0.74226501, 0.69902839, 0.55641803, 0.50033698, 0.45636572, 0.33236099), tolerance = 1e-07, label = paste0(x5$conditionalPowerAchieved[3, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x5), NA))) + expect_output(print(x5)$show()) + invisible(capture.output(expect_error(summary(x5), NA))) + expect_output(summary(x5)$show()) + x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) + expect_equal(x5CodeBased$effect, x5$effect, tolerance = 1e-07) + expect_equal(x5CodeBased$iterations, x5$iterations, tolerance = 1e-07) + expect_equal(x5CodeBased$overallReject, x5$overallReject, tolerance = 1e-07) + expect_equal(x5CodeBased$rejectPerStage, x5$rejectPerStage, tolerance = 1e-07) + expect_equal(x5CodeBased$futilityStop, x5$futilityStop, tolerance = 1e-07) + expect_equal(x5CodeBased$futilityPerStage, x5$futilityPerStage, tolerance = 1e-07) + expect_equal(x5CodeBased$earlyStop, x5$earlyStop, tolerance = 1e-07) + expect_equal(x5CodeBased$expectedNumberOfSubjects, x5$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x5CodeBased$sampleSizes, x5$sampleSizes, tolerance = 1e-07) + expect_equal(x5CodeBased$conditionalPowerAchieved, x5$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x5), "character") + df <- as.data.frame(x5) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x5) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x6 <- getSimulationMeans( + design = getDesignInverseNormal( + futilityBounds = c(-0.5, 0.5), + informationRates = c(0.2, 0.5, 1) + ), groups = 1, thetaH0 = 0.8, + plannedSubjects = plannedSubjects, maxNumberOfIterations = maxNumberOfIterations, + stDev = 1.5, directionUpper = FALSE, seed = seed + ) + + ## Comparison of the results of SimulationResultsMeans object 'x6' with expected results + expect_equal(x6$effect, c(-0.8, -0.6, -0.4, -0.2, 0, 0.2), tolerance = 1e-07, label = paste0(x6$effect)) + expect_equal(x6$iterations[1, ], c(100, 100, 100, 100, 100, 100), label = paste0(x6$iterations[1, ])) + expect_equal(x6$iterations[2, ], c(100, 99, 96, 81, 70, 49), label = paste0(x6$iterations[2, ])) + expect_equal(x6$iterations[3, ], c(22, 43, 75, 57, 27, 7), label = paste0(x6$iterations[3, ])) + expect_equal(x6$overallReject, c(1, 0.96, 0.66, 0.26, 0.02, 0), tolerance = 1e-07, label = paste0(x6$overallReject)) + expect_equal(x6$rejectPerStage[1, ], c(0, 0, 0, 0, 0, 0), label = paste0(x6$rejectPerStage[1, ])) + expect_equal(x6$rejectPerStage[2, ], c(0.78, 0.56, 0.13, 0.05, 0, 0), tolerance = 1e-07, label = paste0(x6$rejectPerStage[2, ])) + expect_equal(x6$rejectPerStage[3, ], c(0.22, 0.4, 0.53, 0.21, 0.02, 0), tolerance = 1e-07, label = paste0(x6$rejectPerStage[3, ])) + expect_equal(x6$futilityStop, c(0, 0.01, 0.12, 0.38, 0.73, 0.93), tolerance = 1e-07, label = paste0(x6$futilityStop)) + expect_equal(x6$futilityPerStage[1, ], c(0, 0.01, 0.04, 0.19, 0.3, 0.51), tolerance = 1e-07, label = paste0(x6$futilityPerStage[1, ])) + expect_equal(x6$futilityPerStage[2, ], c(0, 0, 0.08, 0.19, 0.43, 0.42), tolerance = 1e-07, label = paste0(x6$futilityPerStage[2, ])) + expect_equal(x6$earlyStop, c(0.78, 0.57, 0.25, 0.43, 0.73, 0.93), tolerance = 1e-07, label = paste0(x6$earlyStop)) + expect_equal(x6$expectedNumberOfSubjects, c(54.9, 64.08, 77.67, 65.52, 49.05, 34.38), tolerance = 1e-07, label = paste0(x6$expectedNumberOfSubjects)) + expect_equal(x6$sampleSizes[1, ], c(18, 18, 18, 18, 18, 18), label = paste0(x6$sampleSizes[1, ])) + expect_equal(x6$sampleSizes[2, ], c(27, 27, 27, 27, 27, 27), label = paste0(x6$sampleSizes[2, ])) + expect_equal(x6$sampleSizes[3, ], c(45, 45, 45, 45, 45, 45), label = paste0(x6$sampleSizes[3, ])) + expect_equal(x6$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), label = paste0(x6$conditionalPowerAchieved[1, ])) + expect_equal(x6$conditionalPowerAchieved[2, ], c(0.67267344, 0.52857476, 0.27194206, 0.18361852, 0.064769395, 0.04670856), tolerance = 1e-07, label = paste0(x6$conditionalPowerAchieved[2, ])) + expect_equal(x6$conditionalPowerAchieved[3, ], c(0.81011604, 0.77276452, 0.65795757, 0.50391481, 0.35327029, 0.24591214), tolerance = 1e-07, label = paste0(x6$conditionalPowerAchieved[3, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x6), NA))) + expect_output(print(x6)$show()) + invisible(capture.output(expect_error(summary(x6), NA))) + expect_output(summary(x6)$show()) + x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) + expect_equal(x6CodeBased$effect, x6$effect, tolerance = 1e-07) + expect_equal(x6CodeBased$iterations, x6$iterations, tolerance = 1e-07) + expect_equal(x6CodeBased$overallReject, x6$overallReject, tolerance = 1e-07) + expect_equal(x6CodeBased$rejectPerStage, x6$rejectPerStage, tolerance = 1e-07) + expect_equal(x6CodeBased$futilityStop, x6$futilityStop, tolerance = 1e-07) + expect_equal(x6CodeBased$futilityPerStage, x6$futilityPerStage, tolerance = 1e-07) + expect_equal(x6CodeBased$earlyStop, x6$earlyStop, tolerance = 1e-07) + expect_equal(x6CodeBased$expectedNumberOfSubjects, x6$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x6CodeBased$sampleSizes, x6$sampleSizes, tolerance = 1e-07) + expect_equal(x6CodeBased$conditionalPowerAchieved, x6$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x6), "character") + df <- as.data.frame(x6) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x6) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x7 <- getSimulationMeans( + design = getDesignInverseNormal( + futilityBounds = c(-0.5, 0.5), + informationRates = c(0.2, 0.5, 1) + ), groups = 1, thetaH0 = -0.2, + plannedSubjects = plannedSubjects, maxNumberOfIterations = maxNumberOfIterations, + stDev = 3.5, alternative = seq(-1.2, -0.2, 0.2), + conditionalPower = 0.8, + minNumberOfSubjectsPerStage = c(NA, 10, 10), maxNumberOfSubjectsPerStage = c(NA, 100, 100), + directionUpper = FALSE, seed = seed + ) + + ## Comparison of the results of SimulationResultsMeans object 'x7' with expected results + expect_equal(x7$effect, c(-1, -0.8, -0.6, -0.4, -0.2, 0), tolerance = 1e-07, label = paste0(x7$effect)) + expect_equal(x7$iterations[1, ], c(100, 100, 100, 100, 100, 100), label = paste0(x7$iterations[1, ])) + expect_equal(x7$iterations[2, ], c(93, 97, 88, 78, 78, 74), label = paste0(x7$iterations[2, ])) + expect_equal(x7$iterations[3, ], c(52, 77, 69, 57, 51, 35), label = paste0(x7$iterations[3, ])) + expect_equal(x7$overallReject, c(0.81, 0.82, 0.59, 0.32, 0.12, 0.03), tolerance = 1e-07, label = paste0(x7$overallReject)) + expect_equal(x7$rejectPerStage[1, ], c(0, 0, 0, 0, 0, 0), label = paste0(x7$rejectPerStage[1, ])) + expect_equal(x7$rejectPerStage[2, ], c(0.4, 0.19, 0.12, 0.07, 0, 0), tolerance = 1e-07, label = paste0(x7$rejectPerStage[2, ])) + expect_equal(x7$rejectPerStage[3, ], c(0.41, 0.63, 0.47, 0.25, 0.12, 0.03), tolerance = 1e-07, label = paste0(x7$rejectPerStage[3, ])) + expect_equal(x7$futilityStop, c(0.08, 0.04, 0.19, 0.36, 0.49, 0.65), tolerance = 1e-07, label = paste0(x7$futilityStop)) + expect_equal(x7$futilityPerStage[1, ], c(0.07, 0.03, 0.12, 0.22, 0.22, 0.26), tolerance = 1e-07, label = paste0(x7$futilityPerStage[1, ])) + expect_equal(x7$futilityPerStage[2, ], c(0.01, 0.01, 0.07, 0.14, 0.27, 0.39), tolerance = 1e-07, label = paste0(x7$futilityPerStage[2, ])) + expect_equal(x7$earlyStop, c(0.48, 0.23, 0.31, 0.43, 0.49, 0.65), tolerance = 1e-07, label = paste0(x7$earlyStop)) + expect_equal(x7$expectedNumberOfSubjects, c(105.75972, 141.87769, 144.85789, 134.64079, 139.03875, 121.42333), tolerance = 1e-07, label = paste0(x7$expectedNumberOfSubjects)) + expect_equal(x7$sampleSizes[1, ], c(18, 18, 18, 18, 18, 18), label = paste0(x7$sampleSizes[1, ])) + expect_equal(x7$sampleSizes[2, ], c(74.918717, 83.151367, 90.734126, 88.517379, 94.605927, 95.502536), tolerance = 1e-07, label = paste0(x7$sampleSizes[2, ])) + expect_equal(x7$sampleSizes[3, ], c(34.779445, 56.130993, 68.133125, 83.503922, 92.63947, 93.575595), tolerance = 1e-07, label = paste0(x7$sampleSizes[3, ])) + expect_equal(x7$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), label = paste0(x7$conditionalPowerAchieved[1, ])) + expect_equal(x7$conditionalPowerAchieved[2, ], c(0.48960058, 0.35501907, 0.33230293, 0.3239724, 0.20164899, 0.17099815), tolerance = 1e-07, label = paste0(x7$conditionalPowerAchieved[2, ])) + expect_equal(x7$conditionalPowerAchieved[3, ], c(0.75975737, 0.70067902, 0.61722401, 0.51061814, 0.40378864, 0.28388391), tolerance = 1e-07, label = paste0(x7$conditionalPowerAchieved[3, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x7), NA))) + expect_output(print(x7)$show()) + invisible(capture.output(expect_error(summary(x7), NA))) + expect_output(summary(x7)$show()) + x7CodeBased <- eval(parse(text = getObjectRCode(x7, stringWrapParagraphWidth = NULL))) + expect_equal(x7CodeBased$effect, x7$effect, tolerance = 1e-07) + expect_equal(x7CodeBased$iterations, x7$iterations, tolerance = 1e-07) + expect_equal(x7CodeBased$overallReject, x7$overallReject, tolerance = 1e-07) + expect_equal(x7CodeBased$rejectPerStage, x7$rejectPerStage, tolerance = 1e-07) + expect_equal(x7CodeBased$futilityStop, x7$futilityStop, tolerance = 1e-07) + expect_equal(x7CodeBased$futilityPerStage, x7$futilityPerStage, tolerance = 1e-07) + expect_equal(x7CodeBased$earlyStop, x7$earlyStop, tolerance = 1e-07) + expect_equal(x7CodeBased$expectedNumberOfSubjects, x7$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x7CodeBased$sampleSizes, x7$sampleSizes, tolerance = 1e-07) + expect_equal(x7CodeBased$conditionalPowerAchieved, x7$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x7), "character") + df <- as.data.frame(x7) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x7) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x8 <- getSimulationMeans( + design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5)), + groups = 2, meanRatio = FALSE, thetaH0 = -0.1, plannedSubjects = plannedSubjects, + maxNumberOfIterations = maxNumberOfIterations, allocationRatioPlanned = 3, stDev = 3.5, + conditionalPower = 0.8, + minNumberOfSubjectsPerStage = c(NA, 10, 10), maxNumberOfSubjectsPerStage = c(NA, 100, 100), + seed = seed + ) + + ## Comparison of the results of SimulationResultsMeans object 'x8' with expected results + expect_equal(x8$effect, c(0.1, 0.3, 0.5, 0.7, 0.9, 1.1), tolerance = 1e-07, label = paste0(x8$effect)) + expect_equal(x8$iterations[1, ], c(100, 100, 100, 100, 100, 100), label = paste0(x8$iterations[1, ])) + expect_equal(x8$iterations[2, ], c(74, 78, 81, 81, 90, 86), label = paste0(x8$iterations[2, ])) + expect_equal(x8$iterations[3, ], c(30, 33, 52, 55, 67, 65), label = paste0(x8$iterations[3, ])) + expect_equal(x8$overallReject, c(0.04, 0.03, 0.09, 0.19, 0.35, 0.32), tolerance = 1e-07, label = paste0(x8$overallReject)) + expect_equal(x8$rejectPerStage[1, ], c(0, 0, 0, 0.01, 0, 0), tolerance = 1e-07, label = paste0(x8$rejectPerStage[1, ])) + expect_equal(x8$rejectPerStage[2, ], c(0.02, 0.01, 0.02, 0.06, 0.1, 0.07), tolerance = 1e-07, label = paste0(x8$rejectPerStage[2, ])) + expect_equal(x8$rejectPerStage[3, ], c(0.02, 0.02, 0.07, 0.12, 0.25, 0.25), tolerance = 1e-07, label = paste0(x8$rejectPerStage[3, ])) + expect_equal(x8$futilityStop, c(0.68, 0.66, 0.46, 0.38, 0.23, 0.28), tolerance = 1e-07, label = paste0(x8$futilityStop)) + expect_equal(x8$futilityPerStage[1, ], c(0.26, 0.22, 0.19, 0.18, 0.1, 0.14), tolerance = 1e-07, label = paste0(x8$futilityPerStage[1, ])) + expect_equal(x8$futilityPerStage[2, ], c(0.42, 0.44, 0.27, 0.2, 0.13, 0.14), tolerance = 1e-07, label = paste0(x8$futilityPerStage[2, ])) + expect_equal(x8$earlyStop, c(0.7, 0.67, 0.48, 0.45, 0.33, 0.35), tolerance = 1e-07, label = paste0(x8$earlyStop)) + expect_equal(x8$expectedNumberOfSubjects, c(111.53284, 119.9607, 137.10925, 136.56279, 151.62676, 145.91552), tolerance = 1e-07, label = paste0(x8$expectedNumberOfSubjects)) + expect_equal(x8$sampleSizes[1, ], c(18, 18, 18, 18, 18, 18), label = paste0(x8$sampleSizes[1, ])) + expect_equal(x8$sampleSizes[2, ], c(89.604753, 93.952606, 89.473054, 86.745314, 84.630171, 89.414885), tolerance = 1e-07, label = paste0(x8$sampleSizes[2, ])) + expect_equal(x8$sampleSizes[3, ], c(90.75107, 86.902014, 89.684764, 87.816529, 85.760605, 78.490341), tolerance = 1e-07, label = paste0(x8$sampleSizes[3, ])) + expect_equal(x8$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), label = paste0(x8$conditionalPowerAchieved[1, ])) + expect_equal(x8$conditionalPowerAchieved[2, ], c(0.22129636, 0.2212372, 0.27604385, 0.2610371, 0.30108411, 0.26964038), tolerance = 1e-07, label = paste0(x8$conditionalPowerAchieved[2, ])) + expect_equal(x8$conditionalPowerAchieved[3, ], c(0.30043836, 0.34051211, 0.31802231, 0.36816554, 0.50585406, 0.52804861), tolerance = 1e-07, label = paste0(x8$conditionalPowerAchieved[3, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x8), NA))) + expect_output(print(x8)$show()) + invisible(capture.output(expect_error(summary(x8), NA))) + expect_output(summary(x8)$show()) + x8CodeBased <- eval(parse(text = getObjectRCode(x8, stringWrapParagraphWidth = NULL))) + expect_equal(x8CodeBased$effect, x8$effect, tolerance = 1e-07) + expect_equal(x8CodeBased$iterations, x8$iterations, tolerance = 1e-07) + expect_equal(x8CodeBased$overallReject, x8$overallReject, tolerance = 1e-07) + expect_equal(x8CodeBased$rejectPerStage, x8$rejectPerStage, tolerance = 1e-07) + expect_equal(x8CodeBased$futilityStop, x8$futilityStop, tolerance = 1e-07) + expect_equal(x8CodeBased$futilityPerStage, x8$futilityPerStage, tolerance = 1e-07) + expect_equal(x8CodeBased$earlyStop, x8$earlyStop, tolerance = 1e-07) + expect_equal(x8CodeBased$expectedNumberOfSubjects, x8$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x8CodeBased$sampleSizes, x8$sampleSizes, tolerance = 1e-07) + expect_equal(x8CodeBased$conditionalPowerAchieved, x8$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x8), "character") + df <- as.data.frame(x8) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x8) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x9 <- getSimulationMeans( + design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5)), + groups = 2, meanRatio = TRUE, thetaH0 = 1.6, plannedSubjects = plannedSubjects, + maxNumberOfIterations = maxNumberOfIterations, allocationRatioPlanned = c(1, 3, 3), stDev = 1.5, + alternative = seq(0.8, 1.6, 0.2), conditionalPower = 0.8, + minNumberOfSubjectsPerStage = c(NA, 10, 10), maxNumberOfSubjectsPerStage = c(NA, 100, 100), + directionUpper = FALSE, seed = seed + ) + + ## Comparison of the results of SimulationResultsMeans object 'x9' with expected results + expect_equal(x9$effect, c(-0.8, -0.6, -0.4, -0.2, 0), tolerance = 1e-07, label = paste0(x9$effect)) + expect_equal(x9$iterations[1, ], c(100, 100, 100, 100, 100), label = paste0(x9$iterations[1, ])) + expect_equal(x9$iterations[2, ], c(95, 90, 82, 75, 68), label = paste0(x9$iterations[2, ])) + expect_equal(x9$iterations[3, ], c(73, 68, 53, 48, 26), label = paste0(x9$iterations[3, ])) + expect_equal(x9$overallReject, c(0.55, 0.37, 0.22, 0.1, 0.01), tolerance = 1e-07, label = paste0(x9$overallReject)) + expect_equal(x9$rejectPerStage[1, ], c(0, 0, 0, 0, 0), label = paste0(x9$rejectPerStage[1, ])) + expect_equal(x9$rejectPerStage[2, ], c(0.13, 0.08, 0.06, 0.04, 0), tolerance = 1e-07, label = paste0(x9$rejectPerStage[2, ])) + expect_equal(x9$rejectPerStage[3, ], c(0.42, 0.29, 0.16, 0.06, 0.01), tolerance = 1e-07, label = paste0(x9$rejectPerStage[3, ])) + expect_equal(x9$futilityStop, c(0.14, 0.24, 0.41, 0.48, 0.74), tolerance = 1e-07, label = paste0(x9$futilityStop)) + expect_equal(x9$futilityPerStage[1, ], c(0.05, 0.1, 0.18, 0.25, 0.32), tolerance = 1e-07, label = paste0(x9$futilityPerStage[1, ])) + expect_equal(x9$futilityPerStage[2, ], c(0.09, 0.14, 0.23, 0.23, 0.42), tolerance = 1e-07, label = paste0(x9$futilityPerStage[2, ])) + expect_equal(x9$earlyStop, c(0.27, 0.32, 0.47, 0.52, 0.74), tolerance = 1e-07, label = paste0(x9$earlyStop)) + expect_equal(x9$expectedNumberOfSubjects, c(159.13638, 155.22411, 142.49895, 133.05841, 108.89569), tolerance = 1e-07, label = paste0(x9$expectedNumberOfSubjects)) + expect_equal(x9$sampleSizes[1, ], c(18, 18, 18, 18, 18), label = paste0(x9$sampleSizes[1, ])) + expect_equal(x9$sampleSizes[2, ], c(85.987506, 91.370107, 92.601585, 94.55466, 96.567372), tolerance = 1e-07, label = paste0(x9$sampleSizes[2, ])) + expect_equal(x9$sampleSizes[3, ], c(81.435959, 80.869134, 91.633298, 91.963359, 97.037972), tolerance = 1e-07, label = paste0(x9$sampleSizes[3, ])) + expect_equal(x9$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), label = paste0(x9$conditionalPowerAchieved[1, ])) + expect_equal(x9$conditionalPowerAchieved[2, ], c(0.35135748, 0.25068961, 0.24464869, 0.17965036, 0.12737117), tolerance = 1e-07, label = paste0(x9$conditionalPowerAchieved[2, ])) + expect_equal(x9$conditionalPowerAchieved[3, ], c(0.56072169, 0.49173863, 0.33481257, 0.28442559, 0.25388078), tolerance = 1e-07, label = paste0(x9$conditionalPowerAchieved[3, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x9), NA))) + expect_output(print(x9)$show()) + invisible(capture.output(expect_error(summary(x9), NA))) + expect_output(summary(x9)$show()) + x9CodeBased <- eval(parse(text = getObjectRCode(x9, stringWrapParagraphWidth = NULL))) + expect_equal(x9CodeBased$effect, x9$effect, tolerance = 1e-07) + expect_equal(x9CodeBased$iterations, x9$iterations, tolerance = 1e-07) + expect_equal(x9CodeBased$overallReject, x9$overallReject, tolerance = 1e-07) + expect_equal(x9CodeBased$rejectPerStage, x9$rejectPerStage, tolerance = 1e-07) + expect_equal(x9CodeBased$futilityStop, x9$futilityStop, tolerance = 1e-07) + expect_equal(x9CodeBased$futilityPerStage, x9$futilityPerStage, tolerance = 1e-07) + expect_equal(x9CodeBased$earlyStop, x9$earlyStop, tolerance = 1e-07) + expect_equal(x9CodeBased$expectedNumberOfSubjects, x9$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x9CodeBased$sampleSizes, x9$sampleSizes, tolerance = 1e-07) + expect_equal(x9CodeBased$conditionalPowerAchieved, x9$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x9), "character") + df <- as.data.frame(x9) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x9) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + calcSubjectsFunctionSimulationBaseMeans <- function(..., stage, thetaH0, allocationRatioPlanned, + minNumberOfSubjectsPerStage, maxNumberOfSubjectsPerStage, + sampleSizesPerStage, thetaH1, conditionalPower, conditionalCriticalValue) { + mult <- 1 + if (stage == 2) { + stageSubjects <- (1 + 1 / allocationRatioPlanned + thetaH0^2 * (1 + allocationRatioPlanned)) * + (max(0, conditionalCriticalValue + stats::qnorm(conditionalPower)))^2 * mult / + (max(1e-12, thetaH1))^2 + stageSubjects <- min( + max(minNumberOfSubjectsPerStage[stage], stageSubjects), + maxNumberOfSubjectsPerStage[stage] + ) + } else { + stageSubjects <- sampleSizesPerStage[stage - 1] + } + return(stageSubjects) + } + x10 <- getSimulationMeans( + design = getDesignInverseNormal(futilityBounds = c(0.5, 0.5)), groups = 2, meanRatio = TRUE, thetaH0 = 1.6, + plannedSubjects = c(80, 160, 240), maxNumberOfIterations = maxNumberOfIterations, stDev = 1.5, alternative = seq(0.8, 1.6, 0.2), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(NA, 40, 40), maxNumberOfSubjectsPerStage = c(NA, 400, 400), + allocationRatioPlanned = 3, directionUpper = FALSE, seed = seed, calcSubjectsFunction = calcSubjectsFunctionSimulationBaseMeans + ) + + ## Comparison of the results of SimulationResultsMeans object 'x10' with expected results + expect_equal(x10$effect, c(-0.8, -0.6, -0.4, -0.2, 0), tolerance = 1e-07, label = paste0(x10$effect)) + expect_equal(x10$iterations[1, ], c(100, 100, 100, 100, 100), label = paste0(x10$iterations[1, ])) + expect_equal(x10$iterations[2, ], c(80, 73, 59, 46, 29), label = paste0(x10$iterations[2, ])) + expect_equal(x10$iterations[3, ], c(47, 49, 53, 37, 23), label = paste0(x10$iterations[3, ])) + expect_equal(x10$overallReject, c(0.71, 0.59, 0.3, 0.16, 0.03), tolerance = 1e-07, label = paste0(x10$overallReject)) + expect_equal(x10$rejectPerStage[1, ], c(0.01, 0, 0, 0, 0), tolerance = 1e-07, label = paste0(x10$rejectPerStage[1, ])) + expect_equal(x10$rejectPerStage[2, ], c(0.33, 0.24, 0.05, 0.03, 0.02), tolerance = 1e-07, label = paste0(x10$rejectPerStage[2, ])) + expect_equal(x10$rejectPerStage[3, ], c(0.37, 0.35, 0.25, 0.13, 0.01), tolerance = 1e-07, label = paste0(x10$rejectPerStage[3, ])) + expect_equal(x10$futilityStop, c(0.19, 0.27, 0.42, 0.6, 0.75), tolerance = 1e-07, label = paste0(x10$futilityStop)) + expect_equal(x10$futilityPerStage[1, ], c(0.19, 0.27, 0.41, 0.54, 0.71), tolerance = 1e-07, label = paste0(x10$futilityPerStage[1, ])) + expect_equal(x10$futilityPerStage[2, ], c(0, 0, 0.01, 0.06, 0.04), tolerance = 1e-07, label = paste0(x10$futilityPerStage[2, ])) + expect_equal(x10$earlyStop, c(0.53, 0.51, 0.47, 0.63, 0.77), tolerance = 1e-07, label = paste0(x10$earlyStop)) + expect_equal(x10$expectedNumberOfSubjects, c(275.20455, 279.99813, 331.87372, 312.93302, 202.36219), tolerance = 1e-07, label = paste0(x10$expectedNumberOfSubjects)) + expect_equal(x10$sampleSizes[1, ], c(80, 80, 80, 80, 80), label = paste0(x10$sampleSizes[1, ])) + expect_equal(x10$sampleSizes[2, ], c(160.20991, 162.95615, 228.62104, 285.92049, 236.43279), tolerance = 1e-07, label = paste0(x10$sampleSizes[2, ])) + expect_equal(x10$sampleSizes[3, ], c(142.63111, 165.38805, 220.73076, 274.07999, 233.89861), tolerance = 1e-07, label = paste0(x10$sampleSizes[3, ])) + expect_equal(x10$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), label = paste0(x10$conditionalPowerAchieved[1, ])) + expect_equal(x10$conditionalPowerAchieved[2, ], c(0.48285985, 0.49416594, 0.3951937, 0.3452688, 0.40926839), tolerance = 1e-07, label = paste0(x10$conditionalPowerAchieved[2, ])) + expect_equal(x10$conditionalPowerAchieved[3, ], c(0.70989151, 0.62916384, 0.51917849, 0.36087798, 0.30006833), tolerance = 1e-07, label = paste0(x10$conditionalPowerAchieved[3, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x10), NA))) + expect_output(print(x10)$show()) + invisible(capture.output(expect_error(summary(x10), NA))) + expect_output(summary(x10)$show()) + x10CodeBased <- eval(parse(text = getObjectRCode(x10, stringWrapParagraphWidth = NULL))) + expect_equal(x10CodeBased$effect, x10$effect, tolerance = 1e-07) + expect_equal(x10CodeBased$iterations, x10$iterations, tolerance = 1e-07) + expect_equal(x10CodeBased$overallReject, x10$overallReject, tolerance = 1e-07) + expect_equal(x10CodeBased$rejectPerStage, x10$rejectPerStage, tolerance = 1e-07) + expect_equal(x10CodeBased$futilityStop, x10$futilityStop, tolerance = 1e-07) + expect_equal(x10CodeBased$futilityPerStage, x10$futilityPerStage, tolerance = 1e-07) + expect_equal(x10CodeBased$earlyStop, x10$earlyStop, tolerance = 1e-07) + expect_equal(x10CodeBased$expectedNumberOfSubjects, x10$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x10CodeBased$sampleSizes, x10$sampleSizes, tolerance = 1e-07) + expect_equal(x10CodeBased$conditionalPowerAchieved, x10$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x10), "character") + df <- as.data.frame(x10) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x10) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } }) test_plan_section("Testing Simulation Means Function in a Systematic Way") test_that("'getSimulationMeans': Fisher design with several configurations", { - # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} - # @refFS[Sec.]{fs:sec:simulatingTestingOneHypothesis} - # @refFS[Tab.]{fs:tab:output:getSimulationMeans} - # @refFS[Formula]{fs:simulationOneArmMeansTestStatistics} - # @refFS[Formula]{fs:simulationTwoArmMeansTestStatisticsDiff} - # @refFS[Formula]{fs:simulationTwoArmMeansTestStatisticsRatio} - # @refFS[Formula]{fs:testStatisticGroupSequentialWeightedAverage} - # @refFS[Formula]{fs:testStatisticNormalCombinationTest} - # @refFS[Formula]{fs:testStatisticFisherCombinationTest} - x1 <- getSimulationMeans( - seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), - normalApproximation = TRUE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.05 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x1' with expected results - expect_equal(x1$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(x1$effect, collapse = ", "), ")")) - expect_equal(x1$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x1$iterations[1, ], collapse = ", "), ")")) - expect_equal(x1$iterations[2, ], c(100, 91, 53), label = paste0("c(", paste0(x1$iterations[2, ], collapse = ", "), ")")) - expect_equal(x1$overallReject, c(0.01, 0.67, 0.93), tolerance = 1e-07, label = paste0("c(", paste0(x1$overallReject, collapse = ", "), ")")) - expect_equal(x1$rejectPerStage[1, ], c(0, 0.09, 0.47), tolerance = 1e-07, label = paste0("c(", paste0(x1$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x1$rejectPerStage[2, ], c(0.01, 0.58, 0.46), tolerance = 1e-07, label = paste0("c(", paste0(x1$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x1$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x1$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x1$earlyStop, c(0, 0.09, 0.47), tolerance = 1e-07, label = paste0("c(", paste0(x1$earlyStop, collapse = ", "), ")")) - expect_equal(x1$expectedNumberOfSubjects, c(100.13629, 75.286263, 37.754027), tolerance = 1e-07, label = paste0("c(", paste0(x1$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x1$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x1$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x1$sampleSizes[2, ], c(90.136293, 71.743146, 52.366088), tolerance = 1e-07, label = paste0("c(", paste0(x1$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x1$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x1$conditionalPowerAchieved[2, ], c(0.20283076, 0.49941507, 0.64819831), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x1), NA))) - expect_output(print(x1)$show()) - invisible(capture.output(expect_error(summary(x1), NA))) - expect_output(summary(x1)$show()) - x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) - expect_equal(x1CodeBased$effect, x1$effect, tolerance = 1e-07) - expect_equal(x1CodeBased$iterations, x1$iterations, tolerance = 1e-07) - expect_equal(x1CodeBased$overallReject, x1$overallReject, tolerance = 1e-07) - expect_equal(x1CodeBased$rejectPerStage, x1$rejectPerStage, tolerance = 1e-07) - expect_equal(x1CodeBased$futilityPerStage, x1$futilityPerStage, tolerance = 1e-07) - expect_equal(x1CodeBased$earlyStop, x1$earlyStop, tolerance = 1e-07) - expect_equal(x1CodeBased$expectedNumberOfSubjects, x1$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x1CodeBased$sampleSizes, x1$sampleSizes, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalPowerAchieved, x1$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x1), "character") - df <- as.data.frame(x1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - .skipTestIfDisabled() - - x2 <- getSimulationMeans( - seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), - normalApproximation = TRUE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = FALSE, maxNumberOfIterations = 100, thetaH0 = 0.8 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x2' with expected results - expect_equal(x2$effect, c(-0.8, -0.4, 0), tolerance = 1e-07, label = paste0("c(", paste0(x2$effect, collapse = ", "), ")")) - expect_equal(x2$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x2$iterations[1, ], collapse = ", "), ")")) - expect_equal(x2$iterations[2, ], c(38, 94, 97), label = paste0("c(", paste0(x2$iterations[2, ], collapse = ", "), ")")) - expect_equal(x2$overallReject, c(0.96, 0.74, 0.06), tolerance = 1e-07, label = paste0("c(", paste0(x2$overallReject, collapse = ", "), ")")) - expect_equal(x2$rejectPerStage[1, ], c(0.62, 0.06, 0.03), tolerance = 1e-07, label = paste0("c(", paste0(x2$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x2$rejectPerStage[2, ], c(0.34, 0.68, 0.03), tolerance = 1e-07, label = paste0("c(", paste0(x2$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x2$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x2$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x2$earlyStop, c(0.62, 0.06, 0.03), tolerance = 1e-07, label = paste0("c(", paste0(x2$earlyStop, collapse = ", "), ")")) - expect_equal(x2$expectedNumberOfSubjects, c(25.921375, 81.226383, 97.518855), tolerance = 1e-07, label = paste0("c(", paste0(x2$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x2$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x2$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x2$sampleSizes[2, ], c(41.898355, 75.772748, 90.225624), tolerance = 1e-07, label = paste0("c(", paste0(x2$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x2$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x2$conditionalPowerAchieved[2, ], c(0.66927179, 0.47487279, 0.2338584), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x2), NA))) - expect_output(print(x2)$show()) - invisible(capture.output(expect_error(summary(x2), NA))) - expect_output(summary(x2)$show()) - x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) - expect_equal(x2CodeBased$effect, x2$effect, tolerance = 1e-07) - expect_equal(x2CodeBased$iterations, x2$iterations, tolerance = 1e-07) - expect_equal(x2CodeBased$overallReject, x2$overallReject, tolerance = 1e-07) - expect_equal(x2CodeBased$rejectPerStage, x2$rejectPerStage, tolerance = 1e-07) - expect_equal(x2CodeBased$futilityPerStage, x2$futilityPerStage, tolerance = 1e-07) - expect_equal(x2CodeBased$earlyStop, x2$earlyStop, tolerance = 1e-07) - expect_equal(x2CodeBased$expectedNumberOfSubjects, x2$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x2CodeBased$sampleSizes, x2$sampleSizes, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalPowerAchieved, x2$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x2), "character") - df <- as.data.frame(x2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x3 <- getSimulationMeans( - seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), - normalApproximation = FALSE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.05 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x3' with expected results - expect_equal(x3$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(x3$effect, collapse = ", "), ")")) - expect_equal(x3$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x3$iterations[1, ], collapse = ", "), ")")) - expect_equal(x3$iterations[2, ], c(100, 92, 64), label = paste0("c(", paste0(x3$iterations[2, ], collapse = ", "), ")")) - expect_equal(x3$overallReject, c(0, 0.62, 0.92), tolerance = 1e-07, label = paste0("c(", paste0(x3$overallReject, collapse = ", "), ")")) - expect_equal(x3$rejectPerStage[1, ], c(0, 0.08, 0.36), tolerance = 1e-07, label = paste0("c(", paste0(x3$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x3$rejectPerStage[2, ], c(0, 0.54, 0.56), tolerance = 1e-07, label = paste0("c(", paste0(x3$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x3$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x3$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x3$earlyStop, c(0, 0.08, 0.36), tolerance = 1e-07, label = paste0("c(", paste0(x3$earlyStop, collapse = ", "), ")")) - expect_equal(x3$expectedNumberOfSubjects, c(101.14709, 82.477228, 37.608934), tolerance = 1e-07, label = paste0("c(", paste0(x3$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x3$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x3$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x3$sampleSizes[2, ], c(91.147091, 78.779596, 43.13896), tolerance = 1e-07, label = paste0("c(", paste0(x3$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x3$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x3$conditionalPowerAchieved[2, ], c(0.15986579, 0.45599322, 0.69664803), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x3), NA))) - expect_output(print(x3)$show()) - invisible(capture.output(expect_error(summary(x3), NA))) - expect_output(summary(x3)$show()) - x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) - expect_equal(x3CodeBased$effect, x3$effect, tolerance = 1e-07) - expect_equal(x3CodeBased$iterations, x3$iterations, tolerance = 1e-07) - expect_equal(x3CodeBased$overallReject, x3$overallReject, tolerance = 1e-07) - expect_equal(x3CodeBased$rejectPerStage, x3$rejectPerStage, tolerance = 1e-07) - expect_equal(x3CodeBased$futilityPerStage, x3$futilityPerStage, tolerance = 1e-07) - expect_equal(x3CodeBased$earlyStop, x3$earlyStop, tolerance = 1e-07) - expect_equal(x3CodeBased$expectedNumberOfSubjects, x3$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x3CodeBased$sampleSizes, x3$sampleSizes, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalPowerAchieved, x3$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x3), "character") - df <- as.data.frame(x3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x4 <- getSimulationMeans( - seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), - normalApproximation = FALSE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = FALSE, maxNumberOfIterations = 100, thetaH0 = 0.8 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x4' with expected results - expect_equal(x4$effect, c(-0.8, -0.4, 0), tolerance = 1e-07, label = paste0("c(", paste0(x4$effect, collapse = ", "), ")")) - expect_equal(x4$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x4$iterations[1, ], collapse = ", "), ")")) - expect_equal(x4$iterations[2, ], c(65, 91, 100), label = paste0("c(", paste0(x4$iterations[2, ], collapse = ", "), ")")) - expect_equal(x4$overallReject, c(0.91, 0.73, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(x4$overallReject, collapse = ", "), ")")) - expect_equal(x4$rejectPerStage[1, ], c(0.35, 0.09, 0), tolerance = 1e-07, label = paste0("c(", paste0(x4$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x4$rejectPerStage[2, ], c(0.56, 0.64, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(x4$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x4$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x4$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x4$earlyStop, c(0.35, 0.09, 0), tolerance = 1e-07, label = paste0("c(", paste0(x4$earlyStop, collapse = ", "), ")")) - expect_equal(x4$expectedNumberOfSubjects, c(38.729726, 74.553457, 106.20499), tolerance = 1e-07, label = paste0("c(", paste0(x4$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x4$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x4$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x4$sampleSizes[2, ], c(44.199579, 70.937865, 96.204991), tolerance = 1e-07, label = paste0("c(", paste0(x4$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x4$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x4$conditionalPowerAchieved[2, ], c(0.65544931, 0.50900228, 0.13524564), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x4), NA))) - expect_output(print(x4)$show()) - invisible(capture.output(expect_error(summary(x4), NA))) - expect_output(summary(x4)$show()) - x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) - expect_equal(x4CodeBased$effect, x4$effect, tolerance = 1e-07) - expect_equal(x4CodeBased$iterations, x4$iterations, tolerance = 1e-07) - expect_equal(x4CodeBased$overallReject, x4$overallReject, tolerance = 1e-07) - expect_equal(x4CodeBased$rejectPerStage, x4$rejectPerStage, tolerance = 1e-07) - expect_equal(x4CodeBased$futilityPerStage, x4$futilityPerStage, tolerance = 1e-07) - expect_equal(x4CodeBased$earlyStop, x4$earlyStop, tolerance = 1e-07) - expect_equal(x4CodeBased$expectedNumberOfSubjects, x4$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x4CodeBased$sampleSizes, x4$sampleSizes, tolerance = 1e-07) - expect_equal(x4CodeBased$conditionalPowerAchieved, x4$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x4), "character") - df <- as.data.frame(x4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x5 <- getSimulationMeans( - seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), - normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = TRUE, meanRatio = FALSE, maxNumberOfIterations = 100, thetaH0 = 0.05 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x5' with expected results - expect_equal(x5$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(x5$effect, collapse = ", "), ")")) - expect_equal(x5$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x5$iterations[1, ], collapse = ", "), ")")) - expect_equal(x5$iterations[2, ], c(100, 94, 85), label = paste0("c(", paste0(x5$iterations[2, ], collapse = ", "), ")")) - expect_equal(x5$overallReject, c(0.02, 0.3, 0.65), tolerance = 1e-07, label = paste0("c(", paste0(x5$overallReject, collapse = ", "), ")")) - expect_equal(x5$rejectPerStage[1, ], c(0, 0.06, 0.15), tolerance = 1e-07, label = paste0("c(", paste0(x5$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x5$rejectPerStage[2, ], c(0.02, 0.24, 0.5), tolerance = 1e-07, label = paste0("c(", paste0(x5$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x5$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x5$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x5$earlyStop, c(0, 0.06, 0.15), tolerance = 1e-07, label = paste0("c(", paste0(x5$earlyStop, collapse = ", "), ")")) - expect_equal(x5$expectedNumberOfSubjects, c(99.262844, 92.628587, 72.466684), tolerance = 1e-07, label = paste0("c(", paste0(x5$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x5$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x5$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x5$sampleSizes[2, ], c(89.262844, 87.902752, 73.490217), tolerance = 1e-07, label = paste0("c(", paste0(x5$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x5$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x5$conditionalPowerAchieved[2, ], c(0.21679818, 0.32589621, 0.46073426), tolerance = 1e-07, label = paste0("c(", paste0(x5$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x5), NA))) - expect_output(print(x5)$show()) - invisible(capture.output(expect_error(summary(x5), NA))) - expect_output(summary(x5)$show()) - x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) - expect_equal(x5CodeBased$effect, x5$effect, tolerance = 1e-07) - expect_equal(x5CodeBased$iterations, x5$iterations, tolerance = 1e-07) - expect_equal(x5CodeBased$overallReject, x5$overallReject, tolerance = 1e-07) - expect_equal(x5CodeBased$rejectPerStage, x5$rejectPerStage, tolerance = 1e-07) - expect_equal(x5CodeBased$futilityPerStage, x5$futilityPerStage, tolerance = 1e-07) - expect_equal(x5CodeBased$earlyStop, x5$earlyStop, tolerance = 1e-07) - expect_equal(x5CodeBased$expectedNumberOfSubjects, x5$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x5CodeBased$sampleSizes, x5$sampleSizes, tolerance = 1e-07) - expect_equal(x5CodeBased$conditionalPowerAchieved, x5$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x5), "character") - df <- as.data.frame(x5) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x5) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x6 <- getSimulationMeans( - seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), - normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = FALSE, meanRatio = FALSE, maxNumberOfIterations = 100, thetaH0 = 0.8 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x6' with expected results - expect_equal(x6$effect, c(-0.8, -0.4, 0), tolerance = 1e-07, label = paste0("c(", paste0(x6$effect, collapse = ", "), ")")) - expect_equal(x6$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x6$iterations[1, ], collapse = ", "), ")")) - expect_equal(x6$iterations[2, ], c(85, 94, 97), label = paste0("c(", paste0(x6$iterations[2, ], collapse = ", "), ")")) - expect_equal(x6$overallReject, c(0.73, 0.2, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(x6$overallReject, collapse = ", "), ")")) - expect_equal(x6$rejectPerStage[1, ], c(0.15, 0.06, 0.03), tolerance = 1e-07, label = paste0("c(", paste0(x6$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x6$rejectPerStage[2, ], c(0.58, 0.14, 0.02), tolerance = 1e-07, label = paste0("c(", paste0(x6$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x6$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x6$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x6$earlyStop, c(0.15, 0.06, 0.03), tolerance = 1e-07, label = paste0("c(", paste0(x6$earlyStop, collapse = ", "), ")")) - expect_equal(x6$expectedNumberOfSubjects, c(62.256855, 90.679118, 97.117191), tolerance = 1e-07, label = paste0("c(", paste0(x6$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x6$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x6$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x6$sampleSizes[2, ], c(61.478653, 85.828849, 89.811537), tolerance = 1e-07, label = paste0("c(", paste0(x6$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x6$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x6$conditionalPowerAchieved[2, ], c(0.5750772, 0.31560556, 0.25161462), tolerance = 1e-07, label = paste0("c(", paste0(x6$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x6), NA))) - expect_output(print(x6)$show()) - invisible(capture.output(expect_error(summary(x6), NA))) - expect_output(summary(x6)$show()) - x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) - expect_equal(x6CodeBased$effect, x6$effect, tolerance = 1e-07) - expect_equal(x6CodeBased$iterations, x6$iterations, tolerance = 1e-07) - expect_equal(x6CodeBased$overallReject, x6$overallReject, tolerance = 1e-07) - expect_equal(x6CodeBased$rejectPerStage, x6$rejectPerStage, tolerance = 1e-07) - expect_equal(x6CodeBased$futilityPerStage, x6$futilityPerStage, tolerance = 1e-07) - expect_equal(x6CodeBased$earlyStop, x6$earlyStop, tolerance = 1e-07) - expect_equal(x6CodeBased$expectedNumberOfSubjects, x6$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x6CodeBased$sampleSizes, x6$sampleSizes, tolerance = 1e-07) - expect_equal(x6CodeBased$conditionalPowerAchieved, x6$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x6), "character") - df <- as.data.frame(x6) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x6) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x7 <- getSimulationMeans( - seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), - normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = TRUE, meanRatio = FALSE, maxNumberOfIterations = 100, thetaH0 = 0.05 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x7' with expected results - expect_equal(x7$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(x7$effect, collapse = ", "), ")")) - expect_equal(x7$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x7$iterations[1, ], collapse = ", "), ")")) - expect_equal(x7$iterations[2, ], c(100, 98, 89), label = paste0("c(", paste0(x7$iterations[2, ], collapse = ", "), ")")) - expect_equal(x7$overallReject, c(0, 0.15, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(x7$overallReject, collapse = ", "), ")")) - expect_equal(x7$rejectPerStage[1, ], c(0, 0.02, 0.11), tolerance = 1e-07, label = paste0("c(", paste0(x7$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x7$rejectPerStage[2, ], c(0, 0.13, 0.64), tolerance = 1e-07, label = paste0("c(", paste0(x7$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x7$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x7$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x7$earlyStop, c(0, 0.02, 0.11), tolerance = 1e-07, label = paste0("c(", paste0(x7$earlyStop, collapse = ", "), ")")) - expect_equal(x7$expectedNumberOfSubjects, c(99.499784, 89.67646, 74.321885), tolerance = 1e-07, label = paste0("c(", paste0(x7$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x7$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x7$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x7$sampleSizes[2, ], c(89.499784, 81.30251, 72.27178), tolerance = 1e-07, label = paste0("c(", paste0(x7$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x7$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x7$conditionalPowerAchieved[2, ], c(0.19464679, 0.38425169, 0.50691811), tolerance = 1e-07, label = paste0("c(", paste0(x7$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x7), NA))) - expect_output(print(x7)$show()) - invisible(capture.output(expect_error(summary(x7), NA))) - expect_output(summary(x7)$show()) - x7CodeBased <- eval(parse(text = getObjectRCode(x7, stringWrapParagraphWidth = NULL))) - expect_equal(x7CodeBased$effect, x7$effect, tolerance = 1e-07) - expect_equal(x7CodeBased$iterations, x7$iterations, tolerance = 1e-07) - expect_equal(x7CodeBased$overallReject, x7$overallReject, tolerance = 1e-07) - expect_equal(x7CodeBased$rejectPerStage, x7$rejectPerStage, tolerance = 1e-07) - expect_equal(x7CodeBased$futilityPerStage, x7$futilityPerStage, tolerance = 1e-07) - expect_equal(x7CodeBased$earlyStop, x7$earlyStop, tolerance = 1e-07) - expect_equal(x7CodeBased$expectedNumberOfSubjects, x7$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x7CodeBased$sampleSizes, x7$sampleSizes, tolerance = 1e-07) - expect_equal(x7CodeBased$conditionalPowerAchieved, x7$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x7), "character") - df <- as.data.frame(x7) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x7) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x8 <- getSimulationMeans( - seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), - normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = FALSE, meanRatio = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.8 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x8' with expected results - expect_equal(x8$effect, c(-0.7, -0.4, 0), tolerance = 1e-07, label = paste0("c(", paste0(x8$effect, collapse = ", "), ")")) - expect_equal(x8$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x8$iterations[1, ], collapse = ", "), ")")) - expect_equal(x8$iterations[2, ], c(92, 96, 100), label = paste0("c(", paste0(x8$iterations[2, ], collapse = ", "), ")")) - expect_equal(x8$overallReject, c(0.6, 0.28, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(x8$overallReject, collapse = ", "), ")")) - expect_equal(x8$rejectPerStage[1, ], c(0.08, 0.04, 0), tolerance = 1e-07, label = paste0("c(", paste0(x8$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x8$rejectPerStage[2, ], c(0.52, 0.24, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(x8$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x8$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x8$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x8$earlyStop, c(0.08, 0.04, 0), tolerance = 1e-07, label = paste0("c(", paste0(x8$earlyStop, collapse = ", "), ")")) - expect_equal(x8$expectedNumberOfSubjects, c(75.059866, 89.365281, 105.96832), tolerance = 1e-07, label = paste0("c(", paste0(x8$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x8$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x8$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x8$sampleSizes[2, ], c(70.717246, 82.672167, 95.968315), tolerance = 1e-07, label = paste0("c(", paste0(x8$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x8$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x8$conditionalPowerAchieved[2, ], c(0.47813695, 0.33190551, 0.14267564), tolerance = 1e-07, label = paste0("c(", paste0(x8$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x8), NA))) - expect_output(print(x8)$show()) - invisible(capture.output(expect_error(summary(x8), NA))) - expect_output(summary(x8)$show()) - x8CodeBased <- eval(parse(text = getObjectRCode(x8, stringWrapParagraphWidth = NULL))) - expect_equal(x8CodeBased$effect, x8$effect, tolerance = 1e-07) - expect_equal(x8CodeBased$iterations, x8$iterations, tolerance = 1e-07) - expect_equal(x8CodeBased$overallReject, x8$overallReject, tolerance = 1e-07) - expect_equal(x8CodeBased$rejectPerStage, x8$rejectPerStage, tolerance = 1e-07) - expect_equal(x8CodeBased$futilityPerStage, x8$futilityPerStage, tolerance = 1e-07) - expect_equal(x8CodeBased$earlyStop, x8$earlyStop, tolerance = 1e-07) - expect_equal(x8CodeBased$expectedNumberOfSubjects, x8$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x8CodeBased$sampleSizes, x8$sampleSizes, tolerance = 1e-07) - expect_equal(x8CodeBased$conditionalPowerAchieved, x8$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x8), "character") - df <- as.data.frame(x8) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x8) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x9 <- getSimulationMeans( - seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), normalApproximation = TRUE, - groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = TRUE, meanRatio = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.05 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x9' with expected results - expect_equal(x9$effect, c(0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(x9$effect, collapse = ", "), ")")) - expect_equal(x9$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x9$iterations[1, ], collapse = ", "), ")")) - expect_equal(x9$iterations[2, ], c(99, 94, 80), label = paste0("c(", paste0(x9$iterations[2, ], collapse = ", "), ")")) - expect_equal(x9$overallReject, c(0.06, 0.4, 0.86), tolerance = 1e-07, label = paste0("c(", paste0(x9$overallReject, collapse = ", "), ")")) - expect_equal(x9$rejectPerStage[1, ], c(0.01, 0.06, 0.2), tolerance = 1e-07, label = paste0("c(", paste0(x9$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x9$rejectPerStage[2, ], c(0.05, 0.34, 0.66), tolerance = 1e-07, label = paste0("c(", paste0(x9$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x9$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x9$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x9$earlyStop, c(0.01, 0.06, 0.2), tolerance = 1e-07, label = paste0("c(", paste0(x9$earlyStop, collapse = ", "), ")")) - expect_equal(x9$expectedNumberOfSubjects, c(96.293417, 87.052198, 59.545442), tolerance = 1e-07, label = paste0("c(", paste0(x9$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x9$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x9$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x9$sampleSizes[2, ], c(87.165067, 81.970424, 61.931803), tolerance = 1e-07, label = paste0("c(", paste0(x9$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x9$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x9$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x9$conditionalPowerAchieved[2, ], c(0.23503536, 0.37772778, 0.53734864), tolerance = 1e-07, label = paste0("c(", paste0(x9$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x9), NA))) - expect_output(print(x9)$show()) - invisible(capture.output(expect_error(summary(x9), NA))) - expect_output(summary(x9)$show()) - x9CodeBased <- eval(parse(text = getObjectRCode(x9, stringWrapParagraphWidth = NULL))) - expect_equal(x9CodeBased$effect, x9$effect, tolerance = 1e-07) - expect_equal(x9CodeBased$iterations, x9$iterations, tolerance = 1e-07) - expect_equal(x9CodeBased$overallReject, x9$overallReject, tolerance = 1e-07) - expect_equal(x9CodeBased$rejectPerStage, x9$rejectPerStage, tolerance = 1e-07) - expect_equal(x9CodeBased$futilityPerStage, x9$futilityPerStage, tolerance = 1e-07) - expect_equal(x9CodeBased$earlyStop, x9$earlyStop, tolerance = 1e-07) - expect_equal(x9CodeBased$expectedNumberOfSubjects, x9$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x9CodeBased$sampleSizes, x9$sampleSizes, tolerance = 1e-07) - expect_equal(x9CodeBased$conditionalPowerAchieved, x9$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x9), "character") - df <- as.data.frame(x9) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x9) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x10 <- getSimulationMeans( - seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), - normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = FALSE, meanRatio = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.8 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x10' with expected results - expect_equal(x10$effect, c(-0.7, -0.4, 0), tolerance = 1e-07, label = paste0("c(", paste0(x10$effect, collapse = ", "), ")")) - expect_equal(x10$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x10$iterations[1, ], collapse = ", "), ")")) - expect_equal(x10$iterations[2, ], c(89, 93, 98), label = paste0("c(", paste0(x10$iterations[2, ], collapse = ", "), ")")) - expect_equal(x10$overallReject, c(0.66, 0.31, 0.04), tolerance = 1e-07, label = paste0("c(", paste0(x10$overallReject, collapse = ", "), ")")) - expect_equal(x10$rejectPerStage[1, ], c(0.11, 0.07, 0.02), tolerance = 1e-07, label = paste0("c(", paste0(x10$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x10$rejectPerStage[2, ], c(0.55, 0.24, 0.02), tolerance = 1e-07, label = paste0("c(", paste0(x10$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x10$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x10$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x10$earlyStop, c(0.11, 0.07, 0.02), tolerance = 1e-07, label = paste0("c(", paste0(x10$earlyStop, collapse = ", "), ")")) - expect_equal(x10$expectedNumberOfSubjects, c(64.458245, 88.745903, 98.117191), tolerance = 1e-07, label = paste0("c(", paste0(x10$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x10$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x10$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x10$sampleSizes[2, ], c(61.189039, 84.673014, 89.915501), tolerance = 1e-07, label = paste0("c(", paste0(x10$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x10$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x10$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x10$conditionalPowerAchieved[2, ], c(0.53544626, 0.3174792, 0.23558604), tolerance = 1e-07, label = paste0("c(", paste0(x10$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x10), NA))) - expect_output(print(x10)$show()) - invisible(capture.output(expect_error(summary(x10), NA))) - expect_output(summary(x10)$show()) - x10CodeBased <- eval(parse(text = getObjectRCode(x10, stringWrapParagraphWidth = NULL))) - expect_equal(x10CodeBased$effect, x10$effect, tolerance = 1e-07) - expect_equal(x10CodeBased$iterations, x10$iterations, tolerance = 1e-07) - expect_equal(x10CodeBased$overallReject, x10$overallReject, tolerance = 1e-07) - expect_equal(x10CodeBased$rejectPerStage, x10$rejectPerStage, tolerance = 1e-07) - expect_equal(x10CodeBased$futilityPerStage, x10$futilityPerStage, tolerance = 1e-07) - expect_equal(x10CodeBased$earlyStop, x10$earlyStop, tolerance = 1e-07) - expect_equal(x10CodeBased$expectedNumberOfSubjects, x10$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x10CodeBased$sampleSizes, x10$sampleSizes, tolerance = 1e-07) - expect_equal(x10CodeBased$conditionalPowerAchieved, x10$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x10), "character") - df <- as.data.frame(x10) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x10) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x11 <- getSimulationMeans( - seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), - normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = TRUE, meanRatio = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.05 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x11' with expected results - expect_equal(x11$effect, c(0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(x11$effect, collapse = ", "), ")")) - expect_equal(x11$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x11$iterations[1, ], collapse = ", "), ")")) - expect_equal(x11$iterations[2, ], c(98, 96, 79), label = paste0("c(", paste0(x11$iterations[2, ], collapse = ", "), ")")) - expect_equal(x11$overallReject, c(0.03, 0.32, 0.77), tolerance = 1e-07, label = paste0("c(", paste0(x11$overallReject, collapse = ", "), ")")) - expect_equal(x11$rejectPerStage[1, ], c(0.02, 0.04, 0.21), tolerance = 1e-07, label = paste0("c(", paste0(x11$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x11$rejectPerStage[2, ], c(0.01, 0.28, 0.56), tolerance = 1e-07, label = paste0("c(", paste0(x11$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x11$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x11$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x11$earlyStop, c(0.02, 0.04, 0.21), tolerance = 1e-07, label = paste0("c(", paste0(x11$earlyStop, collapse = ", "), ")")) - expect_equal(x11$expectedNumberOfSubjects, c(96.685833, 88.962444, 54.461927), tolerance = 1e-07, label = paste0("c(", paste0(x11$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x11$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x11$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x11$sampleSizes[2, ], c(88.454932, 82.252546, 56.28092), tolerance = 1e-07, label = paste0("c(", paste0(x11$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x11$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x11$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x11$conditionalPowerAchieved[2, ], c(0.21899188, 0.34972634, 0.63085287), tolerance = 1e-07, label = paste0("c(", paste0(x11$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x11), NA))) - expect_output(print(x11)$show()) - invisible(capture.output(expect_error(summary(x11), NA))) - expect_output(summary(x11)$show()) - x11CodeBased <- eval(parse(text = getObjectRCode(x11, stringWrapParagraphWidth = NULL))) - expect_equal(x11CodeBased$effect, x11$effect, tolerance = 1e-07) - expect_equal(x11CodeBased$iterations, x11$iterations, tolerance = 1e-07) - expect_equal(x11CodeBased$overallReject, x11$overallReject, tolerance = 1e-07) - expect_equal(x11CodeBased$rejectPerStage, x11$rejectPerStage, tolerance = 1e-07) - expect_equal(x11CodeBased$futilityPerStage, x11$futilityPerStage, tolerance = 1e-07) - expect_equal(x11CodeBased$earlyStop, x11$earlyStop, tolerance = 1e-07) - expect_equal(x11CodeBased$expectedNumberOfSubjects, x11$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x11CodeBased$sampleSizes, x11$sampleSizes, tolerance = 1e-07) - expect_equal(x11CodeBased$conditionalPowerAchieved, x11$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x11), "character") - df <- as.data.frame(x11) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x11) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x12 <- getSimulationMeans( - seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), - normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = FALSE, meanRatio = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.8 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x12' with expected results - expect_equal(x12$effect, c(-0.7, -0.4, 0), tolerance = 1e-07, label = paste0("c(", paste0(x12$effect, collapse = ", "), ")")) - expect_equal(x12$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x12$iterations[1, ], collapse = ", "), ")")) - expect_equal(x12$iterations[2, ], c(92, 96, 100), label = paste0("c(", paste0(x12$iterations[2, ], collapse = ", "), ")")) - expect_equal(x12$overallReject, c(0.6, 0.28, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(x12$overallReject, collapse = ", "), ")")) - expect_equal(x12$rejectPerStage[1, ], c(0.08, 0.04, 0), tolerance = 1e-07, label = paste0("c(", paste0(x12$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x12$rejectPerStage[2, ], c(0.52, 0.24, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(x12$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x12$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x12$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x12$earlyStop, c(0.08, 0.04, 0), tolerance = 1e-07, label = paste0("c(", paste0(x12$earlyStop, collapse = ", "), ")")) - expect_equal(x12$expectedNumberOfSubjects, c(75.059866, 89.365281, 105.96832), tolerance = 1e-07, label = paste0("c(", paste0(x12$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x12$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x12$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x12$sampleSizes[2, ], c(70.717246, 82.672167, 95.968315), tolerance = 1e-07, label = paste0("c(", paste0(x12$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x12$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x12$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x12$conditionalPowerAchieved[2, ], c(0.47813695, 0.33190551, 0.14267564), tolerance = 1e-07, label = paste0("c(", paste0(x12$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x12), NA))) - expect_output(print(x12)$show()) - invisible(capture.output(expect_error(summary(x12), NA))) - expect_output(summary(x12)$show()) - x12CodeBased <- eval(parse(text = getObjectRCode(x12, stringWrapParagraphWidth = NULL))) - expect_equal(x12CodeBased$effect, x12$effect, tolerance = 1e-07) - expect_equal(x12CodeBased$iterations, x12$iterations, tolerance = 1e-07) - expect_equal(x12CodeBased$overallReject, x12$overallReject, tolerance = 1e-07) - expect_equal(x12CodeBased$rejectPerStage, x12$rejectPerStage, tolerance = 1e-07) - expect_equal(x12CodeBased$futilityPerStage, x12$futilityPerStage, tolerance = 1e-07) - expect_equal(x12CodeBased$earlyStop, x12$earlyStop, tolerance = 1e-07) - expect_equal(x12CodeBased$expectedNumberOfSubjects, x12$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x12CodeBased$sampleSizes, x12$sampleSizes, tolerance = 1e-07) - expect_equal(x12CodeBased$conditionalPowerAchieved, x12$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x12), "character") - df <- as.data.frame(x12) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x12) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - + # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} + # @refFS[Sec.]{fs:sec:simulatingTestingOneHypothesis} + # @refFS[Tab.]{fs:tab:output:getSimulationMeans} + # @refFS[Formula]{fs:simulationOneArmMeansTestStatistics} + # @refFS[Formula]{fs:simulationTwoArmMeansTestStatisticsDiff} + # @refFS[Formula]{fs:simulationTwoArmMeansTestStatisticsRatio} + # @refFS[Formula]{fs:testStatisticGroupSequentialWeightedAverage} + # @refFS[Formula]{fs:testStatisticNormalCombinationTest} + # @refFS[Formula]{fs:testStatisticFisherCombinationTest} + x1 <- getSimulationMeans( + seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), + normalApproximation = TRUE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.05 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x1' with expected results + expect_equal(x1$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0(x1$effect)) + expect_equal(x1$iterations[1, ], c(100, 100, 100), label = paste0(x1$iterations[1, ])) + expect_equal(x1$iterations[2, ], c(100, 91, 53), label = paste0(x1$iterations[2, ])) + expect_equal(x1$overallReject, c(0.01, 0.67, 0.93), tolerance = 1e-07, label = paste0(x1$overallReject)) + expect_equal(x1$rejectPerStage[1, ], c(0, 0.09, 0.47), tolerance = 1e-07, label = paste0(x1$rejectPerStage[1, ])) + expect_equal(x1$rejectPerStage[2, ], c(0.01, 0.58, 0.46), tolerance = 1e-07, label = paste0(x1$rejectPerStage[2, ])) + expect_equal(x1$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x1$futilityPerStage[1, ])) + expect_equal(x1$earlyStop, c(0, 0.09, 0.47), tolerance = 1e-07, label = paste0(x1$earlyStop)) + expect_equal(x1$expectedNumberOfSubjects, c(100.13629, 75.286263, 37.754027), tolerance = 1e-07, label = paste0(x1$expectedNumberOfSubjects)) + expect_equal(x1$sampleSizes[1, ], c(10, 10, 10), label = paste0(x1$sampleSizes[1, ])) + expect_equal(x1$sampleSizes[2, ], c(90.136293, 71.743146, 52.366088), tolerance = 1e-07, label = paste0(x1$sampleSizes[2, ])) + expect_equal(x1$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x1$conditionalPowerAchieved[1, ])) + expect_equal(x1$conditionalPowerAchieved[2, ], c(0.20283076, 0.49941507, 0.64819831), tolerance = 1e-07, label = paste0(x1$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x1), NA))) + expect_output(print(x1)$show()) + invisible(capture.output(expect_error(summary(x1), NA))) + expect_output(summary(x1)$show()) + x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) + expect_equal(x1CodeBased$effect, x1$effect, tolerance = 1e-07) + expect_equal(x1CodeBased$iterations, x1$iterations, tolerance = 1e-07) + expect_equal(x1CodeBased$overallReject, x1$overallReject, tolerance = 1e-07) + expect_equal(x1CodeBased$rejectPerStage, x1$rejectPerStage, tolerance = 1e-07) + expect_equal(x1CodeBased$futilityPerStage, x1$futilityPerStage, tolerance = 1e-07) + expect_equal(x1CodeBased$earlyStop, x1$earlyStop, tolerance = 1e-07) + expect_equal(x1CodeBased$expectedNumberOfSubjects, x1$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x1CodeBased$sampleSizes, x1$sampleSizes, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalPowerAchieved, x1$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x1), "character") + df <- as.data.frame(x1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + .skipTestIfDisabled() + + x2 <- getSimulationMeans( + seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), + normalApproximation = TRUE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = FALSE, maxNumberOfIterations = 100, thetaH0 = 0.8 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x2' with expected results + expect_equal(x2$effect, c(-0.8, -0.4, 0), tolerance = 1e-07, label = paste0(x2$effect)) + expect_equal(x2$iterations[1, ], c(100, 100, 100), label = paste0(x2$iterations[1, ])) + expect_equal(x2$iterations[2, ], c(38, 94, 97), label = paste0(x2$iterations[2, ])) + expect_equal(x2$overallReject, c(0.96, 0.74, 0.06), tolerance = 1e-07, label = paste0(x2$overallReject)) + expect_equal(x2$rejectPerStage[1, ], c(0.62, 0.06, 0.03), tolerance = 1e-07, label = paste0(x2$rejectPerStage[1, ])) + expect_equal(x2$rejectPerStage[2, ], c(0.34, 0.68, 0.03), tolerance = 1e-07, label = paste0(x2$rejectPerStage[2, ])) + expect_equal(x2$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x2$futilityPerStage[1, ])) + expect_equal(x2$earlyStop, c(0.62, 0.06, 0.03), tolerance = 1e-07, label = paste0(x2$earlyStop)) + expect_equal(x2$expectedNumberOfSubjects, c(25.921375, 81.226383, 97.518855), tolerance = 1e-07, label = paste0(x2$expectedNumberOfSubjects)) + expect_equal(x2$sampleSizes[1, ], c(10, 10, 10), label = paste0(x2$sampleSizes[1, ])) + expect_equal(x2$sampleSizes[2, ], c(41.898355, 75.772748, 90.225624), tolerance = 1e-07, label = paste0(x2$sampleSizes[2, ])) + expect_equal(x2$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x2$conditionalPowerAchieved[1, ])) + expect_equal(x2$conditionalPowerAchieved[2, ], c(0.66927179, 0.47487279, 0.2338584), tolerance = 1e-07, label = paste0(x2$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x2), NA))) + expect_output(print(x2)$show()) + invisible(capture.output(expect_error(summary(x2), NA))) + expect_output(summary(x2)$show()) + x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) + expect_equal(x2CodeBased$effect, x2$effect, tolerance = 1e-07) + expect_equal(x2CodeBased$iterations, x2$iterations, tolerance = 1e-07) + expect_equal(x2CodeBased$overallReject, x2$overallReject, tolerance = 1e-07) + expect_equal(x2CodeBased$rejectPerStage, x2$rejectPerStage, tolerance = 1e-07) + expect_equal(x2CodeBased$futilityPerStage, x2$futilityPerStage, tolerance = 1e-07) + expect_equal(x2CodeBased$earlyStop, x2$earlyStop, tolerance = 1e-07) + expect_equal(x2CodeBased$expectedNumberOfSubjects, x2$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x2CodeBased$sampleSizes, x2$sampleSizes, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalPowerAchieved, x2$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x2), "character") + df <- as.data.frame(x2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x3 <- getSimulationMeans( + seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), + normalApproximation = FALSE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.05 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x3' with expected results + expect_equal(x3$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0(x3$effect)) + expect_equal(x3$iterations[1, ], c(100, 100, 100), label = paste0(x3$iterations[1, ])) + expect_equal(x3$iterations[2, ], c(100, 92, 64), label = paste0(x3$iterations[2, ])) + expect_equal(x3$overallReject, c(0, 0.62, 0.92), tolerance = 1e-07, label = paste0(x3$overallReject)) + expect_equal(x3$rejectPerStage[1, ], c(0, 0.08, 0.36), tolerance = 1e-07, label = paste0(x3$rejectPerStage[1, ])) + expect_equal(x3$rejectPerStage[2, ], c(0, 0.54, 0.56), tolerance = 1e-07, label = paste0(x3$rejectPerStage[2, ])) + expect_equal(x3$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x3$futilityPerStage[1, ])) + expect_equal(x3$earlyStop, c(0, 0.08, 0.36), tolerance = 1e-07, label = paste0(x3$earlyStop)) + expect_equal(x3$expectedNumberOfSubjects, c(101.14709, 82.477228, 37.608934), tolerance = 1e-07, label = paste0(x3$expectedNumberOfSubjects)) + expect_equal(x3$sampleSizes[1, ], c(10, 10, 10), label = paste0(x3$sampleSizes[1, ])) + expect_equal(x3$sampleSizes[2, ], c(91.147091, 78.779596, 43.13896), tolerance = 1e-07, label = paste0(x3$sampleSizes[2, ])) + expect_equal(x3$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x3$conditionalPowerAchieved[1, ])) + expect_equal(x3$conditionalPowerAchieved[2, ], c(0.15986579, 0.45599322, 0.69664803), tolerance = 1e-07, label = paste0(x3$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x3), NA))) + expect_output(print(x3)$show()) + invisible(capture.output(expect_error(summary(x3), NA))) + expect_output(summary(x3)$show()) + x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) + expect_equal(x3CodeBased$effect, x3$effect, tolerance = 1e-07) + expect_equal(x3CodeBased$iterations, x3$iterations, tolerance = 1e-07) + expect_equal(x3CodeBased$overallReject, x3$overallReject, tolerance = 1e-07) + expect_equal(x3CodeBased$rejectPerStage, x3$rejectPerStage, tolerance = 1e-07) + expect_equal(x3CodeBased$futilityPerStage, x3$futilityPerStage, tolerance = 1e-07) + expect_equal(x3CodeBased$earlyStop, x3$earlyStop, tolerance = 1e-07) + expect_equal(x3CodeBased$expectedNumberOfSubjects, x3$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x3CodeBased$sampleSizes, x3$sampleSizes, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalPowerAchieved, x3$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x3), "character") + df <- as.data.frame(x3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x4 <- getSimulationMeans( + seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), + normalApproximation = FALSE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = FALSE, maxNumberOfIterations = 100, thetaH0 = 0.8 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x4' with expected results + expect_equal(x4$effect, c(-0.8, -0.4, 0), tolerance = 1e-07, label = paste0(x4$effect)) + expect_equal(x4$iterations[1, ], c(100, 100, 100), label = paste0(x4$iterations[1, ])) + expect_equal(x4$iterations[2, ], c(65, 91, 100), label = paste0(x4$iterations[2, ])) + expect_equal(x4$overallReject, c(0.91, 0.73, 0.01), tolerance = 1e-07, label = paste0(x4$overallReject)) + expect_equal(x4$rejectPerStage[1, ], c(0.35, 0.09, 0), tolerance = 1e-07, label = paste0(x4$rejectPerStage[1, ])) + expect_equal(x4$rejectPerStage[2, ], c(0.56, 0.64, 0.01), tolerance = 1e-07, label = paste0(x4$rejectPerStage[2, ])) + expect_equal(x4$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x4$futilityPerStage[1, ])) + expect_equal(x4$earlyStop, c(0.35, 0.09, 0), tolerance = 1e-07, label = paste0(x4$earlyStop)) + expect_equal(x4$expectedNumberOfSubjects, c(38.729726, 74.553457, 106.20499), tolerance = 1e-07, label = paste0(x4$expectedNumberOfSubjects)) + expect_equal(x4$sampleSizes[1, ], c(10, 10, 10), label = paste0(x4$sampleSizes[1, ])) + expect_equal(x4$sampleSizes[2, ], c(44.199579, 70.937865, 96.204991), tolerance = 1e-07, label = paste0(x4$sampleSizes[2, ])) + expect_equal(x4$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x4$conditionalPowerAchieved[1, ])) + expect_equal(x4$conditionalPowerAchieved[2, ], c(0.65544931, 0.50900228, 0.13524564), tolerance = 1e-07, label = paste0(x4$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x4), NA))) + expect_output(print(x4)$show()) + invisible(capture.output(expect_error(summary(x4), NA))) + expect_output(summary(x4)$show()) + x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) + expect_equal(x4CodeBased$effect, x4$effect, tolerance = 1e-07) + expect_equal(x4CodeBased$iterations, x4$iterations, tolerance = 1e-07) + expect_equal(x4CodeBased$overallReject, x4$overallReject, tolerance = 1e-07) + expect_equal(x4CodeBased$rejectPerStage, x4$rejectPerStage, tolerance = 1e-07) + expect_equal(x4CodeBased$futilityPerStage, x4$futilityPerStage, tolerance = 1e-07) + expect_equal(x4CodeBased$earlyStop, x4$earlyStop, tolerance = 1e-07) + expect_equal(x4CodeBased$expectedNumberOfSubjects, x4$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x4CodeBased$sampleSizes, x4$sampleSizes, tolerance = 1e-07) + expect_equal(x4CodeBased$conditionalPowerAchieved, x4$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x4), "character") + df <- as.data.frame(x4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x5 <- getSimulationMeans( + seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), + normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = TRUE, meanRatio = FALSE, maxNumberOfIterations = 100, thetaH0 = 0.05 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x5' with expected results + expect_equal(x5$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0(x5$effect)) + expect_equal(x5$iterations[1, ], c(100, 100, 100), label = paste0(x5$iterations[1, ])) + expect_equal(x5$iterations[2, ], c(100, 94, 85), label = paste0(x5$iterations[2, ])) + expect_equal(x5$overallReject, c(0.02, 0.3, 0.65), tolerance = 1e-07, label = paste0(x5$overallReject)) + expect_equal(x5$rejectPerStage[1, ], c(0, 0.06, 0.15), tolerance = 1e-07, label = paste0(x5$rejectPerStage[1, ])) + expect_equal(x5$rejectPerStage[2, ], c(0.02, 0.24, 0.5), tolerance = 1e-07, label = paste0(x5$rejectPerStage[2, ])) + expect_equal(x5$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x5$futilityPerStage[1, ])) + expect_equal(x5$earlyStop, c(0, 0.06, 0.15), tolerance = 1e-07, label = paste0(x5$earlyStop)) + expect_equal(x5$expectedNumberOfSubjects, c(99.262844, 92.628587, 72.466684), tolerance = 1e-07, label = paste0(x5$expectedNumberOfSubjects)) + expect_equal(x5$sampleSizes[1, ], c(10, 10, 10), label = paste0(x5$sampleSizes[1, ])) + expect_equal(x5$sampleSizes[2, ], c(89.262844, 87.902752, 73.490217), tolerance = 1e-07, label = paste0(x5$sampleSizes[2, ])) + expect_equal(x5$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x5$conditionalPowerAchieved[1, ])) + expect_equal(x5$conditionalPowerAchieved[2, ], c(0.21679818, 0.32589621, 0.46073426), tolerance = 1e-07, label = paste0(x5$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x5), NA))) + expect_output(print(x5)$show()) + invisible(capture.output(expect_error(summary(x5), NA))) + expect_output(summary(x5)$show()) + x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) + expect_equal(x5CodeBased$effect, x5$effect, tolerance = 1e-07) + expect_equal(x5CodeBased$iterations, x5$iterations, tolerance = 1e-07) + expect_equal(x5CodeBased$overallReject, x5$overallReject, tolerance = 1e-07) + expect_equal(x5CodeBased$rejectPerStage, x5$rejectPerStage, tolerance = 1e-07) + expect_equal(x5CodeBased$futilityPerStage, x5$futilityPerStage, tolerance = 1e-07) + expect_equal(x5CodeBased$earlyStop, x5$earlyStop, tolerance = 1e-07) + expect_equal(x5CodeBased$expectedNumberOfSubjects, x5$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x5CodeBased$sampleSizes, x5$sampleSizes, tolerance = 1e-07) + expect_equal(x5CodeBased$conditionalPowerAchieved, x5$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x5), "character") + df <- as.data.frame(x5) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x5) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x6 <- getSimulationMeans( + seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), + normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = FALSE, meanRatio = FALSE, maxNumberOfIterations = 100, thetaH0 = 0.8 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x6' with expected results + expect_equal(x6$effect, c(-0.8, -0.4, 0), tolerance = 1e-07, label = paste0(x6$effect)) + expect_equal(x6$iterations[1, ], c(100, 100, 100), label = paste0(x6$iterations[1, ])) + expect_equal(x6$iterations[2, ], c(85, 94, 97), label = paste0(x6$iterations[2, ])) + expect_equal(x6$overallReject, c(0.73, 0.2, 0.05), tolerance = 1e-07, label = paste0(x6$overallReject)) + expect_equal(x6$rejectPerStage[1, ], c(0.15, 0.06, 0.03), tolerance = 1e-07, label = paste0(x6$rejectPerStage[1, ])) + expect_equal(x6$rejectPerStage[2, ], c(0.58, 0.14, 0.02), tolerance = 1e-07, label = paste0(x6$rejectPerStage[2, ])) + expect_equal(x6$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x6$futilityPerStage[1, ])) + expect_equal(x6$earlyStop, c(0.15, 0.06, 0.03), tolerance = 1e-07, label = paste0(x6$earlyStop)) + expect_equal(x6$expectedNumberOfSubjects, c(62.256855, 90.679118, 97.117191), tolerance = 1e-07, label = paste0(x6$expectedNumberOfSubjects)) + expect_equal(x6$sampleSizes[1, ], c(10, 10, 10), label = paste0(x6$sampleSizes[1, ])) + expect_equal(x6$sampleSizes[2, ], c(61.478653, 85.828849, 89.811537), tolerance = 1e-07, label = paste0(x6$sampleSizes[2, ])) + expect_equal(x6$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x6$conditionalPowerAchieved[1, ])) + expect_equal(x6$conditionalPowerAchieved[2, ], c(0.5750772, 0.31560556, 0.25161462), tolerance = 1e-07, label = paste0(x6$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x6), NA))) + expect_output(print(x6)$show()) + invisible(capture.output(expect_error(summary(x6), NA))) + expect_output(summary(x6)$show()) + x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) + expect_equal(x6CodeBased$effect, x6$effect, tolerance = 1e-07) + expect_equal(x6CodeBased$iterations, x6$iterations, tolerance = 1e-07) + expect_equal(x6CodeBased$overallReject, x6$overallReject, tolerance = 1e-07) + expect_equal(x6CodeBased$rejectPerStage, x6$rejectPerStage, tolerance = 1e-07) + expect_equal(x6CodeBased$futilityPerStage, x6$futilityPerStage, tolerance = 1e-07) + expect_equal(x6CodeBased$earlyStop, x6$earlyStop, tolerance = 1e-07) + expect_equal(x6CodeBased$expectedNumberOfSubjects, x6$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x6CodeBased$sampleSizes, x6$sampleSizes, tolerance = 1e-07) + expect_equal(x6CodeBased$conditionalPowerAchieved, x6$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x6), "character") + df <- as.data.frame(x6) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x6) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x7 <- getSimulationMeans( + seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), + normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = TRUE, meanRatio = FALSE, maxNumberOfIterations = 100, thetaH0 = 0.05 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x7' with expected results + expect_equal(x7$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0(x7$effect)) + expect_equal(x7$iterations[1, ], c(100, 100, 100), label = paste0(x7$iterations[1, ])) + expect_equal(x7$iterations[2, ], c(100, 98, 89), label = paste0(x7$iterations[2, ])) + expect_equal(x7$overallReject, c(0, 0.15, 0.75), tolerance = 1e-07, label = paste0(x7$overallReject)) + expect_equal(x7$rejectPerStage[1, ], c(0, 0.02, 0.11), tolerance = 1e-07, label = paste0(x7$rejectPerStage[1, ])) + expect_equal(x7$rejectPerStage[2, ], c(0, 0.13, 0.64), tolerance = 1e-07, label = paste0(x7$rejectPerStage[2, ])) + expect_equal(x7$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x7$futilityPerStage[1, ])) + expect_equal(x7$earlyStop, c(0, 0.02, 0.11), tolerance = 1e-07, label = paste0(x7$earlyStop)) + expect_equal(x7$expectedNumberOfSubjects, c(99.499784, 89.67646, 74.321885), tolerance = 1e-07, label = paste0(x7$expectedNumberOfSubjects)) + expect_equal(x7$sampleSizes[1, ], c(10, 10, 10), label = paste0(x7$sampleSizes[1, ])) + expect_equal(x7$sampleSizes[2, ], c(89.499784, 81.30251, 72.27178), tolerance = 1e-07, label = paste0(x7$sampleSizes[2, ])) + expect_equal(x7$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x7$conditionalPowerAchieved[1, ])) + expect_equal(x7$conditionalPowerAchieved[2, ], c(0.19464679, 0.38425169, 0.50691811), tolerance = 1e-07, label = paste0(x7$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x7), NA))) + expect_output(print(x7)$show()) + invisible(capture.output(expect_error(summary(x7), NA))) + expect_output(summary(x7)$show()) + x7CodeBased <- eval(parse(text = getObjectRCode(x7, stringWrapParagraphWidth = NULL))) + expect_equal(x7CodeBased$effect, x7$effect, tolerance = 1e-07) + expect_equal(x7CodeBased$iterations, x7$iterations, tolerance = 1e-07) + expect_equal(x7CodeBased$overallReject, x7$overallReject, tolerance = 1e-07) + expect_equal(x7CodeBased$rejectPerStage, x7$rejectPerStage, tolerance = 1e-07) + expect_equal(x7CodeBased$futilityPerStage, x7$futilityPerStage, tolerance = 1e-07) + expect_equal(x7CodeBased$earlyStop, x7$earlyStop, tolerance = 1e-07) + expect_equal(x7CodeBased$expectedNumberOfSubjects, x7$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x7CodeBased$sampleSizes, x7$sampleSizes, tolerance = 1e-07) + expect_equal(x7CodeBased$conditionalPowerAchieved, x7$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x7), "character") + df <- as.data.frame(x7) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x7) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x8 <- getSimulationMeans( + seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), + normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = FALSE, meanRatio = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.8 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x8' with expected results + expect_equal(x8$effect, c(-0.7, -0.4, 0), tolerance = 1e-07, label = paste0(x8$effect)) + expect_equal(x8$iterations[1, ], c(100, 100, 100), label = paste0(x8$iterations[1, ])) + expect_equal(x8$iterations[2, ], c(92, 96, 100), label = paste0(x8$iterations[2, ])) + expect_equal(x8$overallReject, c(0.6, 0.28, 0.01), tolerance = 1e-07, label = paste0(x8$overallReject)) + expect_equal(x8$rejectPerStage[1, ], c(0.08, 0.04, 0), tolerance = 1e-07, label = paste0(x8$rejectPerStage[1, ])) + expect_equal(x8$rejectPerStage[2, ], c(0.52, 0.24, 0.01), tolerance = 1e-07, label = paste0(x8$rejectPerStage[2, ])) + expect_equal(x8$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x8$futilityPerStage[1, ])) + expect_equal(x8$earlyStop, c(0.08, 0.04, 0), tolerance = 1e-07, label = paste0(x8$earlyStop)) + expect_equal(x8$expectedNumberOfSubjects, c(75.059866, 89.365281, 105.96832), tolerance = 1e-07, label = paste0(x8$expectedNumberOfSubjects)) + expect_equal(x8$sampleSizes[1, ], c(10, 10, 10), label = paste0(x8$sampleSizes[1, ])) + expect_equal(x8$sampleSizes[2, ], c(70.717246, 82.672167, 95.968315), tolerance = 1e-07, label = paste0(x8$sampleSizes[2, ])) + expect_equal(x8$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x8$conditionalPowerAchieved[1, ])) + expect_equal(x8$conditionalPowerAchieved[2, ], c(0.50516099, 0.35186807, 0.15287771), tolerance = 1e-07, label = paste0(x8$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x8), NA))) + expect_output(print(x8)$show()) + invisible(capture.output(expect_error(summary(x8), NA))) + expect_output(summary(x8)$show()) + x8CodeBased <- eval(parse(text = getObjectRCode(x8, stringWrapParagraphWidth = NULL))) + expect_equal(x8CodeBased$effect, x8$effect, tolerance = 1e-07) + expect_equal(x8CodeBased$iterations, x8$iterations, tolerance = 1e-07) + expect_equal(x8CodeBased$overallReject, x8$overallReject, tolerance = 1e-07) + expect_equal(x8CodeBased$rejectPerStage, x8$rejectPerStage, tolerance = 1e-07) + expect_equal(x8CodeBased$futilityPerStage, x8$futilityPerStage, tolerance = 1e-07) + expect_equal(x8CodeBased$earlyStop, x8$earlyStop, tolerance = 1e-07) + expect_equal(x8CodeBased$expectedNumberOfSubjects, x8$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x8CodeBased$sampleSizes, x8$sampleSizes, tolerance = 1e-07) + expect_equal(x8CodeBased$conditionalPowerAchieved, x8$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x8), "character") + df <- as.data.frame(x8) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x8) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x9 <- getSimulationMeans( + seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), normalApproximation = TRUE, + groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = TRUE, meanRatio = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.05 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x9' with expected results + expect_equal(x9$effect, c(0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0(x9$effect)) + expect_equal(x9$iterations[1, ], c(100, 100, 100), label = paste0(x9$iterations[1, ])) + expect_equal(x9$iterations[2, ], c(99, 94, 80), label = paste0(x9$iterations[2, ])) + expect_equal(x9$overallReject, c(0.06, 0.4, 0.86), tolerance = 1e-07, label = paste0(x9$overallReject)) + expect_equal(x9$rejectPerStage[1, ], c(0.01, 0.06, 0.2), tolerance = 1e-07, label = paste0(x9$rejectPerStage[1, ])) + expect_equal(x9$rejectPerStage[2, ], c(0.05, 0.34, 0.66), tolerance = 1e-07, label = paste0(x9$rejectPerStage[2, ])) + expect_equal(x9$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x9$futilityPerStage[1, ])) + expect_equal(x9$earlyStop, c(0.01, 0.06, 0.2), tolerance = 1e-07, label = paste0(x9$earlyStop)) + expect_equal(x9$expectedNumberOfSubjects, c(96.293417, 87.052198, 59.545442), tolerance = 1e-07, label = paste0(x9$expectedNumberOfSubjects)) + expect_equal(x9$sampleSizes[1, ], c(10, 10, 10), label = paste0(x9$sampleSizes[1, ])) + expect_equal(x9$sampleSizes[2, ], c(87.165067, 81.970424, 61.931803), tolerance = 1e-07, label = paste0(x9$sampleSizes[2, ])) + expect_equal(x9$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x9$conditionalPowerAchieved[1, ])) + expect_equal(x9$conditionalPowerAchieved[2, ], c(0.24145457, 0.38808181, 0.55067182), tolerance = 1e-07, label = paste0(x9$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x9), NA))) + expect_output(print(x9)$show()) + invisible(capture.output(expect_error(summary(x9), NA))) + expect_output(summary(x9)$show()) + x9CodeBased <- eval(parse(text = getObjectRCode(x9, stringWrapParagraphWidth = NULL))) + expect_equal(x9CodeBased$effect, x9$effect, tolerance = 1e-07) + expect_equal(x9CodeBased$iterations, x9$iterations, tolerance = 1e-07) + expect_equal(x9CodeBased$overallReject, x9$overallReject, tolerance = 1e-07) + expect_equal(x9CodeBased$rejectPerStage, x9$rejectPerStage, tolerance = 1e-07) + expect_equal(x9CodeBased$futilityPerStage, x9$futilityPerStage, tolerance = 1e-07) + expect_equal(x9CodeBased$earlyStop, x9$earlyStop, tolerance = 1e-07) + expect_equal(x9CodeBased$expectedNumberOfSubjects, x9$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x9CodeBased$sampleSizes, x9$sampleSizes, tolerance = 1e-07) + expect_equal(x9CodeBased$conditionalPowerAchieved, x9$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x9), "character") + df <- as.data.frame(x9) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x9) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x10 <- getSimulationMeans( + seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), + normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = FALSE, meanRatio = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.8 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x10' with expected results + expect_equal(x10$effect, c(-0.7, -0.4, 0), tolerance = 1e-07, label = paste0(x10$effect)) + expect_equal(x10$iterations[1, ], c(100, 100, 100), label = paste0(x10$iterations[1, ])) + expect_equal(x10$iterations[2, ], c(89, 93, 98), label = paste0(x10$iterations[2, ])) + expect_equal(x10$overallReject, c(0.66, 0.31, 0.04), tolerance = 1e-07, label = paste0(x10$overallReject)) + expect_equal(x10$rejectPerStage[1, ], c(0.11, 0.07, 0.02), tolerance = 1e-07, label = paste0(x10$rejectPerStage[1, ])) + expect_equal(x10$rejectPerStage[2, ], c(0.55, 0.24, 0.02), tolerance = 1e-07, label = paste0(x10$rejectPerStage[2, ])) + expect_equal(x10$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x10$futilityPerStage[1, ])) + expect_equal(x10$earlyStop, c(0.11, 0.07, 0.02), tolerance = 1e-07, label = paste0(x10$earlyStop)) + expect_equal(x10$expectedNumberOfSubjects, c(64.458245, 88.745903, 98.117191), tolerance = 1e-07, label = paste0(x10$expectedNumberOfSubjects)) + expect_equal(x10$sampleSizes[1, ], c(10, 10, 10), label = paste0(x10$sampleSizes[1, ])) + expect_equal(x10$sampleSizes[2, ], c(61.189039, 84.673014, 89.915501), tolerance = 1e-07, label = paste0(x10$sampleSizes[2, ])) + expect_equal(x10$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x10$conditionalPowerAchieved[1, ])) + expect_equal(x10$conditionalPowerAchieved[2, ], c(0.5628553, 0.33552504, 0.24972359), tolerance = 1e-07, label = paste0(x10$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x10), NA))) + expect_output(print(x10)$show()) + invisible(capture.output(expect_error(summary(x10), NA))) + expect_output(summary(x10)$show()) + x10CodeBased <- eval(parse(text = getObjectRCode(x10, stringWrapParagraphWidth = NULL))) + expect_equal(x10CodeBased$effect, x10$effect, tolerance = 1e-07) + expect_equal(x10CodeBased$iterations, x10$iterations, tolerance = 1e-07) + expect_equal(x10CodeBased$overallReject, x10$overallReject, tolerance = 1e-07) + expect_equal(x10CodeBased$rejectPerStage, x10$rejectPerStage, tolerance = 1e-07) + expect_equal(x10CodeBased$futilityPerStage, x10$futilityPerStage, tolerance = 1e-07) + expect_equal(x10CodeBased$earlyStop, x10$earlyStop, tolerance = 1e-07) + expect_equal(x10CodeBased$expectedNumberOfSubjects, x10$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x10CodeBased$sampleSizes, x10$sampleSizes, tolerance = 1e-07) + expect_equal(x10CodeBased$conditionalPowerAchieved, x10$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x10), "character") + df <- as.data.frame(x10) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x10) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x11 <- getSimulationMeans( + seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), + normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = TRUE, meanRatio = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.05 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x11' with expected results + expect_equal(x11$effect, c(0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0(x11$effect)) + expect_equal(x11$iterations[1, ], c(100, 100, 100), label = paste0(x11$iterations[1, ])) + expect_equal(x11$iterations[2, ], c(98, 96, 79), label = paste0(x11$iterations[2, ])) + expect_equal(x11$overallReject, c(0.03, 0.32, 0.77), tolerance = 1e-07, label = paste0(x11$overallReject)) + expect_equal(x11$rejectPerStage[1, ], c(0.02, 0.04, 0.21), tolerance = 1e-07, label = paste0(x11$rejectPerStage[1, ])) + expect_equal(x11$rejectPerStage[2, ], c(0.01, 0.28, 0.56), tolerance = 1e-07, label = paste0(x11$rejectPerStage[2, ])) + expect_equal(x11$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x11$futilityPerStage[1, ])) + expect_equal(x11$earlyStop, c(0.02, 0.04, 0.21), tolerance = 1e-07, label = paste0(x11$earlyStop)) + expect_equal(x11$expectedNumberOfSubjects, c(96.685833, 88.962444, 54.461927), tolerance = 1e-07, label = paste0(x11$expectedNumberOfSubjects)) + expect_equal(x11$sampleSizes[1, ], c(10, 10, 10), label = paste0(x11$sampleSizes[1, ])) + expect_equal(x11$sampleSizes[2, ], c(88.454932, 82.252546, 56.28092), tolerance = 1e-07, label = paste0(x11$sampleSizes[2, ])) + expect_equal(x11$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x11$conditionalPowerAchieved[1, ])) + expect_equal(x11$conditionalPowerAchieved[2, ], c(0.22533731, 0.35971487, 0.64663552), tolerance = 1e-07, label = paste0(x11$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x11), NA))) + expect_output(print(x11)$show()) + invisible(capture.output(expect_error(summary(x11), NA))) + expect_output(summary(x11)$show()) + x11CodeBased <- eval(parse(text = getObjectRCode(x11, stringWrapParagraphWidth = NULL))) + expect_equal(x11CodeBased$effect, x11$effect, tolerance = 1e-07) + expect_equal(x11CodeBased$iterations, x11$iterations, tolerance = 1e-07) + expect_equal(x11CodeBased$overallReject, x11$overallReject, tolerance = 1e-07) + expect_equal(x11CodeBased$rejectPerStage, x11$rejectPerStage, tolerance = 1e-07) + expect_equal(x11CodeBased$futilityPerStage, x11$futilityPerStage, tolerance = 1e-07) + expect_equal(x11CodeBased$earlyStop, x11$earlyStop, tolerance = 1e-07) + expect_equal(x11CodeBased$expectedNumberOfSubjects, x11$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x11CodeBased$sampleSizes, x11$sampleSizes, tolerance = 1e-07) + expect_equal(x11CodeBased$conditionalPowerAchieved, x11$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x11), "character") + df <- as.data.frame(x11) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x11) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x12 <- getSimulationMeans( + seed = 1234, getDesignFisher(informationRates = c(0.3333, 1)), + normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = FALSE, meanRatio = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.8 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x12' with expected results + expect_equal(x12$effect, c(-0.7, -0.4, 0), tolerance = 1e-07, label = paste0(x12$effect)) + expect_equal(x12$iterations[1, ], c(100, 100, 100), label = paste0(x12$iterations[1, ])) + expect_equal(x12$iterations[2, ], c(92, 96, 100), label = paste0(x12$iterations[2, ])) + expect_equal(x12$overallReject, c(0.6, 0.28, 0.01), tolerance = 1e-07, label = paste0(x12$overallReject)) + expect_equal(x12$rejectPerStage[1, ], c(0.08, 0.04, 0), tolerance = 1e-07, label = paste0(x12$rejectPerStage[1, ])) + expect_equal(x12$rejectPerStage[2, ], c(0.52, 0.24, 0.01), tolerance = 1e-07, label = paste0(x12$rejectPerStage[2, ])) + expect_equal(x12$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x12$futilityPerStage[1, ])) + expect_equal(x12$earlyStop, c(0.08, 0.04, 0), tolerance = 1e-07, label = paste0(x12$earlyStop)) + expect_equal(x12$expectedNumberOfSubjects, c(75.059866, 89.365281, 105.96832), tolerance = 1e-07, label = paste0(x12$expectedNumberOfSubjects)) + expect_equal(x12$sampleSizes[1, ], c(10, 10, 10), label = paste0(x12$sampleSizes[1, ])) + expect_equal(x12$sampleSizes[2, ], c(70.717246, 82.672167, 95.968315), tolerance = 1e-07, label = paste0(x12$sampleSizes[2, ])) + expect_equal(x12$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x12$conditionalPowerAchieved[1, ])) + expect_equal(x12$conditionalPowerAchieved[2, ], c(0.50516099, 0.35186807, 0.15287771), tolerance = 1e-07, label = paste0(x12$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x12), NA))) + expect_output(print(x12)$show()) + invisible(capture.output(expect_error(summary(x12), NA))) + expect_output(summary(x12)$show()) + x12CodeBased <- eval(parse(text = getObjectRCode(x12, stringWrapParagraphWidth = NULL))) + expect_equal(x12CodeBased$effect, x12$effect, tolerance = 1e-07) + expect_equal(x12CodeBased$iterations, x12$iterations, tolerance = 1e-07) + expect_equal(x12CodeBased$overallReject, x12$overallReject, tolerance = 1e-07) + expect_equal(x12CodeBased$rejectPerStage, x12$rejectPerStage, tolerance = 1e-07) + expect_equal(x12CodeBased$futilityPerStage, x12$futilityPerStage, tolerance = 1e-07) + expect_equal(x12CodeBased$earlyStop, x12$earlyStop, tolerance = 1e-07) + expect_equal(x12CodeBased$expectedNumberOfSubjects, x12$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x12CodeBased$sampleSizes, x12$sampleSizes, tolerance = 1e-07) + expect_equal(x12CodeBased$conditionalPowerAchieved, x12$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x12), "character") + df <- as.data.frame(x12) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x12) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } }) test_that("'getSimulationMeans': inverse normal design with several configurations", { - - # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} - # @refFS[Sec.]{fs:sec:simulatingTestingOneHypothesis} - # @refFS[Tab.]{fs:tab:output:getSimulationMeans} - # @refFS[Formula]{fs:simulationOneArmMeansTestStatistics} - # @refFS[Formula]{fs:simulationTwoArmMeansTestStatisticsDiff} - # @refFS[Formula]{fs:simulationTwoArmMeansTestStatisticsRatio} - # @refFS[Formula]{fs:testStatisticNormalCombinationTest} - x1 <- getSimulationMeans( - seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), - normalApproximation = TRUE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.05 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x1' with expected results - expect_equal(x1$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(x1$effect, collapse = ", "), ")")) - expect_equal(x1$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x1$iterations[1, ], collapse = ", "), ")")) - expect_equal(x1$iterations[2, ], c(100, 99, 93), label = paste0("c(", paste0(x1$iterations[2, ], collapse = ", "), ")")) - expect_equal(x1$overallReject, c(0.01, 0.62, 0.84), tolerance = 1e-07, label = paste0("c(", paste0(x1$overallReject, collapse = ", "), ")")) - expect_equal(x1$rejectPerStage[1, ], c(0, 0.01, 0.07), tolerance = 1e-07, label = paste0("c(", paste0(x1$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x1$rejectPerStage[2, ], c(0.01, 0.61, 0.77), tolerance = 1e-07, label = paste0("c(", paste0(x1$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x1$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x1$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x1$earlyStop, c(0, 0.01, 0.07), tolerance = 1e-07, label = paste0("c(", paste0(x1$earlyStop, collapse = ", "), ")")) - expect_equal(x1$expectedNumberOfSubjects, c(97.726214, 61.386317, 35.456429), tolerance = 1e-07, label = paste0("c(", paste0(x1$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x1$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x1$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x1$sampleSizes[2, ], c(87.726214, 51.905371, 27.372504), tolerance = 1e-07, label = paste0("c(", paste0(x1$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x1$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x1$conditionalPowerAchieved[2, ], c(0.21948944, 0.59945542, 0.74761937), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x1), NA))) - expect_output(print(x1)$show()) - invisible(capture.output(expect_error(summary(x1), NA))) - expect_output(summary(x1)$show()) - x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) - expect_equal(x1CodeBased$effect, x1$effect, tolerance = 1e-07) - expect_equal(x1CodeBased$iterations, x1$iterations, tolerance = 1e-07) - expect_equal(x1CodeBased$overallReject, x1$overallReject, tolerance = 1e-07) - expect_equal(x1CodeBased$rejectPerStage, x1$rejectPerStage, tolerance = 1e-07) - expect_equal(x1CodeBased$futilityPerStage, x1$futilityPerStage, tolerance = 1e-07) - expect_equal(x1CodeBased$earlyStop, x1$earlyStop, tolerance = 1e-07) - expect_equal(x1CodeBased$expectedNumberOfSubjects, x1$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x1CodeBased$sampleSizes, x1$sampleSizes, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalPowerAchieved, x1$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x1), "character") - df <- as.data.frame(x1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - .skipTestIfDisabled() - - x2 <- getSimulationMeans( - seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), - normalApproximation = TRUE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = FALSE, - maxNumberOfIterations = 100, thetaH0 = 0.8 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x2' with expected results - expect_equal(x2$effect, c(-0.8, -0.4, 0), tolerance = 1e-07, label = paste0("c(", paste0(x2$effect, collapse = ", "), ")")) - expect_equal(x2$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x2$iterations[1, ], collapse = ", "), ")")) - expect_equal(x2$iterations[2, ], c(92, 98, 100), label = paste0("c(", paste0(x2$iterations[2, ], collapse = ", "), ")")) - expect_equal(x2$overallReject, c(0.88, 0.7, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(x2$overallReject, collapse = ", "), ")")) - expect_equal(x2$rejectPerStage[1, ], c(0.08, 0.02, 0), tolerance = 1e-07, label = paste0("c(", paste0(x2$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x2$rejectPerStage[2, ], c(0.8, 0.68, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(x2$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x2$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x2$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x2$earlyStop, c(0.08, 0.02, 0), tolerance = 1e-07, label = paste0("c(", paste0(x2$earlyStop, collapse = ", "), ")")) - expect_equal(x2$expectedNumberOfSubjects, c(30.529806, 74.585778, 94.761842), tolerance = 1e-07, label = paste0("c(", paste0(x2$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x2$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x2$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x2$sampleSizes[2, ], c(22.315007, 65.903855, 84.761842), tolerance = 1e-07, label = paste0("c(", paste0(x2$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x2$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x2$conditionalPowerAchieved[2, ], c(0.78002751, 0.51035441, 0.27866093), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x2), NA))) - expect_output(print(x2)$show()) - invisible(capture.output(expect_error(summary(x2), NA))) - expect_output(summary(x2)$show()) - x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) - expect_equal(x2CodeBased$effect, x2$effect, tolerance = 1e-07) - expect_equal(x2CodeBased$iterations, x2$iterations, tolerance = 1e-07) - expect_equal(x2CodeBased$overallReject, x2$overallReject, tolerance = 1e-07) - expect_equal(x2CodeBased$rejectPerStage, x2$rejectPerStage, tolerance = 1e-07) - expect_equal(x2CodeBased$futilityPerStage, x2$futilityPerStage, tolerance = 1e-07) - expect_equal(x2CodeBased$earlyStop, x2$earlyStop, tolerance = 1e-07) - expect_equal(x2CodeBased$expectedNumberOfSubjects, x2$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x2CodeBased$sampleSizes, x2$sampleSizes, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalPowerAchieved, x2$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x2), "character") - df <- as.data.frame(x2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x3 <- getSimulationMeans( - seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), - normalApproximation = FALSE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = TRUE, - maxNumberOfIterations = 100, thetaH0 = 0.05 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x3' with expected results - expect_equal(x3$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(x3$effect, collapse = ", "), ")")) - expect_equal(x3$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x3$iterations[1, ], collapse = ", "), ")")) - expect_equal(x3$iterations[2, ], c(100, 100, 98), label = paste0("c(", paste0(x3$iterations[2, ], collapse = ", "), ")")) - expect_equal(x3$overallReject, c(0.01, 0.58, 0.86), tolerance = 1e-07, label = paste0("c(", paste0(x3$overallReject, collapse = ", "), ")")) - expect_equal(x3$rejectPerStage[1, ], c(0, 0, 0.02), tolerance = 1e-07, label = paste0("c(", paste0(x3$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x3$rejectPerStage[2, ], c(0.01, 0.58, 0.84), tolerance = 1e-07, label = paste0("c(", paste0(x3$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x3$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x3$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x3$earlyStop, c(0, 0, 0.02), tolerance = 1e-07, label = paste0("c(", paste0(x3$earlyStop, collapse = ", "), ")")) - expect_equal(x3$expectedNumberOfSubjects, c(99.571933, 69.623473, 35.859349), tolerance = 1e-07, label = paste0("c(", paste0(x3$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x3$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x3$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x3$sampleSizes[2, ], c(89.571933, 59.623473, 26.38709), tolerance = 1e-07, label = paste0("c(", paste0(x3$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x3$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x3$conditionalPowerAchieved[2, ], c(0.17531256, 0.54483038, 0.79325539), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x3), NA))) - expect_output(print(x3)$show()) - invisible(capture.output(expect_error(summary(x3), NA))) - expect_output(summary(x3)$show()) - x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) - expect_equal(x3CodeBased$effect, x3$effect, tolerance = 1e-07) - expect_equal(x3CodeBased$iterations, x3$iterations, tolerance = 1e-07) - expect_equal(x3CodeBased$overallReject, x3$overallReject, tolerance = 1e-07) - expect_equal(x3CodeBased$rejectPerStage, x3$rejectPerStage, tolerance = 1e-07) - expect_equal(x3CodeBased$futilityPerStage, x3$futilityPerStage, tolerance = 1e-07) - expect_equal(x3CodeBased$earlyStop, x3$earlyStop, tolerance = 1e-07) - expect_equal(x3CodeBased$expectedNumberOfSubjects, x3$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x3CodeBased$sampleSizes, x3$sampleSizes, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalPowerAchieved, x3$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x3), "character") - df <- as.data.frame(x3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x4 <- getSimulationMeans( - seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), - normalApproximation = FALSE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = FALSE, - maxNumberOfIterations = 100, thetaH0 = 0.8 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x4' with expected results - expect_equal(x4$effect, c(-0.8, -0.4, 0), tolerance = 1e-07, label = paste0("c(", paste0(x4$effect, collapse = ", "), ")")) - expect_equal(x4$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x4$iterations[1, ], collapse = ", "), ")")) - expect_equal(x4$iterations[2, ], c(97, 100, 100), label = paste0("c(", paste0(x4$iterations[2, ], collapse = ", "), ")")) - expect_equal(x4$overallReject, c(0.83, 0.69, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(x4$overallReject, collapse = ", "), ")")) - expect_equal(x4$rejectPerStage[1, ], c(0.03, 0, 0), tolerance = 1e-07, label = paste0("c(", paste0(x4$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x4$rejectPerStage[2, ], c(0.8, 0.69, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(x4$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x4$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x4$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x4$earlyStop, c(0.03, 0, 0), tolerance = 1e-07, label = paste0("c(", paste0(x4$earlyStop, collapse = ", "), ")")) - expect_equal(x4$expectedNumberOfSubjects, c(34.808208, 66.656932, 104.30185), tolerance = 1e-07, label = paste0("c(", paste0(x4$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x4$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x4$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x4$sampleSizes[2, ], c(25.575472, 56.656932, 94.301853), tolerance = 1e-07, label = paste0("c(", paste0(x4$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x4$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x4$conditionalPowerAchieved[2, ], c(0.78184392, 0.58902983, 0.17869551), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x4), NA))) - expect_output(print(x4)$show()) - invisible(capture.output(expect_error(summary(x4), NA))) - expect_output(summary(x4)$show()) - x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) - expect_equal(x4CodeBased$effect, x4$effect, tolerance = 1e-07) - expect_equal(x4CodeBased$iterations, x4$iterations, tolerance = 1e-07) - expect_equal(x4CodeBased$overallReject, x4$overallReject, tolerance = 1e-07) - expect_equal(x4CodeBased$rejectPerStage, x4$rejectPerStage, tolerance = 1e-07) - expect_equal(x4CodeBased$futilityPerStage, x4$futilityPerStage, tolerance = 1e-07) - expect_equal(x4CodeBased$earlyStop, x4$earlyStop, tolerance = 1e-07) - expect_equal(x4CodeBased$expectedNumberOfSubjects, x4$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x4CodeBased$sampleSizes, x4$sampleSizes, tolerance = 1e-07) - expect_equal(x4CodeBased$conditionalPowerAchieved, x4$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x4), "character") - df <- as.data.frame(x4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x5 <- getSimulationMeans( - seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), - normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = TRUE, meanRatio = FALSE, - maxNumberOfIterations = 100, thetaH0 = 0.05 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x5' with expected results - expect_equal(x5$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(x5$effect, collapse = ", "), ")")) - expect_equal(x5$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x5$iterations[1, ], collapse = ", "), ")")) - expect_equal(x5$iterations[2, ], c(100, 100, 100), label = paste0("c(", paste0(x5$iterations[2, ], collapse = ", "), ")")) - expect_equal(x5$overallReject, c(0.02, 0.29, 0.63), tolerance = 1e-07, label = paste0("c(", paste0(x5$overallReject, collapse = ", "), ")")) - expect_equal(x5$rejectPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x5$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x5$rejectPerStage[2, ], c(0.02, 0.29, 0.63), tolerance = 1e-07, label = paste0("c(", paste0(x5$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x5$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x5$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x5$earlyStop, c(0, 0, 0), label = paste0("c(", paste0(x5$earlyStop, collapse = ", "), ")")) - expect_equal(x5$expectedNumberOfSubjects, c(96.372889, 89.619156, 71.907268), tolerance = 1e-07, label = paste0("c(", paste0(x5$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x5$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x5$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x5$sampleSizes[2, ], c(86.372889, 79.619156, 61.907268), tolerance = 1e-07, label = paste0("c(", paste0(x5$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x5$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x5$conditionalPowerAchieved[2, ], c(0.23254121, 0.37156759, 0.50696796), tolerance = 1e-07, label = paste0("c(", paste0(x5$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x5), NA))) - expect_output(print(x5)$show()) - invisible(capture.output(expect_error(summary(x5), NA))) - expect_output(summary(x5)$show()) - x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) - expect_equal(x5CodeBased$effect, x5$effect, tolerance = 1e-07) - expect_equal(x5CodeBased$iterations, x5$iterations, tolerance = 1e-07) - expect_equal(x5CodeBased$overallReject, x5$overallReject, tolerance = 1e-07) - expect_equal(x5CodeBased$rejectPerStage, x5$rejectPerStage, tolerance = 1e-07) - expect_equal(x5CodeBased$futilityPerStage, x5$futilityPerStage, tolerance = 1e-07) - expect_equal(x5CodeBased$earlyStop, x5$earlyStop, tolerance = 1e-07) - expect_equal(x5CodeBased$expectedNumberOfSubjects, x5$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x5CodeBased$sampleSizes, x5$sampleSizes, tolerance = 1e-07) - expect_equal(x5CodeBased$conditionalPowerAchieved, x5$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x5), "character") - df <- as.data.frame(x5) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x5) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x6 <- getSimulationMeans( - seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), - normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = FALSE, meanRatio = FALSE, - maxNumberOfIterations = 100, thetaH0 = 0.8 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x6' with expected results - expect_equal(x6$effect, c(-0.8, -0.4, 0), tolerance = 1e-07, label = paste0("c(", paste0(x6$effect, collapse = ", "), ")")) - expect_equal(x6$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x6$iterations[1, ], collapse = ", "), ")")) - expect_equal(x6$iterations[2, ], c(98, 98, 100), label = paste0("c(", paste0(x6$iterations[2, ], collapse = ", "), ")")) - expect_equal(x6$overallReject, c(0.71, 0.28, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(x6$overallReject, collapse = ", "), ")")) - expect_equal(x6$rejectPerStage[1, ], c(0.02, 0.02, 0), tolerance = 1e-07, label = paste0("c(", paste0(x6$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x6$rejectPerStage[2, ], c(0.69, 0.26, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(x6$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x6$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x6$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x6$earlyStop, c(0.02, 0.02, 0), tolerance = 1e-07, label = paste0("c(", paste0(x6$earlyStop, collapse = ", "), ")")) - expect_equal(x6$expectedNumberOfSubjects, c(61.262488, 89.754099, 94.761842), tolerance = 1e-07, label = paste0("c(", paste0(x6$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x6$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x6$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x6$sampleSizes[2, ], c(52.308661, 81.381734, 84.761842), tolerance = 1e-07, label = paste0("c(", paste0(x6$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x6$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x6$conditionalPowerAchieved[2, ], c(0.57015973, 0.32347024, 0.27139992), tolerance = 1e-07, label = paste0("c(", paste0(x6$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x6), NA))) - expect_output(print(x6)$show()) - invisible(capture.output(expect_error(summary(x6), NA))) - expect_output(summary(x6)$show()) - x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) - expect_equal(x6CodeBased$effect, x6$effect, tolerance = 1e-07) - expect_equal(x6CodeBased$iterations, x6$iterations, tolerance = 1e-07) - expect_equal(x6CodeBased$overallReject, x6$overallReject, tolerance = 1e-07) - expect_equal(x6CodeBased$rejectPerStage, x6$rejectPerStage, tolerance = 1e-07) - expect_equal(x6CodeBased$futilityPerStage, x6$futilityPerStage, tolerance = 1e-07) - expect_equal(x6CodeBased$earlyStop, x6$earlyStop, tolerance = 1e-07) - expect_equal(x6CodeBased$expectedNumberOfSubjects, x6$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x6CodeBased$sampleSizes, x6$sampleSizes, tolerance = 1e-07) - expect_equal(x6CodeBased$conditionalPowerAchieved, x6$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x6), "character") - df <- as.data.frame(x6) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x6) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x7 <- getSimulationMeans( - seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), - normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = TRUE, meanRatio = FALSE, - maxNumberOfIterations = 100, thetaH0 = 0.05 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x7' with expected results - expect_equal(x7$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(x7$effect, collapse = ", "), ")")) - expect_equal(x7$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x7$iterations[1, ], collapse = ", "), ")")) - expect_equal(x7$iterations[2, ], c(100, 100, 99), label = paste0("c(", paste0(x7$iterations[2, ], collapse = ", "), ")")) - expect_equal(x7$overallReject, c(0.01, 0.2, 0.7), tolerance = 1e-07, label = paste0("c(", paste0(x7$overallReject, collapse = ", "), ")")) - expect_equal(x7$rejectPerStage[1, ], c(0, 0, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(x7$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x7$rejectPerStage[2, ], c(0.01, 0.2, 0.69), tolerance = 1e-07, label = paste0("c(", paste0(x7$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x7$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x7$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x7$earlyStop, c(0, 0, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(x7$earlyStop, collapse = ", "), ")")) - expect_equal(x7$expectedNumberOfSubjects, c(99.874349, 85.385224, 62.337209), tolerance = 1e-07, label = paste0("c(", paste0(x7$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x7$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x7$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x7$sampleSizes[2, ], c(89.874349, 75.385224, 52.865867), tolerance = 1e-07, label = paste0("c(", paste0(x7$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x7$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x7$conditionalPowerAchieved[2, ], c(0.19979349, 0.40152955, 0.59344307), tolerance = 1e-07, label = paste0("c(", paste0(x7$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x7), NA))) - expect_output(print(x7)$show()) - invisible(capture.output(expect_error(summary(x7), NA))) - expect_output(summary(x7)$show()) - x7CodeBased <- eval(parse(text = getObjectRCode(x7, stringWrapParagraphWidth = NULL))) - expect_equal(x7CodeBased$effect, x7$effect, tolerance = 1e-07) - expect_equal(x7CodeBased$iterations, x7$iterations, tolerance = 1e-07) - expect_equal(x7CodeBased$overallReject, x7$overallReject, tolerance = 1e-07) - expect_equal(x7CodeBased$rejectPerStage, x7$rejectPerStage, tolerance = 1e-07) - expect_equal(x7CodeBased$futilityPerStage, x7$futilityPerStage, tolerance = 1e-07) - expect_equal(x7CodeBased$earlyStop, x7$earlyStop, tolerance = 1e-07) - expect_equal(x7CodeBased$expectedNumberOfSubjects, x7$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x7CodeBased$sampleSizes, x7$sampleSizes, tolerance = 1e-07) - expect_equal(x7CodeBased$conditionalPowerAchieved, x7$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x7), "character") - df <- as.data.frame(x7) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x7) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x8 <- getSimulationMeans( - seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), - normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = FALSE, meanRatio = TRUE, - maxNumberOfIterations = 100, thetaH0 = 0.8 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x8' with expected results - expect_equal(x8$effect, c(-0.7, -0.4, 0), tolerance = 1e-07, label = paste0("c(", paste0(x8$effect, collapse = ", "), ")")) - expect_equal(x8$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x8$iterations[1, ], collapse = ", "), ")")) - expect_equal(x8$iterations[2, ], c(99, 100, 100), label = paste0("c(", paste0(x8$iterations[2, ], collapse = ", "), ")")) - expect_equal(x8$overallReject, c(0.57, 0.35, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(x8$overallReject, collapse = ", "), ")")) - expect_equal(x8$rejectPerStage[1, ], c(0.01, 0, 0), tolerance = 1e-07, label = paste0("c(", paste0(x8$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x8$rejectPerStage[2, ], c(0.56, 0.35, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(x8$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x8$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x8$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x8$earlyStop, c(0.01, 0, 0), tolerance = 1e-07, label = paste0("c(", paste0(x8$earlyStop, collapse = ", "), ")")) - expect_equal(x8$expectedNumberOfSubjects, c(65.632546, 86.865451, 105.50507), tolerance = 1e-07, label = paste0("c(", paste0(x8$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x8$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x8$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x8$sampleSizes[2, ], c(56.194491, 76.865451, 95.50507), tolerance = 1e-07, label = paste0("c(", paste0(x8$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x8$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x8$conditionalPowerAchieved[2, ], c(0.52087291, 0.38731069, 0.15906003), tolerance = 1e-07, label = paste0("c(", paste0(x8$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x8), NA))) - expect_output(print(x8)$show()) - invisible(capture.output(expect_error(summary(x8), NA))) - expect_output(summary(x8)$show()) - x8CodeBased <- eval(parse(text = getObjectRCode(x8, stringWrapParagraphWidth = NULL))) - expect_equal(x8CodeBased$effect, x8$effect, tolerance = 1e-07) - expect_equal(x8CodeBased$iterations, x8$iterations, tolerance = 1e-07) - expect_equal(x8CodeBased$overallReject, x8$overallReject, tolerance = 1e-07) - expect_equal(x8CodeBased$rejectPerStage, x8$rejectPerStage, tolerance = 1e-07) - expect_equal(x8CodeBased$futilityPerStage, x8$futilityPerStage, tolerance = 1e-07) - expect_equal(x8CodeBased$earlyStop, x8$earlyStop, tolerance = 1e-07) - expect_equal(x8CodeBased$expectedNumberOfSubjects, x8$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x8CodeBased$sampleSizes, x8$sampleSizes, tolerance = 1e-07) - expect_equal(x8CodeBased$conditionalPowerAchieved, x8$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x8), "character") - df <- as.data.frame(x8) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x8) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x9 <- getSimulationMeans( - seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), - normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = TRUE, meanRatio = TRUE, - maxNumberOfIterations = 100, thetaH0 = 0.05 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x9' with expected results - expect_equal(x9$effect, c(0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(x9$effect, collapse = ", "), ")")) - expect_equal(x9$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x9$iterations[1, ], collapse = ", "), ")")) - expect_equal(x9$iterations[2, ], c(100, 99, 98), label = paste0("c(", paste0(x9$iterations[2, ], collapse = ", "), ")")) - expect_equal(x9$overallReject, c(0.04, 0.36, 0.79), tolerance = 1e-07, label = paste0("c(", paste0(x9$overallReject, collapse = ", "), ")")) - expect_equal(x9$rejectPerStage[1, ], c(0, 0.01, 0.02), tolerance = 1e-07, label = paste0("c(", paste0(x9$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x9$rejectPerStage[2, ], c(0.04, 0.35, 0.77), tolerance = 1e-07, label = paste0("c(", paste0(x9$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x9$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x9$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x9$earlyStop, c(0, 0.01, 0.02), tolerance = 1e-07, label = paste0("c(", paste0(x9$earlyStop, collapse = ", "), ")")) - expect_equal(x9$expectedNumberOfSubjects, c(93.166381, 72.993336, 56.443486), tolerance = 1e-07, label = paste0("c(", paste0(x9$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x9$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x9$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x9$sampleSizes[2, ], c(83.166381, 63.629633, 47.391312), tolerance = 1e-07, label = paste0("c(", paste0(x9$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x9$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x9$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x9$conditionalPowerAchieved[2, ], c(0.26023971, 0.52016331, 0.61018937), tolerance = 1e-07, label = paste0("c(", paste0(x9$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x9), NA))) - expect_output(print(x9)$show()) - invisible(capture.output(expect_error(summary(x9), NA))) - expect_output(summary(x9)$show()) - x9CodeBased <- eval(parse(text = getObjectRCode(x9, stringWrapParagraphWidth = NULL))) - expect_equal(x9CodeBased$effect, x9$effect, tolerance = 1e-07) - expect_equal(x9CodeBased$iterations, x9$iterations, tolerance = 1e-07) - expect_equal(x9CodeBased$overallReject, x9$overallReject, tolerance = 1e-07) - expect_equal(x9CodeBased$rejectPerStage, x9$rejectPerStage, tolerance = 1e-07) - expect_equal(x9CodeBased$futilityPerStage, x9$futilityPerStage, tolerance = 1e-07) - expect_equal(x9CodeBased$earlyStop, x9$earlyStop, tolerance = 1e-07) - expect_equal(x9CodeBased$expectedNumberOfSubjects, x9$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x9CodeBased$sampleSizes, x9$sampleSizes, tolerance = 1e-07) - expect_equal(x9CodeBased$conditionalPowerAchieved, x9$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x9), "character") - df <- as.data.frame(x9) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x9) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x10 <- getSimulationMeans( - seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), - normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = FALSE, meanRatio = TRUE, - maxNumberOfIterations = 100, thetaH0 = 0.8 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x10' with expected results - expect_equal(x10$effect, c(-0.7, -0.4, 0), tolerance = 1e-07, label = paste0("c(", paste0(x10$effect, collapse = ", "), ")")) - expect_equal(x10$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x10$iterations[1, ], collapse = ", "), ")")) - expect_equal(x10$iterations[2, ], c(98, 98, 100), label = paste0("c(", paste0(x10$iterations[2, ], collapse = ", "), ")")) - expect_equal(x10$overallReject, c(0.71, 0.32, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(x10$overallReject, collapse = ", "), ")")) - expect_equal(x10$rejectPerStage[1, ], c(0.02, 0.02, 0), tolerance = 1e-07, label = paste0("c(", paste0(x10$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x10$rejectPerStage[2, ], c(0.69, 0.3, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(x10$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x10$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x10$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x10$earlyStop, c(0.02, 0.02, 0), tolerance = 1e-07, label = paste0("c(", paste0(x10$earlyStop, collapse = ", "), ")")) - expect_equal(x10$expectedNumberOfSubjects, c(62.435526, 88.169977, 94.761842), tolerance = 1e-07, label = paste0("c(", paste0(x10$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x10$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x10$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x10$sampleSizes[2, ], c(53.505639, 79.765282, 84.761842), tolerance = 1e-07, label = paste0("c(", paste0(x10$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x10$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x10$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x10$conditionalPowerAchieved[2, ], c(0.54108822, 0.32455187, 0.25936079), tolerance = 1e-07, label = paste0("c(", paste0(x10$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x10), NA))) - expect_output(print(x10)$show()) - invisible(capture.output(expect_error(summary(x10), NA))) - expect_output(summary(x10)$show()) - x10CodeBased <- eval(parse(text = getObjectRCode(x10, stringWrapParagraphWidth = NULL))) - expect_equal(x10CodeBased$effect, x10$effect, tolerance = 1e-07) - expect_equal(x10CodeBased$iterations, x10$iterations, tolerance = 1e-07) - expect_equal(x10CodeBased$overallReject, x10$overallReject, tolerance = 1e-07) - expect_equal(x10CodeBased$rejectPerStage, x10$rejectPerStage, tolerance = 1e-07) - expect_equal(x10CodeBased$futilityPerStage, x10$futilityPerStage, tolerance = 1e-07) - expect_equal(x10CodeBased$earlyStop, x10$earlyStop, tolerance = 1e-07) - expect_equal(x10CodeBased$expectedNumberOfSubjects, x10$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x10CodeBased$sampleSizes, x10$sampleSizes, tolerance = 1e-07) - expect_equal(x10CodeBased$conditionalPowerAchieved, x10$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x10), "character") - df <- as.data.frame(x10) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x10) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x11 <- getSimulationMeans( - seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), - normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = TRUE, meanRatio = TRUE, - maxNumberOfIterations = 100, thetaH0 = 0.05 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x11' with expected results - expect_equal(x11$effect, c(0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(x11$effect, collapse = ", "), ")")) - expect_equal(x11$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x11$iterations[1, ], collapse = ", "), ")")) - expect_equal(x11$iterations[2, ], c(100, 100, 98), label = paste0("c(", paste0(x11$iterations[2, ], collapse = ", "), ")")) - expect_equal(x11$overallReject, c(0.04, 0.33, 0.76), tolerance = 1e-07, label = paste0("c(", paste0(x11$overallReject, collapse = ", "), ")")) - expect_equal(x11$rejectPerStage[1, ], c(0, 0, 0.02), tolerance = 1e-07, label = paste0("c(", paste0(x11$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x11$rejectPerStage[2, ], c(0.04, 0.33, 0.74), tolerance = 1e-07, label = paste0("c(", paste0(x11$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x11$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x11$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x11$earlyStop, c(0, 0, 0.02), tolerance = 1e-07, label = paste0("c(", paste0(x11$earlyStop, collapse = ", "), ")")) - expect_equal(x11$expectedNumberOfSubjects, c(97.820553, 79.30135, 45.942964), tolerance = 1e-07, label = paste0("c(", paste0(x11$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x11$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x11$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x11$sampleSizes[2, ], c(87.820553, 69.30135, 36.676494), tolerance = 1e-07, label = paste0("c(", paste0(x11$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x11$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x11$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x11$conditionalPowerAchieved[2, ], c(0.24110629, 0.45389272, 0.70091861), tolerance = 1e-07, label = paste0("c(", paste0(x11$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x11), NA))) - expect_output(print(x11)$show()) - invisible(capture.output(expect_error(summary(x11), NA))) - expect_output(summary(x11)$show()) - x11CodeBased <- eval(parse(text = getObjectRCode(x11, stringWrapParagraphWidth = NULL))) - expect_equal(x11CodeBased$effect, x11$effect, tolerance = 1e-07) - expect_equal(x11CodeBased$iterations, x11$iterations, tolerance = 1e-07) - expect_equal(x11CodeBased$overallReject, x11$overallReject, tolerance = 1e-07) - expect_equal(x11CodeBased$rejectPerStage, x11$rejectPerStage, tolerance = 1e-07) - expect_equal(x11CodeBased$futilityPerStage, x11$futilityPerStage, tolerance = 1e-07) - expect_equal(x11CodeBased$earlyStop, x11$earlyStop, tolerance = 1e-07) - expect_equal(x11CodeBased$expectedNumberOfSubjects, x11$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x11CodeBased$sampleSizes, x11$sampleSizes, tolerance = 1e-07) - expect_equal(x11CodeBased$conditionalPowerAchieved, x11$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x11), "character") - df <- as.data.frame(x11) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x11) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x12 <- getSimulationMeans( - seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), - normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = FALSE, meanRatio = TRUE, - maxNumberOfIterations = 100, thetaH0 = 0.8 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x12' with expected results - expect_equal(x12$effect, c(-0.7, -0.4, 0), tolerance = 1e-07, label = paste0("c(", paste0(x12$effect, collapse = ", "), ")")) - expect_equal(x12$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x12$iterations[1, ], collapse = ", "), ")")) - expect_equal(x12$iterations[2, ], c(99, 100, 100), label = paste0("c(", paste0(x12$iterations[2, ], collapse = ", "), ")")) - expect_equal(x12$overallReject, c(0.57, 0.35, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(x12$overallReject, collapse = ", "), ")")) - expect_equal(x12$rejectPerStage[1, ], c(0.01, 0, 0), tolerance = 1e-07, label = paste0("c(", paste0(x12$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x12$rejectPerStage[2, ], c(0.56, 0.35, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(x12$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x12$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x12$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x12$earlyStop, c(0.01, 0, 0), tolerance = 1e-07, label = paste0("c(", paste0(x12$earlyStop, collapse = ", "), ")")) - expect_equal(x12$expectedNumberOfSubjects, c(65.632546, 86.865451, 105.50507), tolerance = 1e-07, label = paste0("c(", paste0(x12$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x12$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x12$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x12$sampleSizes[2, ], c(56.194491, 76.865451, 95.50507), tolerance = 1e-07, label = paste0("c(", paste0(x12$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x12$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x12$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x12$conditionalPowerAchieved[2, ], c(0.52087291, 0.38731069, 0.15906003), tolerance = 1e-07, label = paste0("c(", paste0(x12$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x12), NA))) - expect_output(print(x12)$show()) - invisible(capture.output(expect_error(summary(x12), NA))) - expect_output(summary(x12)$show()) - x12CodeBased <- eval(parse(text = getObjectRCode(x12, stringWrapParagraphWidth = NULL))) - expect_equal(x12CodeBased$effect, x12$effect, tolerance = 1e-07) - expect_equal(x12CodeBased$iterations, x12$iterations, tolerance = 1e-07) - expect_equal(x12CodeBased$overallReject, x12$overallReject, tolerance = 1e-07) - expect_equal(x12CodeBased$rejectPerStage, x12$rejectPerStage, tolerance = 1e-07) - expect_equal(x12CodeBased$futilityPerStage, x12$futilityPerStage, tolerance = 1e-07) - expect_equal(x12CodeBased$earlyStop, x12$earlyStop, tolerance = 1e-07) - expect_equal(x12CodeBased$expectedNumberOfSubjects, x12$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x12CodeBased$sampleSizes, x12$sampleSizes, tolerance = 1e-07) - expect_equal(x12CodeBased$conditionalPowerAchieved, x12$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x12), "character") - df <- as.data.frame(x12) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x12) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - + # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} + # @refFS[Sec.]{fs:sec:simulatingTestingOneHypothesis} + # @refFS[Tab.]{fs:tab:output:getSimulationMeans} + # @refFS[Formula]{fs:simulationOneArmMeansTestStatistics} + # @refFS[Formula]{fs:simulationTwoArmMeansTestStatisticsDiff} + # @refFS[Formula]{fs:simulationTwoArmMeansTestStatisticsRatio} + # @refFS[Formula]{fs:testStatisticNormalCombinationTest} + x1 <- getSimulationMeans( + seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), + normalApproximation = TRUE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = TRUE, maxNumberOfIterations = 100, thetaH0 = 0.05 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x1' with expected results + expect_equal(x1$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0(x1$effect)) + expect_equal(x1$iterations[1, ], c(100, 100, 100), label = paste0(x1$iterations[1, ])) + expect_equal(x1$iterations[2, ], c(100, 99, 93), label = paste0(x1$iterations[2, ])) + expect_equal(x1$overallReject, c(0.01, 0.62, 0.84), tolerance = 1e-07, label = paste0(x1$overallReject)) + expect_equal(x1$rejectPerStage[1, ], c(0, 0.01, 0.07), tolerance = 1e-07, label = paste0(x1$rejectPerStage[1, ])) + expect_equal(x1$rejectPerStage[2, ], c(0.01, 0.61, 0.77), tolerance = 1e-07, label = paste0(x1$rejectPerStage[2, ])) + expect_equal(x1$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x1$futilityPerStage[1, ])) + expect_equal(x1$earlyStop, c(0, 0.01, 0.07), tolerance = 1e-07, label = paste0(x1$earlyStop)) + expect_equal(x1$expectedNumberOfSubjects, c(97.726214, 61.386317, 35.456429), tolerance = 1e-07, label = paste0(x1$expectedNumberOfSubjects)) + expect_equal(x1$sampleSizes[1, ], c(10, 10, 10), label = paste0(x1$sampleSizes[1, ])) + expect_equal(x1$sampleSizes[2, ], c(87.726214, 51.905371, 27.372504), tolerance = 1e-07, label = paste0(x1$sampleSizes[2, ])) + expect_equal(x1$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x1$conditionalPowerAchieved[1, ])) + expect_equal(x1$conditionalPowerAchieved[2, ], c(0.21948944, 0.59945542, 0.74761937), tolerance = 1e-07, label = paste0(x1$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x1), NA))) + expect_output(print(x1)$show()) + invisible(capture.output(expect_error(summary(x1), NA))) + expect_output(summary(x1)$show()) + x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) + expect_equal(x1CodeBased$effect, x1$effect, tolerance = 1e-07) + expect_equal(x1CodeBased$iterations, x1$iterations, tolerance = 1e-07) + expect_equal(x1CodeBased$overallReject, x1$overallReject, tolerance = 1e-07) + expect_equal(x1CodeBased$rejectPerStage, x1$rejectPerStage, tolerance = 1e-07) + expect_equal(x1CodeBased$futilityPerStage, x1$futilityPerStage, tolerance = 1e-07) + expect_equal(x1CodeBased$earlyStop, x1$earlyStop, tolerance = 1e-07) + expect_equal(x1CodeBased$expectedNumberOfSubjects, x1$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x1CodeBased$sampleSizes, x1$sampleSizes, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalPowerAchieved, x1$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x1), "character") + df <- as.data.frame(x1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + .skipTestIfDisabled() + + x2 <- getSimulationMeans( + seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), + normalApproximation = TRUE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = FALSE, + maxNumberOfIterations = 100, thetaH0 = 0.8 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x2' with expected results + expect_equal(x2$effect, c(-0.8, -0.4, 0), tolerance = 1e-07, label = paste0(x2$effect)) + expect_equal(x2$iterations[1, ], c(100, 100, 100), label = paste0(x2$iterations[1, ])) + expect_equal(x2$iterations[2, ], c(92, 98, 100), label = paste0(x2$iterations[2, ])) + expect_equal(x2$overallReject, c(0.88, 0.7, 0.05), tolerance = 1e-07, label = paste0(x2$overallReject)) + expect_equal(x2$rejectPerStage[1, ], c(0.08, 0.02, 0), tolerance = 1e-07, label = paste0(x2$rejectPerStage[1, ])) + expect_equal(x2$rejectPerStage[2, ], c(0.8, 0.68, 0.05), tolerance = 1e-07, label = paste0(x2$rejectPerStage[2, ])) + expect_equal(x2$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x2$futilityPerStage[1, ])) + expect_equal(x2$earlyStop, c(0.08, 0.02, 0), tolerance = 1e-07, label = paste0(x2$earlyStop)) + expect_equal(x2$expectedNumberOfSubjects, c(30.529806, 74.585778, 94.761842), tolerance = 1e-07, label = paste0(x2$expectedNumberOfSubjects)) + expect_equal(x2$sampleSizes[1, ], c(10, 10, 10), label = paste0(x2$sampleSizes[1, ])) + expect_equal(x2$sampleSizes[2, ], c(22.315007, 65.903855, 84.761842), tolerance = 1e-07, label = paste0(x2$sampleSizes[2, ])) + expect_equal(x2$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x2$conditionalPowerAchieved[1, ])) + expect_equal(x2$conditionalPowerAchieved[2, ], c(0.78002751, 0.51035441, 0.27866093), tolerance = 1e-07, label = paste0(x2$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x2), NA))) + expect_output(print(x2)$show()) + invisible(capture.output(expect_error(summary(x2), NA))) + expect_output(summary(x2)$show()) + x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) + expect_equal(x2CodeBased$effect, x2$effect, tolerance = 1e-07) + expect_equal(x2CodeBased$iterations, x2$iterations, tolerance = 1e-07) + expect_equal(x2CodeBased$overallReject, x2$overallReject, tolerance = 1e-07) + expect_equal(x2CodeBased$rejectPerStage, x2$rejectPerStage, tolerance = 1e-07) + expect_equal(x2CodeBased$futilityPerStage, x2$futilityPerStage, tolerance = 1e-07) + expect_equal(x2CodeBased$earlyStop, x2$earlyStop, tolerance = 1e-07) + expect_equal(x2CodeBased$expectedNumberOfSubjects, x2$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x2CodeBased$sampleSizes, x2$sampleSizes, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalPowerAchieved, x2$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x2), "character") + df <- as.data.frame(x2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x3 <- getSimulationMeans( + seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), + normalApproximation = FALSE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = TRUE, + maxNumberOfIterations = 100, thetaH0 = 0.05 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x3' with expected results + expect_equal(x3$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0(x3$effect)) + expect_equal(x3$iterations[1, ], c(100, 100, 100), label = paste0(x3$iterations[1, ])) + expect_equal(x3$iterations[2, ], c(100, 100, 98), label = paste0(x3$iterations[2, ])) + expect_equal(x3$overallReject, c(0.01, 0.58, 0.86), tolerance = 1e-07, label = paste0(x3$overallReject)) + expect_equal(x3$rejectPerStage[1, ], c(0, 0, 0.02), tolerance = 1e-07, label = paste0(x3$rejectPerStage[1, ])) + expect_equal(x3$rejectPerStage[2, ], c(0.01, 0.58, 0.84), tolerance = 1e-07, label = paste0(x3$rejectPerStage[2, ])) + expect_equal(x3$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x3$futilityPerStage[1, ])) + expect_equal(x3$earlyStop, c(0, 0, 0.02), tolerance = 1e-07, label = paste0(x3$earlyStop)) + expect_equal(x3$expectedNumberOfSubjects, c(99.571933, 69.623473, 35.859349), tolerance = 1e-07, label = paste0(x3$expectedNumberOfSubjects)) + expect_equal(x3$sampleSizes[1, ], c(10, 10, 10), label = paste0(x3$sampleSizes[1, ])) + expect_equal(x3$sampleSizes[2, ], c(89.571933, 59.623473, 26.38709), tolerance = 1e-07, label = paste0(x3$sampleSizes[2, ])) + expect_equal(x3$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x3$conditionalPowerAchieved[1, ])) + expect_equal(x3$conditionalPowerAchieved[2, ], c(0.17531256, 0.54483038, 0.79325539), tolerance = 1e-07, label = paste0(x3$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x3), NA))) + expect_output(print(x3)$show()) + invisible(capture.output(expect_error(summary(x3), NA))) + expect_output(summary(x3)$show()) + x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) + expect_equal(x3CodeBased$effect, x3$effect, tolerance = 1e-07) + expect_equal(x3CodeBased$iterations, x3$iterations, tolerance = 1e-07) + expect_equal(x3CodeBased$overallReject, x3$overallReject, tolerance = 1e-07) + expect_equal(x3CodeBased$rejectPerStage, x3$rejectPerStage, tolerance = 1e-07) + expect_equal(x3CodeBased$futilityPerStage, x3$futilityPerStage, tolerance = 1e-07) + expect_equal(x3CodeBased$earlyStop, x3$earlyStop, tolerance = 1e-07) + expect_equal(x3CodeBased$expectedNumberOfSubjects, x3$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x3CodeBased$sampleSizes, x3$sampleSizes, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalPowerAchieved, x3$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x3), "character") + df <- as.data.frame(x3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x4 <- getSimulationMeans( + seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), + normalApproximation = FALSE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = FALSE, + maxNumberOfIterations = 100, thetaH0 = 0.8 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x4' with expected results + expect_equal(x4$effect, c(-0.8, -0.4, 0), tolerance = 1e-07, label = paste0(x4$effect)) + expect_equal(x4$iterations[1, ], c(100, 100, 100), label = paste0(x4$iterations[1, ])) + expect_equal(x4$iterations[2, ], c(97, 100, 100), label = paste0(x4$iterations[2, ])) + expect_equal(x4$overallReject, c(0.83, 0.69, 0.01), tolerance = 1e-07, label = paste0(x4$overallReject)) + expect_equal(x4$rejectPerStage[1, ], c(0.03, 0, 0), tolerance = 1e-07, label = paste0(x4$rejectPerStage[1, ])) + expect_equal(x4$rejectPerStage[2, ], c(0.8, 0.69, 0.01), tolerance = 1e-07, label = paste0(x4$rejectPerStage[2, ])) + expect_equal(x4$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x4$futilityPerStage[1, ])) + expect_equal(x4$earlyStop, c(0.03, 0, 0), tolerance = 1e-07, label = paste0(x4$earlyStop)) + expect_equal(x4$expectedNumberOfSubjects, c(34.808208, 66.656932, 104.30185), tolerance = 1e-07, label = paste0(x4$expectedNumberOfSubjects)) + expect_equal(x4$sampleSizes[1, ], c(10, 10, 10), label = paste0(x4$sampleSizes[1, ])) + expect_equal(x4$sampleSizes[2, ], c(25.575472, 56.656932, 94.301853), tolerance = 1e-07, label = paste0(x4$sampleSizes[2, ])) + expect_equal(x4$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x4$conditionalPowerAchieved[1, ])) + expect_equal(x4$conditionalPowerAchieved[2, ], c(0.78184392, 0.58902983, 0.17869551), tolerance = 1e-07, label = paste0(x4$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x4), NA))) + expect_output(print(x4)$show()) + invisible(capture.output(expect_error(summary(x4), NA))) + expect_output(summary(x4)$show()) + x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) + expect_equal(x4CodeBased$effect, x4$effect, tolerance = 1e-07) + expect_equal(x4CodeBased$iterations, x4$iterations, tolerance = 1e-07) + expect_equal(x4CodeBased$overallReject, x4$overallReject, tolerance = 1e-07) + expect_equal(x4CodeBased$rejectPerStage, x4$rejectPerStage, tolerance = 1e-07) + expect_equal(x4CodeBased$futilityPerStage, x4$futilityPerStage, tolerance = 1e-07) + expect_equal(x4CodeBased$earlyStop, x4$earlyStop, tolerance = 1e-07) + expect_equal(x4CodeBased$expectedNumberOfSubjects, x4$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x4CodeBased$sampleSizes, x4$sampleSizes, tolerance = 1e-07) + expect_equal(x4CodeBased$conditionalPowerAchieved, x4$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x4), "character") + df <- as.data.frame(x4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x5 <- getSimulationMeans( + seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), + normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = TRUE, meanRatio = FALSE, + maxNumberOfIterations = 100, thetaH0 = 0.05 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x5' with expected results + expect_equal(x5$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0(x5$effect)) + expect_equal(x5$iterations[1, ], c(100, 100, 100), label = paste0(x5$iterations[1, ])) + expect_equal(x5$iterations[2, ], c(100, 100, 100), label = paste0(x5$iterations[2, ])) + expect_equal(x5$overallReject, c(0.02, 0.29, 0.63), tolerance = 1e-07, label = paste0(x5$overallReject)) + expect_equal(x5$rejectPerStage[1, ], c(0, 0, 0), label = paste0(x5$rejectPerStage[1, ])) + expect_equal(x5$rejectPerStage[2, ], c(0.02, 0.29, 0.63), tolerance = 1e-07, label = paste0(x5$rejectPerStage[2, ])) + expect_equal(x5$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x5$futilityPerStage[1, ])) + expect_equal(x5$earlyStop, c(0, 0, 0), label = paste0(x5$earlyStop)) + expect_equal(x5$expectedNumberOfSubjects, c(96.372889, 89.619156, 71.907268), tolerance = 1e-07, label = paste0(x5$expectedNumberOfSubjects)) + expect_equal(x5$sampleSizes[1, ], c(10, 10, 10), label = paste0(x5$sampleSizes[1, ])) + expect_equal(x5$sampleSizes[2, ], c(86.372889, 79.619156, 61.907268), tolerance = 1e-07, label = paste0(x5$sampleSizes[2, ])) + expect_equal(x5$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x5$conditionalPowerAchieved[1, ])) + expect_equal(x5$conditionalPowerAchieved[2, ], c(0.23254121, 0.37156759, 0.50696796), tolerance = 1e-07, label = paste0(x5$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x5), NA))) + expect_output(print(x5)$show()) + invisible(capture.output(expect_error(summary(x5), NA))) + expect_output(summary(x5)$show()) + x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) + expect_equal(x5CodeBased$effect, x5$effect, tolerance = 1e-07) + expect_equal(x5CodeBased$iterations, x5$iterations, tolerance = 1e-07) + expect_equal(x5CodeBased$overallReject, x5$overallReject, tolerance = 1e-07) + expect_equal(x5CodeBased$rejectPerStage, x5$rejectPerStage, tolerance = 1e-07) + expect_equal(x5CodeBased$futilityPerStage, x5$futilityPerStage, tolerance = 1e-07) + expect_equal(x5CodeBased$earlyStop, x5$earlyStop, tolerance = 1e-07) + expect_equal(x5CodeBased$expectedNumberOfSubjects, x5$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x5CodeBased$sampleSizes, x5$sampleSizes, tolerance = 1e-07) + expect_equal(x5CodeBased$conditionalPowerAchieved, x5$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x5), "character") + df <- as.data.frame(x5) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x5) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x6 <- getSimulationMeans( + seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), + normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = FALSE, meanRatio = FALSE, + maxNumberOfIterations = 100, thetaH0 = 0.8 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x6' with expected results + expect_equal(x6$effect, c(-0.8, -0.4, 0), tolerance = 1e-07, label = paste0(x6$effect)) + expect_equal(x6$iterations[1, ], c(100, 100, 100), label = paste0(x6$iterations[1, ])) + expect_equal(x6$iterations[2, ], c(98, 98, 100), label = paste0(x6$iterations[2, ])) + expect_equal(x6$overallReject, c(0.71, 0.28, 0.05), tolerance = 1e-07, label = paste0(x6$overallReject)) + expect_equal(x6$rejectPerStage[1, ], c(0.02, 0.02, 0), tolerance = 1e-07, label = paste0(x6$rejectPerStage[1, ])) + expect_equal(x6$rejectPerStage[2, ], c(0.69, 0.26, 0.05), tolerance = 1e-07, label = paste0(x6$rejectPerStage[2, ])) + expect_equal(x6$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x6$futilityPerStage[1, ])) + expect_equal(x6$earlyStop, c(0.02, 0.02, 0), tolerance = 1e-07, label = paste0(x6$earlyStop)) + expect_equal(x6$expectedNumberOfSubjects, c(61.262488, 89.754099, 94.761842), tolerance = 1e-07, label = paste0(x6$expectedNumberOfSubjects)) + expect_equal(x6$sampleSizes[1, ], c(10, 10, 10), label = paste0(x6$sampleSizes[1, ])) + expect_equal(x6$sampleSizes[2, ], c(52.308661, 81.381734, 84.761842), tolerance = 1e-07, label = paste0(x6$sampleSizes[2, ])) + expect_equal(x6$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x6$conditionalPowerAchieved[1, ])) + expect_equal(x6$conditionalPowerAchieved[2, ], c(0.57015973, 0.32347024, 0.27139992), tolerance = 1e-07, label = paste0(x6$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x6), NA))) + expect_output(print(x6)$show()) + invisible(capture.output(expect_error(summary(x6), NA))) + expect_output(summary(x6)$show()) + x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) + expect_equal(x6CodeBased$effect, x6$effect, tolerance = 1e-07) + expect_equal(x6CodeBased$iterations, x6$iterations, tolerance = 1e-07) + expect_equal(x6CodeBased$overallReject, x6$overallReject, tolerance = 1e-07) + expect_equal(x6CodeBased$rejectPerStage, x6$rejectPerStage, tolerance = 1e-07) + expect_equal(x6CodeBased$futilityPerStage, x6$futilityPerStage, tolerance = 1e-07) + expect_equal(x6CodeBased$earlyStop, x6$earlyStop, tolerance = 1e-07) + expect_equal(x6CodeBased$expectedNumberOfSubjects, x6$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x6CodeBased$sampleSizes, x6$sampleSizes, tolerance = 1e-07) + expect_equal(x6CodeBased$conditionalPowerAchieved, x6$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x6), "character") + df <- as.data.frame(x6) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x6) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x7 <- getSimulationMeans( + seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), + normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = TRUE, meanRatio = FALSE, + maxNumberOfIterations = 100, thetaH0 = 0.05 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x7' with expected results + expect_equal(x7$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0(x7$effect)) + expect_equal(x7$iterations[1, ], c(100, 100, 100), label = paste0(x7$iterations[1, ])) + expect_equal(x7$iterations[2, ], c(100, 100, 99), label = paste0(x7$iterations[2, ])) + expect_equal(x7$overallReject, c(0.01, 0.2, 0.7), tolerance = 1e-07, label = paste0(x7$overallReject)) + expect_equal(x7$rejectPerStage[1, ], c(0, 0, 0.01), tolerance = 1e-07, label = paste0(x7$rejectPerStage[1, ])) + expect_equal(x7$rejectPerStage[2, ], c(0.01, 0.2, 0.69), tolerance = 1e-07, label = paste0(x7$rejectPerStage[2, ])) + expect_equal(x7$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x7$futilityPerStage[1, ])) + expect_equal(x7$earlyStop, c(0, 0, 0.01), tolerance = 1e-07, label = paste0(x7$earlyStop)) + expect_equal(x7$expectedNumberOfSubjects, c(99.874349, 85.385224, 62.337209), tolerance = 1e-07, label = paste0(x7$expectedNumberOfSubjects)) + expect_equal(x7$sampleSizes[1, ], c(10, 10, 10), label = paste0(x7$sampleSizes[1, ])) + expect_equal(x7$sampleSizes[2, ], c(89.874349, 75.385224, 52.865867), tolerance = 1e-07, label = paste0(x7$sampleSizes[2, ])) + expect_equal(x7$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x7$conditionalPowerAchieved[1, ])) + expect_equal(x7$conditionalPowerAchieved[2, ], c(0.19979349, 0.40152955, 0.59344307), tolerance = 1e-07, label = paste0(x7$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x7), NA))) + expect_output(print(x7)$show()) + invisible(capture.output(expect_error(summary(x7), NA))) + expect_output(summary(x7)$show()) + x7CodeBased <- eval(parse(text = getObjectRCode(x7, stringWrapParagraphWidth = NULL))) + expect_equal(x7CodeBased$effect, x7$effect, tolerance = 1e-07) + expect_equal(x7CodeBased$iterations, x7$iterations, tolerance = 1e-07) + expect_equal(x7CodeBased$overallReject, x7$overallReject, tolerance = 1e-07) + expect_equal(x7CodeBased$rejectPerStage, x7$rejectPerStage, tolerance = 1e-07) + expect_equal(x7CodeBased$futilityPerStage, x7$futilityPerStage, tolerance = 1e-07) + expect_equal(x7CodeBased$earlyStop, x7$earlyStop, tolerance = 1e-07) + expect_equal(x7CodeBased$expectedNumberOfSubjects, x7$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x7CodeBased$sampleSizes, x7$sampleSizes, tolerance = 1e-07) + expect_equal(x7CodeBased$conditionalPowerAchieved, x7$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x7), "character") + df <- as.data.frame(x7) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x7) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x8 <- getSimulationMeans( + seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), + normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = FALSE, meanRatio = TRUE, + maxNumberOfIterations = 100, thetaH0 = 0.8 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x8' with expected results + expect_equal(x8$effect, c(-0.7, -0.4, 0), tolerance = 1e-07, label = paste0(x8$effect)) + expect_equal(x8$iterations[1, ], c(100, 100, 100), label = paste0(x8$iterations[1, ])) + expect_equal(x8$iterations[2, ], c(99, 100, 100), label = paste0(x8$iterations[2, ])) + expect_equal(x8$overallReject, c(0.57, 0.35, 0.01), tolerance = 1e-07, label = paste0(x8$overallReject)) + expect_equal(x8$rejectPerStage[1, ], c(0.01, 0, 0), tolerance = 1e-07, label = paste0(x8$rejectPerStage[1, ])) + expect_equal(x8$rejectPerStage[2, ], c(0.56, 0.35, 0.01), tolerance = 1e-07, label = paste0(x8$rejectPerStage[2, ])) + expect_equal(x8$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x8$futilityPerStage[1, ])) + expect_equal(x8$earlyStop, c(0.01, 0, 0), tolerance = 1e-07, label = paste0(x8$earlyStop)) + expect_equal(x8$expectedNumberOfSubjects, c(65.632546, 86.865451, 105.50507), tolerance = 1e-07, label = paste0(x8$expectedNumberOfSubjects)) + expect_equal(x8$sampleSizes[1, ], c(10, 10, 10), label = paste0(x8$sampleSizes[1, ])) + expect_equal(x8$sampleSizes[2, ], c(56.194491, 76.865451, 95.50507), tolerance = 1e-07, label = paste0(x8$sampleSizes[2, ])) + expect_equal(x8$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x8$conditionalPowerAchieved[1, ])) + expect_equal(x8$conditionalPowerAchieved[2, ], c(0.54121667, 0.404747, 0.16826779), tolerance = 1e-07, label = paste0(x8$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x8), NA))) + expect_output(print(x8)$show()) + invisible(capture.output(expect_error(summary(x8), NA))) + expect_output(summary(x8)$show()) + x8CodeBased <- eval(parse(text = getObjectRCode(x8, stringWrapParagraphWidth = NULL))) + expect_equal(x8CodeBased$effect, x8$effect, tolerance = 1e-07) + expect_equal(x8CodeBased$iterations, x8$iterations, tolerance = 1e-07) + expect_equal(x8CodeBased$overallReject, x8$overallReject, tolerance = 1e-07) + expect_equal(x8CodeBased$rejectPerStage, x8$rejectPerStage, tolerance = 1e-07) + expect_equal(x8CodeBased$futilityPerStage, x8$futilityPerStage, tolerance = 1e-07) + expect_equal(x8CodeBased$earlyStop, x8$earlyStop, tolerance = 1e-07) + expect_equal(x8CodeBased$expectedNumberOfSubjects, x8$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x8CodeBased$sampleSizes, x8$sampleSizes, tolerance = 1e-07) + expect_equal(x8CodeBased$conditionalPowerAchieved, x8$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x8), "character") + df <- as.data.frame(x8) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x8) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x9 <- getSimulationMeans( + seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), + normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = TRUE, meanRatio = TRUE, + maxNumberOfIterations = 100, thetaH0 = 0.05 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x9' with expected results + expect_equal(x9$effect, c(0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0(x9$effect)) + expect_equal(x9$iterations[1, ], c(100, 100, 100), label = paste0(x9$iterations[1, ])) + expect_equal(x9$iterations[2, ], c(100, 99, 98), label = paste0(x9$iterations[2, ])) + expect_equal(x9$overallReject, c(0.04, 0.36, 0.79), tolerance = 1e-07, label = paste0(x9$overallReject)) + expect_equal(x9$rejectPerStage[1, ], c(0, 0.01, 0.02), tolerance = 1e-07, label = paste0(x9$rejectPerStage[1, ])) + expect_equal(x9$rejectPerStage[2, ], c(0.04, 0.35, 0.77), tolerance = 1e-07, label = paste0(x9$rejectPerStage[2, ])) + expect_equal(x9$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x9$futilityPerStage[1, ])) + expect_equal(x9$earlyStop, c(0, 0.01, 0.02), tolerance = 1e-07, label = paste0(x9$earlyStop)) + expect_equal(x9$expectedNumberOfSubjects, c(93.166381, 72.993336, 56.443486), tolerance = 1e-07, label = paste0(x9$expectedNumberOfSubjects)) + expect_equal(x9$sampleSizes[1, ], c(10, 10, 10), label = paste0(x9$sampleSizes[1, ])) + expect_equal(x9$sampleSizes[2, ], c(83.166381, 63.629633, 47.391312), tolerance = 1e-07, label = paste0(x9$sampleSizes[2, ])) + expect_equal(x9$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x9$conditionalPowerAchieved[1, ])) + expect_equal(x9$conditionalPowerAchieved[2, ], c(0.26603921, 0.53043264, 0.62119237), tolerance = 1e-07, label = paste0(x9$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x9), NA))) + expect_output(print(x9)$show()) + invisible(capture.output(expect_error(summary(x9), NA))) + expect_output(summary(x9)$show()) + x9CodeBased <- eval(parse(text = getObjectRCode(x9, stringWrapParagraphWidth = NULL))) + expect_equal(x9CodeBased$effect, x9$effect, tolerance = 1e-07) + expect_equal(x9CodeBased$iterations, x9$iterations, tolerance = 1e-07) + expect_equal(x9CodeBased$overallReject, x9$overallReject, tolerance = 1e-07) + expect_equal(x9CodeBased$rejectPerStage, x9$rejectPerStage, tolerance = 1e-07) + expect_equal(x9CodeBased$futilityPerStage, x9$futilityPerStage, tolerance = 1e-07) + expect_equal(x9CodeBased$earlyStop, x9$earlyStop, tolerance = 1e-07) + expect_equal(x9CodeBased$expectedNumberOfSubjects, x9$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x9CodeBased$sampleSizes, x9$sampleSizes, tolerance = 1e-07) + expect_equal(x9CodeBased$conditionalPowerAchieved, x9$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x9), "character") + df <- as.data.frame(x9) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x9) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x10 <- getSimulationMeans( + seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), + normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = FALSE, meanRatio = TRUE, + maxNumberOfIterations = 100, thetaH0 = 0.8 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x10' with expected results + expect_equal(x10$effect, c(-0.7, -0.4, 0), tolerance = 1e-07, label = paste0(x10$effect)) + expect_equal(x10$iterations[1, ], c(100, 100, 100), label = paste0(x10$iterations[1, ])) + expect_equal(x10$iterations[2, ], c(98, 98, 100), label = paste0(x10$iterations[2, ])) + expect_equal(x10$overallReject, c(0.71, 0.32, 0.05), tolerance = 1e-07, label = paste0(x10$overallReject)) + expect_equal(x10$rejectPerStage[1, ], c(0.02, 0.02, 0), tolerance = 1e-07, label = paste0(x10$rejectPerStage[1, ])) + expect_equal(x10$rejectPerStage[2, ], c(0.69, 0.3, 0.05), tolerance = 1e-07, label = paste0(x10$rejectPerStage[2, ])) + expect_equal(x10$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x10$futilityPerStage[1, ])) + expect_equal(x10$earlyStop, c(0.02, 0.02, 0), tolerance = 1e-07, label = paste0(x10$earlyStop)) + expect_equal(x10$expectedNumberOfSubjects, c(62.435526, 88.169977, 94.761842), tolerance = 1e-07, label = paste0(x10$expectedNumberOfSubjects)) + expect_equal(x10$sampleSizes[1, ], c(10, 10, 10), label = paste0(x10$sampleSizes[1, ])) + expect_equal(x10$sampleSizes[2, ], c(53.505639, 79.765282, 84.761842), tolerance = 1e-07, label = paste0(x10$sampleSizes[2, ])) + expect_equal(x10$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x10$conditionalPowerAchieved[1, ])) + expect_equal(x10$conditionalPowerAchieved[2, ], c(0.56217158, 0.33884596, 0.27139992), tolerance = 1e-07, label = paste0(x10$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x10), NA))) + expect_output(print(x10)$show()) + invisible(capture.output(expect_error(summary(x10), NA))) + expect_output(summary(x10)$show()) + x10CodeBased <- eval(parse(text = getObjectRCode(x10, stringWrapParagraphWidth = NULL))) + expect_equal(x10CodeBased$effect, x10$effect, tolerance = 1e-07) + expect_equal(x10CodeBased$iterations, x10$iterations, tolerance = 1e-07) + expect_equal(x10CodeBased$overallReject, x10$overallReject, tolerance = 1e-07) + expect_equal(x10CodeBased$rejectPerStage, x10$rejectPerStage, tolerance = 1e-07) + expect_equal(x10CodeBased$futilityPerStage, x10$futilityPerStage, tolerance = 1e-07) + expect_equal(x10CodeBased$earlyStop, x10$earlyStop, tolerance = 1e-07) + expect_equal(x10CodeBased$expectedNumberOfSubjects, x10$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x10CodeBased$sampleSizes, x10$sampleSizes, tolerance = 1e-07) + expect_equal(x10CodeBased$conditionalPowerAchieved, x10$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x10), "character") + df <- as.data.frame(x10) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x10) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x11 <- getSimulationMeans( + seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), + normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = TRUE, meanRatio = TRUE, + maxNumberOfIterations = 100, thetaH0 = 0.05 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x11' with expected results + expect_equal(x11$effect, c(0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0(x11$effect)) + expect_equal(x11$iterations[1, ], c(100, 100, 100), label = paste0(x11$iterations[1, ])) + expect_equal(x11$iterations[2, ], c(100, 100, 98), label = paste0(x11$iterations[2, ])) + expect_equal(x11$overallReject, c(0.04, 0.33, 0.76), tolerance = 1e-07, label = paste0(x11$overallReject)) + expect_equal(x11$rejectPerStage[1, ], c(0, 0, 0.02), tolerance = 1e-07, label = paste0(x11$rejectPerStage[1, ])) + expect_equal(x11$rejectPerStage[2, ], c(0.04, 0.33, 0.74), tolerance = 1e-07, label = paste0(x11$rejectPerStage[2, ])) + expect_equal(x11$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x11$futilityPerStage[1, ])) + expect_equal(x11$earlyStop, c(0, 0, 0.02), tolerance = 1e-07, label = paste0(x11$earlyStop)) + expect_equal(x11$expectedNumberOfSubjects, c(97.820553, 79.30135, 45.942964), tolerance = 1e-07, label = paste0(x11$expectedNumberOfSubjects)) + expect_equal(x11$sampleSizes[1, ], c(10, 10, 10), label = paste0(x11$sampleSizes[1, ])) + expect_equal(x11$sampleSizes[2, ], c(87.820553, 69.30135, 36.676494), tolerance = 1e-07, label = paste0(x11$sampleSizes[2, ])) + expect_equal(x11$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x11$conditionalPowerAchieved[1, ])) + expect_equal(x11$conditionalPowerAchieved[2, ], c(0.24692411, 0.46371008, 0.71242546), tolerance = 1e-07, label = paste0(x11$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x11), NA))) + expect_output(print(x11)$show()) + invisible(capture.output(expect_error(summary(x11), NA))) + expect_output(summary(x11)$show()) + x11CodeBased <- eval(parse(text = getObjectRCode(x11, stringWrapParagraphWidth = NULL))) + expect_equal(x11CodeBased$effect, x11$effect, tolerance = 1e-07) + expect_equal(x11CodeBased$iterations, x11$iterations, tolerance = 1e-07) + expect_equal(x11CodeBased$overallReject, x11$overallReject, tolerance = 1e-07) + expect_equal(x11CodeBased$rejectPerStage, x11$rejectPerStage, tolerance = 1e-07) + expect_equal(x11CodeBased$futilityPerStage, x11$futilityPerStage, tolerance = 1e-07) + expect_equal(x11CodeBased$earlyStop, x11$earlyStop, tolerance = 1e-07) + expect_equal(x11CodeBased$expectedNumberOfSubjects, x11$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x11CodeBased$sampleSizes, x11$sampleSizes, tolerance = 1e-07) + expect_equal(x11CodeBased$conditionalPowerAchieved, x11$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x11), "character") + df <- as.data.frame(x11) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x11) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x12 <- getSimulationMeans( + seed = 1234, getDesignInverseNormal(informationRates = c(0.3333, 1)), + normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = FALSE, meanRatio = TRUE, + maxNumberOfIterations = 100, thetaH0 = 0.8 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x12' with expected results + expect_equal(x12$effect, c(-0.7, -0.4, 0), tolerance = 1e-07, label = paste0(x12$effect)) + expect_equal(x12$iterations[1, ], c(100, 100, 100), label = paste0(x12$iterations[1, ])) + expect_equal(x12$iterations[2, ], c(99, 100, 100), label = paste0(x12$iterations[2, ])) + expect_equal(x12$overallReject, c(0.57, 0.35, 0.01), tolerance = 1e-07, label = paste0(x12$overallReject)) + expect_equal(x12$rejectPerStage[1, ], c(0.01, 0, 0), tolerance = 1e-07, label = paste0(x12$rejectPerStage[1, ])) + expect_equal(x12$rejectPerStage[2, ], c(0.56, 0.35, 0.01), tolerance = 1e-07, label = paste0(x12$rejectPerStage[2, ])) + expect_equal(x12$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x12$futilityPerStage[1, ])) + expect_equal(x12$earlyStop, c(0.01, 0, 0), tolerance = 1e-07, label = paste0(x12$earlyStop)) + expect_equal(x12$expectedNumberOfSubjects, c(65.632546, 86.865451, 105.50507), tolerance = 1e-07, label = paste0(x12$expectedNumberOfSubjects)) + expect_equal(x12$sampleSizes[1, ], c(10, 10, 10), label = paste0(x12$sampleSizes[1, ])) + expect_equal(x12$sampleSizes[2, ], c(56.194491, 76.865451, 95.50507), tolerance = 1e-07, label = paste0(x12$sampleSizes[2, ])) + expect_equal(x12$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x12$conditionalPowerAchieved[1, ])) + expect_equal(x12$conditionalPowerAchieved[2, ], c(0.54121667, 0.404747, 0.16826779), tolerance = 1e-07, label = paste0(x12$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x12), NA))) + expect_output(print(x12)$show()) + invisible(capture.output(expect_error(summary(x12), NA))) + expect_output(summary(x12)$show()) + x12CodeBased <- eval(parse(text = getObjectRCode(x12, stringWrapParagraphWidth = NULL))) + expect_equal(x12CodeBased$effect, x12$effect, tolerance = 1e-07) + expect_equal(x12CodeBased$iterations, x12$iterations, tolerance = 1e-07) + expect_equal(x12CodeBased$overallReject, x12$overallReject, tolerance = 1e-07) + expect_equal(x12CodeBased$rejectPerStage, x12$rejectPerStage, tolerance = 1e-07) + expect_equal(x12CodeBased$futilityPerStage, x12$futilityPerStage, tolerance = 1e-07) + expect_equal(x12CodeBased$earlyStop, x12$earlyStop, tolerance = 1e-07) + expect_equal(x12CodeBased$expectedNumberOfSubjects, x12$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x12CodeBased$sampleSizes, x12$sampleSizes, tolerance = 1e-07) + expect_equal(x12CodeBased$conditionalPowerAchieved, x12$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x12), "character") + df <- as.data.frame(x12) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x12) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } }) test_that("'getSimulationMeans': group sequential design with several configurations", { - - # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} - # @refFS[Sec.]{fs:sec:simulatingTestingOneHypothesis} - # @refFS[Tab.]{fs:tab:output:getSimulationMeans} - # @refFS[Formula]{fs:simulationOneArmMeansTestStatistics} - # @refFS[Formula]{fs:simulationTwoArmMeansTestStatisticsDiff} - # @refFS[Formula]{fs:simulationTwoArmMeansTestStatisticsRatio} - # @refFS[Formula]{fs:testStatisticGroupSequentialWeightedAverage} - x1 <- getSimulationMeans( - seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), - normalApproximation = TRUE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = TRUE, - maxNumberOfIterations = 100, thetaH0 = 0.05 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x1' with expected results - expect_equal(x1$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(x1$effect, collapse = ", "), ")")) - expect_equal(x1$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x1$iterations[1, ], collapse = ", "), ")")) - expect_equal(x1$iterations[2, ], c(100, 99, 93), label = paste0("c(", paste0(x1$iterations[2, ], collapse = ", "), ")")) - expect_equal(x1$overallReject, c(0.02, 0.71, 0.93), tolerance = 1e-07, label = paste0("c(", paste0(x1$overallReject, collapse = ", "), ")")) - expect_equal(x1$rejectPerStage[1, ], c(0, 0.01, 0.07), tolerance = 1e-07, label = paste0("c(", paste0(x1$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x1$rejectPerStage[2, ], c(0.02, 0.7, 0.86), tolerance = 1e-07, label = paste0("c(", paste0(x1$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x1$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x1$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x1$earlyStop, c(0, 0.01, 0.07), tolerance = 1e-07, label = paste0("c(", paste0(x1$earlyStop, collapse = ", "), ")")) - expect_equal(x1$expectedNumberOfSubjects, c(97.726214, 61.386317, 35.456429), tolerance = 1e-07, label = paste0("c(", paste0(x1$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x1$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x1$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x1$sampleSizes[2, ], c(87.726214, 51.905371, 27.372504), tolerance = 1e-07, label = paste0("c(", paste0(x1$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x1$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x1$conditionalPowerAchieved[2, ], c(0.21948944, 0.59945542, 0.74761937), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x1), NA))) - expect_output(print(x1)$show()) - invisible(capture.output(expect_error(summary(x1), NA))) - expect_output(summary(x1)$show()) - x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) - expect_equal(x1CodeBased$effect, x1$effect, tolerance = 1e-07) - expect_equal(x1CodeBased$iterations, x1$iterations, tolerance = 1e-07) - expect_equal(x1CodeBased$overallReject, x1$overallReject, tolerance = 1e-07) - expect_equal(x1CodeBased$rejectPerStage, x1$rejectPerStage, tolerance = 1e-07) - expect_equal(x1CodeBased$futilityPerStage, x1$futilityPerStage, tolerance = 1e-07) - expect_equal(x1CodeBased$earlyStop, x1$earlyStop, tolerance = 1e-07) - expect_equal(x1CodeBased$expectedNumberOfSubjects, x1$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x1CodeBased$sampleSizes, x1$sampleSizes, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalPowerAchieved, x1$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x1), "character") - df <- as.data.frame(x1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - .skipTestIfDisabled() - - x2 <- getSimulationMeans( - seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), - normalApproximation = TRUE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = FALSE, - maxNumberOfIterations = 100, thetaH0 = 0.8 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x2' with expected results - expect_equal(x2$effect, c(-0.8, -0.4, 0), tolerance = 1e-07, label = paste0("c(", paste0(x2$effect, collapse = ", "), ")")) - expect_equal(x2$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x2$iterations[1, ], collapse = ", "), ")")) - expect_equal(x2$iterations[2, ], c(92, 98, 100), label = paste0("c(", paste0(x2$iterations[2, ], collapse = ", "), ")")) - expect_equal(x2$overallReject, c(0.94, 0.81, 0.07), tolerance = 1e-07, label = paste0("c(", paste0(x2$overallReject, collapse = ", "), ")")) - expect_equal(x2$rejectPerStage[1, ], c(0.08, 0.02, 0), tolerance = 1e-07, label = paste0("c(", paste0(x2$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x2$rejectPerStage[2, ], c(0.86, 0.79, 0.07), tolerance = 1e-07, label = paste0("c(", paste0(x2$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x2$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x2$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x2$earlyStop, c(0.08, 0.02, 0), tolerance = 1e-07, label = paste0("c(", paste0(x2$earlyStop, collapse = ", "), ")")) - expect_equal(x2$expectedNumberOfSubjects, c(30.529806, 74.585778, 94.761842), tolerance = 1e-07, label = paste0("c(", paste0(x2$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x2$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x2$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x2$sampleSizes[2, ], c(22.315007, 65.903855, 84.761842), tolerance = 1e-07, label = paste0("c(", paste0(x2$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x2$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x2$conditionalPowerAchieved[2, ], c(0.78002751, 0.51035441, 0.27866093), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x2), NA))) - expect_output(print(x2)$show()) - invisible(capture.output(expect_error(summary(x2), NA))) - expect_output(summary(x2)$show()) - x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) - expect_equal(x2CodeBased$effect, x2$effect, tolerance = 1e-07) - expect_equal(x2CodeBased$iterations, x2$iterations, tolerance = 1e-07) - expect_equal(x2CodeBased$overallReject, x2$overallReject, tolerance = 1e-07) - expect_equal(x2CodeBased$rejectPerStage, x2$rejectPerStage, tolerance = 1e-07) - expect_equal(x2CodeBased$futilityPerStage, x2$futilityPerStage, tolerance = 1e-07) - expect_equal(x2CodeBased$earlyStop, x2$earlyStop, tolerance = 1e-07) - expect_equal(x2CodeBased$expectedNumberOfSubjects, x2$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x2CodeBased$sampleSizes, x2$sampleSizes, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalPowerAchieved, x2$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x2), "character") - df <- as.data.frame(x2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x3 <- getSimulationMeans( - seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), - normalApproximation = FALSE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = TRUE, - maxNumberOfIterations = 100, thetaH0 = 0.05 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x3' with expected results - expect_equal(x3$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(x3$effect, collapse = ", "), ")")) - expect_equal(x3$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x3$iterations[1, ], collapse = ", "), ")")) - expect_equal(x3$iterations[2, ], c(100, 100, 98), label = paste0("c(", paste0(x3$iterations[2, ], collapse = ", "), ")")) - expect_equal(x3$overallReject, c(0.01, 0.68, 0.94), tolerance = 1e-07, label = paste0("c(", paste0(x3$overallReject, collapse = ", "), ")")) - expect_equal(x3$rejectPerStage[1, ], c(0, 0, 0.02), tolerance = 1e-07, label = paste0("c(", paste0(x3$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x3$rejectPerStage[2, ], c(0.01, 0.68, 0.92), tolerance = 1e-07, label = paste0("c(", paste0(x3$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x3$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x3$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x3$earlyStop, c(0, 0, 0.02), tolerance = 1e-07, label = paste0("c(", paste0(x3$earlyStop, collapse = ", "), ")")) - expect_equal(x3$expectedNumberOfSubjects, c(99.571933, 69.623473, 35.859349), tolerance = 1e-07, label = paste0("c(", paste0(x3$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x3$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x3$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x3$sampleSizes[2, ], c(89.571933, 59.623473, 26.38709), tolerance = 1e-07, label = paste0("c(", paste0(x3$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x3$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x3$conditionalPowerAchieved[2, ], c(0.17531256, 0.54483038, 0.79325539), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x3), NA))) - expect_output(print(x3)$show()) - invisible(capture.output(expect_error(summary(x3), NA))) - expect_output(summary(x3)$show()) - x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) - expect_equal(x3CodeBased$effect, x3$effect, tolerance = 1e-07) - expect_equal(x3CodeBased$iterations, x3$iterations, tolerance = 1e-07) - expect_equal(x3CodeBased$overallReject, x3$overallReject, tolerance = 1e-07) - expect_equal(x3CodeBased$rejectPerStage, x3$rejectPerStage, tolerance = 1e-07) - expect_equal(x3CodeBased$futilityPerStage, x3$futilityPerStage, tolerance = 1e-07) - expect_equal(x3CodeBased$earlyStop, x3$earlyStop, tolerance = 1e-07) - expect_equal(x3CodeBased$expectedNumberOfSubjects, x3$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x3CodeBased$sampleSizes, x3$sampleSizes, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalPowerAchieved, x3$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x3), "character") - df <- as.data.frame(x3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x4 <- getSimulationMeans( - seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), - normalApproximation = FALSE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = FALSE, - maxNumberOfIterations = 100, thetaH0 = 0.8 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x4' with expected results - expect_equal(x4$effect, c(-0.8, -0.4, 0), tolerance = 1e-07, label = paste0("c(", paste0(x4$effect, collapse = ", "), ")")) - expect_equal(x4$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x4$iterations[1, ], collapse = ", "), ")")) - expect_equal(x4$iterations[2, ], c(97, 100, 100), label = paste0("c(", paste0(x4$iterations[2, ], collapse = ", "), ")")) - expect_equal(x4$overallReject, c(0.92, 0.78, 0.02), tolerance = 1e-07, label = paste0("c(", paste0(x4$overallReject, collapse = ", "), ")")) - expect_equal(x4$rejectPerStage[1, ], c(0.03, 0, 0), tolerance = 1e-07, label = paste0("c(", paste0(x4$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x4$rejectPerStage[2, ], c(0.89, 0.78, 0.02), tolerance = 1e-07, label = paste0("c(", paste0(x4$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x4$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x4$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x4$earlyStop, c(0.03, 0, 0), tolerance = 1e-07, label = paste0("c(", paste0(x4$earlyStop, collapse = ", "), ")")) - expect_equal(x4$expectedNumberOfSubjects, c(34.808208, 66.656932, 104.30185), tolerance = 1e-07, label = paste0("c(", paste0(x4$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x4$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x4$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x4$sampleSizes[2, ], c(25.575472, 56.656932, 94.301853), tolerance = 1e-07, label = paste0("c(", paste0(x4$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x4$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x4$conditionalPowerAchieved[2, ], c(0.78184392, 0.58902983, 0.17869551), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x4), NA))) - expect_output(print(x4)$show()) - invisible(capture.output(expect_error(summary(x4), NA))) - expect_output(summary(x4)$show()) - x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) - expect_equal(x4CodeBased$effect, x4$effect, tolerance = 1e-07) - expect_equal(x4CodeBased$iterations, x4$iterations, tolerance = 1e-07) - expect_equal(x4CodeBased$overallReject, x4$overallReject, tolerance = 1e-07) - expect_equal(x4CodeBased$rejectPerStage, x4$rejectPerStage, tolerance = 1e-07) - expect_equal(x4CodeBased$futilityPerStage, x4$futilityPerStage, tolerance = 1e-07) - expect_equal(x4CodeBased$earlyStop, x4$earlyStop, tolerance = 1e-07) - expect_equal(x4CodeBased$expectedNumberOfSubjects, x4$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x4CodeBased$sampleSizes, x4$sampleSizes, tolerance = 1e-07) - expect_equal(x4CodeBased$conditionalPowerAchieved, x4$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x4), "character") - df <- as.data.frame(x4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x5 <- getSimulationMeans( - seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), - normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = TRUE, meanRatio = FALSE, - maxNumberOfIterations = 100, thetaH0 = 0.05 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x5' with expected results - expect_equal(x5$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(x5$effect, collapse = ", "), ")")) - expect_equal(x5$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x5$iterations[1, ], collapse = ", "), ")")) - expect_equal(x5$iterations[2, ], c(100, 100, 100), label = paste0("c(", paste0(x5$iterations[2, ], collapse = ", "), ")")) - expect_equal(x5$overallReject, c(0.03, 0.36, 0.74), tolerance = 1e-07, label = paste0("c(", paste0(x5$overallReject, collapse = ", "), ")")) - expect_equal(x5$rejectPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x5$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x5$rejectPerStage[2, ], c(0.03, 0.36, 0.74), tolerance = 1e-07, label = paste0("c(", paste0(x5$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x5$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x5$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x5$earlyStop, c(0, 0, 0), label = paste0("c(", paste0(x5$earlyStop, collapse = ", "), ")")) - expect_equal(x5$expectedNumberOfSubjects, c(96.372889, 89.619156, 71.907268), tolerance = 1e-07, label = paste0("c(", paste0(x5$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x5$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x5$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x5$sampleSizes[2, ], c(86.372889, 79.619156, 61.907268), tolerance = 1e-07, label = paste0("c(", paste0(x5$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x5$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x5$conditionalPowerAchieved[2, ], c(0.23254121, 0.37156759, 0.50696796), tolerance = 1e-07, label = paste0("c(", paste0(x5$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x5), NA))) - expect_output(print(x5)$show()) - invisible(capture.output(expect_error(summary(x5), NA))) - expect_output(summary(x5)$show()) - x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) - expect_equal(x5CodeBased$effect, x5$effect, tolerance = 1e-07) - expect_equal(x5CodeBased$iterations, x5$iterations, tolerance = 1e-07) - expect_equal(x5CodeBased$overallReject, x5$overallReject, tolerance = 1e-07) - expect_equal(x5CodeBased$rejectPerStage, x5$rejectPerStage, tolerance = 1e-07) - expect_equal(x5CodeBased$futilityPerStage, x5$futilityPerStage, tolerance = 1e-07) - expect_equal(x5CodeBased$earlyStop, x5$earlyStop, tolerance = 1e-07) - expect_equal(x5CodeBased$expectedNumberOfSubjects, x5$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x5CodeBased$sampleSizes, x5$sampleSizes, tolerance = 1e-07) - expect_equal(x5CodeBased$conditionalPowerAchieved, x5$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x5), "character") - df <- as.data.frame(x5) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x5) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x6 <- getSimulationMeans( - seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), - normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = FALSE, meanRatio = FALSE, - maxNumberOfIterations = 100, thetaH0 = 0.8 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x6' with expected results - expect_equal(x6$effect, c(-0.8, -0.4, 0), tolerance = 1e-07, label = paste0("c(", paste0(x6$effect, collapse = ", "), ")")) - expect_equal(x6$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x6$iterations[1, ], collapse = ", "), ")")) - expect_equal(x6$iterations[2, ], c(98, 98, 100), label = paste0("c(", paste0(x6$iterations[2, ], collapse = ", "), ")")) - expect_equal(x6$overallReject, c(0.79, 0.36, 0.06), tolerance = 1e-07, label = paste0("c(", paste0(x6$overallReject, collapse = ", "), ")")) - expect_equal(x6$rejectPerStage[1, ], c(0.02, 0.02, 0), tolerance = 1e-07, label = paste0("c(", paste0(x6$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x6$rejectPerStage[2, ], c(0.77, 0.34, 0.06), tolerance = 1e-07, label = paste0("c(", paste0(x6$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x6$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x6$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x6$earlyStop, c(0.02, 0.02, 0), tolerance = 1e-07, label = paste0("c(", paste0(x6$earlyStop, collapse = ", "), ")")) - expect_equal(x6$expectedNumberOfSubjects, c(61.262488, 89.754099, 94.761842), tolerance = 1e-07, label = paste0("c(", paste0(x6$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x6$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x6$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x6$sampleSizes[2, ], c(52.308661, 81.381734, 84.761842), tolerance = 1e-07, label = paste0("c(", paste0(x6$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x6$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x6$conditionalPowerAchieved[2, ], c(0.57015973, 0.32347024, 0.27139992), tolerance = 1e-07, label = paste0("c(", paste0(x6$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x6), NA))) - expect_output(print(x6)$show()) - invisible(capture.output(expect_error(summary(x6), NA))) - expect_output(summary(x6)$show()) - x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) - expect_equal(x6CodeBased$effect, x6$effect, tolerance = 1e-07) - expect_equal(x6CodeBased$iterations, x6$iterations, tolerance = 1e-07) - expect_equal(x6CodeBased$overallReject, x6$overallReject, tolerance = 1e-07) - expect_equal(x6CodeBased$rejectPerStage, x6$rejectPerStage, tolerance = 1e-07) - expect_equal(x6CodeBased$futilityPerStage, x6$futilityPerStage, tolerance = 1e-07) - expect_equal(x6CodeBased$earlyStop, x6$earlyStop, tolerance = 1e-07) - expect_equal(x6CodeBased$expectedNumberOfSubjects, x6$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x6CodeBased$sampleSizes, x6$sampleSizes, tolerance = 1e-07) - expect_equal(x6CodeBased$conditionalPowerAchieved, x6$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x6), "character") - df <- as.data.frame(x6) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x6) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x7 <- getSimulationMeans( - seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), - normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = TRUE, meanRatio = FALSE, - maxNumberOfIterations = 100, thetaH0 = 0.05 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x7' with expected results - expect_equal(x7$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(x7$effect, collapse = ", "), ")")) - expect_equal(x7$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x7$iterations[1, ], collapse = ", "), ")")) - expect_equal(x7$iterations[2, ], c(100, 100, 99), label = paste0("c(", paste0(x7$iterations[2, ], collapse = ", "), ")")) - expect_equal(x7$overallReject, c(0.01, 0.23, 0.83), tolerance = 1e-07, label = paste0("c(", paste0(x7$overallReject, collapse = ", "), ")")) - expect_equal(x7$rejectPerStage[1, ], c(0, 0, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(x7$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x7$rejectPerStage[2, ], c(0.01, 0.23, 0.82), tolerance = 1e-07, label = paste0("c(", paste0(x7$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x7$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x7$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x7$earlyStop, c(0, 0, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(x7$earlyStop, collapse = ", "), ")")) - expect_equal(x7$expectedNumberOfSubjects, c(99.874349, 85.385224, 62.337209), tolerance = 1e-07, label = paste0("c(", paste0(x7$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x7$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x7$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x7$sampleSizes[2, ], c(89.874349, 75.385224, 52.865867), tolerance = 1e-07, label = paste0("c(", paste0(x7$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x7$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x7$conditionalPowerAchieved[2, ], c(0.19979349, 0.40152955, 0.59344307), tolerance = 1e-07, label = paste0("c(", paste0(x7$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x7), NA))) - expect_output(print(x7)$show()) - invisible(capture.output(expect_error(summary(x7), NA))) - expect_output(summary(x7)$show()) - x7CodeBased <- eval(parse(text = getObjectRCode(x7, stringWrapParagraphWidth = NULL))) - expect_equal(x7CodeBased$effect, x7$effect, tolerance = 1e-07) - expect_equal(x7CodeBased$iterations, x7$iterations, tolerance = 1e-07) - expect_equal(x7CodeBased$overallReject, x7$overallReject, tolerance = 1e-07) - expect_equal(x7CodeBased$rejectPerStage, x7$rejectPerStage, tolerance = 1e-07) - expect_equal(x7CodeBased$futilityPerStage, x7$futilityPerStage, tolerance = 1e-07) - expect_equal(x7CodeBased$earlyStop, x7$earlyStop, tolerance = 1e-07) - expect_equal(x7CodeBased$expectedNumberOfSubjects, x7$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x7CodeBased$sampleSizes, x7$sampleSizes, tolerance = 1e-07) - expect_equal(x7CodeBased$conditionalPowerAchieved, x7$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x7), "character") - df <- as.data.frame(x7) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x7) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x8 <- getSimulationMeans( - seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), - normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = FALSE, meanRatio = TRUE, - maxNumberOfIterations = 100, thetaH0 = 0.8 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x8' with expected results - expect_equal(x8$effect, c(-0.7, -0.4, 0), tolerance = 1e-07, label = paste0("c(", paste0(x8$effect, collapse = ", "), ")")) - expect_equal(x8$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x8$iterations[1, ], collapse = ", "), ")")) - expect_equal(x8$iterations[2, ], c(99, 100, 100), label = paste0("c(", paste0(x8$iterations[2, ], collapse = ", "), ")")) - expect_equal(x8$overallReject, c(0.72, 0.45, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(x8$overallReject, collapse = ", "), ")")) - expect_equal(x8$rejectPerStage[1, ], c(0.01, 0, 0), tolerance = 1e-07, label = paste0("c(", paste0(x8$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x8$rejectPerStage[2, ], c(0.71, 0.45, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(x8$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x8$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x8$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x8$earlyStop, c(0.01, 0, 0), tolerance = 1e-07, label = paste0("c(", paste0(x8$earlyStop, collapse = ", "), ")")) - expect_equal(x8$expectedNumberOfSubjects, c(65.632546, 86.865451, 105.50507), tolerance = 1e-07, label = paste0("c(", paste0(x8$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x8$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x8$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x8$sampleSizes[2, ], c(56.194491, 76.865451, 95.50507), tolerance = 1e-07, label = paste0("c(", paste0(x8$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x8$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x8$conditionalPowerAchieved[2, ], c(0.52087291, 0.38731069, 0.15906003), tolerance = 1e-07, label = paste0("c(", paste0(x8$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x8), NA))) - expect_output(print(x8)$show()) - invisible(capture.output(expect_error(summary(x8), NA))) - expect_output(summary(x8)$show()) - x8CodeBased <- eval(parse(text = getObjectRCode(x8, stringWrapParagraphWidth = NULL))) - expect_equal(x8CodeBased$effect, x8$effect, tolerance = 1e-07) - expect_equal(x8CodeBased$iterations, x8$iterations, tolerance = 1e-07) - expect_equal(x8CodeBased$overallReject, x8$overallReject, tolerance = 1e-07) - expect_equal(x8CodeBased$rejectPerStage, x8$rejectPerStage, tolerance = 1e-07) - expect_equal(x8CodeBased$futilityPerStage, x8$futilityPerStage, tolerance = 1e-07) - expect_equal(x8CodeBased$earlyStop, x8$earlyStop, tolerance = 1e-07) - expect_equal(x8CodeBased$expectedNumberOfSubjects, x8$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x8CodeBased$sampleSizes, x8$sampleSizes, tolerance = 1e-07) - expect_equal(x8CodeBased$conditionalPowerAchieved, x8$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x8), "character") - df <- as.data.frame(x8) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x8) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x9 <- getSimulationMeans( - seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), - normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = TRUE, meanRatio = TRUE, - maxNumberOfIterations = 100, thetaH0 = 0.05 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x9' with expected results - expect_equal(x9$effect, c(0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(x9$effect, collapse = ", "), ")")) - expect_equal(x9$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x9$iterations[1, ], collapse = ", "), ")")) - expect_equal(x9$iterations[2, ], c(100, 99, 98), label = paste0("c(", paste0(x9$iterations[2, ], collapse = ", "), ")")) - expect_equal(x9$overallReject, c(0.09, 0.44, 0.85), tolerance = 1e-07, label = paste0("c(", paste0(x9$overallReject, collapse = ", "), ")")) - expect_equal(x9$rejectPerStage[1, ], c(0, 0.01, 0.02), tolerance = 1e-07, label = paste0("c(", paste0(x9$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x9$rejectPerStage[2, ], c(0.09, 0.43, 0.83), tolerance = 1e-07, label = paste0("c(", paste0(x9$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x9$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x9$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x9$earlyStop, c(0, 0.01, 0.02), tolerance = 1e-07, label = paste0("c(", paste0(x9$earlyStop, collapse = ", "), ")")) - expect_equal(x9$expectedNumberOfSubjects, c(93.166381, 72.993336, 56.443486), tolerance = 1e-07, label = paste0("c(", paste0(x9$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x9$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x9$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x9$sampleSizes[2, ], c(83.166381, 63.629633, 47.391312), tolerance = 1e-07, label = paste0("c(", paste0(x9$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x9$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x9$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x9$conditionalPowerAchieved[2, ], c(0.26023971, 0.52016331, 0.61018937), tolerance = 1e-07, label = paste0("c(", paste0(x9$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x9), NA))) - expect_output(print(x9)$show()) - invisible(capture.output(expect_error(summary(x9), NA))) - expect_output(summary(x9)$show()) - x9CodeBased <- eval(parse(text = getObjectRCode(x9, stringWrapParagraphWidth = NULL))) - expect_equal(x9CodeBased$effect, x9$effect, tolerance = 1e-07) - expect_equal(x9CodeBased$iterations, x9$iterations, tolerance = 1e-07) - expect_equal(x9CodeBased$overallReject, x9$overallReject, tolerance = 1e-07) - expect_equal(x9CodeBased$rejectPerStage, x9$rejectPerStage, tolerance = 1e-07) - expect_equal(x9CodeBased$futilityPerStage, x9$futilityPerStage, tolerance = 1e-07) - expect_equal(x9CodeBased$earlyStop, x9$earlyStop, tolerance = 1e-07) - expect_equal(x9CodeBased$expectedNumberOfSubjects, x9$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x9CodeBased$sampleSizes, x9$sampleSizes, tolerance = 1e-07) - expect_equal(x9CodeBased$conditionalPowerAchieved, x9$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x9), "character") - df <- as.data.frame(x9) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x9) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x10 <- getSimulationMeans( - seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), - normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = FALSE, meanRatio = TRUE, - maxNumberOfIterations = 100, thetaH0 = 0.8 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x10' with expected results - expect_equal(x10$effect, c(-0.7, -0.4, 0), tolerance = 1e-07, label = paste0("c(", paste0(x10$effect, collapse = ", "), ")")) - expect_equal(x10$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x10$iterations[1, ], collapse = ", "), ")")) - expect_equal(x10$iterations[2, ], c(98, 98, 100), label = paste0("c(", paste0(x10$iterations[2, ], collapse = ", "), ")")) - expect_equal(x10$overallReject, c(0.76, 0.42, 0.06), tolerance = 1e-07, label = paste0("c(", paste0(x10$overallReject, collapse = ", "), ")")) - expect_equal(x10$rejectPerStage[1, ], c(0.02, 0.02, 0), tolerance = 1e-07, label = paste0("c(", paste0(x10$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x10$rejectPerStage[2, ], c(0.74, 0.4, 0.06), tolerance = 1e-07, label = paste0("c(", paste0(x10$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x10$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x10$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x10$earlyStop, c(0.02, 0.02, 0), tolerance = 1e-07, label = paste0("c(", paste0(x10$earlyStop, collapse = ", "), ")")) - expect_equal(x10$expectedNumberOfSubjects, c(62.435526, 88.169977, 94.761842), tolerance = 1e-07, label = paste0("c(", paste0(x10$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x10$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x10$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x10$sampleSizes[2, ], c(53.505639, 79.765282, 84.761842), tolerance = 1e-07, label = paste0("c(", paste0(x10$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x10$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x10$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x10$conditionalPowerAchieved[2, ], c(0.54108822, 0.32455187, 0.25936079), tolerance = 1e-07, label = paste0("c(", paste0(x10$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x10), NA))) - expect_output(print(x10)$show()) - invisible(capture.output(expect_error(summary(x10), NA))) - expect_output(summary(x10)$show()) - x10CodeBased <- eval(parse(text = getObjectRCode(x10, stringWrapParagraphWidth = NULL))) - expect_equal(x10CodeBased$effect, x10$effect, tolerance = 1e-07) - expect_equal(x10CodeBased$iterations, x10$iterations, tolerance = 1e-07) - expect_equal(x10CodeBased$overallReject, x10$overallReject, tolerance = 1e-07) - expect_equal(x10CodeBased$rejectPerStage, x10$rejectPerStage, tolerance = 1e-07) - expect_equal(x10CodeBased$futilityPerStage, x10$futilityPerStage, tolerance = 1e-07) - expect_equal(x10CodeBased$earlyStop, x10$earlyStop, tolerance = 1e-07) - expect_equal(x10CodeBased$expectedNumberOfSubjects, x10$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x10CodeBased$sampleSizes, x10$sampleSizes, tolerance = 1e-07) - expect_equal(x10CodeBased$conditionalPowerAchieved, x10$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x10), "character") - df <- as.data.frame(x10) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x10) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x11 <- getSimulationMeans( - seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), - normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = TRUE, meanRatio = TRUE, - maxNumberOfIterations = 100, thetaH0 = 0.05 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x11' with expected results - expect_equal(x11$effect, c(0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(x11$effect, collapse = ", "), ")")) - expect_equal(x11$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x11$iterations[1, ], collapse = ", "), ")")) - expect_equal(x11$iterations[2, ], c(100, 100, 98), label = paste0("c(", paste0(x11$iterations[2, ], collapse = ", "), ")")) - expect_equal(x11$overallReject, c(0.12, 0.39, 0.87), tolerance = 1e-07, label = paste0("c(", paste0(x11$overallReject, collapse = ", "), ")")) - expect_equal(x11$rejectPerStage[1, ], c(0, 0, 0.02), tolerance = 1e-07, label = paste0("c(", paste0(x11$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x11$rejectPerStage[2, ], c(0.12, 0.39, 0.85), tolerance = 1e-07, label = paste0("c(", paste0(x11$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x11$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x11$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x11$earlyStop, c(0, 0, 0.02), tolerance = 1e-07, label = paste0("c(", paste0(x11$earlyStop, collapse = ", "), ")")) - expect_equal(x11$expectedNumberOfSubjects, c(97.820553, 79.30135, 45.942964), tolerance = 1e-07, label = paste0("c(", paste0(x11$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x11$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x11$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x11$sampleSizes[2, ], c(87.820553, 69.30135, 36.676494), tolerance = 1e-07, label = paste0("c(", paste0(x11$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x11$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x11$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x11$conditionalPowerAchieved[2, ], c(0.24110629, 0.45389272, 0.70091861), tolerance = 1e-07, label = paste0("c(", paste0(x11$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x11), NA))) - expect_output(print(x11)$show()) - invisible(capture.output(expect_error(summary(x11), NA))) - expect_output(summary(x11)$show()) - x11CodeBased <- eval(parse(text = getObjectRCode(x11, stringWrapParagraphWidth = NULL))) - expect_equal(x11CodeBased$effect, x11$effect, tolerance = 1e-07) - expect_equal(x11CodeBased$iterations, x11$iterations, tolerance = 1e-07) - expect_equal(x11CodeBased$overallReject, x11$overallReject, tolerance = 1e-07) - expect_equal(x11CodeBased$rejectPerStage, x11$rejectPerStage, tolerance = 1e-07) - expect_equal(x11CodeBased$futilityPerStage, x11$futilityPerStage, tolerance = 1e-07) - expect_equal(x11CodeBased$earlyStop, x11$earlyStop, tolerance = 1e-07) - expect_equal(x11CodeBased$expectedNumberOfSubjects, x11$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x11CodeBased$sampleSizes, x11$sampleSizes, tolerance = 1e-07) - expect_equal(x11CodeBased$conditionalPowerAchieved, x11$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x11), "character") - df <- as.data.frame(x11) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x11) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x12 <- getSimulationMeans( - seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), - normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), - conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), - stDev = 1.2, directionUpper = FALSE, meanRatio = TRUE, - maxNumberOfIterations = 100, thetaH0 = 0.8 - ) - - ## Comparison of the results of SimulationResultsMeans object 'x12' with expected results - expect_equal(x12$effect, c(-0.7, -0.4, 0), tolerance = 1e-07, label = paste0("c(", paste0(x12$effect, collapse = ", "), ")")) - expect_equal(x12$iterations[1, ], c(100, 100, 100), label = paste0("c(", paste0(x12$iterations[1, ], collapse = ", "), ")")) - expect_equal(x12$iterations[2, ], c(99, 100, 100), label = paste0("c(", paste0(x12$iterations[2, ], collapse = ", "), ")")) - expect_equal(x12$overallReject, c(0.72, 0.45, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(x12$overallReject, collapse = ", "), ")")) - expect_equal(x12$rejectPerStage[1, ], c(0.01, 0, 0), tolerance = 1e-07, label = paste0("c(", paste0(x12$rejectPerStage[1, ], collapse = ", "), ")")) - expect_equal(x12$rejectPerStage[2, ], c(0.71, 0.45, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(x12$rejectPerStage[2, ], collapse = ", "), ")")) - expect_equal(x12$futilityPerStage[1, ], c(0, 0, 0), label = paste0("c(", paste0(x12$futilityPerStage[1, ], collapse = ", "), ")")) - expect_equal(x12$earlyStop, c(0.01, 0, 0), tolerance = 1e-07, label = paste0("c(", paste0(x12$earlyStop, collapse = ", "), ")")) - expect_equal(x12$expectedNumberOfSubjects, c(65.632546, 86.865451, 105.50507), tolerance = 1e-07, label = paste0("c(", paste0(x12$expectedNumberOfSubjects, collapse = ", "), ")")) - expect_equal(x12$sampleSizes[1, ], c(10, 10, 10), label = paste0("c(", paste0(x12$sampleSizes[1, ], collapse = ", "), ")")) - expect_equal(x12$sampleSizes[2, ], c(56.194491, 76.865451, 95.50507), tolerance = 1e-07, label = paste0("c(", paste0(x12$sampleSizes[2, ], collapse = ", "), ")")) - expect_equal(x12$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x12$conditionalPowerAchieved[1, ], collapse = ", "), ")")) - expect_equal(x12$conditionalPowerAchieved[2, ], c(0.52087291, 0.38731069, 0.15906003), tolerance = 1e-07, label = paste0("c(", paste0(x12$conditionalPowerAchieved[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x12), NA))) - expect_output(print(x12)$show()) - invisible(capture.output(expect_error(summary(x12), NA))) - expect_output(summary(x12)$show()) - x12CodeBased <- eval(parse(text = getObjectRCode(x12, stringWrapParagraphWidth = NULL))) - expect_equal(x12CodeBased$effect, x12$effect, tolerance = 1e-07) - expect_equal(x12CodeBased$iterations, x12$iterations, tolerance = 1e-07) - expect_equal(x12CodeBased$overallReject, x12$overallReject, tolerance = 1e-07) - expect_equal(x12CodeBased$rejectPerStage, x12$rejectPerStage, tolerance = 1e-07) - expect_equal(x12CodeBased$futilityPerStage, x12$futilityPerStage, tolerance = 1e-07) - expect_equal(x12CodeBased$earlyStop, x12$earlyStop, tolerance = 1e-07) - expect_equal(x12CodeBased$expectedNumberOfSubjects, x12$expectedNumberOfSubjects, tolerance = 1e-07) - expect_equal(x12CodeBased$sampleSizes, x12$sampleSizes, tolerance = 1e-07) - expect_equal(x12CodeBased$conditionalPowerAchieved, x12$conditionalPowerAchieved, tolerance = 1e-07) - expect_type(names(x12), "character") - df <- as.data.frame(x12) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x12) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - + # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} + # @refFS[Sec.]{fs:sec:simulatingTestingOneHypothesis} + # @refFS[Tab.]{fs:tab:output:getSimulationMeans} + # @refFS[Formula]{fs:simulationOneArmMeansTestStatistics} + # @refFS[Formula]{fs:simulationTwoArmMeansTestStatisticsDiff} + # @refFS[Formula]{fs:simulationTwoArmMeansTestStatisticsRatio} + # @refFS[Formula]{fs:testStatisticGroupSequentialWeightedAverage} + x1 <- getSimulationMeans( + seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), + normalApproximation = TRUE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = TRUE, + maxNumberOfIterations = 100, thetaH0 = 0.05 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x1' with expected results + expect_equal(x1$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0(x1$effect)) + expect_equal(x1$iterations[1, ], c(100, 100, 100), label = paste0(x1$iterations[1, ])) + expect_equal(x1$iterations[2, ], c(100, 99, 93), label = paste0(x1$iterations[2, ])) + expect_equal(x1$overallReject, c(0.02, 0.71, 0.93), tolerance = 1e-07, label = paste0(x1$overallReject)) + expect_equal(x1$rejectPerStage[1, ], c(0, 0.01, 0.07), tolerance = 1e-07, label = paste0(x1$rejectPerStage[1, ])) + expect_equal(x1$rejectPerStage[2, ], c(0.02, 0.7, 0.86), tolerance = 1e-07, label = paste0(x1$rejectPerStage[2, ])) + expect_equal(x1$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x1$futilityPerStage[1, ])) + expect_equal(x1$earlyStop, c(0, 0.01, 0.07), tolerance = 1e-07, label = paste0(x1$earlyStop)) + expect_equal(x1$expectedNumberOfSubjects, c(97.726214, 61.386317, 35.456429), tolerance = 1e-07, label = paste0(x1$expectedNumberOfSubjects)) + expect_equal(x1$sampleSizes[1, ], c(10, 10, 10), label = paste0(x1$sampleSizes[1, ])) + expect_equal(x1$sampleSizes[2, ], c(87.726214, 51.905371, 27.372504), tolerance = 1e-07, label = paste0(x1$sampleSizes[2, ])) + expect_equal(x1$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x1$conditionalPowerAchieved[1, ])) + expect_equal(x1$conditionalPowerAchieved[2, ], c(0.21948944, 0.59945542, 0.74761937), tolerance = 1e-07, label = paste0(x1$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x1), NA))) + expect_output(print(x1)$show()) + invisible(capture.output(expect_error(summary(x1), NA))) + expect_output(summary(x1)$show()) + x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) + expect_equal(x1CodeBased$effect, x1$effect, tolerance = 1e-07) + expect_equal(x1CodeBased$iterations, x1$iterations, tolerance = 1e-07) + expect_equal(x1CodeBased$overallReject, x1$overallReject, tolerance = 1e-07) + expect_equal(x1CodeBased$rejectPerStage, x1$rejectPerStage, tolerance = 1e-07) + expect_equal(x1CodeBased$futilityPerStage, x1$futilityPerStage, tolerance = 1e-07) + expect_equal(x1CodeBased$earlyStop, x1$earlyStop, tolerance = 1e-07) + expect_equal(x1CodeBased$expectedNumberOfSubjects, x1$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x1CodeBased$sampleSizes, x1$sampleSizes, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalPowerAchieved, x1$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x1), "character") + df <- as.data.frame(x1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + .skipTestIfDisabled() + + x2 <- getSimulationMeans( + seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), + normalApproximation = TRUE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = FALSE, + maxNumberOfIterations = 100, thetaH0 = 0.8 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x2' with expected results + expect_equal(x2$effect, c(-0.8, -0.4, 0), tolerance = 1e-07, label = paste0(x2$effect)) + expect_equal(x2$iterations[1, ], c(100, 100, 100), label = paste0(x2$iterations[1, ])) + expect_equal(x2$iterations[2, ], c(92, 98, 100), label = paste0(x2$iterations[2, ])) + expect_equal(x2$overallReject, c(0.94, 0.81, 0.07), tolerance = 1e-07, label = paste0(x2$overallReject)) + expect_equal(x2$rejectPerStage[1, ], c(0.08, 0.02, 0), tolerance = 1e-07, label = paste0(x2$rejectPerStage[1, ])) + expect_equal(x2$rejectPerStage[2, ], c(0.86, 0.79, 0.07), tolerance = 1e-07, label = paste0(x2$rejectPerStage[2, ])) + expect_equal(x2$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x2$futilityPerStage[1, ])) + expect_equal(x2$earlyStop, c(0.08, 0.02, 0), tolerance = 1e-07, label = paste0(x2$earlyStop)) + expect_equal(x2$expectedNumberOfSubjects, c(30.529806, 74.585778, 94.761842), tolerance = 1e-07, label = paste0(x2$expectedNumberOfSubjects)) + expect_equal(x2$sampleSizes[1, ], c(10, 10, 10), label = paste0(x2$sampleSizes[1, ])) + expect_equal(x2$sampleSizes[2, ], c(22.315007, 65.903855, 84.761842), tolerance = 1e-07, label = paste0(x2$sampleSizes[2, ])) + expect_equal(x2$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x2$conditionalPowerAchieved[1, ])) + expect_equal(x2$conditionalPowerAchieved[2, ], c(0.78002751, 0.51035441, 0.27866093), tolerance = 1e-07, label = paste0(x2$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x2), NA))) + expect_output(print(x2)$show()) + invisible(capture.output(expect_error(summary(x2), NA))) + expect_output(summary(x2)$show()) + x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) + expect_equal(x2CodeBased$effect, x2$effect, tolerance = 1e-07) + expect_equal(x2CodeBased$iterations, x2$iterations, tolerance = 1e-07) + expect_equal(x2CodeBased$overallReject, x2$overallReject, tolerance = 1e-07) + expect_equal(x2CodeBased$rejectPerStage, x2$rejectPerStage, tolerance = 1e-07) + expect_equal(x2CodeBased$futilityPerStage, x2$futilityPerStage, tolerance = 1e-07) + expect_equal(x2CodeBased$earlyStop, x2$earlyStop, tolerance = 1e-07) + expect_equal(x2CodeBased$expectedNumberOfSubjects, x2$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x2CodeBased$sampleSizes, x2$sampleSizes, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalPowerAchieved, x2$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x2), "character") + df <- as.data.frame(x2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x3 <- getSimulationMeans( + seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), + normalApproximation = FALSE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = TRUE, + maxNumberOfIterations = 100, thetaH0 = 0.05 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x3' with expected results + expect_equal(x3$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0(x3$effect)) + expect_equal(x3$iterations[1, ], c(100, 100, 100), label = paste0(x3$iterations[1, ])) + expect_equal(x3$iterations[2, ], c(100, 100, 98), label = paste0(x3$iterations[2, ])) + expect_equal(x3$overallReject, c(0.01, 0.68, 0.94), tolerance = 1e-07, label = paste0(x3$overallReject)) + expect_equal(x3$rejectPerStage[1, ], c(0, 0, 0.02), tolerance = 1e-07, label = paste0(x3$rejectPerStage[1, ])) + expect_equal(x3$rejectPerStage[2, ], c(0.01, 0.68, 0.92), tolerance = 1e-07, label = paste0(x3$rejectPerStage[2, ])) + expect_equal(x3$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x3$futilityPerStage[1, ])) + expect_equal(x3$earlyStop, c(0, 0, 0.02), tolerance = 1e-07, label = paste0(x3$earlyStop)) + expect_equal(x3$expectedNumberOfSubjects, c(99.571933, 69.623473, 35.859349), tolerance = 1e-07, label = paste0(x3$expectedNumberOfSubjects)) + expect_equal(x3$sampleSizes[1, ], c(10, 10, 10), label = paste0(x3$sampleSizes[1, ])) + expect_equal(x3$sampleSizes[2, ], c(89.571933, 59.623473, 26.38709), tolerance = 1e-07, label = paste0(x3$sampleSizes[2, ])) + expect_equal(x3$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x3$conditionalPowerAchieved[1, ])) + expect_equal(x3$conditionalPowerAchieved[2, ], c(0.17531256, 0.54483038, 0.79325539), tolerance = 1e-07, label = paste0(x3$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x3), NA))) + expect_output(print(x3)$show()) + invisible(capture.output(expect_error(summary(x3), NA))) + expect_output(summary(x3)$show()) + x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) + expect_equal(x3CodeBased$effect, x3$effect, tolerance = 1e-07) + expect_equal(x3CodeBased$iterations, x3$iterations, tolerance = 1e-07) + expect_equal(x3CodeBased$overallReject, x3$overallReject, tolerance = 1e-07) + expect_equal(x3CodeBased$rejectPerStage, x3$rejectPerStage, tolerance = 1e-07) + expect_equal(x3CodeBased$futilityPerStage, x3$futilityPerStage, tolerance = 1e-07) + expect_equal(x3CodeBased$earlyStop, x3$earlyStop, tolerance = 1e-07) + expect_equal(x3CodeBased$expectedNumberOfSubjects, x3$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x3CodeBased$sampleSizes, x3$sampleSizes, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalPowerAchieved, x3$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x3), "character") + df <- as.data.frame(x3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x4 <- getSimulationMeans( + seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), + normalApproximation = FALSE, groups = 1, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = FALSE, + maxNumberOfIterations = 100, thetaH0 = 0.8 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x4' with expected results + expect_equal(x4$effect, c(-0.8, -0.4, 0), tolerance = 1e-07, label = paste0(x4$effect)) + expect_equal(x4$iterations[1, ], c(100, 100, 100), label = paste0(x4$iterations[1, ])) + expect_equal(x4$iterations[2, ], c(97, 100, 100), label = paste0(x4$iterations[2, ])) + expect_equal(x4$overallReject, c(0.92, 0.78, 0.02), tolerance = 1e-07, label = paste0(x4$overallReject)) + expect_equal(x4$rejectPerStage[1, ], c(0.03, 0, 0), tolerance = 1e-07, label = paste0(x4$rejectPerStage[1, ])) + expect_equal(x4$rejectPerStage[2, ], c(0.89, 0.78, 0.02), tolerance = 1e-07, label = paste0(x4$rejectPerStage[2, ])) + expect_equal(x4$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x4$futilityPerStage[1, ])) + expect_equal(x4$earlyStop, c(0.03, 0, 0), tolerance = 1e-07, label = paste0(x4$earlyStop)) + expect_equal(x4$expectedNumberOfSubjects, c(34.808208, 66.656932, 104.30185), tolerance = 1e-07, label = paste0(x4$expectedNumberOfSubjects)) + expect_equal(x4$sampleSizes[1, ], c(10, 10, 10), label = paste0(x4$sampleSizes[1, ])) + expect_equal(x4$sampleSizes[2, ], c(25.575472, 56.656932, 94.301853), tolerance = 1e-07, label = paste0(x4$sampleSizes[2, ])) + expect_equal(x4$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x4$conditionalPowerAchieved[1, ])) + expect_equal(x4$conditionalPowerAchieved[2, ], c(0.78184392, 0.58902983, 0.17869551), tolerance = 1e-07, label = paste0(x4$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x4), NA))) + expect_output(print(x4)$show()) + invisible(capture.output(expect_error(summary(x4), NA))) + expect_output(summary(x4)$show()) + x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) + expect_equal(x4CodeBased$effect, x4$effect, tolerance = 1e-07) + expect_equal(x4CodeBased$iterations, x4$iterations, tolerance = 1e-07) + expect_equal(x4CodeBased$overallReject, x4$overallReject, tolerance = 1e-07) + expect_equal(x4CodeBased$rejectPerStage, x4$rejectPerStage, tolerance = 1e-07) + expect_equal(x4CodeBased$futilityPerStage, x4$futilityPerStage, tolerance = 1e-07) + expect_equal(x4CodeBased$earlyStop, x4$earlyStop, tolerance = 1e-07) + expect_equal(x4CodeBased$expectedNumberOfSubjects, x4$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x4CodeBased$sampleSizes, x4$sampleSizes, tolerance = 1e-07) + expect_equal(x4CodeBased$conditionalPowerAchieved, x4$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x4), "character") + df <- as.data.frame(x4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x5 <- getSimulationMeans( + seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), + normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = TRUE, meanRatio = FALSE, + maxNumberOfIterations = 100, thetaH0 = 0.05 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x5' with expected results + expect_equal(x5$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0(x5$effect)) + expect_equal(x5$iterations[1, ], c(100, 100, 100), label = paste0(x5$iterations[1, ])) + expect_equal(x5$iterations[2, ], c(100, 100, 100), label = paste0(x5$iterations[2, ])) + expect_equal(x5$overallReject, c(0.03, 0.36, 0.74), tolerance = 1e-07, label = paste0(x5$overallReject)) + expect_equal(x5$rejectPerStage[1, ], c(0, 0, 0), label = paste0(x5$rejectPerStage[1, ])) + expect_equal(x5$rejectPerStage[2, ], c(0.03, 0.36, 0.74), tolerance = 1e-07, label = paste0(x5$rejectPerStage[2, ])) + expect_equal(x5$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x5$futilityPerStage[1, ])) + expect_equal(x5$earlyStop, c(0, 0, 0), label = paste0(x5$earlyStop)) + expect_equal(x5$expectedNumberOfSubjects, c(96.372889, 89.619156, 71.907268), tolerance = 1e-07, label = paste0(x5$expectedNumberOfSubjects)) + expect_equal(x5$sampleSizes[1, ], c(10, 10, 10), label = paste0(x5$sampleSizes[1, ])) + expect_equal(x5$sampleSizes[2, ], c(86.372889, 79.619156, 61.907268), tolerance = 1e-07, label = paste0(x5$sampleSizes[2, ])) + expect_equal(x5$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x5$conditionalPowerAchieved[1, ])) + expect_equal(x5$conditionalPowerAchieved[2, ], c(0.23254121, 0.37156759, 0.50696796), tolerance = 1e-07, label = paste0(x5$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x5), NA))) + expect_output(print(x5)$show()) + invisible(capture.output(expect_error(summary(x5), NA))) + expect_output(summary(x5)$show()) + x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) + expect_equal(x5CodeBased$effect, x5$effect, tolerance = 1e-07) + expect_equal(x5CodeBased$iterations, x5$iterations, tolerance = 1e-07) + expect_equal(x5CodeBased$overallReject, x5$overallReject, tolerance = 1e-07) + expect_equal(x5CodeBased$rejectPerStage, x5$rejectPerStage, tolerance = 1e-07) + expect_equal(x5CodeBased$futilityPerStage, x5$futilityPerStage, tolerance = 1e-07) + expect_equal(x5CodeBased$earlyStop, x5$earlyStop, tolerance = 1e-07) + expect_equal(x5CodeBased$expectedNumberOfSubjects, x5$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x5CodeBased$sampleSizes, x5$sampleSizes, tolerance = 1e-07) + expect_equal(x5CodeBased$conditionalPowerAchieved, x5$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x5), "character") + df <- as.data.frame(x5) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x5) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x6 <- getSimulationMeans( + seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), + normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = FALSE, meanRatio = FALSE, + maxNumberOfIterations = 100, thetaH0 = 0.8 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x6' with expected results + expect_equal(x6$effect, c(-0.8, -0.4, 0), tolerance = 1e-07, label = paste0(x6$effect)) + expect_equal(x6$iterations[1, ], c(100, 100, 100), label = paste0(x6$iterations[1, ])) + expect_equal(x6$iterations[2, ], c(98, 98, 100), label = paste0(x6$iterations[2, ])) + expect_equal(x6$overallReject, c(0.79, 0.36, 0.06), tolerance = 1e-07, label = paste0(x6$overallReject)) + expect_equal(x6$rejectPerStage[1, ], c(0.02, 0.02, 0), tolerance = 1e-07, label = paste0(x6$rejectPerStage[1, ])) + expect_equal(x6$rejectPerStage[2, ], c(0.77, 0.34, 0.06), tolerance = 1e-07, label = paste0(x6$rejectPerStage[2, ])) + expect_equal(x6$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x6$futilityPerStage[1, ])) + expect_equal(x6$earlyStop, c(0.02, 0.02, 0), tolerance = 1e-07, label = paste0(x6$earlyStop)) + expect_equal(x6$expectedNumberOfSubjects, c(61.262488, 89.754099, 94.761842), tolerance = 1e-07, label = paste0(x6$expectedNumberOfSubjects)) + expect_equal(x6$sampleSizes[1, ], c(10, 10, 10), label = paste0(x6$sampleSizes[1, ])) + expect_equal(x6$sampleSizes[2, ], c(52.308661, 81.381734, 84.761842), tolerance = 1e-07, label = paste0(x6$sampleSizes[2, ])) + expect_equal(x6$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x6$conditionalPowerAchieved[1, ])) + expect_equal(x6$conditionalPowerAchieved[2, ], c(0.57015973, 0.32347024, 0.27139992), tolerance = 1e-07, label = paste0(x6$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x6), NA))) + expect_output(print(x6)$show()) + invisible(capture.output(expect_error(summary(x6), NA))) + expect_output(summary(x6)$show()) + x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) + expect_equal(x6CodeBased$effect, x6$effect, tolerance = 1e-07) + expect_equal(x6CodeBased$iterations, x6$iterations, tolerance = 1e-07) + expect_equal(x6CodeBased$overallReject, x6$overallReject, tolerance = 1e-07) + expect_equal(x6CodeBased$rejectPerStage, x6$rejectPerStage, tolerance = 1e-07) + expect_equal(x6CodeBased$futilityPerStage, x6$futilityPerStage, tolerance = 1e-07) + expect_equal(x6CodeBased$earlyStop, x6$earlyStop, tolerance = 1e-07) + expect_equal(x6CodeBased$expectedNumberOfSubjects, x6$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x6CodeBased$sampleSizes, x6$sampleSizes, tolerance = 1e-07) + expect_equal(x6CodeBased$conditionalPowerAchieved, x6$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x6), "character") + df <- as.data.frame(x6) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x6) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x7 <- getSimulationMeans( + seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), + normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = TRUE, meanRatio = FALSE, + maxNumberOfIterations = 100, thetaH0 = 0.05 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x7' with expected results + expect_equal(x7$effect, c(-0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0(x7$effect)) + expect_equal(x7$iterations[1, ], c(100, 100, 100), label = paste0(x7$iterations[1, ])) + expect_equal(x7$iterations[2, ], c(100, 100, 99), label = paste0(x7$iterations[2, ])) + expect_equal(x7$overallReject, c(0.01, 0.23, 0.83), tolerance = 1e-07, label = paste0(x7$overallReject)) + expect_equal(x7$rejectPerStage[1, ], c(0, 0, 0.01), tolerance = 1e-07, label = paste0(x7$rejectPerStage[1, ])) + expect_equal(x7$rejectPerStage[2, ], c(0.01, 0.23, 0.82), tolerance = 1e-07, label = paste0(x7$rejectPerStage[2, ])) + expect_equal(x7$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x7$futilityPerStage[1, ])) + expect_equal(x7$earlyStop, c(0, 0, 0.01), tolerance = 1e-07, label = paste0(x7$earlyStop)) + expect_equal(x7$expectedNumberOfSubjects, c(99.874349, 85.385224, 62.337209), tolerance = 1e-07, label = paste0(x7$expectedNumberOfSubjects)) + expect_equal(x7$sampleSizes[1, ], c(10, 10, 10), label = paste0(x7$sampleSizes[1, ])) + expect_equal(x7$sampleSizes[2, ], c(89.874349, 75.385224, 52.865867), tolerance = 1e-07, label = paste0(x7$sampleSizes[2, ])) + expect_equal(x7$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x7$conditionalPowerAchieved[1, ])) + expect_equal(x7$conditionalPowerAchieved[2, ], c(0.19979349, 0.40152955, 0.59344307), tolerance = 1e-07, label = paste0(x7$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x7), NA))) + expect_output(print(x7)$show()) + invisible(capture.output(expect_error(summary(x7), NA))) + expect_output(summary(x7)$show()) + x7CodeBased <- eval(parse(text = getObjectRCode(x7, stringWrapParagraphWidth = NULL))) + expect_equal(x7CodeBased$effect, x7$effect, tolerance = 1e-07) + expect_equal(x7CodeBased$iterations, x7$iterations, tolerance = 1e-07) + expect_equal(x7CodeBased$overallReject, x7$overallReject, tolerance = 1e-07) + expect_equal(x7CodeBased$rejectPerStage, x7$rejectPerStage, tolerance = 1e-07) + expect_equal(x7CodeBased$futilityPerStage, x7$futilityPerStage, tolerance = 1e-07) + expect_equal(x7CodeBased$earlyStop, x7$earlyStop, tolerance = 1e-07) + expect_equal(x7CodeBased$expectedNumberOfSubjects, x7$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x7CodeBased$sampleSizes, x7$sampleSizes, tolerance = 1e-07) + expect_equal(x7CodeBased$conditionalPowerAchieved, x7$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x7), "character") + df <- as.data.frame(x7) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x7) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x8 <- getSimulationMeans( + seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), + normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = FALSE, meanRatio = TRUE, + maxNumberOfIterations = 100, thetaH0 = 0.8 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x8' with expected results + expect_equal(x8$effect, c(-0.7, -0.4, 0), tolerance = 1e-07, label = paste0(x8$effect)) + expect_equal(x8$iterations[1, ], c(100, 100, 100), label = paste0(x8$iterations[1, ])) + expect_equal(x8$iterations[2, ], c(99, 100, 100), label = paste0(x8$iterations[2, ])) + expect_equal(x8$overallReject, c(0.72, 0.45, 0.01), tolerance = 1e-07, label = paste0(x8$overallReject)) + expect_equal(x8$rejectPerStage[1, ], c(0.01, 0, 0), tolerance = 1e-07, label = paste0(x8$rejectPerStage[1, ])) + expect_equal(x8$rejectPerStage[2, ], c(0.71, 0.45, 0.01), tolerance = 1e-07, label = paste0(x8$rejectPerStage[2, ])) + expect_equal(x8$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x8$futilityPerStage[1, ])) + expect_equal(x8$earlyStop, c(0.01, 0, 0), tolerance = 1e-07, label = paste0(x8$earlyStop)) + expect_equal(x8$expectedNumberOfSubjects, c(65.632546, 86.865451, 105.50507), tolerance = 1e-07, label = paste0(x8$expectedNumberOfSubjects)) + expect_equal(x8$sampleSizes[1, ], c(10, 10, 10), label = paste0(x8$sampleSizes[1, ])) + expect_equal(x8$sampleSizes[2, ], c(56.194491, 76.865451, 95.50507), tolerance = 1e-07, label = paste0(x8$sampleSizes[2, ])) + expect_equal(x8$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x8$conditionalPowerAchieved[1, ])) + expect_equal(x8$conditionalPowerAchieved[2, ], c(0.54121667, 0.404747, 0.16826779), tolerance = 1e-07, label = paste0(x8$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x8), NA))) + expect_output(print(x8)$show()) + invisible(capture.output(expect_error(summary(x8), NA))) + expect_output(summary(x8)$show()) + x8CodeBased <- eval(parse(text = getObjectRCode(x8, stringWrapParagraphWidth = NULL))) + expect_equal(x8CodeBased$effect, x8$effect, tolerance = 1e-07) + expect_equal(x8CodeBased$iterations, x8$iterations, tolerance = 1e-07) + expect_equal(x8CodeBased$overallReject, x8$overallReject, tolerance = 1e-07) + expect_equal(x8CodeBased$rejectPerStage, x8$rejectPerStage, tolerance = 1e-07) + expect_equal(x8CodeBased$futilityPerStage, x8$futilityPerStage, tolerance = 1e-07) + expect_equal(x8CodeBased$earlyStop, x8$earlyStop, tolerance = 1e-07) + expect_equal(x8CodeBased$expectedNumberOfSubjects, x8$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x8CodeBased$sampleSizes, x8$sampleSizes, tolerance = 1e-07) + expect_equal(x8CodeBased$conditionalPowerAchieved, x8$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x8), "character") + df <- as.data.frame(x8) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x8) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x9 <- getSimulationMeans( + seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), + normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = TRUE, meanRatio = TRUE, + maxNumberOfIterations = 100, thetaH0 = 0.05 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x9' with expected results + expect_equal(x9$effect, c(0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0(x9$effect)) + expect_equal(x9$iterations[1, ], c(100, 100, 100), label = paste0(x9$iterations[1, ])) + expect_equal(x9$iterations[2, ], c(100, 99, 98), label = paste0(x9$iterations[2, ])) + expect_equal(x9$overallReject, c(0.09, 0.44, 0.85), tolerance = 1e-07, label = paste0(x9$overallReject)) + expect_equal(x9$rejectPerStage[1, ], c(0, 0.01, 0.02), tolerance = 1e-07, label = paste0(x9$rejectPerStage[1, ])) + expect_equal(x9$rejectPerStage[2, ], c(0.09, 0.43, 0.83), tolerance = 1e-07, label = paste0(x9$rejectPerStage[2, ])) + expect_equal(x9$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x9$futilityPerStage[1, ])) + expect_equal(x9$earlyStop, c(0, 0.01, 0.02), tolerance = 1e-07, label = paste0(x9$earlyStop)) + expect_equal(x9$expectedNumberOfSubjects, c(93.166381, 72.993336, 56.443486), tolerance = 1e-07, label = paste0(x9$expectedNumberOfSubjects)) + expect_equal(x9$sampleSizes[1, ], c(10, 10, 10), label = paste0(x9$sampleSizes[1, ])) + expect_equal(x9$sampleSizes[2, ], c(83.166381, 63.629633, 47.391312), tolerance = 1e-07, label = paste0(x9$sampleSizes[2, ])) + expect_equal(x9$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x9$conditionalPowerAchieved[1, ])) + expect_equal(x9$conditionalPowerAchieved[2, ], c(0.26603921, 0.53043264, 0.62119237), tolerance = 1e-07, label = paste0(x9$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x9), NA))) + expect_output(print(x9)$show()) + invisible(capture.output(expect_error(summary(x9), NA))) + expect_output(summary(x9)$show()) + x9CodeBased <- eval(parse(text = getObjectRCode(x9, stringWrapParagraphWidth = NULL))) + expect_equal(x9CodeBased$effect, x9$effect, tolerance = 1e-07) + expect_equal(x9CodeBased$iterations, x9$iterations, tolerance = 1e-07) + expect_equal(x9CodeBased$overallReject, x9$overallReject, tolerance = 1e-07) + expect_equal(x9CodeBased$rejectPerStage, x9$rejectPerStage, tolerance = 1e-07) + expect_equal(x9CodeBased$futilityPerStage, x9$futilityPerStage, tolerance = 1e-07) + expect_equal(x9CodeBased$earlyStop, x9$earlyStop, tolerance = 1e-07) + expect_equal(x9CodeBased$expectedNumberOfSubjects, x9$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x9CodeBased$sampleSizes, x9$sampleSizes, tolerance = 1e-07) + expect_equal(x9CodeBased$conditionalPowerAchieved, x9$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x9), "character") + df <- as.data.frame(x9) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x9) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x10 <- getSimulationMeans( + seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), + normalApproximation = TRUE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = FALSE, meanRatio = TRUE, + maxNumberOfIterations = 100, thetaH0 = 0.8 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x10' with expected results + expect_equal(x10$effect, c(-0.7, -0.4, 0), tolerance = 1e-07, label = paste0(x10$effect)) + expect_equal(x10$iterations[1, ], c(100, 100, 100), label = paste0(x10$iterations[1, ])) + expect_equal(x10$iterations[2, ], c(98, 98, 100), label = paste0(x10$iterations[2, ])) + expect_equal(x10$overallReject, c(0.76, 0.42, 0.06), tolerance = 1e-07, label = paste0(x10$overallReject)) + expect_equal(x10$rejectPerStage[1, ], c(0.02, 0.02, 0), tolerance = 1e-07, label = paste0(x10$rejectPerStage[1, ])) + expect_equal(x10$rejectPerStage[2, ], c(0.74, 0.4, 0.06), tolerance = 1e-07, label = paste0(x10$rejectPerStage[2, ])) + expect_equal(x10$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x10$futilityPerStage[1, ])) + expect_equal(x10$earlyStop, c(0.02, 0.02, 0), tolerance = 1e-07, label = paste0(x10$earlyStop)) + expect_equal(x10$expectedNumberOfSubjects, c(62.435526, 88.169977, 94.761842), tolerance = 1e-07, label = paste0(x10$expectedNumberOfSubjects)) + expect_equal(x10$sampleSizes[1, ], c(10, 10, 10), label = paste0(x10$sampleSizes[1, ])) + expect_equal(x10$sampleSizes[2, ], c(53.505639, 79.765282, 84.761842), tolerance = 1e-07, label = paste0(x10$sampleSizes[2, ])) + expect_equal(x10$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x10$conditionalPowerAchieved[1, ])) + expect_equal(x10$conditionalPowerAchieved[2, ], c(0.56217158, 0.33884596, 0.27139992), tolerance = 1e-07, label = paste0(x10$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x10), NA))) + expect_output(print(x10)$show()) + invisible(capture.output(expect_error(summary(x10), NA))) + expect_output(summary(x10)$show()) + x10CodeBased <- eval(parse(text = getObjectRCode(x10, stringWrapParagraphWidth = NULL))) + expect_equal(x10CodeBased$effect, x10$effect, tolerance = 1e-07) + expect_equal(x10CodeBased$iterations, x10$iterations, tolerance = 1e-07) + expect_equal(x10CodeBased$overallReject, x10$overallReject, tolerance = 1e-07) + expect_equal(x10CodeBased$rejectPerStage, x10$rejectPerStage, tolerance = 1e-07) + expect_equal(x10CodeBased$futilityPerStage, x10$futilityPerStage, tolerance = 1e-07) + expect_equal(x10CodeBased$earlyStop, x10$earlyStop, tolerance = 1e-07) + expect_equal(x10CodeBased$expectedNumberOfSubjects, x10$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x10CodeBased$sampleSizes, x10$sampleSizes, tolerance = 1e-07) + expect_equal(x10CodeBased$conditionalPowerAchieved, x10$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x10), "character") + df <- as.data.frame(x10) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x10) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x11 <- getSimulationMeans( + seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), + normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = TRUE, meanRatio = TRUE, + maxNumberOfIterations = 100, thetaH0 = 0.05 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x11' with expected results + expect_equal(x11$effect, c(0.05, 0.35, 0.75), tolerance = 1e-07, label = paste0(x11$effect)) + expect_equal(x11$iterations[1, ], c(100, 100, 100), label = paste0(x11$iterations[1, ])) + expect_equal(x11$iterations[2, ], c(100, 100, 98), label = paste0(x11$iterations[2, ])) + expect_equal(x11$overallReject, c(0.12, 0.39, 0.87), tolerance = 1e-07, label = paste0(x11$overallReject)) + expect_equal(x11$rejectPerStage[1, ], c(0, 0, 0.02), tolerance = 1e-07, label = paste0(x11$rejectPerStage[1, ])) + expect_equal(x11$rejectPerStage[2, ], c(0.12, 0.39, 0.85), tolerance = 1e-07, label = paste0(x11$rejectPerStage[2, ])) + expect_equal(x11$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x11$futilityPerStage[1, ])) + expect_equal(x11$earlyStop, c(0, 0, 0.02), tolerance = 1e-07, label = paste0(x11$earlyStop)) + expect_equal(x11$expectedNumberOfSubjects, c(97.820553, 79.30135, 45.942964), tolerance = 1e-07, label = paste0(x11$expectedNumberOfSubjects)) + expect_equal(x11$sampleSizes[1, ], c(10, 10, 10), label = paste0(x11$sampleSizes[1, ])) + expect_equal(x11$sampleSizes[2, ], c(87.820553, 69.30135, 36.676494), tolerance = 1e-07, label = paste0(x11$sampleSizes[2, ])) + expect_equal(x11$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x11$conditionalPowerAchieved[1, ])) + expect_equal(x11$conditionalPowerAchieved[2, ], c(0.24692411, 0.46371008, 0.71242546), tolerance = 1e-07, label = paste0(x11$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x11), NA))) + expect_output(print(x11)$show()) + invisible(capture.output(expect_error(summary(x11), NA))) + expect_output(summary(x11)$show()) + x11CodeBased <- eval(parse(text = getObjectRCode(x11, stringWrapParagraphWidth = NULL))) + expect_equal(x11CodeBased$effect, x11$effect, tolerance = 1e-07) + expect_equal(x11CodeBased$iterations, x11$iterations, tolerance = 1e-07) + expect_equal(x11CodeBased$overallReject, x11$overallReject, tolerance = 1e-07) + expect_equal(x11CodeBased$rejectPerStage, x11$rejectPerStage, tolerance = 1e-07) + expect_equal(x11CodeBased$futilityPerStage, x11$futilityPerStage, tolerance = 1e-07) + expect_equal(x11CodeBased$earlyStop, x11$earlyStop, tolerance = 1e-07) + expect_equal(x11CodeBased$expectedNumberOfSubjects, x11$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x11CodeBased$sampleSizes, x11$sampleSizes, tolerance = 1e-07) + expect_equal(x11CodeBased$conditionalPowerAchieved, x11$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x11), "character") + df <- as.data.frame(x11) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x11) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x12 <- getSimulationMeans( + seed = 1234, getDesignGroupSequential(informationRates = c(0.3333, 1)), + normalApproximation = FALSE, groups = 2, plannedSubjects = c(10, 30), alternative = c(0.1, 0.4, 0.8), + conditionalPower = 0.8, minNumberOfSubjectsPerStage = c(10, 4), maxNumberOfSubjectsPerStage = c(10, 100), + stDev = 1.2, directionUpper = FALSE, meanRatio = TRUE, + maxNumberOfIterations = 100, thetaH0 = 0.8 + ) + + ## Comparison of the results of SimulationResultsMeans object 'x12' with expected results + expect_equal(x12$effect, c(-0.7, -0.4, 0), tolerance = 1e-07, label = paste0(x12$effect)) + expect_equal(x12$iterations[1, ], c(100, 100, 100), label = paste0(x12$iterations[1, ])) + expect_equal(x12$iterations[2, ], c(99, 100, 100), label = paste0(x12$iterations[2, ])) + expect_equal(x12$overallReject, c(0.72, 0.45, 0.01), tolerance = 1e-07, label = paste0(x12$overallReject)) + expect_equal(x12$rejectPerStage[1, ], c(0.01, 0, 0), tolerance = 1e-07, label = paste0(x12$rejectPerStage[1, ])) + expect_equal(x12$rejectPerStage[2, ], c(0.71, 0.45, 0.01), tolerance = 1e-07, label = paste0(x12$rejectPerStage[2, ])) + expect_equal(x12$futilityPerStage[1, ], c(0, 0, 0), label = paste0(x12$futilityPerStage[1, ])) + expect_equal(x12$earlyStop, c(0.01, 0, 0), tolerance = 1e-07, label = paste0(x12$earlyStop)) + expect_equal(x12$expectedNumberOfSubjects, c(65.632546, 86.865451, 105.50507), tolerance = 1e-07, label = paste0(x12$expectedNumberOfSubjects)) + expect_equal(x12$sampleSizes[1, ], c(10, 10, 10), label = paste0(x12$sampleSizes[1, ])) + expect_equal(x12$sampleSizes[2, ], c(56.194491, 76.865451, 95.50507), tolerance = 1e-07, label = paste0(x12$sampleSizes[2, ])) + expect_equal(x12$conditionalPowerAchieved[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0(x12$conditionalPowerAchieved[1, ])) + expect_equal(x12$conditionalPowerAchieved[2, ], c(0.54121667, 0.404747, 0.16826779), tolerance = 1e-07, label = paste0(x12$conditionalPowerAchieved[2, ])) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x12), NA))) + expect_output(print(x12)$show()) + invisible(capture.output(expect_error(summary(x12), NA))) + expect_output(summary(x12)$show()) + x12CodeBased <- eval(parse(text = getObjectRCode(x12, stringWrapParagraphWidth = NULL))) + expect_equal(x12CodeBased$effect, x12$effect, tolerance = 1e-07) + expect_equal(x12CodeBased$iterations, x12$iterations, tolerance = 1e-07) + expect_equal(x12CodeBased$overallReject, x12$overallReject, tolerance = 1e-07) + expect_equal(x12CodeBased$rejectPerStage, x12$rejectPerStage, tolerance = 1e-07) + expect_equal(x12CodeBased$futilityPerStage, x12$futilityPerStage, tolerance = 1e-07) + expect_equal(x12CodeBased$earlyStop, x12$earlyStop, tolerance = 1e-07) + expect_equal(x12CodeBased$expectedNumberOfSubjects, x12$expectedNumberOfSubjects, tolerance = 1e-07) + expect_equal(x12CodeBased$sampleSizes, x12$sampleSizes, tolerance = 1e-07) + expect_equal(x12CodeBased$conditionalPowerAchieved, x12$conditionalPowerAchieved, tolerance = 1e-07) + expect_type(names(x12), "character") + df <- as.data.frame(x12) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x12) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } }) test_that("'getSimulationMeans': comparison with getPowerMeans() results", { + # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} + # @refFS[Sec.]{fs:sec:simulatingTestingOneHypothesis} + # @refFS[Tab.]{fs:tab:output:getSimulationMeans} + # @refFS[Formula]{fs:simulationOneArmMeansTestStatistics} + # @refFS[Formula]{fs:simulationTwoArmMeansTestStatisticsDiff} + # @refFS[Formula]{fs:simulationTwoArmMeansTestStatisticsRatio} + # @refFS[Formula]{fs:testStatisticNormalCombinationTest} + .skipTestIfDisabled() + + x1 <- getSimulationMeans( + seed = 1234, design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = c(0.2, 0.5, 1)), groups = 2, meanRatio = TRUE, thetaH0 = 0.4, + plannedSubjects = c(40, 100, 200), maxNumberOfIterations = 1000, allocationRatioPlanned = 3, stDev = 1.5 + ) + y1 <- getPowerMeans( + design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = c(0.2, 0.5, 1)), groups = 2, meanRatio = TRUE, thetaH0 = 0.4, + maxNumberOfSubjects = 200, allocationRatioPlanned = 3, stDev = 1.5, normalApproximation = TRUE + ) - # @refFS[Sec.]{fs:sec:reproducibilityOfSimulationResults} - # @refFS[Sec.]{fs:sec:simulatingTestingOneHypothesis} - # @refFS[Tab.]{fs:tab:output:getSimulationMeans} - # @refFS[Formula]{fs:simulationOneArmMeansTestStatistics} - # @refFS[Formula]{fs:simulationTwoArmMeansTestStatisticsDiff} - # @refFS[Formula]{fs:simulationTwoArmMeansTestStatisticsRatio} - # @refFS[Formula]{fs:testStatisticNormalCombinationTest} - .skipTestIfDisabled() - - x1 <- getSimulationMeans( - seed = 1234, design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = c(0.2, 0.5, 1)), groups = 2, meanRatio = TRUE, thetaH0 = 0.4, - plannedSubjects = c(40, 100, 200), maxNumberOfIterations = 1000, allocationRatioPlanned = 3, stDev = 1.5 - ) - y1 <- getPowerMeans( - design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = c(0.2, 0.5, 1)), groups = 2, meanRatio = TRUE, thetaH0 = 0.4, - maxNumberOfSubjects = 200, allocationRatioPlanned = 3, stDev = 1.5, normalApproximation = TRUE - ) + expectedNumberOfSubjectsDiff <- round((x1$expectedNumberOfSubjects - y1$expectedNumberOfSubjects) / 200, 4) - expectedNumberOfSubjectsDiff <- round((x1$expectedNumberOfSubjects - y1$expectedNumberOfSubjects) / 200, 4) + ## Comparison of the results of numeric object 'expectedNumberOfSubjectsDiff' with expected results + expect_equal(expectedNumberOfSubjectsDiff, c(0.0027, 0.0092, 0.0016, -0.0071, 0.0018, 0.0013), tolerance = 1e-07, label = paste0(expectedNumberOfSubjectsDiff)) - ## Comparison of the results of numeric object 'expectedNumberOfSubjectsDiff' with expected results - expect_equal(expectedNumberOfSubjectsDiff, c(0.0027, 0.0092, 0.0016, -0.0071, 0.0018, 0.0013), tolerance = 1e-07, label = paste0("c(", paste0(expectedNumberOfSubjectsDiff, collapse = ", "), ")")) + overallRejectDiff1 <- round(x1$overallReject - y1$overallReject, 4) - overallRejectDiff1 <- round(x1$overallReject - y1$overallReject, 4) + ## Comparison of the results of numeric object 'overallRejectDiff1' with expected results + expect_equal(overallRejectDiff1, c(-0.0018, 0.0015, 2e-04, 0, 0, 0), tolerance = 1e-07, label = paste0(overallRejectDiff1)) - ## Comparison of the results of numeric object 'overallRejectDiff1' with expected results - expect_equal(overallRejectDiff1, c(-0.0018, 0.0015, 2e-04, 0, 0, 0), tolerance = 1e-07, label = paste0("c(", paste0(overallRejectDiff1, collapse = ", "), ")")) + futilityStopDiff1 <- round(x1$futilityStop - y1$futilityStop, 4) - futilityStopDiff1 <- round(x1$futilityStop - y1$futilityStop, 4) + ## Comparison of the results of numeric object 'futilityStopDiff1' with expected results + expect_equal(futilityStopDiff1, c(0.003, -0.0012, -2e-04, 0, 0, 0), tolerance = 1e-07, label = paste0(futilityStopDiff1)) + + x2 <- getSimulationMeans( + seed = 1234, design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = c(0.2, 0.5, 1)), groups = 2, meanRatio = FALSE, thetaH0 = 0.2, + plannedSubjects = c(40, 100, 200), maxNumberOfIterations = 1000, allocationRatioPlanned = 3, stDev = 1.5 + ) + y2 <- getPowerMeans( + design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = c(0.2, 0.5, 1)), groups = 2, meanRatio = FALSE, thetaH0 = 0.2, + maxNumberOfSubjects = 200, allocationRatioPlanned = 3, stDev = 1.5, normalApproximation = TRUE + ) + expectedNumberOfSubjectsDiff <- round((x2$expectedNumberOfSubjects - y2$expectedNumberOfSubjects) / 200, 4) - ## Comparison of the results of numeric object 'futilityStopDiff1' with expected results - expect_equal(futilityStopDiff1, c(0.003, -0.0012, -2e-04, 0, 0, 0), tolerance = 1e-07, label = paste0("c(", paste0(futilityStopDiff1, collapse = ", "), ")")) + ## Comparison of the results of numeric object 'expectedNumberOfSubjectsDiff' with expected results + expect_equal(expectedNumberOfSubjectsDiff, c(-0.0117, 0.0015, -4e-04, 4e-04, -0.0018, 0.0065), tolerance = 1e-07, label = paste0(expectedNumberOfSubjectsDiff)) - x2 <- getSimulationMeans( - seed = 1234, design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = c(0.2, 0.5, 1)), groups = 2, meanRatio = FALSE, thetaH0 = 0.2, - plannedSubjects = c(40, 100, 200), maxNumberOfIterations = 1000, allocationRatioPlanned = 3, stDev = 1.5 - ) - y2 <- getPowerMeans( - design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = c(0.2, 0.5, 1)), groups = 2, meanRatio = FALSE, thetaH0 = 0.2, - maxNumberOfSubjects = 200, allocationRatioPlanned = 3, stDev = 1.5, normalApproximation = TRUE - ) - expectedNumberOfSubjectsDiff <- round((x2$expectedNumberOfSubjects - y2$expectedNumberOfSubjects) / 200, 4) + overallRejectDiff2 <- round(x2$overallReject - y2$overallReject, 4) - ## Comparison of the results of numeric object 'expectedNumberOfSubjectsDiff' with expected results - expect_equal(expectedNumberOfSubjectsDiff, c(-0.0117, 0.0015, -4e-04, 4e-04, -0.0018, 0.0065), tolerance = 1e-07, label = paste0("c(", paste0(expectedNumberOfSubjectsDiff, collapse = ", "), ")")) + ## Comparison of the results of numeric object 'overallRejectDiff2' with expected results + expect_equal(overallRejectDiff2, c(-0.0016, 0.0111, 0.0023, 0.0198, 0.0107, -0.0071), tolerance = 1e-07, label = paste0(overallRejectDiff2)) - overallRejectDiff2 <- round(x2$overallReject - y2$overallReject, 4) + futilityStopDiff2 <- round(x2$futilityStop - y2$futilityStop, 4) - ## Comparison of the results of numeric object 'overallRejectDiff2' with expected results - expect_equal(overallRejectDiff2, c(-0.0016, 0.0111, 0.0023, 0.0198, 0.0107, -0.0071), tolerance = 1e-07, label = paste0("c(", paste0(overallRejectDiff2, collapse = ", "), ")")) + ## Comparison of the results of numeric object 'futilityStopDiff2' with expected results + expect_equal(futilityStopDiff2, c(0.0132, -0.0034, 0.0147, -3e-04, 0.0035, 0.0013), tolerance = 1e-07, label = paste0(futilityStopDiff2)) - futilityStopDiff2 <- round(x2$futilityStop - y2$futilityStop, 4) + x4 <- getSimulationMeans( + seed = 1234, design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = c(0.2, 0.5, 1)), groups = 1, thetaH0 = 0.2, + plannedSubjects = c(40, 100, 200), maxNumberOfIterations = 1000, stDev = 1.5 + ) + y4 <- getPowerMeans( + design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = c(0.2, 0.5, 1)), groups = 1, thetaH0 = 0.2, + maxNumberOfSubjects = 200, stDev = 1.5, normalApproximation = TRUE + ) + expectedNumberOfSubjectsDiff <- round((x4$expectedNumberOfSubjects - y4$expectedNumberOfSubjects) / 200, 4) - ## Comparison of the results of numeric object 'futilityStopDiff2' with expected results - expect_equal(futilityStopDiff2, c(0.0132, -0.0034, 0.0147, -3e-04, 0.0035, 0.0013), tolerance = 1e-07, label = paste0("c(", paste0(futilityStopDiff2, collapse = ", "), ")")) + ## Comparison of the results of numeric object 'expectedNumberOfSubjectsDiff' with expected results + expect_equal(expectedNumberOfSubjectsDiff, c(-0.0038, 0.0042, 0.0102, -0.0074, -0.002, -0.0036), tolerance = 1e-07, label = paste0(expectedNumberOfSubjectsDiff)) - x4 <- getSimulationMeans( - seed = 1234, design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = c(0.2, 0.5, 1)), groups = 1, thetaH0 = 0.2, - plannedSubjects = c(40, 100, 200), maxNumberOfIterations = 1000, stDev = 1.5 - ) - y4 <- getPowerMeans( - design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = c(0.2, 0.5, 1)), groups = 1, thetaH0 = 0.2, - maxNumberOfSubjects = 200, stDev = 1.5, normalApproximation = TRUE - ) - expectedNumberOfSubjectsDiff <- round((x4$expectedNumberOfSubjects - y4$expectedNumberOfSubjects) / 200, 4) + overallRejectDiff4 <- round(x4$overallReject - y4$overallReject, 4) - ## Comparison of the results of numeric object 'expectedNumberOfSubjectsDiff' with expected results - expect_equal(expectedNumberOfSubjectsDiff, c(-0.0038, 0.0042, 0.0102, -0.0074, -0.002, -0.0036), tolerance = 1e-07, label = paste0("c(", paste0(expectedNumberOfSubjectsDiff, collapse = ", "), ")")) + ## Comparison of the results of numeric object 'overallRejectDiff4' with expected results + expect_equal(overallRejectDiff4, c(-1e-04, 0.0121, -0.0064, 0.0131, -0.0015, 1e-04), tolerance = 1e-07, label = paste0(overallRejectDiff4)) - overallRejectDiff4 <- round(x4$overallReject - y4$overallReject, 4) + futilityStopDiff4 <- round(x4$futilityStop - y4$futilityStop, 4) - ## Comparison of the results of numeric object 'overallRejectDiff4' with expected results - expect_equal(overallRejectDiff4, c(-1e-04, 0.0121, -0.0064, 0.0131, -0.0015, 1e-04), tolerance = 1e-07, label = paste0("c(", paste0(overallRejectDiff4, collapse = ", "), ")")) + ## Comparison of the results of numeric object 'futilityStopDiff4' with expected results + expect_equal(futilityStopDiff4, c(0.0013, -0.0094, -0.0191, -0.007, 0.0016, -1e-04), tolerance = 1e-07, label = paste0(futilityStopDiff4)) - futilityStopDiff4 <- round(x4$futilityStop - y4$futilityStop, 4) + x5 <- getSimulationMeans( + seed = 1234, design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = c(0.2, 0.5, 1)), groups = 2, meanRatio = TRUE, thetaH0 = 1.1, + plannedSubjects = c(40, 100, 200), maxNumberOfIterations = 1000, allocationRatioPlanned = 3, stDev = 1.5, directionUpper = FALSE + ) + y5 <- getPowerMeans( + design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = c(0.2, 0.5, 1)), groups = 2, meanRatio = TRUE, thetaH0 = 1.1, + maxNumberOfSubjects = 200, allocationRatioPlanned = 3, stDev = 1.5, normalApproximation = TRUE, directionUpper = FALSE + ) + expectedNumberOfSubjectsDiff <- round((x5$expectedNumberOfSubjects - y5$expectedNumberOfSubjects) / 200, 4) - ## Comparison of the results of numeric object 'futilityStopDiff4' with expected results - expect_equal(futilityStopDiff4, c(0.0013, -0.0094, -0.0191, -0.007, 0.0016, -1e-04), tolerance = 1e-07, label = paste0("c(", paste0(futilityStopDiff4, collapse = ", "), ")")) + ## Comparison of the results of numeric object 'expectedNumberOfSubjectsDiff' with expected results + expect_equal(expectedNumberOfSubjectsDiff, c(0.008, -0.0088, 0.0023, -0.001, -0.0062, -0.0039), tolerance = 1e-07, label = paste0(expectedNumberOfSubjectsDiff)) - x5 <- getSimulationMeans( - seed = 1234, design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = c(0.2, 0.5, 1)), groups = 2, meanRatio = TRUE, thetaH0 = 1.1, - plannedSubjects = c(40, 100, 200), maxNumberOfIterations = 1000, allocationRatioPlanned = 3, stDev = 1.5, directionUpper = FALSE - ) - y5 <- getPowerMeans( - design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = c(0.2, 0.5, 1)), groups = 2, meanRatio = TRUE, thetaH0 = 1.1, - maxNumberOfSubjects = 200, allocationRatioPlanned = 3, stDev = 1.5, normalApproximation = TRUE, directionUpper = FALSE - ) - expectedNumberOfSubjectsDiff <- round((x5$expectedNumberOfSubjects - y5$expectedNumberOfSubjects) / 200, 4) + overallRejectDiff5 <- round(x5$overallReject - y5$overallReject, 4) - ## Comparison of the results of numeric object 'expectedNumberOfSubjectsDiff' with expected results - expect_equal(expectedNumberOfSubjectsDiff, c(0.008, -0.0088, 0.0023, -0.001, -0.0062, -0.0039), tolerance = 1e-07, label = paste0("c(", paste0(expectedNumberOfSubjectsDiff, collapse = ", "), ")")) + ## Comparison of the results of numeric object 'overallRejectDiff5' with expected results + expect_equal(overallRejectDiff5, c(0, -0.0019, -9e-04, -1e-04, 0, 0), tolerance = 1e-07, label = paste0(overallRejectDiff5)) - overallRejectDiff5 <- round(x5$overallReject - y5$overallReject, 4) + futilityStopDiff5 <- round(x5$futilityStop - y5$futilityStop, 4) - ## Comparison of the results of numeric object 'overallRejectDiff5' with expected results - expect_equal(overallRejectDiff5, c(0, -0.0019, -9e-04, -1e-04, 0, 0), tolerance = 1e-07, label = paste0("c(", paste0(overallRejectDiff5, collapse = ", "), ")")) + ## Comparison of the results of numeric object 'futilityStopDiff5' with expected results + expect_equal(futilityStopDiff5, c(-0.0164, 0.0103, 0.0038, 0.0057, 0.0018, 6e-04), tolerance = 1e-07, label = paste0(futilityStopDiff5)) - futilityStopDiff5 <- round(x5$futilityStop - y5$futilityStop, 4) + x6 <- getSimulationMeans( + seed = 1234, design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = c(0.2, 0.5, 1)), groups = 2, meanRatio = FALSE, thetaH0 = 1.1, + plannedSubjects = c(40, 100, 200), maxNumberOfIterations = 1000, allocationRatioPlanned = 3, stDev = 1.5, directionUpper = FALSE + ) + y6 <- getPowerMeans( + design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = c(0.2, 0.5, 1)), groups = 2, meanRatio = FALSE, thetaH0 = 1.1, + maxNumberOfSubjects = 200, allocationRatioPlanned = 3, stDev = 1.5, normalApproximation = TRUE, directionUpper = FALSE + ) + expectedNumberOfSubjectsDiff <- round((x6$expectedNumberOfSubjects - y6$expectedNumberOfSubjects) / 200, 4) - ## Comparison of the results of numeric object 'futilityStopDiff5' with expected results - expect_equal(futilityStopDiff5, c(-0.0164, 0.0103, 0.0038, 0.0057, 0.0018, 6e-04), tolerance = 1e-07, label = paste0("c(", paste0(futilityStopDiff5, collapse = ", "), ")")) + ## Comparison of the results of numeric object 'expectedNumberOfSubjectsDiff' with expected results + expect_equal(expectedNumberOfSubjectsDiff, c(0.0029, -0.0013, 0.0079, 0.023, -0.003, -0.0132), tolerance = 1e-07, label = paste0(expectedNumberOfSubjectsDiff)) - x6 <- getSimulationMeans( - seed = 1234, design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = c(0.2, 0.5, 1)), groups = 2, meanRatio = FALSE, thetaH0 = 1.1, - plannedSubjects = c(40, 100, 200), maxNumberOfIterations = 1000, allocationRatioPlanned = 3, stDev = 1.5, directionUpper = FALSE - ) - y6 <- getPowerMeans( - design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = c(0.2, 0.5, 1)), groups = 2, meanRatio = FALSE, thetaH0 = 1.1, - maxNumberOfSubjects = 200, allocationRatioPlanned = 3, stDev = 1.5, normalApproximation = TRUE, directionUpper = FALSE - ) - expectedNumberOfSubjectsDiff <- round((x6$expectedNumberOfSubjects - y6$expectedNumberOfSubjects) / 200, 4) + overallRejectDiff6 <- round(x6$overallReject - y6$overallReject, 4) - ## Comparison of the results of numeric object 'expectedNumberOfSubjectsDiff' with expected results - expect_equal(expectedNumberOfSubjectsDiff, c(0.0029, -0.0013, 0.0079, 0.023, -0.003, -0.0132), tolerance = 1e-07, label = paste0("c(", paste0(expectedNumberOfSubjectsDiff, collapse = ", "), ")")) + ## Comparison of the results of numeric object 'overallRejectDiff6' with expected results + expect_equal(overallRejectDiff6, c(0.0036, 0.003, -0.0112, -0.0033, -0.0108, -0.0031), tolerance = 1e-07, label = paste0(overallRejectDiff6)) - overallRejectDiff6 <- round(x6$overallReject - y6$overallReject, 4) + futilityStopDiff6 <- round(x6$futilityStop - y6$futilityStop, 4) - ## Comparison of the results of numeric object 'overallRejectDiff6' with expected results - expect_equal(overallRejectDiff6, c(0.0036, 0.003, -0.0112, -0.0033, -0.0108, -0.0031), tolerance = 1e-07, label = paste0("c(", paste0(overallRejectDiff6, collapse = ", "), ")")) + ## Comparison of the results of numeric object 'futilityStopDiff6' with expected results + expect_equal(futilityStopDiff6, c(-0.004, 2e-04, 0.0083, -0.0213, -4e-04, 0.0232), tolerance = 1e-07, label = paste0(futilityStopDiff6)) - futilityStopDiff6 <- round(x6$futilityStop - y6$futilityStop, 4) + x7 <- getSimulationMeans( + seed = 1234, design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = c(0.2, 0.5, 1)), groups = 1, thetaH0 = 0.8, + plannedSubjects = c(40, 100, 200), maxNumberOfIterations = 1000, stDev = 1.5, directionUpper = FALSE + ) + y7 <- getPowerMeans( + design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = c(0.2, 0.5, 1)), groups = 1, thetaH0 = 0.8, + maxNumberOfSubjects = 200, stDev = 1.5, normalApproximation = TRUE, directionUpper = FALSE + ) + expectedNumberOfSubjectsDiff <- round((x7$expectedNumberOfSubjects - y7$expectedNumberOfSubjects) / 200, 4) - ## Comparison of the results of numeric object 'futilityStopDiff6' with expected results - expect_equal(futilityStopDiff6, c(-0.004, 2e-04, 0.0083, -0.0213, -4e-04, 0.0232), tolerance = 1e-07, label = paste0("c(", paste0(futilityStopDiff6, collapse = ", "), ")")) + ## Comparison of the results of numeric object 'expectedNumberOfSubjectsDiff' with expected results + expect_equal(expectedNumberOfSubjectsDiff, c(0.0012, 6e-04, -0.0061, -3e-04, 0.0091, 0.0036), tolerance = 1e-07, label = paste0(expectedNumberOfSubjectsDiff)) - x7 <- getSimulationMeans( - seed = 1234, design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = c(0.2, 0.5, 1)), groups = 1, thetaH0 = 0.8, - plannedSubjects = c(40, 100, 200), maxNumberOfIterations = 1000, stDev = 1.5, directionUpper = FALSE - ) - y7 <- getPowerMeans( - design = getDesignInverseNormal(futilityBounds = c(-0.5, 0.5), informationRates = c(0.2, 0.5, 1)), groups = 1, thetaH0 = 0.8, - maxNumberOfSubjects = 200, stDev = 1.5, normalApproximation = TRUE, directionUpper = FALSE - ) - expectedNumberOfSubjectsDiff <- round((x7$expectedNumberOfSubjects - y7$expectedNumberOfSubjects) / 200, 4) + overallRejectDiff7 <- round(x7$overallReject - y7$overallReject, 4) - ## Comparison of the results of numeric object 'expectedNumberOfSubjectsDiff' with expected results - expect_equal(expectedNumberOfSubjectsDiff, c(0.0012, 6e-04, -0.0061, -3e-04, 0.0091, 0.0036), tolerance = 1e-07, label = paste0("c(", paste0(expectedNumberOfSubjectsDiff, collapse = ", "), ")")) + ## Comparison of the results of numeric object 'overallRejectDiff7' with expected results + expect_equal(overallRejectDiff7, c(1e-04, 5e-04, -9e-04, -0.0224, -9e-04, -1e-04), tolerance = 1e-07, label = paste0(overallRejectDiff7)) - overallRejectDiff7 <- round(x7$overallReject - y7$overallReject, 4) - - ## Comparison of the results of numeric object 'overallRejectDiff7' with expected results - expect_equal(overallRejectDiff7, c(1e-04, 5e-04, -9e-04, -0.0224, -9e-04, -1e-04), tolerance = 1e-07, label = paste0("c(", paste0(overallRejectDiff7, collapse = ", "), ")")) - - futilityStopDiff7 <- round(x7$futilityStop - y7$futilityStop, 4) - - ## Comparison of the results of numeric object 'futilityStopDiff7' with expected results - expect_equal(futilityStopDiff7, c(-1e-04, -4e-04, -0.003, 0.0059, -4e-04, 0.0033), tolerance = 1e-07, label = paste0("c(", paste0(futilityStopDiff7, collapse = ", "), ")")) + futilityStopDiff7 <- round(x7$futilityStop - y7$futilityStop, 4) + ## Comparison of the results of numeric object 'futilityStopDiff7' with expected results + expect_equal(futilityStopDiff7, c(-1e-04, -4e-04, -0.003, 0.0059, -4e-04, 0.0033), tolerance = 1e-07, label = paste0(futilityStopDiff7)) }) test_that("Internal simulation base means functions throw errors when arguments are missing or wrong", { - - expect_error(.getSimulationMeansStageSubjects()) - + expect_error(.getSimulationMeansStageSubjects()) }) - diff --git a/tests/testthat/test-f_simulation_calc_subjects_function.R b/tests/testthat/test-f_simulation_calc_subjects_function.R index d2a20e3e..2a337c62 100644 --- a/tests/testthat/test-f_simulation_calc_subjects_function.R +++ b/tests/testthat/test-f_simulation_calc_subjects_function.R @@ -29,7 +29,7 @@ test_that("Function .getCalcSubjectsFunctionCppCode works for C++ code", { design <- getDesignInverseNormal() result <- .getCalcSubjectsFunction( design = design, - simulationResults = SimulationResultsRates(design = design), + simulationResults = SimulationResultsRates$new(design = design), calcFunction = calcFunction, expectedFunction = .getSimulationRatesStageSubjects, cppEnabled = TRUE diff --git a/tests/testthat/test-f_simulation_performance_score.R b/tests/testthat/test-f_simulation_performance_score.R index c543bb0c..b2c5534f 100644 --- a/tests/testthat/test-f_simulation_performance_score.R +++ b/tests/testthat/test-f_simulation_performance_score.R @@ -15,8 +15,8 @@ ## | ## | File name: test-f_simulation_performance_score.R ## | Creation date: 06 February 2023, 12:14:51 -## | File version: $Revision: 7662 $ -## | Last changed: $Date: 2024-02-23 12:42:26 +0100 (Fr, 23 Feb 2024) $ +## | File version: $Revision: 7702 $ +## | Last changed: $Date: 2024-03-07 13:30:30 +0100 (Do, 07 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -67,18 +67,18 @@ test_that("getPerformanceScore handles SimulationResultsMeans", { simulationResult <- createCorrectSimulationResultObject("SimulationResultsNonMeans") expect_error( getPerformanceScore(simulationResult), - "Illegal argument: performance score so far implemented only for single comparisons with continuous endpoints" + "Illegal argument: performance score so far implemented only for single comparisons with continuous and binary endpoints" ) }) -# 1. Test for a simulationResult that does not have `bindingFutility = TRUE`. +# Test for a simulationResult that does not have `bindingFutility = TRUE` test_that("getPerformanceScore handles non-binding futility", { simulationResult <- createCorrectSimulationResultObject("SimulationResultsMeans") simulationResult$.design$bindingFutility <- FALSE expect_warning(getPerformanceScore(simulationResult)) }) -# 2. Test for a simulationResult that does not have `kMax = 2`. +# Test for a simulationResult that does not have `kMax = 2` test_that("getPerformanceScore handles non-two-stage designs", { simulationResult <- createCorrectSimulationResultObject("SimulationResultsMeans") simulationResult$.design$kMax <- 3 @@ -88,21 +88,21 @@ test_that("getPerformanceScore handles non-two-stage designs", { ) }) -# 3. Test for a simulationResult that has a non-null `conditionalPower`. +# Test for a simulationResult that has a non-null `conditionalPower`. test_that("getPerformanceScore handles non-null conditionalPower", { simulationResult <- createCorrectSimulationResultObject("SimulationResultsMeans") simulationResult$conditionalPower <- 0.8 suppressWarnings(expect_type(getPerformanceScore(simulationResult), "environment")) }) -# 4. Test to verify the correctness of the performance score calculation. +# Test to verify the correctness of the performance score calculation test_that("getPerformanceScore calculates performance score correctly", { simulationResult <- createCorrectSimulationResultObject("SimulationResultsMeans") suppressWarnings(scores <- getPerformanceScore(simulationResult)) expect_type(scores, "environment") }) -# 5. Test to verify that the warning about the function being experimental is issued. +# Test to verify that the warning about the function being experimental is issued test_that("getPerformanceScore issues warning", { simulationResult <- createCorrectSimulationResultObject("SimulationResultsMeans") expect_warning( @@ -111,15 +111,15 @@ test_that("getPerformanceScore issues warning", { ) }) -# 6. Test to check if the correct values are returned in the resultList. +# Test to check if the correct values are returned test_that("getPerformanceScore returns correct result object", { simulationResult <- createCorrectSimulationResultObject("SimulationResultsMeans") suppressWarnings(result <- getPerformanceScore(simulationResult)) expect_type(result, "environment") }) -# 7. Test to check if the correct values are returned in the resultList. -test_that("Print getPerformanceScore results", { +# Test to check if the correct values are returned +test_that("Print getPerformanceScore of simualtion means results", { .skipTestIfDisabled() design <- getDesignGroupSequential( @@ -156,3 +156,41 @@ test_that("Print getPerformanceScore results", { expect_true(any(grepl("Performance score", capture.output(result)))) }) + +# Test to check if the correct values are returned (rates) +test_that("Print getPerformanceScore of simualtion rates results", { + .skipTestIfDisabled() + + design <- getDesignGroupSequential( + kMax = 2, + alpha = 0.025, + beta = 0.2, + sided = 1, + typeOfDesign = "P", + futilityBounds = 0, + bindingFutility = TRUE + ) + simulationResult <- getSimulationRates( + design = design, + normalApproximation = TRUE, + plannedSubjects = c(100, 300), + minNumberOfSubjectsPerStage = c(NA, 1), + maxNumberOfSubjectsPerStage = c(NA, 300), + conditionalPower = 0.8, + maxNumberOfIterations = 5, + showStatistics = FALSE, + seed = 4378258 + ) + suppressWarnings(result <- getPerformanceScore(simulationResult)) + + ## Comparison of the results of PerformanceScore object 'result' with expected results + expect_equal(result$locationSampleSize, c(0.33333333, 0.76333333, 0.6331616, NaN), tolerance = 1e-07, label = paste0(result$locationSampleSize)) + expect_equal(result$variationSampleSize, c(NA_real_, 0.32538077, 0.33802988, NA_real_), tolerance = 1e-07, label = paste0(result$variationSampleSize)) + expect_equal(result$subscoreSampleSize, c(0.33333333, 0.54435705, 0.48559574, NaN), tolerance = 1e-07, label = paste0(result$subscoreSampleSize)) + expect_equal(result$locationConditionalPower, c(0.32576, 0.9990159, 0.99927128, NaN), tolerance = 1e-07, label = paste0(result$locationConditionalPower)) + expect_equal(result$variationConditionalPower, c(NA_real_, 0.99864022, 0.99927015, NA_real_), tolerance = 1e-07, label = paste0(result$variationConditionalPower)) + expect_equal(result$subscoreConditionalPower, c(0.32576, 0.99882806, 0.99927071, NaN), tolerance = 1e-07, label = paste0(result$subscoreConditionalPower)) + expect_equal(result$performanceScore, c(0.32954667, 0.77159255, 0.74243323, NaN), tolerance = 1e-07, label = paste0(result$performanceScore)) + + expect_true(any(grepl("Performance score", capture.output(result)))) +}) diff --git a/tests/testthat/test-f_simulation_plot.R b/tests/testthat/test-f_simulation_plot.R index c7f56134..1e9867d4 100644 --- a/tests/testthat/test-f_simulation_plot.R +++ b/tests/testthat/test-f_simulation_plot.R @@ -15,8 +15,8 @@ ## | ## | File name: test-f_simulation_performance_score.R ## | Creation date: 06 February 2023, 12:14:51 -## | File version: $Revision: 7659 $ -## | Last changed: $Date: 2024-02-23 10:42:33 +0100 (Fr, 23 Feb 2024) $ +## | File version: $Revision: 7682 $ +## | Last changed: $Date: 2024-03-05 07:53:40 +0100 (Di, 05 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -108,16 +108,9 @@ test_that(".getPowerAndStoppingProbabilities handles expectedNumberOfSubjects", expect_equal(result$data$yValues, c(1, 2, 3)) }) -test_that(".plotSimulationResults handles type = 4", { +test_that("Plot simulation means results", { .skipTestIfDisabled() - simulationResults <- getSimulationSurvival( - maxNumberOfSubjects = 200, plannedEvents = 50, - accrualTime = c(0, 3, 6, 12), accrualIntensity = c(0.1, 0.2, 0.2), - maxNumberOfIterations = 100, seed = 1234567890 - ) - - # means maxNumberOfSubjects <- 90 informationRates <- c(0.2, 0.5, 1) plannedSubjects <- round(informationRates * maxNumberOfSubjects) @@ -125,15 +118,18 @@ test_that(".plotSimulationResults handles type = 4", { futilityBounds = c(-0.5, 0.5), informationRates = informationRates ) - x_means <- getSimulationMeans( + simulationMeansResult <- getSimulationMeans( design = design, groups = 2, meanRatio = TRUE, thetaH0 = 0.4, plannedSubjects = plannedSubjects, maxNumberOfIterations = 500, allocationRatioPlanned = 3, stDev = 1.5, seed = 1234567890 ) - expect_silent(plot(x_means, type = "all", grid = 0)) + expect_silent(plot(simulationMeansResult, type = "all", grid = 0)) +}) + +test_that("Plot simulation rates results", { + .skipTestIfDisabled() - # rates maxNumberOfSubjects <- 90 informationRates <- (1:3) / 3 plannedSubjects <- round(informationRates * maxNumberOfSubjects) @@ -141,18 +137,21 @@ test_that(".plotSimulationResults handles type = 4", { futilityBounds = c(-0.5, 0.5), informationRates = informationRates ) - x_rates <- getSimulationRates( + simulationRatesResult <- getSimulationRates( design = getDesignFisher(), groups = 2, riskRatio = TRUE, thetaH0 = 0.8, plannedSubjects = plannedSubjects, maxNumberOfIterations = 500, allocationRatioPlanned = 3, seed = 1234567890 ) - expect_silent(plot(x_rates, type = "all", grid = 0)) + expect_silent(plot(simulationRatesResult, type = "all", grid = 0)) +}) + +test_that("Plot simulation survival results", { + .skipTestIfDisabled() - # survival design <- getDesignFisher(kMax = 3, alpha0Vec = c(0.5, 0.5)) - x_surv <- getSimulationSurvival( + simulationSurvivalResult <- getSimulationSurvival( design = design, pi2 = 0.6, pi1 = seq(0.3, 0.45, 0.05), directionUpper = FALSE, maxNumberOfSubjects = 500, plannedEvents = (1:design$kMax) * 20, @@ -163,7 +162,11 @@ test_that(".plotSimulationResults handles type = 4", { maxNumberOfEventsPerStage = c(NA_real_, 100, 200), maxNumberOfIterations = 500, seed = 1234567890 ) - expect_silent(plot(x_surv, type = 4, grid = 0)) + expect_silent(plot(simulationSurvivalResult, type = 4, grid = 0)) +}) + +test_that("Plot simulation piecewise survival time results", { + .skipTestIfDisabled() design <- getDesignGroupSequential(kMax = 3, typeOfDesign = "WT", deltaWT = 0.25) piecewiseSurvivalTime <- list( @@ -173,7 +176,7 @@ test_that(".plotSimulationResults handles type = 4", { "15 - <21" = 0.01, ">=21" = 0.007 ) - x <- getSimulationSurvival( + simulationSurvivalResult <- getSimulationSurvival( design = design, directionUpper = TRUE, maxNumberOfSubjects = 500, plannedEvents = (1:design$kMax) * 20, allocation1 = 1, @@ -185,7 +188,11 @@ test_that(".plotSimulationResults handles type = 4", { maxNumberOfEventsPerStage = c(NA_real_, 100, 200), maxNumberOfIterations = 500, seed = 1234567890 ) - expect_silent(plot(x, type = "all", grid = 0)) + expect_silent(plot(simulationSurvivalResult, type = "all", grid = 0)) +}) + +test_that("Plot simulation multi-arm means results", { + .skipTestIfDisabled() design <- getDesignInverseNormal( informationRates = c(0.2, 0.6, 1), @@ -200,6 +207,10 @@ test_that(".plotSimulationResults handles type = 4", { maxNumberOfIterations = 500, seed = 1234567890 ) expect_silent(plot(x, type = "all", grid = 0)) +}) + +test_that("Plot simulation multi-arm rates results", { + .skipTestIfDisabled() design <- getDesignInverseNormal( informationRates = c(0.2, 0.6, 1), @@ -215,6 +226,10 @@ test_that(".plotSimulationResults handles type = 4", { maxNumberOfIterations = 500, seed = 1234567890 ) expect_silent(plot(x, type = "all", grid = 0)) +}) + +test_that("Plot simulation multi-arm survival results", { + .skipTestIfDisabled() design <- getDesignInverseNormal( informationRates = c(0.2, 0.6, 1), @@ -229,6 +244,10 @@ test_that(".plotSimulationResults handles type = 4", { maxNumberOfIterations = 500, seed = 1234567890 ) expect_silent(plot(x, type = "all", grid = 0)) +}) + +test_that("Plot simulation enrichment means results", { + .skipTestIfDisabled() design <- getDesignInverseNormal( informationRates = c(0.2, 0.6, 1), @@ -254,7 +273,7 @@ test_that(".plotSimulationResults handles type = 4", { stDevs = stDev, effects = effects ) - x <- getSimulationEnrichmentMeans( + suppressWarnings(x <- getSimulationEnrichmentMeans( design = design, plannedSubjects = c(10, 30, 50), effectList = el, @@ -264,9 +283,13 @@ test_that(".plotSimulationResults handles type = 4", { maxNumberOfSubjectsPerStage = c(10, 100, 100), maxNumberOfIterations = 500, seed = 1234567890 - ) + )) suppressWarnings(expect_silent(plot(x, type = "all", grid = 0))) +}) + +test_that("Plot simulation enrichment rates results", { + .skipTestIfDisabled() design <- getDesignInverseNormal( informationRates = c(0.2, 0.6, 1), @@ -293,15 +316,20 @@ test_that(".plotSimulationResults handles type = 4", { ) ) - x <- getSimulationEnrichmentRates( + suppressWarnings(x <- getSimulationEnrichmentRates( design = design, plannedSubjects = c(10, 30, 50), effectList = el, maxNumberOfIterations = 500, seed = 1234567890 - ) + )) suppressWarnings(expect_silent(plot(x, type = "all", grid = 0))) +}) + + +test_that("Plot simulation enrichment survival results", { + .skipTestIfDisabled() # Define subgroups and their prevalences subGroups <- c("S1", "S2", "S12", "R") # fixed names! @@ -320,7 +348,7 @@ test_that(".plotSimulationResults handles type = 4", { ) # Perform simulation - x <- getSimulationEnrichmentSurvival( + suppressWarnings(x <- getSimulationEnrichmentSurvival( design = getDesignInverseNormal(typeOfDesign = "noEarlyEfficacy"), effectList = el, typeOfSelection = "rbest", @@ -329,10 +357,19 @@ test_that(".plotSimulationResults handles type = 4", { plannedEvents = c(30, 80, 120), maxNumberOfIterations = 500, directionUpper = FALSE - ) + )) suppressWarnings(expect_silent(plot(x, type = "all", grid = 0))) +}) + +test_that("Plot simulation results with wrong plot types", { + .skipTestIfDisabled() + simulationResults <- getSimulationSurvival( + maxNumberOfSubjects = 200, plannedEvents = 50, + accrualTime = c(0, 3, 6, 12), accrualIntensity = c(0.1, 0.2, 0.2), + maxNumberOfIterations = 100, seed = 1234567890 + ) designMaster <- list("kMax" = 1) expect_silent(.plotSimulationResults(simulationResults, designMaster, type = 4)) expect_error(.plotSimulationResults(simulationResults, designMaster, type = 1)) diff --git a/tests/testthat/test-f_simulation_utilities.R b/tests/testthat/test-f_simulation_utilities.R index 5aa4013c..c362bf56 100644 --- a/tests/testthat/test-f_simulation_utilities.R +++ b/tests/testthat/test-f_simulation_utilities.R @@ -15,8 +15,8 @@ ## | ## | File name: test-f_simulation_performance_score.R ## | Creation date: 06 February 2023, 12:14:51 -## | File version: $Revision: 7659 $ -## | Last changed: $Date: 2024-02-23 10:42:33 +0100 (Fr, 23 Feb 2024) $ +## | File version: $Revision: 7682 $ +## | Last changed: $Date: 2024-03-05 07:53:40 +0100 (Di, 05 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/tests/testthat/test-generic_functions.R b/tests/testthat/test-generic_functions.R index ddbdf8b5..e2ec753c 100644 --- a/tests/testthat/test-generic_functions.R +++ b/tests/testthat/test-generic_functions.R @@ -1,159 +1,160 @@ -## | -## | *Unit tests* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | RPACT package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File name: test-generic_functions.R -## | Creation date: 08 November 2023, 09:12:05 -## | File version: $Revision$ -## | Last changed: $Date$ -## | Last changed by: $Author$ -## | - -test_plan_section("Testing Class 'SummaryFactory'") - - -test_that("Testing 'summary.ParameterSet': no errors occur", { - .skipTestIfDisabled() - - design <- getDesignGroupSequential( - alpha = 0.05, kMax = 4, - sided = 1, typeOfDesign = "WT", deltaWT = 0.1 - ) - - designFisher <- getDesignFisher( - kMax = 4, alpha = 0.025, - informationRates = c(0.2, 0.5, 0.8, 1), alpha0Vec = rep(0.4, 3) - ) - - designCharacteristics <- getDesignCharacteristics(design) - - powerAndASN <- getPowerAndAverageSampleNumber(design, theta = 1, nMax = 100) - - designSet <- getDesignSet(design = design, deltaWT = c(0.3, 0.4)) - - dataset <- getDataset( - n1 = c(22, 11, 22, 11), - n2 = c(22, 13, 22, 13), - means1 = c(1, 1.1, 1, 1), - means2 = c(1.4, 1.5, 3, 2.5), - stDevs1 = c(1, 2, 2, 1.3), - stDevs2 = c(1, 2, 2, 1.3) - ) - - stageResults <- getStageResults(design, dataset) - - suppressWarnings(designPlan <- getSampleSizeMeans(design)) - - simulationResults <- getSimulationSurvival(design, - maxNumberOfSubjects = 1200, plannedEvents = c(50, 100, 150, 200), seed = 12345 - ) - - piecewiseSurvivalTime <- getPiecewiseSurvivalTime(list( - "0 - <6" = 0.025, - "6 - <9" = 0.04, - "9 - <15" = 0.015, - "15 - <21" = 0.01, - ">=21" = 0.007 - ), hazardRatio = 0.8) - - accrualTime <- getAccrualTime(list( - "0 - <12" = 15, - "12 - <13" = 21, - "13 - <14" = 27, - "14 - <15" = 33, - "15 - <16" = 39, - ">=16" = 45 - ), maxNumberOfSubjects = 1400) - - expect_vector(names(design)) - expect_vector(names(designFisher)) - expect_vector(names(designCharacteristics)) - expect_vector(names(powerAndASN)) - expect_vector(names(designSet)) - expect_vector(names(dataset)) - expect_vector(names(stageResults)) - expect_vector(names(designPlan)) - expect_vector(names(simulationResults)) - expect_vector(names(piecewiseSurvivalTime)) - expect_vector(names(accrualTime)) - - expect_output(print(design)) - expect_output(print(designFisher)) - expect_output(print(designCharacteristics)) - expect_output(print(powerAndASN)) - expect_output(print(designSet)) - expect_output(print(dataset)) - expect_output(print(stageResults)) - expect_output(print(designPlan)) - expect_output(print(simulationResults)) - expect_output(print(piecewiseSurvivalTime)) - expect_output(print(accrualTime)) - - expect_output(summary(design)$show()) - expect_output(summary(designFisher)$show()) - expect_output(summary(designCharacteristics)$show()) - expect_output(summary(powerAndASN)) - expect_output(print(summary(designSet))) - expect_output(summary(dataset)$show()) - expect_output(summary(stageResults)) - expect_output(summary(designPlan)$show()) - expect_output(summary(simulationResults)$show()) - expect_output(summary(piecewiseSurvivalTime)) - expect_output(summary(accrualTime)) - - expect_named(as.data.frame(design)) - expect_named(as.data.frame(designFisher)) - expect_named(as.data.frame(designCharacteristics)) - expect_named(as.data.frame(powerAndASN)) - expect_named(as.data.frame(designSet)) - expect_named(as.data.frame(dataset)) - expect_named(as.data.frame(stageResults)) - expect_named(as.data.frame(designPlan)) - expect_named(as.data.frame(simulationResults)) - expect_named(as.data.frame(piecewiseSurvivalTime)) - expect_named(as.data.frame(accrualTime)) - - expect_s3_class(as.data.frame(design, niceColumnNamesEnabled = FALSE), "data.frame") - expect_s3_class(as.data.frame(designFisher, niceColumnNamesEnabled = FALSE), "data.frame") - expect_s3_class(as.data.frame(designCharacteristics, niceColumnNamesEnabled = FALSE), "data.frame") - expect_s3_class(as.data.frame(powerAndASN, niceColumnNamesEnabled = FALSE), "data.frame") - expect_s3_class(as.data.frame(designSet, niceColumnNamesEnabled = FALSE), "data.frame") - expect_s3_class(as.data.frame(dataset, niceColumnNamesEnabled = FALSE), "data.frame") - expect_s3_class(as.data.frame(stageResults, niceColumnNamesEnabled = FALSE), "data.frame") - expect_s3_class(as.data.frame(designPlan, niceColumnNamesEnabled = FALSE), "data.frame") - expect_s3_class(as.data.frame(simulationResults, niceColumnNamesEnabled = FALSE), "data.frame") - expect_s3_class(as.data.frame(piecewiseSurvivalTime, niceColumnNamesEnabled = FALSE), "data.frame") - expect_s3_class(as.data.frame(accrualTime, niceColumnNamesEnabled = FALSE), "data.frame") - - expect_type(as.matrix(design), "character") - expect_type(as.matrix(designFisher), "character") - expect_type(as.matrix(designCharacteristics), "double") - expect_type(as.matrix(powerAndASN), "double") - expect_type(as.matrix(designSet), "character") - expect_type(as.matrix(dataset), "double") - expect_type(as.matrix(stageResults), "character") - expect_type(as.matrix(designPlan), "double") - expect_type(as.matrix(simulationResults), "double") - expect_type(as.matrix(piecewiseSurvivalTime), "double") - expect_type(as.matrix(accrualTime), "double") - - suppressWarnings(analysisResults <- getAnalysisResults(design, dataset)) - expect_vector(names(analysisResults)) - expect_output(print(analysisResults)) - expect_output(summary(analysisResults)$show()) - expect_named(as.data.frame(analysisResults)) - expect_s3_class(as.data.frame(analysisResults, niceColumnNamesEnabled = FALSE), "data.frame") - expect_type(as.matrix(analysisResults), "character") -}) - +## | +## | *Unit tests* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | RPACT package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File name: test-generic_functions.R +## | Creation date: 08 November 2023, 09:12:05 +## | File version: $Revision$ +## | Last changed: $Date$ +## | Last changed by: $Author$ +## | + +test_plan_section("Testing Class 'SummaryFactory'") + + +test_that("Testing 'summary.ParameterSet': no errors occur", { + .skipTestIfDisabled() + + design <- getDesignGroupSequential( + alpha = 0.05, kMax = 4, + sided = 1, typeOfDesign = "WT", deltaWT = 0.1 + ) + + designFisher <- getDesignFisher( + kMax = 4, alpha = 0.025, + informationRates = c(0.2, 0.5, 0.8, 1), alpha0Vec = rep(0.4, 3) + ) + + designCharacteristics <- getDesignCharacteristics(design) + + powerAndASN <- getPowerAndAverageSampleNumber(design, theta = 1, nMax = 100) + + designSet <- getDesignSet(design = design, deltaWT = c(0.3, 0.4)) + + dataset <- getDataset( + n1 = c(22, 11, 22, 11), + n2 = c(22, 13, 22, 13), + means1 = c(1, 1.1, 1, 1), + means2 = c(1.4, 1.5, 3, 2.5), + stDevs1 = c(1, 2, 2, 1.3), + stDevs2 = c(1, 2, 2, 1.3) + ) + + stageResults <- getStageResults(design, dataset) + + suppressWarnings(designPlan <- getSampleSizeMeans(design)) + + simulationResults <- getSimulationSurvival(design, + maxNumberOfSubjects = 1200, plannedEvents = c(50, 100, 150, 200), seed = 12345 + ) + + piecewiseSurvivalTime <- getPiecewiseSurvivalTime(list( + "0 - <6" = 0.025, + "6 - <9" = 0.04, + "9 - <15" = 0.015, + "15 - <21" = 0.01, + ">=21" = 0.007 + ), hazardRatio = 0.8) + + accrualTime <- getAccrualTime(list( + "0 - <12" = 15, + "12 - <13" = 21, + "13 - <14" = 27, + "14 - <15" = 33, + "15 - <16" = 39, + ">=16" = 45 + ), maxNumberOfSubjects = 1400) + + expect_vector(names(design)) + expect_vector(names(designFisher)) + expect_vector(names(designCharacteristics)) + expect_vector(names(powerAndASN)) + expect_vector(names(designSet)) + expect_vector(names(dataset)) + expect_vector(names(stageResults)) + expect_vector(names(designPlan)) + expect_vector(names(simulationResults)) + expect_vector(names(piecewiseSurvivalTime)) + expect_vector(names(accrualTime)) + + expect_output(print(design)) + expect_output(print(designFisher)) + expect_output(print(designCharacteristics)) + expect_output(print(powerAndASN)) + expect_output(print(designSet)) + expect_output(print(dataset)) + expect_output(print(stageResults)) + expect_output(print(designPlan)) + expect_output(print(simulationResults)) + expect_output(print(piecewiseSurvivalTime)) + expect_output(print(accrualTime)) + + expect_output(summary(design)$show()) + expect_output(summary(designFisher)$show()) + expect_output(summary(designCharacteristics)$show()) + expect_output(summary(powerAndASN)) + expect_output(print(summary(designSet))) + expect_output(summary(dataset)$show()) + expect_output(summary(stageResults)) + expect_output(summary(designPlan)$show()) + expect_output(summary(simulationResults)$show()) + expect_output(summary(piecewiseSurvivalTime)) + expect_output(summary(accrualTime)) + + expect_named(as.data.frame(design)) + expect_named(as.data.frame(designFisher)) + expect_named(as.data.frame(designCharacteristics)) + expect_named(as.data.frame(powerAndASN)) + expect_named(as.data.frame(designSet)) + expect_named(as.data.frame(dataset)) + expect_named(as.data.frame(stageResults)) + expect_named(as.data.frame(designPlan)) + expect_named(as.data.frame(simulationResults)) + expect_named(as.data.frame(piecewiseSurvivalTime)) + expect_named(as.data.frame(accrualTime)) + + expect_s3_class(as.data.frame(design, niceColumnNamesEnabled = FALSE), "data.frame") + expect_s3_class(as.data.frame(designFisher, niceColumnNamesEnabled = FALSE), "data.frame") + expect_s3_class(as.data.frame(designCharacteristics, niceColumnNamesEnabled = FALSE), "data.frame") + expect_s3_class(as.data.frame(powerAndASN, niceColumnNamesEnabled = FALSE), "data.frame") + expect_s3_class(as.data.frame(designSet, niceColumnNamesEnabled = FALSE), "data.frame") + expect_s3_class(as.data.frame(dataset, niceColumnNamesEnabled = FALSE), "data.frame") + expect_s3_class(as.data.frame(stageResults, niceColumnNamesEnabled = FALSE), "data.frame") + expect_s3_class(as.data.frame(designPlan, niceColumnNamesEnabled = FALSE), "data.frame") + expect_s3_class(as.data.frame(simulationResults, niceColumnNamesEnabled = FALSE), "data.frame") + expect_s3_class(as.data.frame(piecewiseSurvivalTime, niceColumnNamesEnabled = FALSE), "data.frame") + expect_s3_class(as.data.frame(accrualTime, niceColumnNamesEnabled = FALSE), "data.frame") + + expect_type(as.matrix(design), "character") + expect_type(as.matrix(designFisher), "character") + expect_type(as.matrix(designCharacteristics), "double") + expect_type(as.matrix(powerAndASN), "double") + expect_type(as.matrix(designSet), "character") + expect_type(as.matrix(dataset), "double") + expect_type(as.matrix(stageResults), "character") + expect_type(as.matrix(designPlan), "double") + expect_type(as.matrix(simulationResults), "double") + expect_type(as.matrix(piecewiseSurvivalTime), "double") + expect_type(as.matrix(accrualTime), "double") + + suppressWarnings(analysisResults <- getAnalysisResults(design, dataset)) + expect_vector(names(analysisResults)) + expect_output(print(analysisResults)) + expect_output(summary(analysisResults)$show()) + expect_named(as.data.frame(analysisResults)) + expect_s3_class(as.data.frame(analysisResults, niceColumnNamesEnabled = FALSE), "data.frame") + expect_type(as.matrix(analysisResults), "character") + +}) + From 3bfedb441a9c1c94142751266c861e0b1e1b3d65 Mon Sep 17 00:00:00 2001 From: Till Jensen <114589522+tilljensen@users.noreply.github.com> Date: Thu, 14 Mar 2024 11:23:52 +0100 Subject: [PATCH 13/28] Delete load_source_files.R --- load_source_files.R | 195 -------------------------------------------- 1 file changed, 195 deletions(-) delete mode 100644 load_source_files.R diff --git a/load_source_files.R b/load_source_files.R deleted file mode 100644 index eab39581..00000000 --- a/load_source_files.R +++ /dev/null @@ -1,195 +0,0 @@ -###################################################################################### -# # -# -- Load source files -- # -# # -# This file is part of the R package RPACT - R Package for Adaptive Clinical Trials. # -# # -# Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD # -# Licensed under "GNU Lesser General Public License" version 3 # -# License text can be found here: https://www.r-project.org/Licenses/LGPL-3 # -# # -# RPACT company website: https://www.rpact.com # -# RPACT package website: https://www.rpact.org # -# # -# Contact us for information about our services: info@rpact.com # -# # -# File version: $Revision: 4443 $ # -# Last changed: $Date: 2021-02-22 09:13:17 +0100 (Mon, 22 Feb 2021) $ # -# Last changed by: $Author: pahlke $ # -###################################################################################### - -#setwd("C:\\Users\\Till\\CLionProjects\\rpactsvn") -#setwd("/home/massive/eclipse-workspace/rpact.ext") - -library(Rcpp) -library(tictoc) -library(testthat) -library(parallel) -library(rbenchmark) -library(doParallel) -library(foreach) -library(R6) -library(profvis) -library(rpact.as251) - -tic() - -Sys.setenv("RPACT_COMPILE_CPP_FILES" = FALSE) -#Sys.setenv("RPACT_DEVELOPMENT_MODE" = TRUE) -Sys.setenv("RPACT_DEVELOPMENT_MODE" = FALSE) -Sys.setenv("RPACT_COMPLETE_UNIT_TEST_SET_ENABLED" = TRUE) - -#print("The following packages are not up to date:") -#pacman::p_update(FALSE) - -#sessionInfo() - -# eliminate package startup messages -#suppressPackageStartupMessages() - -if (exists(".onUnload")) { - .onUnload("") -} - -# cleanup (remove all variables and functions) -rm(list=ls(all=TRUE), envir = .GlobalEnv) -# help 'environment': https://stat.ethz.ch/R-manual/R-devel/library/base/html/environment.html - -#makeActiveBinding("refresh", function() { system(paste0(R.home(),"/bin/x64/R")); q("no") }, .GlobalEnv) -#paste0(R.home(),"/bin/x64/R --no-save") - -### rpact.dev::detachPackage("rpact", characterOnly = TRUE) - -# debug warnings: -#options(warn=2) # normal: options(warn=1) -# traceback() - -gc() - -baseDir <- file.path(sub("/R$", "", getwd())) -sourceFileDir <- file.path(baseDir, 'R') - -fileNames <- c( - "class_core_parameter_set_r6", - "class_analysis_stage_results_r6", - "class_analysis_results_r6", - "class_summary_r6", - "class_design_r6", - "class_core_plot_settings_r6", - "class_design_set_r6", - "class_event_probabilities_r6", - "class_time_r6", - "class_design_power_and_asn_r6", - "class_performance_score_r6", - "f_core_constants", - "class_design_plan_r6", - "f_design_utilities", - "f_analysis_utilities", - "class_analysis_dataset_r6", - "class_core_parameter_set", - "class_simulation_results_r6", - #"class_core_plot_settings", - "f_core_assertions", - "f_core_utilities", - #"class_design", - #"class_design_set", - #"class_design_power_and_asn", - #"class_time", - "class_summary", - "f_logger", - #"class_design_plan", - #"class_analysis_dataset", - #"class_analysis_stage_results", - #"class_analysis_results", - #"class_simulation_results", - #"class_event_probabilities", - "f_core_output_formats", - "f_core_plot", - "f_design_group_sequential", - "f_design_fisher_combination_test", - "f_design_sample_size_calculator", - "f_analysis_base_means", - "f_analysis_base_rates", - "f_analysis_base_survival", - "f_analysis_base", - "f_analysis_enrichment", - "f_analysis_enrichment_means", - "f_analysis_enrichment_rates", - "f_analysis_enrichment_survival", - "f_analysis_multiarm_means", - "f_analysis_multiarm_rates", - "f_analysis_multiarm_survival", - "f_analysis_multiarm", - "f_simulation_calc_subjects_function", - "f_simulation_base_means", - "f_simulation_base_rates", - "f_simulation_base_survival", - "f_simulation_multiarm", - "f_simulation_multiarm_means", - "f_simulation_multiarm_rates", - "f_simulation_multiarm_survival", - "f_simulation_utilities", - "f_simulation_performance_score", - "f_parameter_set_utilities", - "f_object_r_code" -) - -# https://stackoverflow.com/questions/17635531/calling-cuda-compiled-dll-from-r - -if (as.logical(Sys.getenv("RPACT_COMPILE_CPP_FILES"))) { - # Important: .Call methods will be only added to lookup table if used in the R folder - Rcpp::compileAttributes(verbose = TRUE) -} - -# Create init file. The file must be deleted before Rcpp::compileAttributes execution! -#tools::package_native_routine_registration_skeleton(".", file.path(baseDir, "src", "rpact_init.c"), character_only = FALSE) - -#pkgbuild::clean_dll() -dllFile <- file.path(baseDir, "src", "rpact.dll") -if (!file.exists(dllFile)) { - if (is.loaded(dllFile) || !is.null(getLoadedDLLs()[["rpact"]])) { - dyn.unload(dllFile) - } - # Warning: does not create all required dll's! Use rpact.dev::buildPackage instead respectively first time! - pkgbuild::compile_dll(force = TRUE, compile_attributes = FALSE, register_routines = FALSE) - #pkgbuild::compile_dll(force = TRUE, compile_attributes = TRUE, register_routines = FALSE) - #pkgbuild::compile_dll(force = TRUE, compile_attributes = TRUE, register_routines = TRUE) -} -### print(paste0("Execute dyn.load('", dllFile, "')...")) -### print(dyn.load(dllFile)) - -### print(getDLLRegisteredRoutines("rpact")) -# .Call .Call.numParameters -# 1 _rpact_getRandomSurvivalDistribution 2 -# 2 _rpact_getRandomPiecewiseExponentialDistribution 3 -# 3 _rpact_getSimulationSurvivalCpp 31 -# 4 R_getDensityValues 6 - -for (fileName in fileNames) { - sourceFile <- file.path(sourceFileDir, paste0(fileName, ".R")) - print(paste0("Update source file '", sourceFile, "'...")) - source(sourceFile) -} - -rHome <- Sys.getenv("R_HOME") -if (grepl("Program Files", rHome)) { - stop("R must be installed in a directory without spaces; current directory: ", rHome) -} - -if (as.logical(Sys.getenv("RPACT_COMPILE_CPP_FILES")) || !exists("getSimulationSurvivalCpp")) { - cppSourceFiles <- list.files(file.path(baseDir, "src"), pattern = "\\.cpp$") - cppSourceFiles <- cppSourceFiles[!(cppSourceFiles %in% c("RcppExports.cpp"))] - cppSourceFiles <- sort(cppSourceFiles, decreasing = TRUE) - for (cppSourceFile in cppSourceFiles) { - if(cppSourceFile != "f_as251.cpp") { - file <- file.path(baseDir, "src", cppSourceFile) - print(paste0("Perform sourceCpp(", file, ")...")) - Rcpp::sourceCpp(file) - } - } -} - - -print("Initialization completed.") - -toc() From aa97d457c5ec07485ce95a26dfd32e50f9965323 Mon Sep 17 00:00:00 2001 From: Till Jensen Date: Thu, 14 Mar 2024 11:49:19 +0100 Subject: [PATCH 14/28] added r6 prefixes --- R/class_analysis_dataset.R | 12 ++++---- R/class_analysis_results.R | 51 ++++++++++++++++---------------- R/class_analysis_stage_results.R | 21 +++++++------ R/class_core_parameter_set.R | 5 ++-- R/class_core_plot_settings.R | 6 ++-- R/class_design.R | 13 ++++---- R/class_design_plan.R | 10 +++---- R/class_design_power_and_asn.R | 2 +- R/class_design_set.R | 2 +- R/class_event_probabilities.R | 4 +-- R/class_performance_score.R | 2 +- R/class_simulation_results.R | 26 ++++++++-------- R/class_summary.R | 4 +-- R/class_time.R | 6 ++-- R/f_core_utilities.R | 2 -- 15 files changed, 80 insertions(+), 86 deletions(-) diff --git a/R/class_analysis_dataset.R b/R/class_analysis_dataset.R index 25cdd6fc..a4646f9f 100644 --- a/R/class_analysis_dataset.R +++ b/R/class_analysis_dataset.R @@ -909,7 +909,7 @@ getDataSet <- function(..., floatingPointNumbersEnabled = FALSE) { emptySubsetNames <- validSubsetNames[!(validSubsetNames %in% subsetNames)] for (subsetName in subsetNames) { subset <- args[[subsetName]] - if (is.null(subset) || (!is.R6(subset) && is.na(subset))) { + if (is.null(subset) || (!R6::is.R6(subset) && is.na(subset))) { emptySubsetNames <- c(emptySubsetNames, subsetName) } else { if (!.isDataset(subset)) { @@ -1360,7 +1360,7 @@ getDataSet <- function(..., floatingPointNumbersEnabled = FALSE) { #' #' @importFrom methods new #' -Dataset <- R6Class("Dataset", +Dataset <- R6::R6Class("Dataset", inherit = ParameterSet, public = list( .data = NULL, @@ -1828,7 +1828,7 @@ Dataset <- R6Class("Dataset", #' #' @importFrom methods new #' -DatasetMeans <- R6Class("DatasetMeans", +DatasetMeans <- R6::R6Class("DatasetMeans", inherit = Dataset, public = list( sampleSizes = NULL, @@ -2709,7 +2709,7 @@ plot.Dataset <- function(x, y, ..., main = "Dataset", xlab = "Stage", ylab = NA_ #' #' @importFrom methods new #' -DatasetRates <- R6Class("DatasetRates", +DatasetRates <- R6::R6Class("DatasetRates", inherit = Dataset, public = list( sampleSizes = NULL, @@ -3183,7 +3183,7 @@ DatasetRates <- R6Class("DatasetRates", #' #' @importFrom methods new #' -DatasetSurvival <- R6Class("DatasetSurvival", +DatasetSurvival <- R6::R6Class("DatasetSurvival", inherit = Dataset, public = list( overallEvents = NULL, @@ -3734,7 +3734,7 @@ DatasetSurvival <- R6Class("DatasetSurvival", #' #' @keywords internal #' -DatasetEnrichmentSurvival <- R6Class("DatasetEnrichmentSurvival", +DatasetEnrichmentSurvival <- R6::R6Class("DatasetEnrichmentSurvival", inherit = DatasetSurvival, public = list( expectedEvents = NULL, diff --git a/R/class_analysis_results.R b/R/class_analysis_results.R index 24371c45..51daf369 100644 --- a/R/class_analysis_results.R +++ b/R/class_analysis_results.R @@ -1,4 +1,3 @@ -library("R6") ## | ## | *Analysis result classes* ## | @@ -45,7 +44,7 @@ library("R6") #' #' @importFrom methods new #' -ConditionalPowerResults <- R6Class("ConditionalPowerResults", +ConditionalPowerResults <- R6::R6Class("ConditionalPowerResults", inherit = ParameterSet, public = list( .plotSettings = NULL, @@ -154,7 +153,7 @@ ConditionalPowerResults <- R6Class("ConditionalPowerResults", #' #' @importFrom methods new #' -ConditionalPowerResultsMeans <- R6Class("ConditionalPowerResultsMeans", +ConditionalPowerResultsMeans <- R6::R6Class("ConditionalPowerResultsMeans", inherit = ConditionalPowerResults, public = list( conditionalPower = NULL, @@ -185,7 +184,7 @@ ConditionalPowerResultsMeans <- R6Class("ConditionalPowerResultsMeans", ) ) -ConditionalPowerResultsMultiHypotheses <- R6Class("ConditionalPowerResultsMultiHypotheses", +ConditionalPowerResultsMultiHypotheses <- R6::R6Class("ConditionalPowerResultsMultiHypotheses", inherit = ConditionalPowerResults, public = list( conditionalPower = NULL, @@ -238,7 +237,7 @@ ConditionalPowerResultsMultiHypotheses <- R6Class("ConditionalPowerResultsMultiH ) ) -ConditionalPowerResultsMultiArmMeans <- R6Class("ConditionalPowerResultsMultiArmMeans", +ConditionalPowerResultsMultiArmMeans <- R6::R6Class("ConditionalPowerResultsMultiArmMeans", inherit = ConditionalPowerResultsMultiHypotheses, public = list( thetaH1 = NULL, @@ -287,7 +286,7 @@ ConditionalPowerResultsMultiArmMeans <- R6Class("ConditionalPowerResultsMultiArm #' #' @importFrom methods new #' -ConditionalPowerResultsRates <- R6Class("ConditionalPowerResultsRates", +ConditionalPowerResultsRates <- R6::R6Class("ConditionalPowerResultsRates", inherit = ConditionalPowerResults, public = list( conditionalPower = NULL, @@ -320,7 +319,7 @@ ConditionalPowerResultsRates <- R6Class("ConditionalPowerResultsRates", ) ) -ConditionalPowerResultsMultiArmRates <- R6Class("ConditionalPowerResultsMultiArmRates", +ConditionalPowerResultsMultiArmRates <- R6::R6Class("ConditionalPowerResultsMultiArmRates", inherit = ConditionalPowerResultsMultiHypotheses, public = list( piTreatments = NULL, @@ -368,7 +367,7 @@ ConditionalPowerResultsMultiArmRates <- R6Class("ConditionalPowerResultsMultiArm #' #' @importFrom methods new #' -ConditionalPowerResultsSurvival <- R6Class("ConditionalPowerResultsSurvival", +ConditionalPowerResultsSurvival <- R6::R6Class("ConditionalPowerResultsSurvival", inherit = ConditionalPowerResults, public = list( conditionalPower = NULL, @@ -393,7 +392,7 @@ ConditionalPowerResultsSurvival <- R6Class("ConditionalPowerResultsSurvival", ) ) -ConditionalPowerResultsMultiArmSurvival <- R6Class("ConditionalPowerResultsMultiArmSurvival", +ConditionalPowerResultsMultiArmSurvival <- R6::R6Class("ConditionalPowerResultsMultiArmSurvival", inherit = ConditionalPowerResultsMultiHypotheses, public = list( thetaH1 = NULL, @@ -437,7 +436,7 @@ ConditionalPowerResultsMultiArmSurvival <- R6Class("ConditionalPowerResultsMulti #' #' @importFrom methods new #' -ConditionalPowerResultsEnrichmentMeans <- R6Class("ConditionalPowerResultsEnrichmentMeans", +ConditionalPowerResultsEnrichmentMeans <- R6::R6Class("ConditionalPowerResultsEnrichmentMeans", inherit = ConditionalPowerResultsMultiArmMeans ) @@ -467,7 +466,7 @@ ConditionalPowerResultsEnrichmentMeans <- R6Class("ConditionalPowerResultsEnrich #' #' @importFrom methods new #' -ConditionalPowerResultsEnrichmentRates <- R6Class("ConditionalPowerResultsEnrichmentRates", +ConditionalPowerResultsEnrichmentRates <- R6::R6Class("ConditionalPowerResultsEnrichmentRates", inherit = ConditionalPowerResultsMultiHypotheses, public = list( piTreatments = NULL, @@ -491,7 +490,7 @@ ConditionalPowerResultsEnrichmentRates <- R6Class("ConditionalPowerResultsEnrich ) -ConditionalPowerResultsEnrichmentSurvival <- R6Class("ConditionalPowerResultsEnrichmentSurvival", +ConditionalPowerResultsEnrichmentSurvival <- R6::R6Class("ConditionalPowerResultsEnrichmentSurvival", inherit = ConditionalPowerResultsMultiArmSurvival ) @@ -522,7 +521,7 @@ ConditionalPowerResultsEnrichmentSurvival <- R6Class("ConditionalPowerResultsEnr #' #' @importFrom methods new #' -ClosedCombinationTestResults <- R6Class("ClosedCombinationTestResults", +ClosedCombinationTestResults <- R6::R6Class("ClosedCombinationTestResults", inherit = ParameterSet, public = list( .plotSettings = NULL, @@ -717,7 +716,7 @@ ClosedCombinationTestResults <- R6Class("ClosedCombinationTestResults", #' #' @importFrom methods new #' -AnalysisResults <- R6Class("AnalysisResults", +AnalysisResults <- R6::R6Class("AnalysisResults", inherit = ParameterSet, public = list( .plotSettings = NULL, @@ -951,7 +950,7 @@ AnalysisResults <- R6Class("AnalysisResults", ) ) -AnalysisResultsBase <- R6Class("AnalysisResultsBase", +AnalysisResultsBase <- R6::R6Class("AnalysisResultsBase", inherit = AnalysisResults, public = list( thetaH1 = NULL, @@ -1030,7 +1029,7 @@ AnalysisResultsBase <- R6Class("AnalysisResultsBase", #' #' @importFrom methods new #' -AnalysisResultsMultiHypotheses <- R6Class("AnalysisResultsMultiHypotheses", +AnalysisResultsMultiHypotheses <- R6::R6Class("AnalysisResultsMultiHypotheses", inherit = AnalysisResults, public = list( .closedTestResults = NULL, @@ -1103,7 +1102,7 @@ AnalysisResultsMultiHypotheses <- R6Class("AnalysisResultsMultiHypotheses", #' #' @importFrom methods new #' -AnalysisResultsMultiArm <- R6Class("AnalysisResultsMultiArm", +AnalysisResultsMultiArm <- R6::R6Class("AnalysisResultsMultiArm", inherit = AnalysisResultsMultiHypotheses, public = list( piControl = NULL, # rates only @@ -1156,7 +1155,7 @@ AnalysisResultsMultiArm <- R6Class("AnalysisResultsMultiArm", #' #' @importFrom methods new #' -AnalysisResultsEnrichment <- R6Class("AnalysisResultsEnrichment", +AnalysisResultsEnrichment <- R6::R6Class("AnalysisResultsEnrichment", inherit = AnalysisResultsMultiHypotheses, public = list( piControls = NULL, # rates only @@ -1310,7 +1309,7 @@ names.AnalysisResults <- function(x) { #' #' @importFrom methods new #' -AnalysisResultsGroupSequential <- R6Class("AnalysisResultsGroupSequential", +AnalysisResultsGroupSequential <- R6::R6Class("AnalysisResultsGroupSequential", inherit = AnalysisResultsBase, public = list( maxInformation = NULL, @@ -1372,7 +1371,7 @@ AnalysisResultsGroupSequential <- R6Class("AnalysisResultsGroupSequential", #' #' @importFrom methods new #' -AnalysisResultsInverseNormal <- R6Class("AnalysisResultsInverseNormal", +AnalysisResultsInverseNormal <- R6::R6Class("AnalysisResultsInverseNormal", inherit = AnalysisResultsBase ) @@ -1418,7 +1417,7 @@ AnalysisResultsInverseNormal <- R6Class("AnalysisResultsInverseNormal", #' #' @importFrom methods new #' -AnalysisResultsMultiArmInverseNormal <- R6Class("AnalysisResultsMultiArmInverseNormal", +AnalysisResultsMultiArmInverseNormal <- R6::R6Class("AnalysisResultsMultiArmInverseNormal", inherit = AnalysisResultsMultiArm ) @@ -1465,7 +1464,7 @@ AnalysisResultsMultiArmInverseNormal <- R6Class("AnalysisResultsMultiArmInverseN #' #' @importFrom methods new #' -AnalysisResultsEnrichmentInverseNormal <- R6Class("AnalysisResultsEnrichmentInverseNormal", +AnalysisResultsEnrichmentInverseNormal <- R6::R6Class("AnalysisResultsEnrichmentInverseNormal", inherit = AnalysisResultsEnrichment, public = list( stratifiedAnalysis = NULL @@ -1520,7 +1519,7 @@ AnalysisResultsEnrichmentInverseNormal <- R6Class("AnalysisResultsEnrichmentInve #' #' @importFrom methods new #' -AnalysisResultsFisher <- R6Class("AnalysisResultsFisher", +AnalysisResultsFisher <- R6::R6Class("AnalysisResultsFisher", inherit = AnalysisResultsBase, public = list( conditionalPowerSimulated = NULL, @@ -1578,7 +1577,7 @@ AnalysisResultsFisher <- R6Class("AnalysisResultsFisher", #' #' @importFrom methods new #' -AnalysisResultsMultiArmFisher <- R6Class("AnalysisResultsMultiArmFisher", +AnalysisResultsMultiArmFisher <- R6::R6Class("AnalysisResultsMultiArmFisher", inherit = AnalysisResultsMultiArm, public = list( conditionalPowerSimulated = NULL, @@ -1632,7 +1631,7 @@ AnalysisResultsMultiArmFisher <- R6Class("AnalysisResultsMultiArmFisher", #' #' @importFrom methods new #' -AnalysisResultsEnrichmentFisher <- R6Class("AnalysisResultsEnrichmentFisher", +AnalysisResultsEnrichmentFisher <- R6::R6Class("AnalysisResultsEnrichmentFisher", inherit = AnalysisResultsEnrichment, public = list( conditionalPowerSimulated = NULL, @@ -1678,7 +1677,7 @@ AnalysisResultsEnrichmentFisher <- R6Class("AnalysisResultsEnrichmentFisher", #' #' @importFrom methods new #' -AnalysisResultsConditionalDunnett <- R6Class("AnalysisResultsConditionalDunnett", +AnalysisResultsConditionalDunnett <- R6::R6Class("AnalysisResultsConditionalDunnett", inherit = AnalysisResultsMultiArm, public = list() ) diff --git a/R/class_analysis_stage_results.R b/R/class_analysis_stage_results.R index 1abf61fb..61c451d3 100644 --- a/R/class_analysis_stage_results.R +++ b/R/class_analysis_stage_results.R @@ -1,4 +1,3 @@ -library("R6") ## | ## | *Stage results classes* ## | @@ -63,7 +62,7 @@ library("R6") #' #' @importFrom methods new #' -StageResults <- R6Class("StageResults", +StageResults <- R6::R6Class("StageResults", inherit = ParameterSet, public = list( .plotSettings = NULL, @@ -288,7 +287,7 @@ StageResults <- R6Class("StageResults", #' #' @importFrom methods new #' -StageResultsMeans <- R6Class("StageResultsMeans", +StageResultsMeans <- R6::R6Class("StageResultsMeans", inherit = StageResults, public = list( combInverseNormal = NULL, @@ -475,7 +474,7 @@ StageResultsMeans <- R6Class("StageResultsMeans", #' #' @importFrom methods new #' -StageResultsMultiArmMeans <- R6Class("StageResultsMultiArmMeans", +StageResultsMultiArmMeans <- R6::R6Class("StageResultsMultiArmMeans", inherit = StageResults, public = list( combInverseNormal = NULL, @@ -623,7 +622,7 @@ StageResultsMultiArmMeans <- R6Class("StageResultsMultiArmMeans", #' #' @importFrom methods new #' -StageResultsRates <- R6Class("StageResultsRates", +StageResultsRates <- R6::R6Class("StageResultsRates", inherit = StageResults, public = list( combInverseNormal = NULL, @@ -796,7 +795,7 @@ StageResultsRates <- R6Class("StageResultsRates", #' #' @importFrom methods new #' -StageResultsMultiArmRates <- R6Class("StageResultsMultiArmRates", +StageResultsMultiArmRates <- R6::R6Class("StageResultsMultiArmRates", inherit = StageResults, public = list( stage = NULL, @@ -943,7 +942,7 @@ StageResultsMultiArmRates <- R6Class("StageResultsMultiArmRates", #' #' @importFrom methods new #' -StageResultsSurvival <- R6Class("StageResultsSurvival", +StageResultsSurvival <- R6::R6Class("StageResultsSurvival", inherit = StageResults, public = list( combInverseNormal = NULL, @@ -1075,7 +1074,7 @@ StageResultsSurvival <- R6Class("StageResultsSurvival", #' #' @importFrom methods new #' -StageResultsMultiArmSurvival <- R6Class("StageResultsMultiArmSurvival", +StageResultsMultiArmSurvival <- R6::R6Class("StageResultsMultiArmSurvival", inherit = StageResults, public = list( stage = NULL, @@ -1206,7 +1205,7 @@ StageResultsMultiArmSurvival <- R6Class("StageResultsMultiArmSurvival", #' #' @importFrom methods new #' -StageResultsEnrichmentMeans <- R6Class("StageResultsEnrichmentMeans", +StageResultsEnrichmentMeans <- R6::R6Class("StageResultsEnrichmentMeans", inherit = StageResultsMultiArmMeans, public = list( .overallSampleSizes1 = NULL, @@ -1245,7 +1244,7 @@ StageResultsEnrichmentMeans <- R6Class("StageResultsEnrichmentMeans", #' #' @importFrom methods new #' -StageResultsEnrichmentRates <- R6Class("StageResultsEnrichmentRates", +StageResultsEnrichmentRates <- R6::R6Class("StageResultsEnrichmentRates", inherit = StageResultsMultiArmRates, public = list( .overallSampleSizes1 = NULL, @@ -1288,7 +1287,7 @@ StageResultsEnrichmentRates <- R6Class("StageResultsEnrichmentRates", #' #' @importFrom methods new #' -StageResultsEnrichmentSurvival <- R6Class("StageResultsEnrichmentSurvival", +StageResultsEnrichmentSurvival <- R6::R6Class("StageResultsEnrichmentSurvival", inherit = StageResultsMultiArmSurvival, public = list( stratifiedAnalysis = NULL, diff --git a/R/class_core_parameter_set.R b/R/class_core_parameter_set.R index a13f40e2..4f48573f 100644 --- a/R/class_core_parameter_set.R +++ b/R/class_core_parameter_set.R @@ -1,4 +1,3 @@ -library("R6") ## | ## | *Parameter set classes* ## | @@ -42,7 +41,7 @@ NULL #' #' @importFrom methods new #' -FieldSet <- R6Class("FieldSet", +FieldSet <- R6::R6Class("FieldSet", public = list( .parameterTypes = NULL, .showParameterTypeEnabled = NULL, @@ -191,7 +190,7 @@ FieldSet <- R6Class("FieldSet", #' #' @importFrom methods new #' -ParameterSet <- R6Class("ParameterSet", +ParameterSet <- R6::R6Class("ParameterSet", inherit = FieldSet, public = list( initialize = function(..., .showParameterTypeEnabled = TRUE) { diff --git a/R/class_core_plot_settings.R b/R/class_core_plot_settings.R index 70979916..51a2b233 100644 --- a/R/class_core_plot_settings.R +++ b/R/class_core_plot_settings.R @@ -18,7 +18,7 @@ ## | Last changed by: $Author: pahlke $ ## | -PlotSubTitleItem <- R6Class("PlotSubTitleItem", +PlotSubTitleItem <- R6::R6Class("PlotSubTitleItem", public = list( title = NULL, subscript = NULL, @@ -55,7 +55,7 @@ PlotSubTitleItem <- R6Class("PlotSubTitleItem", ) ) -PlotSubTitleItems <- R6Class("PlotSubTitleItems", +PlotSubTitleItems <- R6::R6Class("PlotSubTitleItems", public = list( title = NULL, subtitle = NULL, @@ -292,7 +292,7 @@ getPlotSettings <- function(lineSize = 0.8, #' #' @importFrom methods new #' -PlotSettings <- R6Class("PlotSettings", +PlotSettings <- R6::R6Class("PlotSettings", inherit = ParameterSet, public = list( .legendLineBreakIndex = NULL, diff --git a/R/class_design.R b/R/class_design.R index 0095db0a..96c77d36 100644 --- a/R/class_design.R +++ b/R/class_design.R @@ -1,4 +1,3 @@ -library("R6") ## | ## | *Trial design classes* ## | @@ -63,7 +62,7 @@ NULL #' #' @importFrom methods new #' -TrialDesign <- R6Class("TrialDesign", +TrialDesign <- R6::R6Class("TrialDesign", inherit = ParameterSet, public = list( .plotSettings = NULL, @@ -206,7 +205,7 @@ TrialDesign <- R6Class("TrialDesign", #' #' @importFrom methods new #' -TrialDesignCharacteristics <- R6Class("TrialDesignCharacteristics", +TrialDesignCharacteristics <- R6::R6Class("TrialDesignCharacteristics", inherit = ParameterSet, public = list( .design = NULL, @@ -377,7 +376,7 @@ as.data.frame.TrialDesignCharacteristics <- function(x, row.names = NULL, #' #' @importFrom methods new #' -TrialDesignFisher <- R6Class("TrialDesignFisher", +TrialDesignFisher <- R6::R6Class("TrialDesignFisher", inherit = TrialDesign, public = list( method = NULL, @@ -533,7 +532,7 @@ TrialDesignFisher <- R6Class("TrialDesignFisher", #' #' @importFrom methods new #' -TrialDesignInverseNormal <- R6Class("TrialDesignInverseNormal", +TrialDesignInverseNormal <- R6::R6Class("TrialDesignInverseNormal", inherit = TrialDesign, public = list( typeOfDesign = NULL, @@ -830,7 +829,7 @@ TrialDesignInverseNormal <- R6Class("TrialDesignInverseNormal", #' #' @importFrom methods new #' -TrialDesignGroupSequential <- R6Class("TrialDesignGroupSequential", +TrialDesignGroupSequential <- R6::R6Class("TrialDesignGroupSequential", inherit = TrialDesignInverseNormal, public = list( initialize = function(...) { @@ -881,7 +880,7 @@ TrialDesignGroupSequential <- R6Class("TrialDesignGroupSequential", #' #' @seealso \code{\link{getDesignConditionalDunnett}} for creating a conditional Dunnett test design. #' -TrialDesignConditionalDunnett <- R6Class("TrialDesignConditionalDunnett", +TrialDesignConditionalDunnett <- R6::R6Class("TrialDesignConditionalDunnett", inherit = TrialDesign, public = list( informationAtInterim = NULL, diff --git a/R/class_design_plan.R b/R/class_design_plan.R index 08da9e20..936bca8c 100644 --- a/R/class_design_plan.R +++ b/R/class_design_plan.R @@ -100,7 +100,7 @@ C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_COUNT_DATA <- list( #' #' @importFrom methods new #' -TrialDesignPlan <- R6Class("TrialDesignPlan", +TrialDesignPlan <- R6::R6Class("TrialDesignPlan", inherit = ParameterSet, public = list( .plotSettings = NULL, @@ -342,7 +342,7 @@ as.data.frame.TrialDesignPlan <- function(x, row.names = NULL, #' #' @importFrom methods new #' -TrialDesignPlanMeans <- R6Class("TrialDesignPlanMeans", +TrialDesignPlanMeans <- R6::R6Class("TrialDesignPlanMeans", inherit = TrialDesignPlan, public = list( meanRatio = NULL, @@ -491,7 +491,7 @@ TrialDesignPlanMeans <- R6Class("TrialDesignPlanMeans", #' #' @importFrom methods new #' -TrialDesignPlanRates <- R6Class("TrialDesignPlanRates", +TrialDesignPlanRates <- R6::R6Class("TrialDesignPlanRates", inherit = TrialDesignPlan, public = list( riskRatio = NULL, @@ -665,7 +665,7 @@ TrialDesignPlanRates <- R6Class("TrialDesignPlanRates", #' #' @importFrom methods new #' -TrialDesignPlanSurvival <- R6Class("TrialDesignPlanSurvival", +TrialDesignPlanSurvival <- R6::R6Class("TrialDesignPlanSurvival", inherit = TrialDesignPlan, public = list( .piecewiseSurvivalTime = NULL, @@ -883,7 +883,7 @@ TrialDesignPlanSurvival <- R6Class("TrialDesignPlanSurvival", #' #' @importFrom methods new #' -TrialDesignPlanCountData <- R6Class("TrialDesignPlanCountData", +TrialDesignPlanCountData <- R6::R6Class("TrialDesignPlanCountData", inherit = TrialDesignPlan, public = list( .designCharacteristics = NULL, diff --git a/R/class_design_power_and_asn.R b/R/class_design_power_and_asn.R index ac73071b..f8837b21 100644 --- a/R/class_design_power_and_asn.R +++ b/R/class_design_power_and_asn.R @@ -50,7 +50,7 @@ #' #' @importFrom methods new #' -PowerAndAverageSampleNumberResult <- R6Class("PowerAndAverageSampleNumberResult", +PowerAndAverageSampleNumberResult <- R6::R6Class("PowerAndAverageSampleNumberResult", inherit = ParameterSet, public = list( .design = NULL, diff --git a/R/class_design_set.R b/R/class_design_set.R index 81ab7fe4..6295becc 100644 --- a/R/class_design_set.R +++ b/R/class_design_set.R @@ -165,7 +165,7 @@ summary.TrialDesignSet <- function(object, ..., type = 1, digits = NA_integer_) #' #' @importFrom methods new #' -TrialDesignSet <- R6Class("TrialDesignSet", +TrialDesignSet <- R6::R6Class("TrialDesignSet", inherit = FieldSet, public = list( .plotSettings = NULL, diff --git a/R/class_event_probabilities.R b/R/class_event_probabilities.R index c20baa8f..96710727 100644 --- a/R/class_event_probabilities.R +++ b/R/class_event_probabilities.R @@ -56,7 +56,7 @@ #' #' @keywords internal #' -EventProbabilities <- R6Class("EventProbabilities", +EventProbabilities <- R6::R6Class("EventProbabilities", inherit = ParameterSet, public = list( .piecewiseSurvivalTime = NULL, @@ -179,7 +179,7 @@ EventProbabilities <- R6Class("EventProbabilities", #' #' @keywords internal #' -NumberOfSubjects <- R6Class("NumberOfSubjects", +NumberOfSubjects <- R6::R6Class("NumberOfSubjects", inherit = ParameterSet, public = list( .accrualTime = NULL, diff --git a/R/class_performance_score.R b/R/class_performance_score.R index d50a2ed9..1bbfbfea 100644 --- a/R/class_performance_score.R +++ b/R/class_performance_score.R @@ -41,7 +41,7 @@ #' #' @importFrom methods new #' -PerformanceScore <- R6Class("PerformanceScore", +PerformanceScore <- R6::R6Class("PerformanceScore", inherit = ParameterSet, public = list( .simulationResults = NULL, diff --git a/R/class_simulation_results.R b/R/class_simulation_results.R index 25e8c573..1aa970b2 100644 --- a/R/class_simulation_results.R +++ b/R/class_simulation_results.R @@ -86,7 +86,7 @@ names.SimulationResults <- function(x) { #' #' @importFrom methods new #' -SimulationResults <- R6Class("SimulationResults", +SimulationResults <- R6::R6Class("SimulationResults", inherit = ParameterSet, public = list( .plotSettings = NULL, @@ -560,7 +560,7 @@ SimulationResults <- R6Class("SimulationResults", ) ) -SimulationResultsBaseMeans <- R6Class("SimulationResultsBaseMeans", +SimulationResultsBaseMeans <- R6::R6Class("SimulationResultsBaseMeans", inherit = SimulationResults, public = list( stDev =NULL, @@ -650,7 +650,7 @@ SimulationResultsBaseMeans <- R6Class("SimulationResultsBaseMeans", #' #' @importFrom methods new #' -SimulationResultsMeans <- R6Class("SimulationResultsMeans", +SimulationResultsMeans <- R6::R6Class("SimulationResultsMeans", inherit = SimulationResultsBaseMeans, public = list( meanRatio =NULL, @@ -733,7 +733,7 @@ SimulationResultsMeans <- R6Class("SimulationResultsMeans", #' #' @importFrom methods new #' -SimulationResultsMultiArmMeans <- R6Class("SimulationResultsMultiArmMeans", +SimulationResultsMultiArmMeans <- R6::R6Class("SimulationResultsMultiArmMeans", inherit = SimulationResultsBaseMeans, public = list( activeArms = NULL, @@ -775,7 +775,7 @@ SimulationResultsMultiArmMeans <- R6Class("SimulationResultsMultiArmMeans", ) ) -SimulationResultsBaseRates <- R6Class("SimulationResultsBaseRates", +SimulationResultsBaseRates <- R6::R6Class("SimulationResultsBaseRates", inherit = SimulationResults, public = list( directionUpper = NULL, @@ -864,7 +864,7 @@ SimulationResultsBaseRates <- R6Class("SimulationResultsBaseRates", #' #' @importFrom methods new #' -SimulationResultsRates <- R6Class("SimulationResultsRates", +SimulationResultsRates <- R6::R6Class("SimulationResultsRates", inherit = SimulationResultsBaseRates, public = list( riskRatio = NULL, @@ -971,7 +971,7 @@ SimulationResultsRates <- R6Class("SimulationResultsRates", #' #' @importFrom methods new #' -SimulationResultsMultiArmRates <- R6Class("SimulationResultsMultiArmRates", +SimulationResultsMultiArmRates <- R6::R6Class("SimulationResultsMultiArmRates", inherit = SimulationResultsBaseRates, public = list( activeArms = NULL, @@ -1016,7 +1016,7 @@ SimulationResultsMultiArmRates <- R6Class("SimulationResultsMultiArmRates", ) ) -SimulationResultsBaseSurvival <- R6Class("SimulationResultsBaseSurvival", +SimulationResultsBaseSurvival <- R6::R6Class("SimulationResultsBaseSurvival", inherit = SimulationResults, public = list( directionUpper = NULL, @@ -1124,7 +1124,7 @@ SimulationResultsBaseSurvival <- R6Class("SimulationResultsBaseSurvival", #' #' @importFrom methods new #' -SimulationResultsSurvival <- R6Class("SimulationResultsSurvival", +SimulationResultsSurvival <- R6::R6Class("SimulationResultsSurvival", inherit = SimulationResultsBaseSurvival, public = list( .piecewiseSurvivalTime = NULL, @@ -1263,7 +1263,7 @@ SimulationResultsSurvival <- R6Class("SimulationResultsSurvival", #' #' @importFrom methods new #' -SimulationResultsMultiArmSurvival <- R6Class("SimulationResultsMultiArmSurvival", +SimulationResultsMultiArmSurvival <- R6::R6Class("SimulationResultsMultiArmSurvival", inherit = SimulationResultsBaseSurvival, public = list( activeArms = NULL, @@ -1370,7 +1370,7 @@ SimulationResultsMultiArmSurvival <- R6Class("SimulationResultsMultiArmSurvival" #' #' @importFrom methods new #' -SimulationResultsEnrichmentMeans <- R6Class("SimulationResultsEnrichmentMeans", +SimulationResultsEnrichmentMeans <- R6::R6Class("SimulationResultsEnrichmentMeans", inherit = SimulationResultsBaseMeans, public = list( populations = NULL, @@ -1469,7 +1469,7 @@ SimulationResultsEnrichmentMeans <- R6Class("SimulationResultsEnrichmentMeans", #' #' @importFrom methods new #' -SimulationResultsEnrichmentRates <- R6Class("SimulationResultsEnrichmentRates", +SimulationResultsEnrichmentRates <- R6::R6Class("SimulationResultsEnrichmentRates", inherit = SimulationResultsBaseRates, public = list( populations = NULL, @@ -1572,7 +1572,7 @@ SimulationResultsEnrichmentRates <- R6Class("SimulationResultsEnrichmentRates", #' #' @importFrom methods new #' -SimulationResultsEnrichmentSurvival <- R6Class("SimulationResultsEnrichmentSurvival", +SimulationResultsEnrichmentSurvival <- R6::R6Class("SimulationResultsEnrichmentSurvival", inherit = SimulationResultsBaseSurvival, public = list( populations = NULL, diff --git a/R/class_summary.R b/R/class_summary.R index e3dff977..1dfbc950 100644 --- a/R/class_summary.R +++ b/R/class_summary.R @@ -23,7 +23,7 @@ NULL -SummaryItem <- R6Class("SummaryItem", +SummaryItem <- R6::R6Class("SummaryItem", public = list( title = NULL, values = NULL, @@ -177,7 +177,7 @@ print.SummaryFactory <- function(x, ..., #' #' @importFrom methods new #' -SummaryFactory <- R6Class("SummaryFactory", +SummaryFactory <- R6::R6Class("SummaryFactory", inherit = ParameterSet, public = list( object = NULL, diff --git a/R/class_time.R b/R/class_time.R index a2ec52b9..eb3162d7 100644 --- a/R/class_time.R +++ b/R/class_time.R @@ -26,7 +26,7 @@ C_REGEXP_SMALLER <- "< ?" C_REGEXP_SMALLER_OR_EQUAL <- "<= ?" C_REGEXP_DECIMAL_NUMBER <- "\\d*(\\.{1}\\d*)?" -TimeDefinition <- R6Class("TimeDefinition", +TimeDefinition <- R6::R6Class("TimeDefinition", inherit = ParameterSet, public = list( initialize = function(...) { @@ -392,7 +392,7 @@ getAccrualTime <- function(accrualTime = NA_real_, #' #' @importFrom methods new #' -PiecewiseSurvivalTime <- R6Class("PiecewiseSurvivalTime", +PiecewiseSurvivalTime <- R6::R6Class("PiecewiseSurvivalTime", inherit = TimeDefinition, public = list( .pi1Default = NULL, @@ -1351,7 +1351,7 @@ PiecewiseSurvivalTime <- R6Class("PiecewiseSurvivalTime", #' #' @importFrom methods new #' -AccrualTime <- R6Class("AccrualTime", +AccrualTime <- R6::R6Class("AccrualTime", inherit = TimeDefinition, public = list( .showWarnings = NULL, diff --git a/R/f_core_utilities.R b/R/f_core_utilities.R index b62be178..b55b9594 100644 --- a/R/f_core_utilities.R +++ b/R/f_core_utilities.R @@ -1,5 +1,3 @@ -library("R6") - ## | ## | *Core utilities* ## | From a488b327846d899d62284248a76d053cb8f1678c Mon Sep 17 00:00:00 2001 From: Till Jensen Date: Thu, 14 Mar 2024 12:00:36 +0100 Subject: [PATCH 15/28] removed old Rd files --- man/AnalysisResultsMultiArmFisherR6.Rd | 59 ----------- man/FieldSetR6.Rd | 12 --- man/ParameterSetR6.Rd | 12 --- man/as.data.frame.AnalysisResultsR6.Rd | 34 ------ man/as.data.frame.ParameterSetR6.Rd | 39 ------- man/as.data.frame.StageResultsR6.Rd | 40 ------- man/as.matrix.FieldSetR6.Rd | 31 ------ man/kable.ParameterSetR6.Rd | 24 ----- man/names.AnalysisResultsR6.Rd | 21 ---- man/names.FieldSetR6.Rd | 21 ---- man/names.StageResultsR6.Rd | 21 ---- man/plot.AnalysisResultsR6.Rd | 139 ------------------------- man/plot.ParameterSetR6.Rd | 78 -------------- man/plot.StageResultsR6.Rd | 132 ----------------------- man/print.FieldSetR6.Rd | 21 ---- man/print.ParameterSetR6.Rd | 24 ----- man/summary.AnalysisResultsR6.Rd | 63 ----------- man/summary.ParameterSetR6.Rd | 69 ------------ 18 files changed, 840 deletions(-) delete mode 100644 man/AnalysisResultsMultiArmFisherR6.Rd delete mode 100644 man/FieldSetR6.Rd delete mode 100644 man/ParameterSetR6.Rd delete mode 100644 man/as.data.frame.AnalysisResultsR6.Rd delete mode 100644 man/as.data.frame.ParameterSetR6.Rd delete mode 100644 man/as.data.frame.StageResultsR6.Rd delete mode 100644 man/as.matrix.FieldSetR6.Rd delete mode 100644 man/kable.ParameterSetR6.Rd delete mode 100644 man/names.AnalysisResultsR6.Rd delete mode 100644 man/names.FieldSetR6.Rd delete mode 100644 man/names.StageResultsR6.Rd delete mode 100644 man/plot.AnalysisResultsR6.Rd delete mode 100644 man/plot.ParameterSetR6.Rd delete mode 100644 man/plot.StageResultsR6.Rd delete mode 100644 man/print.FieldSetR6.Rd delete mode 100644 man/print.ParameterSetR6.Rd delete mode 100644 man/summary.AnalysisResultsR6.Rd delete mode 100644 man/summary.ParameterSetR6.Rd diff --git a/man/AnalysisResultsMultiArmFisherR6.Rd b/man/AnalysisResultsMultiArmFisherR6.Rd deleted file mode 100644 index 97fac7cf..00000000 --- a/man/AnalysisResultsMultiArmFisherR6.Rd +++ /dev/null @@ -1,59 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results_r6.R -\name{AnalysisResultsMultiArmFisherR6} -\alias{AnalysisResultsMultiArmFisherR6} -\title{Analysis Results Multi-Arm Fisher} -\description{ -Class for multi-arm analysis results based on a Fisher combination test design. -} -\details{ -This object cannot be created directly; use \code{\link{getAnalysisResults}} -with suitable arguments to create the multi-arm analysis results of a Fisher combination test design. -} -\section{Fields}{ - -\describe{ -\item{\code{normalApproximation}}{Describes if a normal approximation was used when calculating p-values. Default for means is \code{FALSE} and \code{TRUE} for rates and hazard ratio. Is a logical vector of length 1.} - -\item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} - -\item{\code{thetaH0}}{The difference or assumed effect under H0. Is a numeric vector of length 1.} - -\item{\code{pi1}}{The assumed probability or probabilities in the active treatment group in two-group designs, or the alternative probability for a one-group design.} - -\item{\code{pi2}}{The assumed probability in the reference group for two-group designs. Is a numeric vector of length 1 containing a value between 0 and 1.} - -\item{\code{nPlanned}}{The sample size planned for each of the subsequent stages. Is a numeric vector of length \code{kMax} containing whole numbers.} - -\item{\code{allocationRatioPlanned}}{The planned allocation ratio (\code{n1 / n2}) for the groups. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. Is a positive numeric vector of length 1.} - -\item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} - -\item{\code{assumedStDevs}}{Assumed standard deviations to calculate conditional power in multi-arm trials or enrichment designs. Is a numeric vector.} - -\item{\code{piTreatments}}{The assumed rates in the treatment groups for multi-arm and enrichment designs, i.e., designs with multiple subsets.} - -\item{\code{intersectionTest}}{The multiple test used for intersection hypotheses in closed systems of hypotheses. Is a character vector of length 1.} - -\item{\code{varianceOption}}{Defines the way to calculate the variance in multiple (i.e., >2) treatment arms or population enrichment designs when testing means. Available options for multiple arms: \code{"overallPooled", "pairwisePooled", "notPooled"}. Available options for enrichment designs: \code{"pooled", "pooledFromFull", "notPooled"}.} - -\item{\code{conditionalRejectionProbabilities}}{The probabilities of rejecting the null hypothesis at each stage, given the stage has been reached. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{conditionalPower}}{The conditional power at each stage of the trial. Is a numeric vector of length 1 containing a value between 0 and 1.} - -\item{\code{repeatedConfidenceIntervalLowerBounds}}{The lower bound of the confidence intervals that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax}.} - -\item{\code{repeatedConfidenceIntervalUpperBounds}}{The upper bound of the confidence interval that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax}.} - -\item{\code{repeatedPValues}}{The p-values that are calculated at any stage of the trial. Is a numeric vector of length \code{kMax} containing values between 0 and 1.} - -\item{\code{piControl}}{The assumed probability in the control arm for simulation and under which the sample size recalculation is performed. Is a numeric vector of length 1 containing a value between 0 and 1.} - -\item{\code{conditionalPowerSimulated}}{The simulated conditional power, under the assumption of observed or assumed effect sizes.} - -\item{\code{iterations}}{The number of iterations used for simulations. Is a numeric vector of length 1 containing a whole number.} - -\item{\code{seed}}{The seed used for random number generation. Is a numeric vector of length 1.} -}} - -\keyword{internal} diff --git a/man/FieldSetR6.Rd b/man/FieldSetR6.Rd deleted file mode 100644 index 38faefea..00000000 --- a/man/FieldSetR6.Rd +++ /dev/null @@ -1,12 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_core_parameter_set_r6.R -\name{FieldSetR6} -\alias{FieldSetR6} -\title{Field Set} -\description{ -Basic class for field sets. -} -\details{ -The field set implements basic functions for a set of fields. -} -\keyword{internal} diff --git a/man/ParameterSetR6.Rd b/man/ParameterSetR6.Rd deleted file mode 100644 index d39e1ae1..00000000 --- a/man/ParameterSetR6.Rd +++ /dev/null @@ -1,12 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_core_parameter_set_r6.R -\name{ParameterSetR6} -\alias{ParameterSetR6} -\title{Parameter Set} -\description{ -Basic class for parameter sets. -} -\details{ -The parameter set implements basic functions for a set of parameters. -} -\keyword{internal} diff --git a/man/as.data.frame.AnalysisResultsR6.Rd b/man/as.data.frame.AnalysisResultsR6.Rd deleted file mode 100644 index 84cbe128..00000000 --- a/man/as.data.frame.AnalysisResultsR6.Rd +++ /dev/null @@ -1,34 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results_r6.R -\name{as.data.frame.AnalysisResultsR6} -\alias{as.data.frame.AnalysisResultsR6} -\title{Coerce AnalysisResults to a Data Frame} -\usage{ -\method{as.data.frame}{AnalysisResultsR6}( - x, - row.names = NULL, - optional = FALSE, - ..., - niceColumnNamesEnabled = FALSE -) -} -\arguments{ -\item{x}{An \code{\link{AnalysisResults}} object created by \code{\link[=getAnalysisResults]{getAnalysisResults()}}.} - -\item{...}{Ensures that all arguments (starting from the "...") are to be named and -that a warning will be displayed if unknown arguments are passed.} - -\item{niceColumnNamesEnabled}{Logical. If \code{TRUE}, nice looking column -names will be used; syntactic names (variable names) otherwise -(see \code{\link[base]{make.names}}).} -} -\value{ -Returns a \code{\link[base]{data.frame}}. -} -\description{ -Returns the \code{\link{AnalysisResults}} object as data frame. -} -\details{ -Coerces the analysis results to a data frame. -} -\keyword{internal} diff --git a/man/as.data.frame.ParameterSetR6.Rd b/man/as.data.frame.ParameterSetR6.Rd deleted file mode 100644 index 608c78ff..00000000 --- a/man/as.data.frame.ParameterSetR6.Rd +++ /dev/null @@ -1,39 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_core_parameter_set_r6.R -\name{as.data.frame.ParameterSetR6} -\alias{as.data.frame.ParameterSetR6} -\title{Coerce Parameter Set to a Data Frame} -\usage{ -\method{as.data.frame}{ParameterSetR6}( - x, - row.names = NULL, - optional = FALSE, - niceColumnNamesEnabled = FALSE, - includeAllParameters = FALSE, - ... -) -} -\arguments{ -\item{x}{A \code{\link{FieldSet}} object.} - -\item{niceColumnNamesEnabled}{Logical. If \code{TRUE}, nice looking column -names will be used; syntactic names (variable names) otherwise -(see \code{\link[base]{make.names}}).} - -\item{includeAllParameters}{Logical. If \code{TRUE}, all available -parameters will be included in the data frame; -a meaningful parameter selection otherwise, default is \code{FALSE}.} - -\item{...}{Ensures that all arguments (starting from the "...") are to be named and -that a warning will be displayed if unknown arguments are passed.} -} -\value{ -Returns a \code{\link[base]{data.frame}}. -} -\description{ -Returns the \code{ParameterSet} as data frame. -} -\details{ -Coerces the parameter set to a data frame. -} -\keyword{internal} diff --git a/man/as.data.frame.StageResultsR6.Rd b/man/as.data.frame.StageResultsR6.Rd deleted file mode 100644 index eb6ebb47..00000000 --- a/man/as.data.frame.StageResultsR6.Rd +++ /dev/null @@ -1,40 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_stage_results_r6.R -\name{as.data.frame.StageResultsR6} -\alias{as.data.frame.StageResultsR6} -\title{Coerce Stage Results to a Data Frame} -\usage{ -\method{as.data.frame}{StageResultsR6}( - x, - row.names = NULL, - optional = FALSE, - niceColumnNamesEnabled = FALSE, - includeAllParameters = FALSE, - type = 1, - ... -) -} -\arguments{ -\item{x}{A \code{\link{StageResults}} object.} - -\item{niceColumnNamesEnabled}{Logical. If \code{TRUE}, nice looking column -names will be used; syntactic names (variable names) otherwise -(see \code{\link[base]{make.names}}).} - -\item{includeAllParameters}{Logical. If \code{TRUE}, all available -parameters will be included in the data frame; -a meaningful parameter selection otherwise, default is \code{FALSE}.} - -\item{...}{Ensures that all arguments (starting from the "...") are to be named and -that a warning will be displayed if unknown arguments are passed.} -} -\value{ -Returns a \code{\link[base]{data.frame}}. -} -\description{ -Returns the \code{StageResults} as data frame. -} -\details{ -Coerces the stage results to a data frame. -} -\keyword{internal} diff --git a/man/as.matrix.FieldSetR6.Rd b/man/as.matrix.FieldSetR6.Rd deleted file mode 100644 index 81339699..00000000 --- a/man/as.matrix.FieldSetR6.Rd +++ /dev/null @@ -1,31 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_core_parameter_set_r6.R -\name{as.matrix.FieldSetR6} -\alias{as.matrix.FieldSetR6} -\title{Coerce Field Set to a Matrix} -\usage{ -\method{as.matrix}{FieldSetR6}(x, ..., enforceRowNames = TRUE, niceColumnNamesEnabled = TRUE) -} -\arguments{ -\item{x}{A \code{\link{FieldSet}} object.} - -\item{...}{Ensures that all arguments (starting from the "...") are to be named and -that a warning will be displayed if unknown arguments are passed.} - -\item{enforceRowNames}{If \code{TRUE}, row names will be created -depending on the object type, default is \code{TRUE}.} - -\item{niceColumnNamesEnabled}{Logical. If \code{TRUE}, nice looking column -names will be used; syntactic names (variable names) otherwise -(see \code{\link[base]{make.names}}).} -} -\value{ -Returns a \code{\link[base]{matrix}}. -} -\description{ -Returns the \code{FrameSet} as matrix. -} -\details{ -Coerces the frame set to a matrix. -} -\keyword{internal} diff --git a/man/kable.ParameterSetR6.Rd b/man/kable.ParameterSetR6.Rd deleted file mode 100644 index 356e1ec1..00000000 --- a/man/kable.ParameterSetR6.Rd +++ /dev/null @@ -1,24 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_core_parameter_set_r6.R -\name{kable.ParameterSetR6} -\alias{kable.ParameterSetR6} -\title{Create output in Markdown} -\usage{ -kable.ParameterSetR6(x, ...) -} -\arguments{ -\item{x}{A \code{ParameterSet}. If x does not inherit from class \code{\link{ParameterSet}}, -\code{knitr::kable(x)} will be returned.} - -\item{...}{Other arguments (see \code{\link[knitr]{kable}}).} -} -\description{ -The \code{kable()} function returns the output of the specified object formatted in Markdown. -} -\details{ -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. -} diff --git a/man/names.AnalysisResultsR6.Rd b/man/names.AnalysisResultsR6.Rd deleted file mode 100644 index c5748e69..00000000 --- a/man/names.AnalysisResultsR6.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results_r6.R -\name{names.AnalysisResultsR6} -\alias{names.AnalysisResultsR6} -\title{Names of a Analysis Results Object} -\usage{ -\method{names}{AnalysisResultsR6}(x) -} -\arguments{ -\item{x}{An \code{\link{AnalysisResults}} object created by \code{\link[=getAnalysisResults]{getAnalysisResults()}}.} -} -\value{ -Returns a \code{\link[base]{character}} vector containing the names of the \code{\link{AnalysisResults}} object. -} -\description{ -Function to get the names of an \code{\link{AnalysisResults}} object. -} -\details{ -Returns the names of an analysis results that can be accessed by the user. -} -\keyword{internal} diff --git a/man/names.FieldSetR6.Rd b/man/names.FieldSetR6.Rd deleted file mode 100644 index 11d54e2f..00000000 --- a/man/names.FieldSetR6.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_core_parameter_set_r6.R -\name{names.FieldSetR6} -\alias{names.FieldSetR6} -\title{Names of a Field Set Object} -\usage{ -\method{names}{FieldSetR6}(x) -} -\arguments{ -\item{x}{A \code{\link{FieldSet}} object.} -} -\value{ -Returns a \code{\link[base]{character}} vector containing the names of the \code{\link{AnalysisResults}} object. -} -\description{ -Function to get the names of a \code{\link{FieldSet}} object. -} -\details{ -Returns the names of a field set that can be accessed by the user. -} -\keyword{internal} diff --git a/man/names.StageResultsR6.Rd b/man/names.StageResultsR6.Rd deleted file mode 100644 index 8250fbad..00000000 --- a/man/names.StageResultsR6.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_stage_results_r6.R -\name{names.StageResultsR6} -\alias{names.StageResultsR6} -\title{Names of a Stage Results Object} -\usage{ -\method{names}{StageResultsR6}(x) -} -\arguments{ -\item{x}{A \code{\link{StageResults}} object.} -} -\value{ -Returns a \code{\link[base]{character}} vector containing the names of the \code{\link{AnalysisResults}} object. -} -\description{ -Function to get the names of a \code{\link{StageResults}} object. -} -\details{ -Returns the names of stage results that can be accessed by the user. -} -\keyword{internal} diff --git a/man/plot.AnalysisResultsR6.Rd b/man/plot.AnalysisResultsR6.Rd deleted file mode 100644 index 374064f4..00000000 --- a/man/plot.AnalysisResultsR6.Rd +++ /dev/null @@ -1,139 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results_r6.R -\name{plot.AnalysisResultsR6} -\alias{plot.AnalysisResultsR6} -\title{Analysis Results Plotting} -\usage{ -\method{plot}{AnalysisResultsR6}( - 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 -) -} -\arguments{ -\item{x}{The analysis results at given stage, obtained from \code{\link[=getAnalysisResults]{getAnalysisResults()}}.} - -\item{y}{Not available for this kind of plot (is only defined to be compatible to the generic plot function).} - -\item{...}{Optional \link[=param_three_dots_plot]{plot arguments}. Furthermore the following arguments can be defined: -\itemize{ -\item \code{thetaRange}: A range of assumed effect sizes if testing means or a survival design was specified. -Additionally, if testing means was selected, \code{assumedStDev} (assumed standard deviation) -can be specified (default is \code{1}). -\item \code{piTreatmentRange}: A range of assumed rates pi1 to calculate the conditional power. -Additionally, if a two-sample comparison was selected, \code{pi2} can be specified (default is the value from -\code{\link[=getAnalysisResults]{getAnalysisResults()}}). -\item \code{directionUpper}: Specifies the direction of the alternative, -only applicable for one-sided testing; default is \code{TRUE} -which means that larger values of the test statistics yield smaller p-values. -\item \code{\link[=param_thetaH0]{thetaH0}}: The null hypothesis value, default is \code{0} for -the normal and the binary case, it is \code{1} for the survival case. -For testing a rate in one sample, a value thetaH0 in (0, 1) has to be specified for -defining the null hypothesis H0: \code{pi = thetaH0}. -}} - -\item{type}{The plot type (default = 1). Note that at the moment only one type (the conditional power plot) is available.} - -\item{nPlanned}{The additional (i.e., "new" and not cumulative) sample size planned for each of the subsequent stages. -The argument must be a vector with length equal to the number of remaining stages and contain -the combined sample size from both treatment groups if two groups are considered. For survival outcomes, -it should contain the planned number of additional events. -For multi-arm designs, it is the per-comparison (combined) sample size. -For enrichment designs, it is the (combined) sample size for the considered sub-population.} - -\item{allocationRatioPlanned}{The planned allocation ratio \code{n1 / n2} for a two treatment groups -design, default is \code{1}. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. -For simulating means and rates for a two treatment groups design, it can be a vector of length kMax, the number of stages. -It can be a vector of length kMax, too, for multi-arm and enrichment designs. -In these cases, a change of allocating subjects to treatment groups over the stages can be assessed.} - -\item{main}{The main title, default is \code{"Dataset"}.} - -\item{xlab}{The x-axis label, default is \code{"Stage"}.} - -\item{ylab}{The y-axis label.} - -\item{legendTitle}{The legend title, default is \code{""}.} - -\item{palette}{The palette, default is \code{"Set1"}.} - -\item{legendPosition}{The position of the legend. -By default (\code{NA_integer_}) the algorithm tries to find a suitable position. -Choose one of the following values to specify the position manually: -\itemize{ -\item \code{-1}: no legend will be shown -\item \code{NA}: the algorithm tries to find a suitable position -\item \code{0}: legend position outside plot -\item \code{1}: legend position left top -\item \code{2}: legend position left center -\item \code{3}: legend position left bottom -\item \code{4}: legend position right top -\item \code{5}: legend position right center -\item \code{6}: legend position right bottom -}} - -\item{showSource}{Logical. If \code{TRUE}, the parameter names of the object will -be printed which were used to create the plot; that may be, e.g., -useful to check the values or to create own plots with the base R \code{plot} function. -Alternatively \code{showSource} can be defined as one of the following character values: -\itemize{ -\item \code{"commands"}: returns a character vector with plot commands -\item \code{"axes"}: returns a list with the axes definitions -\item \code{"test"}: all plot commands will be validated with \code{eval(parse())} and -returned as character vector (function does not stop if an error occurs) -\item \code{"validate"}: all plot commands will be validated with \code{eval(parse())} and -returned as character vector (function stops if an error occurs) -} -Note: no plot object will be returned if \code{showSource} is a character.} - -\item{grid}{An integer value specifying the output of multiple plots. -By default (\code{1}) a list of \code{ggplot} objects will be returned. -If a \code{grid} value > 1 was specified, a grid plot will be returned -if the number of plots is <= specified \code{grid} value; -a list of \code{ggplot} objects will be returned otherwise. -If \code{grid = 0} is specified, all plots will be created using \code{\link[base]{print}} command -and a list of \code{ggplot} objects will be returned invisible. -Note that one of the following packages must be installed to create a grid plot: -'ggpubr', 'gridExtra', or 'cowplot'.} - -\item{plotSettings}{An object of class \code{PlotSettings} created by \code{\link[=getPlotSettings]{getPlotSetting()s}}.} -} -\value{ -Returns a \code{ggplot2} object. -} -\description{ -Plots the conditional power together with the likelihood function. -} -\details{ -The conditional power is calculated only if effect size and sample size is specified. -} -\examples{ -\dontrun{ -design <- getDesignGroupSequential(kMax = 2) - -dataExample <- getDataset( - n = c(20, 30), - means = c(50, 51), - stDevs = c(130, 140) -) - -result <- getAnalysisResults(design = design, - dataInput = dataExample, thetaH0 = 20, - nPlanned = c(30), thetaH1 = 1.5, stage = 1) - -if (require(ggplot2)) plot(result, thetaRange = c(0, 100)) -} - -} diff --git a/man/plot.ParameterSetR6.Rd b/man/plot.ParameterSetR6.Rd deleted file mode 100644 index 3aa70716..00000000 --- a/man/plot.ParameterSetR6.Rd +++ /dev/null @@ -1,78 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_core_parameter_set_r6.R -\name{plot.ParameterSetR6} -\alias{plot.ParameterSetR6} -\title{Parameter Set Plotting} -\usage{ -\method{plot}{ParameterSetR6}( - x, - y, - ..., - main = NA_character_, - xlab = NA_character_, - ylab = NA_character_, - type = 1L, - palette = "Set1", - legendPosition = NA_integer_, - showSource = FALSE, - plotSettings = NULL -) -} -\arguments{ -\item{x}{The object that inherits from \code{\link{ParameterSet}}.} - -\item{y}{Not available for this kind of plot (is only defined to be compatible to the generic plot function).} - -\item{...}{Optional plot arguments. At the moment \code{xlim} and \code{ylim} are implemented -for changing x or y axis limits without dropping data observations.} - -\item{main}{The main title.} - -\item{xlab}{The x-axis label.} - -\item{ylab}{The y-axis label.} - -\item{type}{The plot type (default = 1).} - -\item{palette}{The palette, default is \code{"Set1"}.} - -\item{legendPosition}{The position of the legend. -By default (\code{NA_integer_}) the algorithm tries to find a suitable position. -Choose one of the following values to specify the position manually: -\itemize{ -\item \code{-1}: no legend will be shown -\item \code{NA}: the algorithm tries to find a suitable position -\item \code{0}: legend position outside plot -\item \code{1}: legend position left top -\item \code{2}: legend position left center -\item \code{3}: legend position left bottom -\item \code{4}: legend position right top -\item \code{5}: legend position right center -\item \code{6}: legend position right bottom -}} - -\item{showSource}{Logical. If \code{TRUE}, the parameter names of the object will -be printed which were used to create the plot; that may be, e.g., -useful to check the values or to create own plots with the base R \code{plot} function. -Alternatively \code{showSource} can be defined as one of the following character values: -\itemize{ -\item \code{"commands"}: returns a character vector with plot commands -\item \code{"axes"}: returns a list with the axes definitions -\item \code{"test"}: all plot commands will be validated with \code{eval(parse())} and -returned as character vector (function does not stop if an error occurs) -\item \code{"validate"}: all plot commands will be validated with \code{eval(parse())} and -returned as character vector (function stops if an error occurs) -} -Note: no plot object will be returned if \code{showSource} is a character.} - -\item{plotSettings}{An object of class \code{PlotSettings} created by \code{\link[=getPlotSettings]{getPlotSetting()s}}.} -} -\value{ -Returns a \code{ggplot2} object. -} -\description{ -Plots an object that inherits from class \code{\link{ParameterSet}}. -} -\details{ -Generic function to plot a parameter set. -} diff --git a/man/plot.StageResultsR6.Rd b/man/plot.StageResultsR6.Rd deleted file mode 100644 index 3935065e..00000000 --- a/man/plot.StageResultsR6.Rd +++ /dev/null @@ -1,132 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_stage_results_r6.R -\name{plot.StageResultsR6} -\alias{plot.StageResultsR6} -\title{Stage Results Plotting} -\usage{ -\method{plot}{StageResultsR6}( - x, - y, - ..., - type = 1L, - nPlanned, - allocationRatioPlanned = 1, - main = NA_character_, - xlab = NA_character_, - ylab = NA_character_, - legendTitle = NA_character_, - palette = "Set1", - legendPosition = NA_integer_, - showSource = FALSE, - plotSettings = NULL -) -} -\arguments{ -\item{x}{The stage results at given stage, obtained from \code{\link[=getStageResults]{getStageResults()}} or -\code{\link[=getAnalysisResults]{getAnalysisResults()}}.} - -\item{y}{Not available for this kind of plot (is only defined to be compatible to the generic plot function).} - -\item{...}{Optional \link[=param_three_dots_plot]{plot arguments}. Furthermore the following arguments can be defined: -\itemize{ -\item \code{thetaRange}: A range of assumed effect sizes if testing means or a survival design was specified. -Additionally, if testing means was selected, an assumed standard deviation can be specified (default is 1). -\item \code{piTreatmentRange}: A range of assumed rates pi1 to calculate the conditional power. -Additionally, if a two-sample comparison was selected, pi2 can be specified (default is the value from -\code{\link[=getAnalysisResults]{getAnalysisResults()}}). -\item \code{directionUpper}: Specifies the direction of the alternative, -only applicable for one-sided testing; default is \code{TRUE} -which means that larger values of the test statistics yield smaller p-values. -\item \code{\link[=param_thetaH0]{thetaH0}}: The null hypothesis value, default is 0 for the normal and the binary case, -it is 1 for the survival case. -For testing a rate in one sample, a value thetaH0 in (0,1) has to be specified for -defining the null hypothesis H0: pi = thetaH0. -}} - -\item{type}{The plot type (default = 1). Note that at the moment only one type -(the conditional power plot) is available.} - -\item{nPlanned}{The additional (i.e., "new" and not cumulative) sample size planned for each of the subsequent stages. -The argument must be a vector with length equal to the number of remaining stages and contain -the combined sample size from both treatment groups if two groups are considered. For survival outcomes, -it should contain the planned number of additional events. -For multi-arm designs, it is the per-comparison (combined) sample size. -For enrichment designs, it is the (combined) sample size for the considered sub-population.} - -\item{allocationRatioPlanned}{The planned allocation ratio \code{n1 / n2} for a two treatment groups -design, default is \code{1}. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. -For simulating means and rates for a two treatment groups design, it can be a vector of length kMax, the number of stages. -It can be a vector of length kMax, too, for multi-arm and enrichment designs. -In these cases, a change of allocating subjects to treatment groups over the stages can be assessed.} - -\item{main}{The main title.} - -\item{xlab}{The x-axis label.} - -\item{ylab}{The y-axis label.} - -\item{legendTitle}{The legend title.} - -\item{palette}{The palette, default is \code{"Set1"}.} - -\item{legendPosition}{The position of the legend. -By default (\code{NA_integer_}) the algorithm tries to find a suitable position. -Choose one of the following values to specify the position manually: -\itemize{ -\item \code{-1}: no legend will be shown -\item \code{NA}: the algorithm tries to find a suitable position -\item \code{0}: legend position outside plot -\item \code{1}: legend position left top -\item \code{2}: legend position left center -\item \code{3}: legend position left bottom -\item \code{4}: legend position right top -\item \code{5}: legend position right center -\item \code{6}: legend position right bottom -}} - -\item{showSource}{Logical. If \code{TRUE}, the parameter names of the object will -be printed which were used to create the plot; that may be, e.g., -useful to check the values or to create own plots with the base R \code{plot} function. -Alternatively \code{showSource} can be defined as one of the following character values: -\itemize{ -\item \code{"commands"}: returns a character vector with plot commands -\item \code{"axes"}: returns a list with the axes definitions -\item \code{"test"}: all plot commands will be validated with \code{eval(parse())} and -returned as character vector (function does not stop if an error occurs) -\item \code{"validate"}: all plot commands will be validated with \code{eval(parse())} and -returned as character vector (function stops if an error occurs) -} -Note: no plot object will be returned if \code{showSource} is a character.} - -\item{plotSettings}{An object of class \code{PlotSettings} created by \code{\link[=getPlotSettings]{getPlotSetting()s}}.} -} -\value{ -Returns a \code{ggplot2} object. -} -\description{ -Plots the conditional power together with the likelihood function. -} -\details{ -Generic function to plot all kinds of stage results. -The conditional power is calculated only if effect size and sample size is specified. -} -\examples{ -design <- getDesignGroupSequential( - kMax = 4, alpha = 0.025, - informationRates = c(0.2, 0.5, 0.8, 1), - typeOfDesign = "WT", deltaWT = 0.25 -) - -dataExample <- getDataset( - n = c(20, 30, 30), - means = c(50, 51, 55), - stDevs = c(130, 140, 120) -) - -stageResults <- getStageResults(design, dataExample, thetaH0 = 20) - -\dontrun{ -if (require(ggplot2)) plot(stageResults, nPlanned = c(30), thetaRange = c(0, 100)) -} - -} diff --git a/man/print.FieldSetR6.Rd b/man/print.FieldSetR6.Rd deleted file mode 100644 index 47230409..00000000 --- a/man/print.FieldSetR6.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_core_parameter_set_r6.R -\name{print.FieldSetR6} -\alias{print.FieldSetR6} -\title{Print Field Set Values} -\usage{ -\method{print}{FieldSetR6}(x, ...) -} -\arguments{ -\item{x}{A \code{\link{FieldSet}} object.} - -\item{...}{Ensures that all arguments (starting from the "...") are to be named and -that a warning will be displayed if unknown arguments are passed.} -} -\description{ -\code{print} prints its \code{\link{FieldSet}} argument and returns it invisibly (via \code{invisible(x)}). -} -\details{ -Prints the field set. -} -\keyword{internal} diff --git a/man/print.ParameterSetR6.Rd b/man/print.ParameterSetR6.Rd deleted file mode 100644 index 572446af..00000000 --- a/man/print.ParameterSetR6.Rd +++ /dev/null @@ -1,24 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_core_parameter_set_r6.R -\name{print.ParameterSetR6} -\alias{print.ParameterSetR6} -\title{Print Parameter Set Values} -\usage{ -\method{print}{ParameterSetR6}(x, ..., markdown = FALSE) -} -\arguments{ -\item{x}{The \code{\link{ParameterSet}} object to print.} - -\item{...}{Ensures that all arguments (starting from the "...") are to be named and -that a warning will be displayed if unknown arguments are passed.} - -\item{markdown}{If \code{TRUE}, the object \code{x} will be printed using markdown syntax; -normal representation will be used otherwise (default is \code{FALSE})} -} -\description{ -\code{print} prints its \code{ParameterSet} argument and returns it invisibly (via \code{invisible(x)}). -} -\details{ -Prints the parameters and results of a parameter set. -} -\keyword{internal} diff --git a/man/summary.AnalysisResultsR6.Rd b/man/summary.AnalysisResultsR6.Rd deleted file mode 100644 index e2b10a70..00000000 --- a/man/summary.AnalysisResultsR6.Rd +++ /dev/null @@ -1,63 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_analysis_results_r6.R -\name{summary.AnalysisResultsR6} -\alias{summary.AnalysisResultsR6} -\title{Analysis Results Summary} -\usage{ -\method{summary}{AnalysisResultsR6}(object, ..., type = 1, digits = NA_integer_) -} -\arguments{ -\item{object}{An \code{\link{AnalysisResults}} object.} - -\item{...}{Ensures that all arguments (starting from the "...") are to be named and -that a warning will be displayed if unknown arguments are passed.} - -\item{digits}{Defines how many digits are to be used for numeric values. Must be a positive integer of length 1.} -} -\value{ -Returns a \code{\link{SummaryFactory}} object. -The following generics (R generic functions) are available for this result object: -\itemize{ -\item \code{\link[=names.FieldSet]{names()}} to obtain the field names, -\item \code{\link[=print.FieldSet]{print()}} to print the object -} -} -\description{ -Displays a summary of \code{\link{AnalysisResults}} object. -} -\details{ -Summarizes the parameters and results of an analysis results object. -} -\section{Summary options}{ - -The following options can be set globally: -\enumerate{ -\item \code{rpact.summary.output.size}: one of \code{c("small", "medium", "large")}; -defines how many details will be included into the summary; -default is \code{"large"}, i.e., all available details are displayed. -\item \code{rpact.summary.justify}: one of \code{c("right", "left", "centre")}; -shall the values be right-justified (the default), left-justified or centered. -\item \code{rpact.summary.width}: defines the maximum number of characters to be used per line (default is \code{83}). -\item \code{rpact.summary.intervalFormat}: defines how intervals will be displayed in the summary, -default is \code{"[\%s; \%s]"}. -\item \code{rpact.summary.digits}: defines how many digits are to be used for numeric values (default is \code{3}). -\item \code{rpact.summary.digits.probs}: defines how many digits are to be used for numeric values -(default is one more than value of \code{rpact.summary.digits}, i.e., \code{4}). -\item \code{rpact.summary.trim.zeroes}: if \code{TRUE} (default) zeroes will always displayed as "0", -e.g. "0.000" will become "0". -} -Example: \code{options("rpact.summary.intervalFormat" = "\%s - \%s")} -} - -\section{How to get help for generic functions}{ - -Click on the link of a generic in the list above to go directly to the help documentation of -the \code{rpact} specific implementation of the generic. -Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and -to identify the object specific name of it, e.g., -use \code{methods("plot")} to get all the methods for the \code{plot} generic. -There you can find, e.g., \code{plot.AnalysisResults} and -obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. -} - -\keyword{internal} diff --git a/man/summary.ParameterSetR6.Rd b/man/summary.ParameterSetR6.Rd deleted file mode 100644 index e2e9bd89..00000000 --- a/man/summary.ParameterSetR6.Rd +++ /dev/null @@ -1,69 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_core_parameter_set_r6.R -\name{summary.ParameterSetR6} -\alias{summary.ParameterSetR6} -\title{Parameter Set Summary} -\usage{ -\method{summary}{ParameterSetR6}( - object, - ..., - type = 1, - digits = NA_integer_, - output = c("all", "title", "overview", "body") -) -} -\arguments{ -\item{object}{A \code{\link{ParameterSet}} object.} - -\item{...}{Ensures that all arguments (starting from the "...") are to be named and -that a warning will be displayed if unknown arguments are passed.} - -\item{digits}{Defines how many digits are to be used for numeric values. Must be a positive integer of length 1.} -} -\value{ -Returns a \code{\link{SummaryFactory}} object. -The following generics (R generic functions) are available for this result object: -\itemize{ -\item \code{\link[=names.FieldSet]{names()}} to obtain the field names, -\item \code{\link[=print.FieldSet]{print()}} to print the object -} -} -\description{ -Displays a summary of \code{\link{ParameterSet}} object. -} -\details{ -Summarizes the parameters and results of a parameter set. -} -\section{Summary options}{ - -The following options can be set globally: -\enumerate{ -\item \code{rpact.summary.output.size}: one of \code{c("small", "medium", "large")}; -defines how many details will be included into the summary; -default is \code{"large"}, i.e., all available details are displayed. -\item \code{rpact.summary.justify}: one of \code{c("right", "left", "centre")}; -shall the values be right-justified (the default), left-justified or centered. -\item \code{rpact.summary.width}: defines the maximum number of characters to be used per line (default is \code{83}). -\item \code{rpact.summary.intervalFormat}: defines how intervals will be displayed in the summary, -default is \code{"[\%s; \%s]"}. -\item \code{rpact.summary.digits}: defines how many digits are to be used for numeric values (default is \code{3}). -\item \code{rpact.summary.digits.probs}: defines how many digits are to be used for numeric values -(default is one more than value of \code{rpact.summary.digits}, i.e., \code{4}). -\item \code{rpact.summary.trim.zeroes}: if \code{TRUE} (default) zeroes will always displayed as "0", -e.g. "0.000" will become "0". -} -Example: \code{options("rpact.summary.intervalFormat" = "\%s - \%s")} -} - -\section{How to get help for generic functions}{ - -Click on the link of a generic in the list above to go directly to the help documentation of -the \code{rpact} specific implementation of the generic. -Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and -to identify the object specific name of it, e.g., -use \code{methods("plot")} to get all the methods for the \code{plot} generic. -There you can find, e.g., \code{plot.AnalysisResults} and -obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. -} - -\keyword{internal} From 9d5f5214c435320c4178f73f13a45e003278b2b6 Mon Sep 17 00:00:00 2001 From: Till Jensen Date: Thu, 14 Mar 2024 12:17:34 +0100 Subject: [PATCH 16/28] removed whitespace changes --- R/class_analysis_stage_results.R | 2 +- tests/testthat/test-class_summary.R | 1169 ++-- tests/testthat/test-class_time.R | 5469 ++++++++--------- tests/testthat/test-f_analysis_base_rates.R | 4867 ++++++++------- .../test-f_analysis_enrichment_rates.R | 1335 ++-- .../test-f_analysis_input_validation.R | 229 +- tests/testthat/test-f_core_assertions.R | 507 +- tests/testthat/test-f_core_output_formats.R | 885 ++- tests/testthat/test-f_core_plot.R | 231 +- .../test-f_design_fisher_combination_test.R | 1129 ++-- .../testthat/test-f_design_group_sequential.R | 4217 +++++++------ .../testthat/test-f_parameter_set_utilities.R | 173 +- tests/testthat/test-generic_functions.R | 319 +- 13 files changed, 10260 insertions(+), 10272 deletions(-) diff --git a/R/class_analysis_stage_results.R b/R/class_analysis_stage_results.R index 61c451d3..b003828e 100644 --- a/R/class_analysis_stage_results.R +++ b/R/class_analysis_stage_results.R @@ -29,7 +29,7 @@ #' #' @template field_stages #' @template field_testStatistics -#' @template field_pValues +#' @template field_pValues #' @template field_combInverseNormal #' @template field_combFisher #' @template field_effectSizes diff --git a/tests/testthat/test-class_summary.R b/tests/testthat/test-class_summary.R index a914e871..73912fc9 100644 --- a/tests/testthat/test-class_summary.R +++ b/tests/testthat/test-class_summary.R @@ -1,585 +1,584 @@ -## | -## | *Unit tests* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | RPACT package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File name: test-class_summary.R -## | Creation date: 08 November 2023, 08:49:48 -## | File version: $Revision$ -## | Last changed: $Date$ -## | Last changed by: $Author$ -## | - -test_plan_section("Testing Class 'SummaryFactory'") - - -test_that("Testing 'summary.ParameterSet': no errors occur", { - .skipTestIfDisabled() - - # @refFS[Function]{fs:outputOfGenericFunctions} - invisible(capture.output(expect_error(summary(getDesignGroupSequential( - beta = 0.05, typeOfDesign = "asKD", gammaA = 1, typeBetaSpending = "bsOF" - )), NA))) - invisible(capture.output(expect_error(summary(getDesignGroupSequential(kMax = 1)), NA))) - invisible(capture.output(expect_error(summary(getDesignGroupSequential(kMax = 4, sided = 2)), NA))) - invisible(capture.output(expect_error(summary(getDesignGroupSequential(kMax = 4, sided = 2), digits = 0), NA))) - invisible(capture.output(expect_error(summary(getDesignGroupSequential(kMax = 1, sided = 2)), NA))) - invisible(capture.output(expect_error(summary(getDesignGroupSequential(futilityBounds = c(-6, 0))), NA))) - invisible(capture.output(expect_error(summary(getDesignGroupSequential(futilityBounds = c(-6, 0)), digits = 5), NA))) - - invisible(capture.output(expect_error(summary(getDataset( - n = c(13, 25), - means = c(242, 222), - stDevs = c(244, 221) - )), NA))) - - invisible(capture.output(expect_error(summary(getDataset( - n = c(13), - means = c(242), - stDevs = c(244) - )), NA))) - - invisible(capture.output(expect_error(summary(getDataset( - n1 = c(13, 25), - n2 = c(15, NA), - n3 = c(14, 27), - n4 = c(12, 29), - means1 = c(242, 222), - means2 = c(188, NA), - means3 = c(267, 277), - means4 = c(92, 122), - stDevs1 = c(244, 221), - stDevs2 = c(212, NA), - stDevs3 = c(256, 232), - stDevs4 = c(215, 227) - )), NA))) - - invisible(capture.output(expect_error(summary(getDataset( - n1 = c(11, 13, 12, 13), - n2 = c(8, 10, 9, 11), - n3 = c(7, 10, 8, 9), - events1 = c(10, 10, 12, 12), - events2 = c(3, 5, 5, 6), - events3 = c(2, 4, 3, 5) - )), NA))) - - invisible(capture.output(expect_error(summary(getDataset( - events1 = c(25, 32), - events2 = c(18, NA), - events3 = c(22, 36), - logRanks1 = c(2.2, 1.8), - logRanks2 = c(1.99, NA), - logRanks3 = c(2.32, 2.11) - )), NA))) - - invisible(capture.output(expect_error(summary(getDesignInverseNormal(kMax = 1)), NA))) - invisible(capture.output(expect_error(summary(getDesignInverseNormal(futilityBounds = c(0, 1))), NA))) - invisible(capture.output(expect_error(summary(getDesignInverseNormal(kMax = 1)), NA))) - invisible(capture.output(expect_error(summary(getDesignInverseNormal(kMax = 4, sided = 2)), NA))) - invisible(capture.output(expect_error(summary(getDesignInverseNormal(kMax = 4, sided = 2), digits = 0), NA))) - invisible(capture.output(expect_error(summary(getDesignInverseNormal(kMax = 1, sided = 2)), NA))) - - invisible(capture.output(expect_error(summary(getDesignFisher()), NA))) - invisible(capture.output(expect_error(summary(getDesignFisher(alpha0Vec = c(0.1, 0.2))), NA))) - invisible(capture.output(expect_error(summary(getDesignFisher(kMax = 1)), NA))) - invisible(capture.output(expect_error(summary(getDesignFisher(kMax = 4), digits = 5), NA))) - invisible(capture.output(expect_error(summary(getDesignFisher(kMax = 4), digits = 0), NA))) - invisible(capture.output(expect_error(summary(getDesignFisher(kMax = 1)), NA))) - - ## test design plans - means - - invisible(capture.output(expect_error(summary(getSampleSizeMeans(sided = 2, alternative = -0.5)), NA))) - invisible(capture.output(expect_warning(summary(getSampleSizeMeans(sided = 2), alternative = -0.5)))) # warning expected - invisible(capture.output(expect_error(summary(getPowerMeans( - sided = 1, alternative = c(-0.5, -0.3), - maxNumberOfSubjects = 100, directionUpper = FALSE - )), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeMeans( - thetaH0 = 0, - alternative = 0.5, sided = 1, stDev = 2.5 - )), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeMeans( - thetaH0 = 0, - alternative = 0.5, sided = 1, stDev = 1, groups = 1 - )), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeMeans( - thetaH0 = 0, - sided = 2, stDev = 1, groups = 1 - )), NA))) - - invisible(capture.output(expect_error(summary(getSampleSizeMeans( - thetaH0 = 0, - alternative = 1.2, sided = 2, stDev = 5 - )), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeMeans( - thetaH0 = 0, - alternative = 1.2, sided = 2, stDev = 5, allocationRatioPlanned = 0 - )), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeMeans( - thetaH0 = 0, - alternative = 1.2, sided = 2, stDev = 5, groups = 1 - )), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeMeans( - getDesignGroupSequential(futilityBounds = c(1, 2)) - )), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeMeans( - getDesignGroupSequential(futilityBounds = c(1, 2)) - ), digits = 0), NA))) - invisible(capture.output(expect_error(summary(getPowerMeans( - getDesignGroupSequential(futilityBounds = c(1, 2)), - maxNumberOfSubjects = 100, alternative = 1 - )), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeMeans( - getDesignGroupSequential(kMax = 4, sided = 2) - )), NA))) - invisible(capture.output(expect_error(summary(getPowerMeans( - getDesignGroupSequential(kMax = 4, sided = 2), - maxNumberOfSubjects = 100 - )), NA))) - invisible(capture.output(expect_error(summary(getPowerMeans( - getDesignGroupSequential(kMax = 1, sided = 2), - maxNumberOfSubjects = 100 - )), NA))) - - invisible(capture.output(expect_error(summary(getSampleSizeMeans( - getDesignGroupSequential(futilityBounds = c(1, 2)) - )), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeMeans( - getDesignGroupSequential(futilityBounds = c(1, 2)) - ), digits = 4), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeMeans( - getDesignGroupSequential(futilityBounds = c(1, 2)) - ), digits = 3), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeMeans( - getDesignGroupSequential(futilityBounds = c(1, 2)) - ), digits = 2), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeMeans( - getDesignGroupSequential(futilityBounds = c(1, 2)) - ), digits = -1), NA))) - - ## test design plans - rates - - invisible(capture.output(expect_error(summary(getSampleSizeRates(pi2 = 0.3)), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeRates(groups = 1, thetaH0 = 0.3)), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeRates(groups = 1, thetaH0 = 0.45)), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeRates( - groups = 2, thetaH0 = 0.45, allocationRatioPlanned = 0 - )), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeRates( - getDesignGroupSequential(futilityBounds = c(1, 2)) - )), NA))) - invisible(capture.output(expect_error(summary(getPowerRates( - getDesignGroupSequential(futilityBounds = c(1, 2)), - maxNumberOfSubjects = 100 - )), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeRates( - getDesignGroupSequential(kMax = 4, sided = 2) - )), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeRates( - getDesignGroupSequential(kMax = 4, sided = 2), - groups = 1, thetaH0 = 0.3 - )), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeRates( - getDesignGroupSequential(kMax = 1, sided = 2), - groups = 1, thetaH0 = 0.2, pi1 = c(0.4, 0.5) - )), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeRates( - getDesignGroupSequential(kMax = 1, sided = 2), - groups = 1, thetaH0 = 0.2, pi1 = 0.4 - )), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeRates( - getDesignGroupSequential(kMax = 1, sided = 2), - groups = 2, thetaH0 = 0, pi1 = 0.25 - )), NA))) - invisible(capture.output(expect_error(summary(getPowerRates( - getDesignGroupSequential(kMax = 4, sided = 2), - maxNumberOfSubjects = 100 - )), NA))) - - ## test design plans - survival - - invisible(capture.output(expect_error(summary(getSampleSizeSurvival()), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeSurvival(lambda2 = 0.3, hazardRatio = 1.2)), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeSurvival(lambda2 = 0.3, hazardRatio = c(1.2, 2))), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeSurvival(pi2 = 0.3, hazardRatio = 1.2)), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeSurvival(pi1 = 0.1, pi2 = 0.3)), NA))) - - invisible(capture.output(expect_error(summary(getSampleSizeSurvival(lambda2 = 0.03, lambda1 = c(0.040))), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeSurvival(piecewiseSurvivalTime = list( - "0 - <6" = 0.025, - "6 - <9" = 0.04, - "9 - <15" = 0.015, - "15 - <21" = 0.01, - ">=21" = 0.007 - ), hazardRatio = 1.2)), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeSurvival( - getDesignGroupSequential(futilityBounds = c(1, 2)) - )), NA))) - invisible(capture.output(expect_error(summary(getPowerSurvival( - getDesignGroupSequential(futilityBounds = c(1, 2)), - maxNumberOfSubjects = 100, maxNumberOfEvents = 60 - )), NA))) - invisible(capture.output(expect_error(summary(getSampleSizeSurvival( - getDesignGroupSequential(kMax = 4, sided = 2) - )), NA))) - invisible(capture.output(expect_error(summary(getPowerSurvival( - getDesignGroupSequential(kMax = 4, sided = 2), - maxNumberOfSubjects = 100, maxNumberOfEvents = 60 - )), NA))) - - invisible(capture.output(expect_error(summary(getSampleSizeSurvival(sided = 2, lambda2 = log(2) / 6, lambda1 = log(2) / 8)), NA))) - - invisible(capture.output(expect_error(summary(getPowerSurvival(sided = 2, maxNumberOfSubjects = 200, maxNumberOfEvents = 40, lambda2 = log(2) / 6, lambda1 = log(2) / 8)), NA))) - - invisible(capture.output(expect_error(summary(getSampleSizeSurvival( - getDesignGroupSequential(sided = 2), - lambda2 = log(2) / 6, hazardRatio = c(0.55), - accrualTime = c(0, 10), accrualIntensity = 20 - )), NA))) - - invisible(capture.output(expect_error(summary(getPowerSurvival( - getDesignGroupSequential(kMax = 2), - maxNumberOfEvents = 200, maxNumberOfSubjects = 400, - lambda2 = log(2) / 60, lambda1 = log(2) / 50, - dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, - accrualTime = 0, accrualIntensity = 30 - )), NA))) - - invisible(capture.output(expect_error(summary(getPowerSurvival( - getDesignGroupSequential(kMax = 3), - maxNumberOfEvents = 200, maxNumberOfSubjects = 400, - lambda2 = log(2) / 60, lambda1 = c(log(2) / 50, log(2) / 60), - dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, - accrualTime = 0, accrualIntensity = 30 - )), NA))) - - invisible(capture.output(expect_error(summary(getPowerSurvival( - getDesignGroupSequential(kMax = 3), - maxNumberOfEvents = 200, maxNumberOfSubjects = 400, - lambda2 = log(2) / 60, hazardRatio = c(0.7, 0.8), directionUpper = FALSE, - dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, - accrualTime = 0, accrualIntensity = 30 - )), NA))) - - design1 <- getDesignGroupSequential( - sided = 2, alpha = 0.05, beta = 0.2, - informationRates = c(0.6, 1), - typeOfDesign = "asOF", twoSidedPower = FALSE - ) - - invisible(capture.output(expect_error(summary(getSampleSizeSurvival( - design1, - lambda2 = log(2) / 60, hazardRatio = 0.74, - dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, - accrualTime = 0, accrualIntensity = 30, - followUpTime = 12 - )), NA))) - - invisible(capture.output(expect_error(summary(getSampleSizeSurvival( - design1, - lambda2 = log(2) / 60, lambda1 = log(2) / 50, - dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, - accrualTime = 0, accrualIntensity = 30, - followUpTime = 12 - )), NA))) - - invisible(capture.output(expect_error(summary(getSampleSizeSurvival( - getDesignGroupSequential(kMax = 4, sided = 2) - )), NA))) - - ## simulations - - design2 <- getDesignInverseNormal( - alpha = 0.05, kMax = 4, futilityBounds = c(0, 0, 0), - sided = 1, typeOfDesign = "WT", deltaWT = 0.1 - ) - - invisible(capture.output(expect_error(summary(getSimulationSurvival(design2, - lambda2 = log(2) / 60, lambda1 = c(log(2) / 80), - maxNumberOfSubjects = 1000, plannedEvents = c(50, 100, 150, 200), seed = 12345, directionUpper = FALSE - )), NA))) - - invisible(capture.output(expect_error(summary(getSimulationSurvival(design2, - lambda2 = log(2) / 60, hazardRatio = c(1.2, 1.4), - maxNumberOfSubjects = 1000, plannedEvents = c(50, 100, 150, 200), seed = 12345 - )), NA))) - - design3 <- getDesignGroupSequential(typeOfDesign = "P", futilityBounds = c(1, 1)) - - invisible(capture.output(expect_error(summary(getSampleSizeMeans(design3)), NA))) - - invisible(capture.output(expect_error(summary(getSimulationMeans(design3, stDev = 4, plannedSubjects = (1:3) * 200, alternative = c(1, 2))), NA))) - - invisible(capture.output(expect_error(summary(getSimulationRates(design3, - plannedSubjects = (1:3) * 200, pi1 = c(0.3, 0.4), maxNumberOfIterations = 1000, - minNumberOfSubjectsPerStage = c(NA, 40, 40), maxNumberOfSubjectsPerStage = c(NA, 40, 400), conditionalPower = 0.8 - )), NA))) - - invisible(capture.output(expect_error(summary(getSimulationMeans( - getDesignGroupSequential(kMax = 1), - stDev = 4, plannedSubjects = 200, alternative = c(1) - )), NA))) - -}) - -test_that("Testing 'summary.ParameterSet': output will be produced", { - - .skipTestIfDisabled() - - # @refFS[Function]{fs:outputOfGenericFunctions} - expect_output(summary(getDesignGroupSequential(beta = 0.05, typeOfDesign = "asKD", gammaA = 1, typeBetaSpending = "bsOF"))$show()) - expect_output(summary(getDesignGroupSequential(kMax = 1))$show()) - expect_output(summary(getDesignGroupSequential(kMax = 4, sided = 2))$show()) - expect_output(summary(getDesignGroupSequential(kMax = 4, sided = 2), digits = 0)$show()) - expect_output(summary(getDesignGroupSequential(kMax = 1, sided = 2))$show()) - expect_output(summary(getDesignGroupSequential(futilityBounds = c(-6, 0)))$show()) - expect_output(summary(getDesignGroupSequential(futilityBounds = c(-6, 0)), digits = 5)$show()) - - expect_output(summary(getDataset( - n = c(13, 25), - means = c(242, 222), - stDevs = c(244, 221) - ))$show()) - - expect_output(summary(getDataset( - n = c(13), - means = c(242), - stDevs = c(244) - ))$show()) - - expect_output(summary(getDataset( - n1 = c(13, 25), - n2 = c(15, NA), - n3 = c(14, 27), - n4 = c(12, 29), - means1 = c(242, 222), - means2 = c(188, NA), - means3 = c(267, 277), - means4 = c(92, 122), - stDevs1 = c(244, 221), - stDevs2 = c(212, NA), - stDevs3 = c(256, 232), - stDevs4 = c(215, 227) - ))$show()) - - expect_output(summary(getDataset( - n1 = c(11, 13, 12, 13), - n2 = c(8, 10, 9, 11), - n3 = c(7, 10, 8, 9), - events1 = c(10, 10, 12, 12), - events2 = c(3, 5, 5, 6), - events3 = c(2, 4, 3, 5) - ))$show()) - - expect_output(summary(getDataset( - events1 = c(25, 32), - events2 = c(18, NA), - events3 = c(22, 36), - logRanks1 = c(2.2, 1.8), - logRanks2 = c(1.99, NA), - logRanks3 = c(2.32, 2.11) - ))$show()) - - expect_output(summary(getDesignInverseNormal(kMax = 1))$show()) - expect_output(summary(getDesignInverseNormal(futilityBounds = c(0, 1)))$show()) - expect_output(summary(getDesignInverseNormal(kMax = 1))$show()) - expect_output(summary(getDesignInverseNormal(kMax = 4, sided = 2))$show()) - expect_output(summary(getDesignInverseNormal(kMax = 4, sided = 2), digits = 0)$show()) - expect_output(summary(getDesignInverseNormal(kMax = 1, sided = 2))$show()) - - expect_output(summary(getDesignFisher())$show()) - expect_output(summary(getDesignFisher(alpha0Vec = c(0.1, 0.2)))$show()) - expect_output(summary(getDesignFisher(kMax = 1))$show()) - expect_output(summary(getDesignFisher(kMax = 4), digits = 5)$show()) - expect_output(summary(getDesignFisher(kMax = 4), digits = 0)$show()) - expect_output(summary(getDesignFisher(kMax = 1))$show()) - - ## test design plans - means - - expect_output(summary(getSampleSizeMeans(sided = 2, alternative = -0.5))$show()) - expect_output(summary(getPowerMeans(sided = 1, alternative = c(-0.5, -0.3), maxNumberOfSubjects = 100, directionUpper = FALSE))$show()) - expect_output(summary(getSampleSizeMeans(thetaH0 = 0, alternative = 0.5, sided = 1, stDev = 2.5))$show()) - expect_output(summary(getSampleSizeMeans(thetaH0 = 0, alternative = 0.5, sided = 1, stDev = 1, groups = 1))$show()) - expect_output(summary(getSampleSizeMeans(thetaH0 = 0, sided = 2, stDev = 1, groups = 1))$show()) - - expect_output(summary(getSampleSizeMeans(thetaH0 = 0, alternative = 1.2, sided = 2, stDev = 5))$show()) - expect_output(summary(getSampleSizeMeans(thetaH0 = 0, alternative = 1.2, sided = 2, stDev = 5, allocationRatioPlanned = 0))$show()) - expect_output(summary(getSampleSizeMeans(thetaH0 = 0, alternative = 1.2, sided = 2, stDev = 5, groups = 1))$show()) - expect_output(summary(getSampleSizeMeans( - getDesignGroupSequential(futilityBounds = c(1, 2)) - ))$show()) - expect_output(summary(getSampleSizeMeans( - getDesignGroupSequential(futilityBounds = c(1, 2)) - ), digits = 0)$show()) - expect_output(summary(getPowerMeans( - getDesignGroupSequential(futilityBounds = c(1, 2)), - maxNumberOfSubjects = 100, alternative = 1 - ))$show()) - expect_output(summary(getSampleSizeMeans( - getDesignGroupSequential(kMax = 4, sided = 2) - ))$show()) - expect_output(summary(getPowerMeans( - getDesignGroupSequential(kMax = 4, sided = 2), - maxNumberOfSubjects = 100 - ))$show()) - expect_output(summary(getPowerMeans( - getDesignGroupSequential(kMax = 1, sided = 2), - maxNumberOfSubjects = 100 - ))$show()) - - expect_output(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2))))$show()) - expect_output(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2))), digits = 4)$show()) - expect_output(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2))), digits = 3)$show()) - expect_output(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2))), digits = 2)$show()) - expect_output(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2))), digits = -1)$show()) - - ## test design plans - rates - - expect_output(summary(getSampleSizeRates(pi2 = 0.3))$show()) - expect_output(summary(getSampleSizeRates(groups = 1, thetaH0 = 0.3))$show()) - expect_output(summary(getSampleSizeRates(groups = 1, thetaH0 = 0.45))$show()) - expect_output(summary(getSampleSizeRates(groups = 2, thetaH0 = 0.45, allocationRatioPlanned = 0))$show()) - expect_output(summary(getSampleSizeRates(getDesignGroupSequential(futilityBounds = c(1, 2))))$show()) - expect_output(summary(getPowerRates(getDesignGroupSequential(futilityBounds = c(1, 2)), maxNumberOfSubjects = 100))$show()) - expect_output(summary(getSampleSizeRates(getDesignGroupSequential(kMax = 4, sided = 2)))$show()) - expect_output(summary(getSampleSizeRates(getDesignGroupSequential(kMax = 4, sided = 2), groups = 1, thetaH0 = 0.3))$show()) - expect_output(summary(getSampleSizeRates(getDesignGroupSequential(kMax = 1, sided = 2), - groups = 1, thetaH0 = 0.2, pi1 = c(0.4, 0.5) - ))$show()) - expect_output(summary(getSampleSizeRates(getDesignGroupSequential( - kMax = 1, sided = 2 - ), groups = 1, thetaH0 = 0.2, pi1 = 0.4))$show()) - expect_output(summary(getSampleSizeRates(getDesignGroupSequential( - kMax = 1, sided = 2 - ), groups = 2, thetaH0 = 0, pi1 = 0.25))$show()) - expect_output(summary(getPowerRates(getDesignGroupSequential(kMax = 4, sided = 2), maxNumberOfSubjects = 100))$show()) - - ## test design plans - survival - - expect_output(summary(getSampleSizeSurvival())$show()) - expect_output(summary(getSampleSizeSurvival(lambda2 = 0.3, hazardRatio = 1.2))$show()) - expect_output(summary(getSampleSizeSurvival(lambda2 = 0.3, hazardRatio = c(1.2, 2)))$show()) - expect_output(summary(getSampleSizeSurvival(pi2 = 0.3, hazardRatio = 1.2))$show()) - expect_output(summary(getSampleSizeSurvival(pi1 = 0.1, pi2 = 0.3))$show()) - - expect_output(summary(getSampleSizeSurvival(lambda2 = 0.03, lambda1 = c(0.040)))$show()) - expect_output(summary(getSampleSizeSurvival(piecewiseSurvivalTime = list( - "0 - <6" = 0.025, - "6 - <9" = 0.04, - "9 - <15" = 0.015, - "15 - <21" = 0.01, - ">=21" = 0.007 - ), hazardRatio = 1.2))$show()) - expect_output(summary(getSampleSizeSurvival(getDesignGroupSequential(futilityBounds = c(1, 2))))$show()) - expect_output(summary(getPowerSurvival(getDesignGroupSequential(futilityBounds = c(1, 2)), - maxNumberOfSubjects = 100, maxNumberOfEvents = 60 - ))$show()) - expect_output(summary(getSampleSizeSurvival(getDesignGroupSequential(kMax = 4, sided = 2)))$show()) - expect_output(summary(getPowerSurvival(getDesignGroupSequential(kMax = 4, sided = 2), - maxNumberOfSubjects = 100, maxNumberOfEvents = 60 - ))$show()) - - expect_output(summary(getSampleSizeSurvival(sided = 2, lambda2 = log(2) / 6, lambda1 = log(2) / 8))$show()) - - expect_output(summary(getPowerSurvival( - sided = 2, maxNumberOfSubjects = 200, - maxNumberOfEvents = 40, lambda2 = log(2) / 6, lambda1 = log(2) / 8 - ))$show()) - - expect_warning(expect_output(summary(getSampleSizeSurvival(getDesignGroupSequential(sided = 2), - lambda2 = log(2) / 6, hazardRatio = c(0.55), - accrualTime = c(0, 10), accrualIntensity = 60 - ))$show()), - "Accrual duration longer than maximal study duration (time to maximal number of events); followUpTime = -2.959", - fixed = TRUE - ) - - expect_output(summary(getPowerSurvival(getDesignGroupSequential(kMax = 2), - maxNumberOfEvents = 150, maxNumberOfSubjects = 400, - lambda2 = log(2) / 60, lambda1 = log(2) / 50, - dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, - accrualTime = 0, accrualIntensity = 30 - ))$show()) - - expect_output(summary(getPowerSurvival(getDesignGroupSequential(kMax = 3), - maxNumberOfEvents = 200, maxNumberOfSubjects = 400, - lambda2 = log(2) / 60, lambda1 = c(log(2) / 50, log(2) / 60), - dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, - accrualTime = 0, accrualIntensity = 30 - ))$show()) - - expect_output(summary(getPowerSurvival(getDesignGroupSequential(kMax = 3), - maxNumberOfEvents = 200, maxNumberOfSubjects = 400, - lambda2 = log(2) / 60, hazardRatio = c(0.7, 0.8), directionUpper = FALSE, - dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, - accrualTime = 0, accrualIntensity = 30 - ))$show()) - - design1 <- getDesignGroupSequential( - sided = 2, alpha = 0.05, beta = 0.2, - informationRates = c(0.6, 1), - typeOfDesign = "asOF", twoSidedPower = FALSE - ) - - expect_output(summary(getSampleSizeSurvival( - design1, - lambda2 = log(2) / 60, hazardRatio = 0.74, - dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, - accrualTime = 0, accrualIntensity = 30, - followUpTime = 12 - ))$show()) - - expect_output(summary(getSampleSizeSurvival( - design1, - lambda2 = log(2) / 60, lambda1 = log(2) / 50, - dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, - accrualTime = 0, accrualIntensity = 30, - followUpTime = 12 - ))$show()) - - expect_output(summary(getSampleSizeSurvival(getDesignGroupSequential(kMax = 4, sided = 2)))$show()) - - ## simulations - - design2 <- getDesignInverseNormal( - alpha = 0.05, kMax = 4, futilityBounds = c(0, 0, 0), - sided = 1, typeOfDesign = "WT", deltaWT = 0.1 - ) - - expect_output(summary(getSimulationSurvival(design2, - lambda2 = log(2) / 60, lambda1 = c(log(2) / 80), - maxNumberOfSubjects = 1000, plannedEvents = c(50, 100, 150, 200), seed = 12345, directionUpper = FALSE - ))$show()) - - expect_output(summary(getSimulationSurvival(design2, - lambda2 = log(2) / 60, hazardRatio = c(1.2, 1.4), - maxNumberOfSubjects = 1000, plannedEvents = c(50, 100, 150, 200), seed = 12345 - ))$show()) - - design3 <- getDesignGroupSequential(typeOfDesign = "P", futilityBounds = c(1, 1)) - - expect_output(summary(getSampleSizeMeans(design3))$show()) - - expect_output(summary(getSimulationMeans(design3, stDev = 4, plannedSubjects = (1:3) * 200, alternative = c(1, 2)))$show()) - - expect_output(summary(getSimulationRates(design3, - plannedSubjects = (1:3) * 200, pi1 = c(0.3, 0.4), maxNumberOfIterations = 1000, - minNumberOfSubjectsPerStage = c(NA, 40, 40), maxNumberOfSubjectsPerStage = c(NA, 40, 400), conditionalPower = 0.8 - ))$show()) - - expect_output(summary(getSimulationMeans(getDesignGroupSequential(kMax = 1), - stDev = 4, plannedSubjects = 200, alternative = 1 - ))$show()) - -}) - +## | +## | *Unit tests* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | RPACT package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File name: test-class_summary.R +## | Creation date: 08 November 2023, 08:49:48 +## | File version: $Revision$ +## | Last changed: $Date$ +## | Last changed by: $Author$ +## | + +test_plan_section("Testing Class 'SummaryFactory'") + + +test_that("Testing 'summary.ParameterSet': no errors occur", { + .skipTestIfDisabled() + + # @refFS[Function]{fs:outputOfGenericFunctions} + invisible(capture.output(expect_error(summary(getDesignGroupSequential( + beta = 0.05, typeOfDesign = "asKD", gammaA = 1, typeBetaSpending = "bsOF" + )), NA))) + invisible(capture.output(expect_error(summary(getDesignGroupSequential(kMax = 1)), NA))) + invisible(capture.output(expect_error(summary(getDesignGroupSequential(kMax = 4, sided = 2)), NA))) + invisible(capture.output(expect_error(summary(getDesignGroupSequential(kMax = 4, sided = 2), digits = 0), NA))) + invisible(capture.output(expect_error(summary(getDesignGroupSequential(kMax = 1, sided = 2)), NA))) + invisible(capture.output(expect_error(summary(getDesignGroupSequential(futilityBounds = c(-6, 0))), NA))) + invisible(capture.output(expect_error(summary(getDesignGroupSequential(futilityBounds = c(-6, 0)), digits = 5), NA))) + + invisible(capture.output(expect_error(summary(getDataset( + n = c(13, 25), + means = c(242, 222), + stDevs = c(244, 221) + )), NA))) + + invisible(capture.output(expect_error(summary(getDataset( + n = c(13), + means = c(242), + stDevs = c(244) + )), NA))) + + invisible(capture.output(expect_error(summary(getDataset( + n1 = c(13, 25), + n2 = c(15, NA), + n3 = c(14, 27), + n4 = c(12, 29), + means1 = c(242, 222), + means2 = c(188, NA), + means3 = c(267, 277), + means4 = c(92, 122), + stDevs1 = c(244, 221), + stDevs2 = c(212, NA), + stDevs3 = c(256, 232), + stDevs4 = c(215, 227) + )), NA))) + + invisible(capture.output(expect_error(summary(getDataset( + n1 = c(11, 13, 12, 13), + n2 = c(8, 10, 9, 11), + n3 = c(7, 10, 8, 9), + events1 = c(10, 10, 12, 12), + events2 = c(3, 5, 5, 6), + events3 = c(2, 4, 3, 5) + )), NA))) + + invisible(capture.output(expect_error(summary(getDataset( + events1 = c(25, 32), + events2 = c(18, NA), + events3 = c(22, 36), + logRanks1 = c(2.2, 1.8), + logRanks2 = c(1.99, NA), + logRanks3 = c(2.32, 2.11) + )), NA))) + + invisible(capture.output(expect_error(summary(getDesignInverseNormal(kMax = 1)), NA))) + invisible(capture.output(expect_error(summary(getDesignInverseNormal(futilityBounds = c(0, 1))), NA))) + invisible(capture.output(expect_error(summary(getDesignInverseNormal(kMax = 1)), NA))) + invisible(capture.output(expect_error(summary(getDesignInverseNormal(kMax = 4, sided = 2)), NA))) + invisible(capture.output(expect_error(summary(getDesignInverseNormal(kMax = 4, sided = 2), digits = 0), NA))) + invisible(capture.output(expect_error(summary(getDesignInverseNormal(kMax = 1, sided = 2)), NA))) + + invisible(capture.output(expect_error(summary(getDesignFisher()), NA))) + invisible(capture.output(expect_error(summary(getDesignFisher(alpha0Vec = c(0.1, 0.2))), NA))) + invisible(capture.output(expect_error(summary(getDesignFisher(kMax = 1)), NA))) + invisible(capture.output(expect_error(summary(getDesignFisher(kMax = 4), digits = 5), NA))) + invisible(capture.output(expect_error(summary(getDesignFisher(kMax = 4), digits = 0), NA))) + invisible(capture.output(expect_error(summary(getDesignFisher(kMax = 1)), NA))) + + ## test design plans - means + + invisible(capture.output(expect_error(summary(getSampleSizeMeans(sided = 2, alternative = -0.5)), NA))) + invisible(capture.output(expect_warning(summary(getSampleSizeMeans(sided = 2), alternative = -0.5)))) # warning expected + invisible(capture.output(expect_error(summary(getPowerMeans( + sided = 1, alternative = c(-0.5, -0.3), + maxNumberOfSubjects = 100, directionUpper = FALSE + )), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeMeans( + thetaH0 = 0, + alternative = 0.5, sided = 1, stDev = 2.5 + )), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeMeans( + thetaH0 = 0, + alternative = 0.5, sided = 1, stDev = 1, groups = 1 + )), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeMeans( + thetaH0 = 0, + sided = 2, stDev = 1, groups = 1 + )), NA))) + + invisible(capture.output(expect_error(summary(getSampleSizeMeans( + thetaH0 = 0, + alternative = 1.2, sided = 2, stDev = 5 + )), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeMeans( + thetaH0 = 0, + alternative = 1.2, sided = 2, stDev = 5, allocationRatioPlanned = 0 + )), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeMeans( + thetaH0 = 0, + alternative = 1.2, sided = 2, stDev = 5, groups = 1 + )), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeMeans( + getDesignGroupSequential(futilityBounds = c(1, 2)) + )), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeMeans( + getDesignGroupSequential(futilityBounds = c(1, 2)) + ), digits = 0), NA))) + invisible(capture.output(expect_error(summary(getPowerMeans( + getDesignGroupSequential(futilityBounds = c(1, 2)), + maxNumberOfSubjects = 100, alternative = 1 + )), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeMeans( + getDesignGroupSequential(kMax = 4, sided = 2) + )), NA))) + invisible(capture.output(expect_error(summary(getPowerMeans( + getDesignGroupSequential(kMax = 4, sided = 2), + maxNumberOfSubjects = 100 + )), NA))) + invisible(capture.output(expect_error(summary(getPowerMeans( + getDesignGroupSequential(kMax = 1, sided = 2), + maxNumberOfSubjects = 100 + )), NA))) + + invisible(capture.output(expect_error(summary(getSampleSizeMeans( + getDesignGroupSequential(futilityBounds = c(1, 2)) + )), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeMeans( + getDesignGroupSequential(futilityBounds = c(1, 2)) + ), digits = 4), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeMeans( + getDesignGroupSequential(futilityBounds = c(1, 2)) + ), digits = 3), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeMeans( + getDesignGroupSequential(futilityBounds = c(1, 2)) + ), digits = 2), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeMeans( + getDesignGroupSequential(futilityBounds = c(1, 2)) + ), digits = -1), NA))) + + ## test design plans - rates + + invisible(capture.output(expect_error(summary(getSampleSizeRates(pi2 = 0.3)), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeRates(groups = 1, thetaH0 = 0.3)), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeRates(groups = 1, thetaH0 = 0.45)), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeRates( + groups = 2, thetaH0 = 0.45, allocationRatioPlanned = 0 + )), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeRates( + getDesignGroupSequential(futilityBounds = c(1, 2)) + )), NA))) + invisible(capture.output(expect_error(summary(getPowerRates( + getDesignGroupSequential(futilityBounds = c(1, 2)), + maxNumberOfSubjects = 100 + )), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeRates( + getDesignGroupSequential(kMax = 4, sided = 2) + )), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeRates( + getDesignGroupSequential(kMax = 4, sided = 2), + groups = 1, thetaH0 = 0.3 + )), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeRates( + getDesignGroupSequential(kMax = 1, sided = 2), + groups = 1, thetaH0 = 0.2, pi1 = c(0.4, 0.5) + )), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeRates( + getDesignGroupSequential(kMax = 1, sided = 2), + groups = 1, thetaH0 = 0.2, pi1 = 0.4 + )), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeRates( + getDesignGroupSequential(kMax = 1, sided = 2), + groups = 2, thetaH0 = 0, pi1 = 0.25 + )), NA))) + invisible(capture.output(expect_error(summary(getPowerRates( + getDesignGroupSequential(kMax = 4, sided = 2), + maxNumberOfSubjects = 100 + )), NA))) + + ## test design plans - survival + + invisible(capture.output(expect_error(summary(getSampleSizeSurvival()), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeSurvival(lambda2 = 0.3, hazardRatio = 1.2)), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeSurvival(lambda2 = 0.3, hazardRatio = c(1.2, 2))), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeSurvival(pi2 = 0.3, hazardRatio = 1.2)), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeSurvival(pi1 = 0.1, pi2 = 0.3)), NA))) + + invisible(capture.output(expect_error(summary(getSampleSizeSurvival(lambda2 = 0.03, lambda1 = c(0.040))), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeSurvival(piecewiseSurvivalTime = list( + "0 - <6" = 0.025, + "6 - <9" = 0.04, + "9 - <15" = 0.015, + "15 - <21" = 0.01, + ">=21" = 0.007 + ), hazardRatio = 1.2)), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeSurvival( + getDesignGroupSequential(futilityBounds = c(1, 2)) + )), NA))) + invisible(capture.output(expect_error(summary(getPowerSurvival( + getDesignGroupSequential(futilityBounds = c(1, 2)), + maxNumberOfSubjects = 100, maxNumberOfEvents = 60 + )), NA))) + invisible(capture.output(expect_error(summary(getSampleSizeSurvival( + getDesignGroupSequential(kMax = 4, sided = 2) + )), NA))) + invisible(capture.output(expect_error(summary(getPowerSurvival( + getDesignGroupSequential(kMax = 4, sided = 2), + maxNumberOfSubjects = 100, maxNumberOfEvents = 60 + )), NA))) + + invisible(capture.output(expect_error(summary(getSampleSizeSurvival(sided = 2, lambda2 = log(2) / 6, lambda1 = log(2) / 8)), NA))) + + invisible(capture.output(expect_error(summary(getPowerSurvival(sided = 2, maxNumberOfSubjects = 200, maxNumberOfEvents = 40, lambda2 = log(2) / 6, lambda1 = log(2) / 8)), NA))) + + invisible(capture.output(expect_error(summary(getSampleSizeSurvival( + getDesignGroupSequential(sided = 2), + lambda2 = log(2) / 6, hazardRatio = c(0.55), + accrualTime = c(0, 10), accrualIntensity = 20 + )), NA))) + + invisible(capture.output(expect_error(summary(getPowerSurvival( + getDesignGroupSequential(kMax = 2), + maxNumberOfEvents = 200, maxNumberOfSubjects = 400, + lambda2 = log(2) / 60, lambda1 = log(2) / 50, + dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, + accrualTime = 0, accrualIntensity = 30 + )), NA))) + + invisible(capture.output(expect_error(summary(getPowerSurvival( + getDesignGroupSequential(kMax = 3), + maxNumberOfEvents = 200, maxNumberOfSubjects = 400, + lambda2 = log(2) / 60, lambda1 = c(log(2) / 50, log(2) / 60), + dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, + accrualTime = 0, accrualIntensity = 30 + )), NA))) + + invisible(capture.output(expect_error(summary(getPowerSurvival( + getDesignGroupSequential(kMax = 3), + maxNumberOfEvents = 200, maxNumberOfSubjects = 400, + lambda2 = log(2) / 60, hazardRatio = c(0.7, 0.8), directionUpper = FALSE, + dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, + accrualTime = 0, accrualIntensity = 30 + )), NA))) + + design1 <- getDesignGroupSequential( + sided = 2, alpha = 0.05, beta = 0.2, + informationRates = c(0.6, 1), + typeOfDesign = "asOF", twoSidedPower = FALSE + ) + + invisible(capture.output(expect_error(summary(getSampleSizeSurvival( + design1, + lambda2 = log(2) / 60, hazardRatio = 0.74, + dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, + accrualTime = 0, accrualIntensity = 30, + followUpTime = 12 + )), NA))) + + invisible(capture.output(expect_error(summary(getSampleSizeSurvival( + design1, + lambda2 = log(2) / 60, lambda1 = log(2) / 50, + dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, + accrualTime = 0, accrualIntensity = 30, + followUpTime = 12 + )), NA))) + + invisible(capture.output(expect_error(summary(getSampleSizeSurvival( + getDesignGroupSequential(kMax = 4, sided = 2) + )), NA))) + + ## simulations + + design2 <- getDesignInverseNormal( + alpha = 0.05, kMax = 4, futilityBounds = c(0, 0, 0), + sided = 1, typeOfDesign = "WT", deltaWT = 0.1 + ) + + invisible(capture.output(expect_error(summary(getSimulationSurvival(design2, + lambda2 = log(2) / 60, lambda1 = c(log(2) / 80), + maxNumberOfSubjects = 1000, plannedEvents = c(50, 100, 150, 200), seed = 12345, directionUpper = FALSE + )), NA))) + + invisible(capture.output(expect_error(summary(getSimulationSurvival(design2, + lambda2 = log(2) / 60, hazardRatio = c(1.2, 1.4), + maxNumberOfSubjects = 1000, plannedEvents = c(50, 100, 150, 200), seed = 12345 + )), NA))) + + design3 <- getDesignGroupSequential(typeOfDesign = "P", futilityBounds = c(1, 1)) + + invisible(capture.output(expect_error(summary(getSampleSizeMeans(design3)), NA))) + + invisible(capture.output(expect_error(summary(getSimulationMeans(design3, stDev = 4, plannedSubjects = (1:3) * 200, alternative = c(1, 2))), NA))) + + invisible(capture.output(expect_error(summary(getSimulationRates(design3, + plannedSubjects = (1:3) * 200, pi1 = c(0.3, 0.4), maxNumberOfIterations = 1000, + minNumberOfSubjectsPerStage = c(NA, 40, 40), maxNumberOfSubjectsPerStage = c(NA, 40, 400), conditionalPower = 0.8 + )), NA))) + + invisible(capture.output(expect_error(summary(getSimulationMeans( + getDesignGroupSequential(kMax = 1), + stDev = 4, plannedSubjects = 200, alternative = c(1) + )), NA))) + +}) + +test_that("Testing 'summary.ParameterSet': output will be produced", { + + .skipTestIfDisabled() + + # @refFS[Function]{fs:outputOfGenericFunctions} + expect_output(summary(getDesignGroupSequential(beta = 0.05, typeOfDesign = "asKD", gammaA = 1, typeBetaSpending = "bsOF"))$show()) + expect_output(summary(getDesignGroupSequential(kMax = 1))$show()) + expect_output(summary(getDesignGroupSequential(kMax = 4, sided = 2))$show()) + expect_output(summary(getDesignGroupSequential(kMax = 4, sided = 2), digits = 0)$show()) + expect_output(summary(getDesignGroupSequential(kMax = 1, sided = 2))$show()) + expect_output(summary(getDesignGroupSequential(futilityBounds = c(-6, 0)))$show()) + expect_output(summary(getDesignGroupSequential(futilityBounds = c(-6, 0)), digits = 5)$show()) + + expect_output(summary(getDataset( + n = c(13, 25), + means = c(242, 222), + stDevs = c(244, 221) + ))$show()) + + expect_output(summary(getDataset( + n = c(13), + means = c(242), + stDevs = c(244) + ))$show()) + + expect_output(summary(getDataset( + n1 = c(13, 25), + n2 = c(15, NA), + n3 = c(14, 27), + n4 = c(12, 29), + means1 = c(242, 222), + means2 = c(188, NA), + means3 = c(267, 277), + means4 = c(92, 122), + stDevs1 = c(244, 221), + stDevs2 = c(212, NA), + stDevs3 = c(256, 232), + stDevs4 = c(215, 227) + ))$show()) + + expect_output(summary(getDataset( + n1 = c(11, 13, 12, 13), + n2 = c(8, 10, 9, 11), + n3 = c(7, 10, 8, 9), + events1 = c(10, 10, 12, 12), + events2 = c(3, 5, 5, 6), + events3 = c(2, 4, 3, 5) + ))$show()) + + expect_output(summary(getDataset( + events1 = c(25, 32), + events2 = c(18, NA), + events3 = c(22, 36), + logRanks1 = c(2.2, 1.8), + logRanks2 = c(1.99, NA), + logRanks3 = c(2.32, 2.11) + ))$show()) + + expect_output(summary(getDesignInverseNormal(kMax = 1))$show()) + expect_output(summary(getDesignInverseNormal(futilityBounds = c(0, 1)))$show()) + expect_output(summary(getDesignInverseNormal(kMax = 1))$show()) + expect_output(summary(getDesignInverseNormal(kMax = 4, sided = 2))$show()) + expect_output(summary(getDesignInverseNormal(kMax = 4, sided = 2), digits = 0)$show()) + expect_output(summary(getDesignInverseNormal(kMax = 1, sided = 2))$show()) + + expect_output(summary(getDesignFisher())$show()) + expect_output(summary(getDesignFisher(alpha0Vec = c(0.1, 0.2)))$show()) + expect_output(summary(getDesignFisher(kMax = 1))$show()) + expect_output(summary(getDesignFisher(kMax = 4), digits = 5)$show()) + expect_output(summary(getDesignFisher(kMax = 4), digits = 0)$show()) + expect_output(summary(getDesignFisher(kMax = 1))$show()) + + ## test design plans - means + + expect_output(summary(getSampleSizeMeans(sided = 2, alternative = -0.5))$show()) + expect_output(summary(getPowerMeans(sided = 1, alternative = c(-0.5, -0.3), maxNumberOfSubjects = 100, directionUpper = FALSE))$show()) + expect_output(summary(getSampleSizeMeans(thetaH0 = 0, alternative = 0.5, sided = 1, stDev = 2.5))$show()) + expect_output(summary(getSampleSizeMeans(thetaH0 = 0, alternative = 0.5, sided = 1, stDev = 1, groups = 1))$show()) + expect_output(summary(getSampleSizeMeans(thetaH0 = 0, sided = 2, stDev = 1, groups = 1))$show()) + + expect_output(summary(getSampleSizeMeans(thetaH0 = 0, alternative = 1.2, sided = 2, stDev = 5))$show()) + expect_output(summary(getSampleSizeMeans(thetaH0 = 0, alternative = 1.2, sided = 2, stDev = 5, allocationRatioPlanned = 0))$show()) + expect_output(summary(getSampleSizeMeans(thetaH0 = 0, alternative = 1.2, sided = 2, stDev = 5, groups = 1))$show()) + expect_output(summary(getSampleSizeMeans( + getDesignGroupSequential(futilityBounds = c(1, 2)) + ))$show()) + expect_output(summary(getSampleSizeMeans( + getDesignGroupSequential(futilityBounds = c(1, 2)) + ), digits = 0)$show()) + expect_output(summary(getPowerMeans( + getDesignGroupSequential(futilityBounds = c(1, 2)), + maxNumberOfSubjects = 100, alternative = 1 + ))$show()) + expect_output(summary(getSampleSizeMeans( + getDesignGroupSequential(kMax = 4, sided = 2) + ))$show()) + expect_output(summary(getPowerMeans( + getDesignGroupSequential(kMax = 4, sided = 2), + maxNumberOfSubjects = 100 + ))$show()) + expect_output(summary(getPowerMeans( + getDesignGroupSequential(kMax = 1, sided = 2), + maxNumberOfSubjects = 100 + ))$show()) + + expect_output(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2))))$show()) + expect_output(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2))), digits = 4)$show()) + expect_output(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2))), digits = 3)$show()) + expect_output(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2))), digits = 2)$show()) + expect_output(summary(getSampleSizeMeans(getDesignGroupSequential(futilityBounds = c(1, 2))), digits = -1)$show()) + + ## test design plans - rates + + expect_output(summary(getSampleSizeRates(pi2 = 0.3))$show()) + expect_output(summary(getSampleSizeRates(groups = 1, thetaH0 = 0.3))$show()) + expect_output(summary(getSampleSizeRates(groups = 1, thetaH0 = 0.45))$show()) + expect_output(summary(getSampleSizeRates(groups = 2, thetaH0 = 0.45, allocationRatioPlanned = 0))$show()) + expect_output(summary(getSampleSizeRates(getDesignGroupSequential(futilityBounds = c(1, 2))))$show()) + expect_output(summary(getPowerRates(getDesignGroupSequential(futilityBounds = c(1, 2)), maxNumberOfSubjects = 100))$show()) + expect_output(summary(getSampleSizeRates(getDesignGroupSequential(kMax = 4, sided = 2)))$show()) + expect_output(summary(getSampleSizeRates(getDesignGroupSequential(kMax = 4, sided = 2), groups = 1, thetaH0 = 0.3))$show()) + expect_output(summary(getSampleSizeRates(getDesignGroupSequential(kMax = 1, sided = 2), + groups = 1, thetaH0 = 0.2, pi1 = c(0.4, 0.5) + ))$show()) + expect_output(summary(getSampleSizeRates(getDesignGroupSequential( + kMax = 1, sided = 2 + ), groups = 1, thetaH0 = 0.2, pi1 = 0.4))$show()) + expect_output(summary(getSampleSizeRates(getDesignGroupSequential( + kMax = 1, sided = 2 + ), groups = 2, thetaH0 = 0, pi1 = 0.25))$show()) + expect_output(summary(getPowerRates(getDesignGroupSequential(kMax = 4, sided = 2), maxNumberOfSubjects = 100))$show()) + + ## test design plans - survival + + expect_output(summary(getSampleSizeSurvival())$show()) + expect_output(summary(getSampleSizeSurvival(lambda2 = 0.3, hazardRatio = 1.2))$show()) + expect_output(summary(getSampleSizeSurvival(lambda2 = 0.3, hazardRatio = c(1.2, 2)))$show()) + expect_output(summary(getSampleSizeSurvival(pi2 = 0.3, hazardRatio = 1.2))$show()) + expect_output(summary(getSampleSizeSurvival(pi1 = 0.1, pi2 = 0.3))$show()) + + expect_output(summary(getSampleSizeSurvival(lambda2 = 0.03, lambda1 = c(0.040)))$show()) + expect_output(summary(getSampleSizeSurvival(piecewiseSurvivalTime = list( + "0 - <6" = 0.025, + "6 - <9" = 0.04, + "9 - <15" = 0.015, + "15 - <21" = 0.01, + ">=21" = 0.007 + ), hazardRatio = 1.2))$show()) + expect_output(summary(getSampleSizeSurvival(getDesignGroupSequential(futilityBounds = c(1, 2))))$show()) + expect_output(summary(getPowerSurvival(getDesignGroupSequential(futilityBounds = c(1, 2)), + maxNumberOfSubjects = 100, maxNumberOfEvents = 60 + ))$show()) + expect_output(summary(getSampleSizeSurvival(getDesignGroupSequential(kMax = 4, sided = 2)))$show()) + expect_output(summary(getPowerSurvival(getDesignGroupSequential(kMax = 4, sided = 2), + maxNumberOfSubjects = 100, maxNumberOfEvents = 60 + ))$show()) + + expect_output(summary(getSampleSizeSurvival(sided = 2, lambda2 = log(2) / 6, lambda1 = log(2) / 8))$show()) + + expect_output(summary(getPowerSurvival( + sided = 2, maxNumberOfSubjects = 200, + maxNumberOfEvents = 40, lambda2 = log(2) / 6, lambda1 = log(2) / 8 + ))$show()) + + expect_warning(expect_output(summary(getSampleSizeSurvival(getDesignGroupSequential(sided = 2), + lambda2 = log(2) / 6, hazardRatio = c(0.55), + accrualTime = c(0, 10), accrualIntensity = 60 + ))$show()), + "Accrual duration longer than maximal study duration (time to maximal number of events); followUpTime = -2.959", + fixed = TRUE + ) + + expect_output(summary(getPowerSurvival(getDesignGroupSequential(kMax = 2), + maxNumberOfEvents = 150, maxNumberOfSubjects = 400, + lambda2 = log(2) / 60, lambda1 = log(2) / 50, + dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, + accrualTime = 0, accrualIntensity = 30 + ))$show()) + + expect_output(summary(getPowerSurvival(getDesignGroupSequential(kMax = 3), + maxNumberOfEvents = 200, maxNumberOfSubjects = 400, + lambda2 = log(2) / 60, lambda1 = c(log(2) / 50, log(2) / 60), + dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, + accrualTime = 0, accrualIntensity = 30 + ))$show()) + + expect_output(summary(getPowerSurvival(getDesignGroupSequential(kMax = 3), + maxNumberOfEvents = 200, maxNumberOfSubjects = 400, + lambda2 = log(2) / 60, hazardRatio = c(0.7, 0.8), directionUpper = FALSE, + dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, + accrualTime = 0, accrualIntensity = 30 + ))$show()) + + design1 <- getDesignGroupSequential( + sided = 2, alpha = 0.05, beta = 0.2, + informationRates = c(0.6, 1), + typeOfDesign = "asOF", twoSidedPower = FALSE + ) + + expect_output(summary(getSampleSizeSurvival( + design1, + lambda2 = log(2) / 60, hazardRatio = 0.74, + dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, + accrualTime = 0, accrualIntensity = 30, + followUpTime = 12 + ))$show()) + + expect_output(summary(getSampleSizeSurvival( + design1, + lambda2 = log(2) / 60, lambda1 = log(2) / 50, + dropoutRate1 = 0.025, dropoutRate2 = 0.025, dropoutTime = 12, + accrualTime = 0, accrualIntensity = 30, + followUpTime = 12 + ))$show()) + + expect_output(summary(getSampleSizeSurvival(getDesignGroupSequential(kMax = 4, sided = 2)))$show()) + + ## simulations + + design2 <- getDesignInverseNormal( + alpha = 0.05, kMax = 4, futilityBounds = c(0, 0, 0), + sided = 1, typeOfDesign = "WT", deltaWT = 0.1 + ) + + expect_output(summary(getSimulationSurvival(design2, + lambda2 = log(2) / 60, lambda1 = c(log(2) / 80), + maxNumberOfSubjects = 1000, plannedEvents = c(50, 100, 150, 200), seed = 12345, directionUpper = FALSE + ))$show()) + + expect_output(summary(getSimulationSurvival(design2, + lambda2 = log(2) / 60, hazardRatio = c(1.2, 1.4), + maxNumberOfSubjects = 1000, plannedEvents = c(50, 100, 150, 200), seed = 12345 + ))$show()) + + design3 <- getDesignGroupSequential(typeOfDesign = "P", futilityBounds = c(1, 1)) + + expect_output(summary(getSampleSizeMeans(design3))$show()) + + expect_output(summary(getSimulationMeans(design3, stDev = 4, plannedSubjects = (1:3) * 200, alternative = c(1, 2)))$show()) + + expect_output(summary(getSimulationRates(design3, + plannedSubjects = (1:3) * 200, pi1 = c(0.3, 0.4), maxNumberOfIterations = 1000, + minNumberOfSubjectsPerStage = c(NA, 40, 40), maxNumberOfSubjectsPerStage = c(NA, 40, 400), conditionalPower = 0.8 + ))$show()) + + expect_output(summary(getSimulationMeans(getDesignGroupSequential(kMax = 1), + stDev = 4, plannedSubjects = 200, alternative = 1 + ))$show()) +}) + diff --git a/tests/testthat/test-class_time.R b/tests/testthat/test-class_time.R index 772eae8d..8f2c8810 100644 --- a/tests/testthat/test-class_time.R +++ b/tests/testthat/test-class_time.R @@ -1,2735 +1,2734 @@ -## | -## | *Unit tests* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | RPACT package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File name: test-class_time.R -## | Creation date: 08 November 2023, 08:49:49 -## | File version: $Revision: 7665 $ -## | Last changed: $Date: 2024-02-23 17:33:46 +0100 (Fr, 23 Feb 2024) $ -## | Last changed by: $Author: pahlke $ -## | - -test_plan_section("Testing Class 'PiecewiseSurvivalTime'") - - -test_that("Testing 'getPiecewiseSurvivalTime': isPiecewiseSurvivalEnabled()", { - # @refFS[Tab.]{fs:tab:output:getPiecewiseSurvivalTime} - expect_false(getPiecewiseSurvivalTime()$isPiecewiseSurvivalEnabled()) - expect_false(getPiecewiseSurvivalTime(piecewiseSurvivalTime = NA)$isPiecewiseSurvivalEnabled()) - -}) - -test_that("Testing 'getPiecewiseSurvivalTime': simple vector based definition", { - - # @refFS[Tab.]{fs:tab:output:getPiecewiseSurvivalTime} - pwSurvivalTime1 <- getPiecewiseSurvivalTime(lambda2 = 0.5, hazardRatio = 0.8) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime1' with expected results - expect_equal(pwSurvivalTime1$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime1$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$lambda1, 0.4, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$lambda2, 0.5, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime1$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime1$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$median1, 1.732868, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$median2, 1.3862944, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime1$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime1$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime1$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime1$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime1$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime1), NA))) - expect_output(print(pwSurvivalTime1)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime1), NA))) - expect_output(summary(pwSurvivalTime1)$show()) - pwSurvivalTime1CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime1, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime1CodeBased$piecewiseSurvivalTime, pwSurvivalTime1$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$lambda1, pwSurvivalTime1$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$lambda2, pwSurvivalTime1$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$hazardRatio, pwSurvivalTime1$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$pi1, pwSurvivalTime1$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$pi2, pwSurvivalTime1$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$median1, pwSurvivalTime1$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$median2, pwSurvivalTime1$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$eventTime, pwSurvivalTime1$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$kappa, pwSurvivalTime1$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime1$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$delayedResponseAllowed, pwSurvivalTime1$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$delayedResponseEnabled, pwSurvivalTime1$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime1), "character") - df <- as.data.frame(pwSurvivalTime1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime2 <- getPiecewiseSurvivalTime(lambda2 = 0.5, lambda1 = 0.4) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime2' with expected results - expect_equal(pwSurvivalTime2$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime2$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$lambda1, 0.4, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$lambda2, 0.5, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime2$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime2$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$median1, 1.732868, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$median2, 1.3862944, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime2$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime2$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime2), NA))) - expect_output(print(pwSurvivalTime2)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime2), NA))) - expect_output(summary(pwSurvivalTime2)$show()) - pwSurvivalTime2CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime2, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalTime, pwSurvivalTime2$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$lambda1, pwSurvivalTime2$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$lambda2, pwSurvivalTime2$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$hazardRatio, pwSurvivalTime2$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$pi1, pwSurvivalTime2$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$pi2, pwSurvivalTime2$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$median1, pwSurvivalTime2$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$median2, pwSurvivalTime2$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$eventTime, pwSurvivalTime2$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$kappa, pwSurvivalTime2$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime2$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$delayedResponseAllowed, pwSurvivalTime2$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$delayedResponseEnabled, pwSurvivalTime2$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime2), "character") - df <- as.data.frame(pwSurvivalTime2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - .skipTestIfDisabled() - - pwSurvivalTime2 <- getPiecewiseSurvivalTime(pi2 = 0.5, hazardRatio = 0.8) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime2' with expected results - expect_equal(pwSurvivalTime2$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime2$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$lambda1, 0.046209812, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$lambda2, 0.057762265, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$pi1, 0.42565082, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$pi2, 0.5, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$median1, 15, label = paste0("c(", paste0(pwSurvivalTime2$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$median2, 12, label = paste0("c(", paste0(pwSurvivalTime2$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$eventTime, 12, label = paste0("c(", paste0(pwSurvivalTime2$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime2$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime2), NA))) - expect_output(print(pwSurvivalTime2)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime2), NA))) - expect_output(summary(pwSurvivalTime2)$show()) - pwSurvivalTime2CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime2, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalTime, pwSurvivalTime2$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$lambda1, pwSurvivalTime2$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$lambda2, pwSurvivalTime2$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$hazardRatio, pwSurvivalTime2$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$pi1, pwSurvivalTime2$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$pi2, pwSurvivalTime2$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$median1, pwSurvivalTime2$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$median2, pwSurvivalTime2$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$eventTime, pwSurvivalTime2$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$kappa, pwSurvivalTime2$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime2$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$delayedResponseAllowed, pwSurvivalTime2$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$delayedResponseEnabled, pwSurvivalTime2$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime2), "character") - df <- as.data.frame(pwSurvivalTime2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime2 <- getPiecewiseSurvivalTime(pi2 = 0.5, pi1 = 0.4) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime2' with expected results - expect_equal(pwSurvivalTime2$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime2$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$lambda1, 0.042568802, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$lambda2, 0.057762265, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$hazardRatio, 0.73696559, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$pi1, 0.4, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$pi2, 0.5, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$median1, 16.282985, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$median2, 12, label = paste0("c(", paste0(pwSurvivalTime2$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$eventTime, 12, label = paste0("c(", paste0(pwSurvivalTime2$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime2$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime2), NA))) - expect_output(print(pwSurvivalTime2)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime2), NA))) - expect_output(summary(pwSurvivalTime2)$show()) - pwSurvivalTime2CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime2, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalTime, pwSurvivalTime2$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$lambda1, pwSurvivalTime2$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$lambda2, pwSurvivalTime2$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$hazardRatio, pwSurvivalTime2$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$pi1, pwSurvivalTime2$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$pi2, pwSurvivalTime2$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$median1, pwSurvivalTime2$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$median2, pwSurvivalTime2$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$eventTime, pwSurvivalTime2$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$kappa, pwSurvivalTime2$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime2$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$delayedResponseAllowed, pwSurvivalTime2$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$delayedResponseEnabled, pwSurvivalTime2$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime2), "character") - df <- as.data.frame(pwSurvivalTime2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime3 <- getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), lambda2 = 0.4) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime3' with expected results - expect_equal(pwSurvivalTime3$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime3$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$lambda1, c(0.24, 0.32), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$lambda2, 0.4, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$hazardRatio, c(0.6, 0.8), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime3$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime3$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$median1, c(2.8881133, 2.1660849), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$median2, 1.732868, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime3$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime3$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime3$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime3$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime3$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime3), NA))) - expect_output(print(pwSurvivalTime3)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime3), NA))) - expect_output(summary(pwSurvivalTime3)$show()) - pwSurvivalTime3CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime3, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime3CodeBased$piecewiseSurvivalTime, pwSurvivalTime3$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$lambda1, pwSurvivalTime3$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$lambda2, pwSurvivalTime3$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$hazardRatio, pwSurvivalTime3$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$pi1, pwSurvivalTime3$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$pi2, pwSurvivalTime3$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$median1, pwSurvivalTime3$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$median2, pwSurvivalTime3$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$eventTime, pwSurvivalTime3$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$kappa, pwSurvivalTime3$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime3$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$delayedResponseAllowed, pwSurvivalTime3$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$delayedResponseEnabled, pwSurvivalTime3$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime3), "character") - df <- as.data.frame(pwSurvivalTime3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime8 <- getPiecewiseSurvivalTime(pi2 = 0.4, pi1 = 0.3) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime8' with expected results - expect_equal(pwSurvivalTime8$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime8$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime8$lambda1, 0.029722912, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime8$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime8$lambda2, 0.042568802, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime8$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime8$hazardRatio, 0.69823229, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime8$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime8$pi1, 0.3, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime8$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime8$pi2, 0.4, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime8$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime8$median1, 23.320299, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime8$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime8$median2, 16.282985, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime8$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime8$eventTime, 12, label = paste0("c(", paste0(pwSurvivalTime8$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime8$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime8$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime8$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime8$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime8$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime8$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime8$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime8$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime8), NA))) - expect_output(print(pwSurvivalTime8)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime8), NA))) - expect_output(summary(pwSurvivalTime8)$show()) - pwSurvivalTime8CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime8, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime8CodeBased$piecewiseSurvivalTime, pwSurvivalTime8$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime8CodeBased$lambda1, pwSurvivalTime8$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime8CodeBased$lambda2, pwSurvivalTime8$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime8CodeBased$hazardRatio, pwSurvivalTime8$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime8CodeBased$pi1, pwSurvivalTime8$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime8CodeBased$pi2, pwSurvivalTime8$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime8CodeBased$median1, pwSurvivalTime8$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime8CodeBased$median2, pwSurvivalTime8$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime8CodeBased$eventTime, pwSurvivalTime8$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime8CodeBased$kappa, pwSurvivalTime8$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime8CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime8$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime8CodeBased$delayedResponseAllowed, pwSurvivalTime8$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime8CodeBased$delayedResponseEnabled, pwSurvivalTime8$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime8), "character") - df <- as.data.frame(pwSurvivalTime8) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime8) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime9 <- getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), pi2 = 0.3) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime9' with expected results - expect_equal(pwSurvivalTime9$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime9$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime9$lambda1, c(0.017833747, 0.02377833), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime9$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime9$lambda2, 0.029722912, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime9$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime9$hazardRatio, c(0.6, 0.8), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime9$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime9$pi1, c(0.19265562, 0.24824135), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime9$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime9$pi2, 0.3, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime9$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime9$median1, c(38.867164, 29.150373), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime9$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime9$median2, 23.320299, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime9$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime9$eventTime, 12, label = paste0("c(", paste0(pwSurvivalTime9$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime9$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime9$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime9$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime9$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime9$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime9$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime9$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime9$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime9), NA))) - expect_output(print(pwSurvivalTime9)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime9), NA))) - expect_output(summary(pwSurvivalTime9)$show()) - pwSurvivalTime9CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime9, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime9CodeBased$piecewiseSurvivalTime, pwSurvivalTime9$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime9CodeBased$lambda1, pwSurvivalTime9$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime9CodeBased$lambda2, pwSurvivalTime9$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime9CodeBased$hazardRatio, pwSurvivalTime9$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime9CodeBased$pi1, pwSurvivalTime9$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime9CodeBased$pi2, pwSurvivalTime9$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime9CodeBased$median1, pwSurvivalTime9$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime9CodeBased$median2, pwSurvivalTime9$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime9CodeBased$eventTime, pwSurvivalTime9$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime9CodeBased$kappa, pwSurvivalTime9$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime9CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime9$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime9CodeBased$delayedResponseAllowed, pwSurvivalTime9$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime9CodeBased$delayedResponseEnabled, pwSurvivalTime9$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime9), "character") - df <- as.data.frame(pwSurvivalTime9) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime9) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime10 <- getPiecewiseSurvivalTime(median2 = 1.386294, hazardRatio = 0.8) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime10' with expected results - expect_equal(pwSurvivalTime10$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime10$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$lambda1, 0.4000001, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$lambda2, 0.50000013, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime10$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime10$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$median1, 1.7328675, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$median2, 1.386294, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime10$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime10$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime10$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime10$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime10$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime10), NA))) - expect_output(print(pwSurvivalTime10)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime10), NA))) - expect_output(summary(pwSurvivalTime10)$show()) - pwSurvivalTime10CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime10, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime10CodeBased$piecewiseSurvivalTime, pwSurvivalTime10$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$lambda1, pwSurvivalTime10$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$lambda2, pwSurvivalTime10$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$hazardRatio, pwSurvivalTime10$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$pi1, pwSurvivalTime10$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$pi2, pwSurvivalTime10$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$median1, pwSurvivalTime10$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$median2, pwSurvivalTime10$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$eventTime, pwSurvivalTime10$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$kappa, pwSurvivalTime10$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime10$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$delayedResponseAllowed, pwSurvivalTime10$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$delayedResponseEnabled, pwSurvivalTime10$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime10), "character") - df <- as.data.frame(pwSurvivalTime10) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime10) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime11 <- getPiecewiseSurvivalTime(median2 = 1.386294, lambda1 = 0.4) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime11' with expected results - expect_equal(pwSurvivalTime11$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime11$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$lambda1, 0.4, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$lambda2, 0.50000013, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$hazardRatio, 0.79999979, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime11$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime11$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$median1, 1.732868, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$median2, 1.386294, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime11$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime11$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime11$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime11$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime11$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime11), NA))) - expect_output(print(pwSurvivalTime11)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime11), NA))) - expect_output(summary(pwSurvivalTime11)$show()) - pwSurvivalTime11CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime11, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime11CodeBased$piecewiseSurvivalTime, pwSurvivalTime11$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$lambda1, pwSurvivalTime11$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$lambda2, pwSurvivalTime11$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$hazardRatio, pwSurvivalTime11$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$pi1, pwSurvivalTime11$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$pi2, pwSurvivalTime11$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$median1, pwSurvivalTime11$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$median2, pwSurvivalTime11$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$eventTime, pwSurvivalTime11$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$kappa, pwSurvivalTime11$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime11$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$delayedResponseAllowed, pwSurvivalTime11$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$delayedResponseEnabled, pwSurvivalTime11$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime11), "character") - df <- as.data.frame(pwSurvivalTime11) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime11) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime12 <- getPiecewiseSurvivalTime(median2 = 5, median1 = 6) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime12' with expected results - expect_equal(pwSurvivalTime12$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$lambda1, 0.11552453, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime12$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$lambda2, 0.13862944, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime12$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$hazardRatio, 0.83333333, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime12$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$median1, 6, label = paste0("c(", paste0(pwSurvivalTime12$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$median2, 5, label = paste0("c(", paste0(pwSurvivalTime12$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime12$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime12$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime12$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime12$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime12), NA))) - expect_output(print(pwSurvivalTime12)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime12), NA))) - expect_output(summary(pwSurvivalTime12)$show()) - pwSurvivalTime12CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime12, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime12CodeBased$piecewiseSurvivalTime, pwSurvivalTime12$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$lambda1, pwSurvivalTime12$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$lambda2, pwSurvivalTime12$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$hazardRatio, pwSurvivalTime12$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$pi1, pwSurvivalTime12$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$pi2, pwSurvivalTime12$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$median1, pwSurvivalTime12$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$median2, pwSurvivalTime12$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$eventTime, pwSurvivalTime12$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$kappa, pwSurvivalTime12$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime12$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$delayedResponseAllowed, pwSurvivalTime12$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$delayedResponseEnabled, pwSurvivalTime12$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime12), "character") - df <- as.data.frame(pwSurvivalTime12) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime12) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime13 <- getPiecewiseSurvivalTime(median2 = 1.386294, lambda1 = c(0.3, 0.4)) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime13' with expected results - expect_equal(pwSurvivalTime13$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime13$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$lambda1, c(0.3, 0.4), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime13$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$lambda2, 0.50000013, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime13$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$hazardRatio, c(0.59999984, 0.79999979), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime13$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime13$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime13$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$median1, c(2.3104906, 1.732868), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime13$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$median2, 1.386294, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime13$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime13$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime13$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime13$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime13$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime13$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime13), NA))) - expect_output(print(pwSurvivalTime13)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime13), NA))) - expect_output(summary(pwSurvivalTime13)$show()) - pwSurvivalTime13CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime13, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime13CodeBased$piecewiseSurvivalTime, pwSurvivalTime13$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$lambda1, pwSurvivalTime13$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$lambda2, pwSurvivalTime13$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$hazardRatio, pwSurvivalTime13$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$pi1, pwSurvivalTime13$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$pi2, pwSurvivalTime13$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$median1, pwSurvivalTime13$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$median2, pwSurvivalTime13$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$eventTime, pwSurvivalTime13$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$kappa, pwSurvivalTime13$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime13$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$delayedResponseAllowed, pwSurvivalTime13$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$delayedResponseEnabled, pwSurvivalTime13$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime13), "character") - df <- as.data.frame(pwSurvivalTime13) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime13) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime14 <- getPiecewiseSurvivalTime(median2 = 5, median1 = c(6:8)) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime14' with expected results - expect_equal(pwSurvivalTime14$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime14$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime14$lambda1, c(0.11552453, 0.099021026, 0.086643398), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime14$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime14$lambda2, 0.13862944, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime14$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime14$hazardRatio, c(0.83333333, 0.71428571, 0.625), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime14$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime14$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime14$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime14$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime14$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime14$median1, c(6, 7, 8), label = paste0("c(", paste0(pwSurvivalTime14$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime14$median2, 5, label = paste0("c(", paste0(pwSurvivalTime14$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime14$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime14$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime14$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime14$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime14$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime14$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime14$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime14$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime14$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime14$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime14), NA))) - expect_output(print(pwSurvivalTime14)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime14), NA))) - expect_output(summary(pwSurvivalTime14)$show()) - pwSurvivalTime14CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime14, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime14CodeBased$piecewiseSurvivalTime, pwSurvivalTime14$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime14CodeBased$lambda1, pwSurvivalTime14$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime14CodeBased$lambda2, pwSurvivalTime14$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime14CodeBased$hazardRatio, pwSurvivalTime14$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime14CodeBased$pi1, pwSurvivalTime14$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime14CodeBased$pi2, pwSurvivalTime14$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime14CodeBased$median1, pwSurvivalTime14$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime14CodeBased$median2, pwSurvivalTime14$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime14CodeBased$eventTime, pwSurvivalTime14$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime14CodeBased$kappa, pwSurvivalTime14$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime14CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime14$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime14CodeBased$delayedResponseAllowed, pwSurvivalTime14$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime14CodeBased$delayedResponseEnabled, pwSurvivalTime14$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime14), "character") - df <- as.data.frame(pwSurvivalTime14) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime14) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime15 <- getPiecewiseSurvivalTime(median2 = 2, hazardRatio = 0.8) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime15' with expected results - expect_equal(pwSurvivalTime15$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime15$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime15$lambda1, 0.27725887, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime15$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime15$lambda2, 0.34657359, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime15$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime15$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime15$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime15$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime15$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime15$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime15$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime15$median1, 2.5, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime15$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime15$median2, 2, label = paste0("c(", paste0(pwSurvivalTime15$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime15$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime15$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime15$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime15$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime15$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime15$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime15$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime15$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime15$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime15$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime15), NA))) - expect_output(print(pwSurvivalTime15)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime15), NA))) - expect_output(summary(pwSurvivalTime15)$show()) - pwSurvivalTime15CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime15, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime15CodeBased$piecewiseSurvivalTime, pwSurvivalTime15$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime15CodeBased$lambda1, pwSurvivalTime15$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime15CodeBased$lambda2, pwSurvivalTime15$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime15CodeBased$hazardRatio, pwSurvivalTime15$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime15CodeBased$pi1, pwSurvivalTime15$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime15CodeBased$pi2, pwSurvivalTime15$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime15CodeBased$median1, pwSurvivalTime15$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime15CodeBased$median2, pwSurvivalTime15$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime15CodeBased$eventTime, pwSurvivalTime15$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime15CodeBased$kappa, pwSurvivalTime15$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime15CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime15$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime15CodeBased$delayedResponseAllowed, pwSurvivalTime15$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime15CodeBased$delayedResponseEnabled, pwSurvivalTime15$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime15), "character") - df <- as.data.frame(pwSurvivalTime15) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime15) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime16 <- getPiecewiseSurvivalTime(median1 = c(2, 2), hazardRatio = c(1.4, 1.4)) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime16' with expected results - expect_equal(pwSurvivalTime16$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime16$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime16$lambda1, c(0.34657359, 0.34657359), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime16$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime16$lambda2, c(0.24755256, 0.24755256), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime16$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime16$hazardRatio, c(1.4, 1.4), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime16$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime16$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime16$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime16$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime16$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime16$median1, c(2, 2), label = paste0("c(", paste0(pwSurvivalTime16$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime16$median2, c(2.8, 2.8), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime16$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime16$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime16$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime16$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime16$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime16$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime16$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime16$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime16$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime16$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime16$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime16), NA))) - expect_output(print(pwSurvivalTime16)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime16), NA))) - expect_output(summary(pwSurvivalTime16)$show()) - pwSurvivalTime16CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime16, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime16CodeBased$piecewiseSurvivalTime, pwSurvivalTime16$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime16CodeBased$lambda1, pwSurvivalTime16$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime16CodeBased$lambda2, pwSurvivalTime16$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime16CodeBased$hazardRatio, pwSurvivalTime16$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime16CodeBased$pi1, pwSurvivalTime16$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime16CodeBased$pi2, pwSurvivalTime16$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime16CodeBased$median1, pwSurvivalTime16$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime16CodeBased$median2, pwSurvivalTime16$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime16CodeBased$eventTime, pwSurvivalTime16$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime16CodeBased$kappa, pwSurvivalTime16$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime16CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime16$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime16CodeBased$delayedResponseAllowed, pwSurvivalTime16$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime16CodeBased$delayedResponseEnabled, pwSurvivalTime16$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime16), "character") - df <- as.data.frame(pwSurvivalTime16) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime16) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime17 <- getPiecewiseSurvivalTime(median1 = c(2, 3), median2 = 4) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime17' with expected results - expect_equal(pwSurvivalTime17$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime17$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime17$lambda1, c(0.34657359, 0.23104906), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime17$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime17$lambda2, 0.1732868, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime17$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime17$hazardRatio, c(2, 1.3333333), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime17$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime17$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime17$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime17$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime17$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime17$median1, c(2, 3), label = paste0("c(", paste0(pwSurvivalTime17$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime17$median2, 4, label = paste0("c(", paste0(pwSurvivalTime17$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime17$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime17$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime17$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime17$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime17$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime17$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime17$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime17$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime17$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime17$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime17), NA))) - expect_output(print(pwSurvivalTime17)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime17), NA))) - expect_output(summary(pwSurvivalTime17)$show()) - pwSurvivalTime17CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime17, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime17CodeBased$piecewiseSurvivalTime, pwSurvivalTime17$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime17CodeBased$lambda1, pwSurvivalTime17$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime17CodeBased$lambda2, pwSurvivalTime17$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime17CodeBased$hazardRatio, pwSurvivalTime17$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime17CodeBased$pi1, pwSurvivalTime17$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime17CodeBased$pi2, pwSurvivalTime17$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime17CodeBased$median1, pwSurvivalTime17$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime17CodeBased$median2, pwSurvivalTime17$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime17CodeBased$eventTime, pwSurvivalTime17$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime17CodeBased$kappa, pwSurvivalTime17$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime17CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime17$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime17CodeBased$delayedResponseAllowed, pwSurvivalTime17$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime17CodeBased$delayedResponseEnabled, pwSurvivalTime17$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime17), "character") - df <- as.data.frame(pwSurvivalTime17) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime17) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime18 <- getPiecewiseSurvivalTime(median1 = c(2, 3), lambda2 = 0.4) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime18' with expected results - expect_equal(pwSurvivalTime18$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime18$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime18$lambda1, c(0.34657359, 0.23104906), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime18$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime18$lambda2, 0.4, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime18$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime18$hazardRatio, c(0.86643398, 0.57762265), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime18$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime18$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime18$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime18$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime18$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime18$median1, c(2, 3), label = paste0("c(", paste0(pwSurvivalTime18$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime18$median2, 1.732868, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime18$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime18$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime18$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime18$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime18$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime18$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime18$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime18$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime18$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime18$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime18$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime18), NA))) - expect_output(print(pwSurvivalTime18)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime18), NA))) - expect_output(summary(pwSurvivalTime18)$show()) - pwSurvivalTime18CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime18, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime18CodeBased$piecewiseSurvivalTime, pwSurvivalTime18$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime18CodeBased$lambda1, pwSurvivalTime18$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime18CodeBased$lambda2, pwSurvivalTime18$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime18CodeBased$hazardRatio, pwSurvivalTime18$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime18CodeBased$pi1, pwSurvivalTime18$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime18CodeBased$pi2, pwSurvivalTime18$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime18CodeBased$median1, pwSurvivalTime18$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime18CodeBased$median2, pwSurvivalTime18$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime18CodeBased$eventTime, pwSurvivalTime18$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime18CodeBased$kappa, pwSurvivalTime18$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime18CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime18$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime18CodeBased$delayedResponseAllowed, pwSurvivalTime18$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime18CodeBased$delayedResponseEnabled, pwSurvivalTime18$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime18), "character") - df <- as.data.frame(pwSurvivalTime18) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime18) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime19 <- getPiecewiseSurvivalTime(pi1 = 0.45) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime19' with expected results - expect_equal(pwSurvivalTime19$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime19$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime19$lambda1, 0.04981975, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime19$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime19$lambda2, 0.018595296, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime19$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime19$hazardRatio, 2.6791588, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime19$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime19$pi1, 0.45, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime19$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime19$pi2, 0.2, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime19$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime19$median1, 13.9131, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime19$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime19$median2, 37.275405, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime19$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime19$eventTime, 12, label = paste0("c(", paste0(pwSurvivalTime19$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime19$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime19$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime19$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime19$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime19$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime19$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime19$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime19$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime19), NA))) - expect_output(print(pwSurvivalTime19)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime19), NA))) - expect_output(summary(pwSurvivalTime19)$show()) - pwSurvivalTime19CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime19, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime19CodeBased$piecewiseSurvivalTime, pwSurvivalTime19$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime19CodeBased$lambda1, pwSurvivalTime19$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime19CodeBased$lambda2, pwSurvivalTime19$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime19CodeBased$hazardRatio, pwSurvivalTime19$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime19CodeBased$pi1, pwSurvivalTime19$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime19CodeBased$pi2, pwSurvivalTime19$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime19CodeBased$median1, pwSurvivalTime19$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime19CodeBased$median2, pwSurvivalTime19$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime19CodeBased$eventTime, pwSurvivalTime19$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime19CodeBased$kappa, pwSurvivalTime19$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime19CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime19$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime19CodeBased$delayedResponseAllowed, pwSurvivalTime19$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime19CodeBased$delayedResponseEnabled, pwSurvivalTime19$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime19), "character") - df <- as.data.frame(pwSurvivalTime19) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime19) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime20 <- getPiecewiseSurvivalTime(median1 = c(2, 4), hazardRatio = c(1.4, 0.7)) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime20' with expected results - expect_equal(pwSurvivalTime20$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime20$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime20$lambda1, c(0.34657359, 0.1732868), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime20$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime20$lambda2, c(0.24755256, 0.24755256), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime20$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime20$hazardRatio, c(1.4, 0.7), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime20$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime20$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime20$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime20$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime20$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime20$median1, c(2, 4), label = paste0("c(", paste0(pwSurvivalTime20$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime20$median2, c(2.8, 2.8), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime20$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime20$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime20$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime20$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime20$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime20$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime20$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime20$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime20$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime20$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime20$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime20), NA))) - expect_output(print(pwSurvivalTime20)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime20), NA))) - expect_output(summary(pwSurvivalTime20)$show()) - pwSurvivalTime20CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime20, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime20CodeBased$piecewiseSurvivalTime, pwSurvivalTime20$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime20CodeBased$lambda1, pwSurvivalTime20$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime20CodeBased$lambda2, pwSurvivalTime20$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime20CodeBased$hazardRatio, pwSurvivalTime20$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime20CodeBased$pi1, pwSurvivalTime20$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime20CodeBased$pi2, pwSurvivalTime20$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime20CodeBased$median1, pwSurvivalTime20$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime20CodeBased$median2, pwSurvivalTime20$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime20CodeBased$eventTime, pwSurvivalTime20$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime20CodeBased$kappa, pwSurvivalTime20$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime20CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime20$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime20CodeBased$delayedResponseAllowed, pwSurvivalTime20$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime20CodeBased$delayedResponseEnabled, pwSurvivalTime20$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime20), "character") - df <- as.data.frame(pwSurvivalTime20) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime20) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime21 <- getPiecewiseSurvivalTime(median1 = 3, hazardRatio = 0.8) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime21' with expected results - expect_equal(pwSurvivalTime21$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime21$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime21$lambda1, 0.23104906, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime21$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime21$lambda2, 0.28881133, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime21$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime21$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime21$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime21$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime21$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime21$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime21$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime21$median1, 3, label = paste0("c(", paste0(pwSurvivalTime21$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime21$median2, 2.4, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime21$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime21$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime21$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime21$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime21$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime21$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime21$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime21$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime21$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime21$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime21$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime21), NA))) - expect_output(print(pwSurvivalTime21)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime21), NA))) - expect_output(summary(pwSurvivalTime21)$show()) - pwSurvivalTime21CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime21, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime21CodeBased$piecewiseSurvivalTime, pwSurvivalTime21$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime21CodeBased$lambda1, pwSurvivalTime21$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime21CodeBased$lambda2, pwSurvivalTime21$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime21CodeBased$hazardRatio, pwSurvivalTime21$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime21CodeBased$pi1, pwSurvivalTime21$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime21CodeBased$pi2, pwSurvivalTime21$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime21CodeBased$median1, pwSurvivalTime21$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime21CodeBased$median2, pwSurvivalTime21$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime21CodeBased$eventTime, pwSurvivalTime21$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime21CodeBased$kappa, pwSurvivalTime21$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime21CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime21$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime21CodeBased$delayedResponseAllowed, pwSurvivalTime21$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime21CodeBased$delayedResponseEnabled, pwSurvivalTime21$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime21), "character") - df <- as.data.frame(pwSurvivalTime21) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime21) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - expect_error(getPiecewiseSurvivalTime(median2 = 1.386294, lambda2 = 0.4, hazardRatio = 0.8)) - expect_error(getPiecewiseSurvivalTime(median2 = c(1.5, 1.7), lambda1 = c(0.3, 0.4))) - expect_error(getPiecewiseSurvivalTime(median1 = c(2, 4), hazardRatio = c(1, 0.7))) - expect_error(getPiecewiseSurvivalTime(median1 = c(2, 4), hazardRatio = 0.7)) - -}) - -test_that("Testing 'getPiecewiseSurvivalTime': vector based definition", { - - # @refFS[Tab.]{fs:tab:output:getPiecewiseSurvivalTime} - pwSurvivalTime1 <- getPiecewiseSurvivalTime( - piecewiseSurvivalTime = c(0, 6, 9), - lambda2 = c(0.025, 0.04, 0.015), hazardRatio = 0.8 - ) - expect_equal(pwSurvivalTime1$hazardRatio, 0.8) - expect_equal(pwSurvivalTime1$lambda1, c(0.025, 0.04, 0.015) * 0.8) - expect_false(pwSurvivalTime1$isDelayedResponseEnabled()) - - .skipTestIfDisabled() - - pwSurvivalTime2 <- getPiecewiseSurvivalTime( - piecewiseSurvivalTime = c(0, 5, 10), - lambda2 = c(0.1, 0.2, 0.8), hazardRatio = 0.8 - ) - expect_true(pwSurvivalTime2$isPiecewiseSurvivalEnabled()) - expect_false(pwSurvivalTime2$isDelayedResponseEnabled()) - expect_equal(pwSurvivalTime2$hazardRatio, 0.8) - expect_equal(pwSurvivalTime2$piecewiseSurvivalTime, c(0, 5, 10)) - expect_equal(pwSurvivalTime2$lambda2, c(0.1, 0.2, 0.8)) - - pwSurvivalTime3 <- getPiecewiseSurvivalTime(c(0, 6), lambda2 = c(0.01, 0.03), hazardRatio = 0.8) - expect_true(pwSurvivalTime3$isPiecewiseSurvivalEnabled()) - expect_false(pwSurvivalTime3$isDelayedResponseEnabled()) - expect_equal(pwSurvivalTime3$hazardRatio, 0.8) - expect_equal(pwSurvivalTime3$piecewiseSurvivalTime, c(0, 6)) - expect_equal(pwSurvivalTime3$lambda2, c(0.01, 0.03)) - - pwSurvivalTime4 <- getPiecewiseSurvivalTime(0, lambda2 = 0.01, hazardRatio = 0.8) - expect_true(pwSurvivalTime4$isPiecewiseSurvivalEnabled()) - expect_false(pwSurvivalTime4$isDelayedResponseEnabled()) - expect_equal(pwSurvivalTime4$hazardRatio, 0.8) - expect_equal(pwSurvivalTime4$piecewiseSurvivalTime, 0) - expect_equal(pwSurvivalTime4$lambda2, 0.01) - expect_equal(pwSurvivalTime4$lambda1, 0.01 * 0.8) - - pwSurvivalTime5 <- getPiecewiseSurvivalTime(NA_real_, lambda2 = 0.01, hazardRatio = 0.8) - expect_true(pwSurvivalTime5$isPiecewiseSurvivalEnabled()) - expect_false(pwSurvivalTime5$isDelayedResponseEnabled()) - expect_equal(pwSurvivalTime5$hazardRatio, 0.8) - expect_equal(pwSurvivalTime5$piecewiseSurvivalTime, 0) - expect_equal(pwSurvivalTime5$lambda2, 0.01) - expect_equal(pwSurvivalTime5$lambda1, 0.01 * 0.8) - - pwSurvivalTime6 <- getPiecewiseSurvivalTime(0, lambda2 = 0.01, lambda1 = 0.008) - expect_true(pwSurvivalTime6$isPiecewiseSurvivalEnabled()) - expect_false(pwSurvivalTime6$isDelayedResponseEnabled()) - expect_equal(pwSurvivalTime6$hazardRatio, 0.8) - expect_equal(pwSurvivalTime6$piecewiseSurvivalTime, 0) - expect_equal(pwSurvivalTime6$lambda2, 0.01) - expect_equal(pwSurvivalTime6$lambda1, 0.008) - - pwSurvivalTime7 <- getPiecewiseSurvivalTime(NA_real_, lambda2 = 0.01, lambda1 = 0.008) - expect_true(pwSurvivalTime7$isPiecewiseSurvivalEnabled()) - expect_false(pwSurvivalTime7$isDelayedResponseEnabled()) - expect_equal(pwSurvivalTime7$hazardRatio, 0.8) - expect_equal(pwSurvivalTime7$piecewiseSurvivalTime, 0) - expect_equal(pwSurvivalTime7$lambda2, 0.01) - expect_equal(pwSurvivalTime7$lambda1, 0.008) - - # case 2.2 - pwSurvivalTime9 <- getPiecewiseSurvivalTime( - piecewiseSurvivalTime = c(0, 6, 9), - lambda2 = c(0.025, 0.04, 0.015), - lambda1 = c(0.025, 0.04, 0.015) * 0.8 - ) - expect_true(pwSurvivalTime9$isPiecewiseSurvivalEnabled()) - expect_false(pwSurvivalTime9$isDelayedResponseEnabled()) - expect_equal(pwSurvivalTime9$hazardRatio, 0.8) - - pwSurvivalTime10 <- getPiecewiseSurvivalTime(lambda2 = 0.025, hazardRatio = 0.8) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime10' with expected results - expect_equal(pwSurvivalTime10$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime10$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$lambda1, 0.02, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$lambda2, 0.025, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime10$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime10$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$median1, 34.657359, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$median2, 27.725887, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime10$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime10$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime10$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime10$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime10$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime10$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime10), NA))) - expect_output(print(pwSurvivalTime10)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime10), NA))) - expect_output(summary(pwSurvivalTime10)$show()) - pwSurvivalTime10CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime10, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime10CodeBased$piecewiseSurvivalTime, pwSurvivalTime10$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$lambda1, pwSurvivalTime10$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$lambda2, pwSurvivalTime10$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$hazardRatio, pwSurvivalTime10$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$pi1, pwSurvivalTime10$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$pi2, pwSurvivalTime10$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$median1, pwSurvivalTime10$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$median2, pwSurvivalTime10$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$eventTime, pwSurvivalTime10$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$kappa, pwSurvivalTime10$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime10$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$delayedResponseAllowed, pwSurvivalTime10$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime10CodeBased$delayedResponseEnabled, pwSurvivalTime10$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime10), "character") - df <- as.data.frame(pwSurvivalTime10) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime10) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime11 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = 0, lambda2 = 0.025, hazardRatio = 0.8) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime11' with expected results - expect_equal(pwSurvivalTime11$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime11$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$lambda1, 0.02, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$lambda2, 0.025, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime11$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime11$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$median1, 34.657359, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$median2, 27.725887, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime11$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime11$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime11$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime11$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime11$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime11$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime11), NA))) - expect_output(print(pwSurvivalTime11)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime11), NA))) - expect_output(summary(pwSurvivalTime11)$show()) - pwSurvivalTime11CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime11, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime11CodeBased$piecewiseSurvivalTime, pwSurvivalTime11$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$lambda1, pwSurvivalTime11$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$lambda2, pwSurvivalTime11$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$hazardRatio, pwSurvivalTime11$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$pi1, pwSurvivalTime11$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$pi2, pwSurvivalTime11$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$median1, pwSurvivalTime11$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$median2, pwSurvivalTime11$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$eventTime, pwSurvivalTime11$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$kappa, pwSurvivalTime11$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime11$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$delayedResponseAllowed, pwSurvivalTime11$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime11CodeBased$delayedResponseEnabled, pwSurvivalTime11$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime11), "character") - df <- as.data.frame(pwSurvivalTime11) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime11) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime12 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 6), lambda2 = c(0.025, 0.01), hazardRatio = c(0.8, 0.9)) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime12' with expected results - expect_equal(pwSurvivalTime12$piecewiseSurvivalTime, c(0, 6), label = paste0("c(", paste0(pwSurvivalTime12$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$lambda1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$lambda2, c(0.025, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime12$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$hazardRatio, c(0.8, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime12$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$median1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$median2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime12$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$piecewiseSurvivalEnabled, TRUE, label = paste0("c(", paste0(pwSurvivalTime12$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime12$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime12$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime12$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime12), NA))) - expect_output(print(pwSurvivalTime12)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime12), NA))) - expect_output(summary(pwSurvivalTime12)$show()) - pwSurvivalTime12CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime12, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime12CodeBased$piecewiseSurvivalTime, pwSurvivalTime12$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$lambda1, pwSurvivalTime12$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$lambda2, pwSurvivalTime12$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$hazardRatio, pwSurvivalTime12$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$pi1, pwSurvivalTime12$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$pi2, pwSurvivalTime12$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$median1, pwSurvivalTime12$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$median2, pwSurvivalTime12$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$eventTime, pwSurvivalTime12$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$kappa, pwSurvivalTime12$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime12$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$delayedResponseAllowed, pwSurvivalTime12$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime12CodeBased$delayedResponseEnabled, pwSurvivalTime12$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime12), "character") - df <- as.data.frame(pwSurvivalTime12) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime12) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime13 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 6), lambda2 = c(0.025, 0.01), hazardRatio = c(0.8, 0.9), delayedResponseAllowed = TRUE) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime13' with expected results - expect_equal(pwSurvivalTime13$piecewiseSurvivalTime, c(0, 6), label = paste0("c(", paste0(pwSurvivalTime13$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$lambda1, c(0.02, 0.009), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime13$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$lambda2, c(0.025, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime13$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$hazardRatio, c(0.8, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime13$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime13$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime13$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$median1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime13$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$median2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime13$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime13$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime13$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$piecewiseSurvivalEnabled, TRUE, label = paste0("c(", paste0(pwSurvivalTime13$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$delayedResponseAllowed, TRUE, label = paste0("c(", paste0(pwSurvivalTime13$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime13$delayedResponseEnabled, TRUE, label = paste0("c(", paste0(pwSurvivalTime13$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime13), NA))) - expect_output(print(pwSurvivalTime13)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime13), NA))) - expect_output(summary(pwSurvivalTime13)$show()) - pwSurvivalTime13CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime13, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime13CodeBased$piecewiseSurvivalTime, pwSurvivalTime13$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$lambda1, pwSurvivalTime13$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$lambda2, pwSurvivalTime13$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$hazardRatio, pwSurvivalTime13$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$pi1, pwSurvivalTime13$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$pi2, pwSurvivalTime13$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$median1, pwSurvivalTime13$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$median2, pwSurvivalTime13$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$eventTime, pwSurvivalTime13$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$kappa, pwSurvivalTime13$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime13$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$delayedResponseAllowed, pwSurvivalTime13$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime13CodeBased$delayedResponseEnabled, pwSurvivalTime13$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime13), "character") - df <- as.data.frame(pwSurvivalTime13) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime13) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # case 2.2: error expected - expect_error(getPiecewiseSurvivalTime( - piecewiseSurvivalTime = c(0, 6, 9), - lambda2 = c(0.025, 0.04, 0.015), - lambda1 = c(0.03, 0.04, 0.025) - ), - paste0( - "Illegal argument: 'hazardRatio' can only be calculated if ", - "'unique(lambda1 / lambda2)' result in a single value; ", - "current result = c(1.2, 1, 1.667) (e.g., delayed response is not allowed)" - ), - fixed = TRUE - ) - - # case 3 - expect_false(getPiecewiseSurvivalTime(delayedResponseAllowed = TRUE)$isPiecewiseSurvivalEnabled()) - expect_false(getPiecewiseSurvivalTime( - piecewiseSurvivalTime = NA, - delayedResponseAllowed = TRUE - )$isPiecewiseSurvivalEnabled()) - - # case 3.1 - pwSurvivalTimeSim1 <- getPiecewiseSurvivalTime( - piecewiseSurvivalTime = c(0, 6, 9), - lambda2 = c(0.025, 0.04, 0.015), hazardRatio = 0.8, - delayedResponseAllowed = TRUE - ) - expect_equal(pwSurvivalTimeSim1$hazardRatio, 0.8) - expect_equal(pwSurvivalTimeSim1$lambda1, c(0.025, 0.04, 0.015) * 0.8) - expect_false(pwSurvivalTimeSim1$isDelayedResponseEnabled()) - - # case 3.2 - pwSurvivalTimeSim2 <- getPiecewiseSurvivalTime( - piecewiseSurvivalTime = c(0, 6, 9), - lambda2 = c(0.025, 0.04, 0.015), - lambda1 = c(0.03, 0.04, 0.025), delayedResponseAllowed = TRUE - ) - expect_true(pwSurvivalTimeSim2$isPiecewiseSurvivalEnabled()) - expect_true(pwSurvivalTimeSim2$isDelayedResponseEnabled()) - expect_equal(pwSurvivalTimeSim2$hazardRatio, c(1.2, 1, 5 / 3)) - - pwsTime1 <- getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), lambda2 = 0.4) - expect_equal(pwsTime1$.isLambdaBased(minNumberOfLambdas = 1), TRUE) - -}) - -test_that("Testing 'getPiecewiseSurvivalTime': check error and warnings", { - - # @refFS[Tab.]{fs:tab:output:getPiecewiseSurvivalTime} - expect_error(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), lambda2 = 0.4, pi2 = 0.4), - "Conflicting arguments: it is not allowed to specify 'pi2' (0.4) and 'lambda2' (0.4) concurrently", - fixed = TRUE - ) - - expect_error(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), lambda2 = 0.4, pi2 = 0.4, pi1 = 0.3), - "Conflicting arguments: it is not allowed to specify 'pi1' (0.3) and 'lambda2' (0.4) concurrently", - fixed = TRUE - ) - - expect_error(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), lambda2 = 0.4, pi2 = 0.4, pi1 = 0.3), - "Conflicting arguments: it is not allowed to specify 'pi1' (0.3) and 'lambda2' (0.4) concurrently", - fixed = TRUE - ) - - expect_error(getPiecewiseSurvivalTime(lambda2 = 0.4, lambda1 = 0.3, pi2 = 0.4, pi1 = 0.3), - "Conflicting arguments: it is not allowed to specify 'pi1' (0.3) and 'lambda1' (0.3) concurrently", - fixed = TRUE - ) - - expect_error(getPiecewiseSurvivalTime(lambda2 = 0.4, lambda1 = 0.3, pi2 = 0.4, pi1 = 0.3), - "Conflicting arguments: it is not allowed to specify 'pi1' (0.3) and 'lambda1' (0.3) concurrently", - fixed = TRUE - ) - - expect_equal(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), pi2 = 0.4)$.isPiBased(), TRUE) - - expect_warning(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), pi2 = 0.4, pi1 = 0.3), - "'hazardRatio' (0.6, 0.8) will be ignored because it will be calculated", - fixed = TRUE - ) - - expect_warning(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), pi1 = 0.3), - "'hazardRatio' (0.6, 0.8) will be ignored because it will be calculated", - fixed = TRUE - ) - - expect_error(getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 6), lambda2 = 0.025, hazardRatio = 0.8, delayedResponseAllowed = TRUE), - "Illegal argument: length of 'piecewiseSurvivalTime' (2) and length of 'lambda2' (1) must be equal", - fixed = TRUE - ) - - expect_error(getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 6, 12), lambda2 = 0.025, hazardRatio = 0.8, delayedResponseAllowed = TRUE), - "Illegal argument: length of 'piecewiseSurvivalTime' (3) and length of 'lambda2' (1) must be equal", - fixed = TRUE - ) - - expect_error(getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 6), lambda2 = 0.025, hazardRatio = 0.8), - "Illegal argument: length of 'piecewiseSurvivalTime' (2) and length of 'lambda2' (1) must be equal", - fixed = TRUE - ) - -}) - -test_that("Testing 'getPiecewiseSurvivalTime': list-wise definition", { - - # @refFS[Tab.]{fs:tab:output:getPiecewiseSurvivalTime} - pwSurvivalTime8 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = list( - "<6" = 0.025, - "6 - <9" = 0.04, - "9 - <15" = 0.015, - "15 - <21" = 0.01, - ">=21" = 0.007 - ), hazardRatio = 0.6) - expect_true(pwSurvivalTime8$isPiecewiseSurvivalEnabled()) - expect_false(pwSurvivalTime8$isDelayedResponseEnabled()) - expect_equal(pwSurvivalTime8$hazardRatio, 0.6) - expect_equal(pwSurvivalTime8$piecewiseSurvivalTime, c(0, 6, 9, 15, 21)) - expect_equal(pwSurvivalTime8$lambda2, c(0.025, 0.040, 0.015, 0.010, 0.007)) - expect_equal(pwSurvivalTime8$lambda1, c(0.0150, 0.0240, 0.0090, 0.0060, 0.0042)) - - .skipTestIfDisabled() - - result1 <- getPiecewiseSurvivalTime(list( - "<5" = 0.1, - "5 - <10" = 0.2, - ">=10" = 0.8 - ), hazardRatio = 0.8) - expect_equal(result1$piecewiseSurvivalTime, c(0, 5, 10)) - expect_equal(result1$lambda2, c(0.1, 0.2, 0.8)) - - result2 <- getPiecewiseSurvivalTime(list( - "0 - <5" = 0.1, - "5 - <10" = 0.2, - "10 - Inf" = 0.8 - ), hazardRatio = 0.8) - expect_equal(result2$piecewiseSurvivalTime, c(0, 5, 10)) - expect_equal(result2$lambda2, c(0.1, 0.2, 0.8)) - - pwSurvivalTime2 <- getPiecewiseSurvivalTime( - piecewiseSurvivalTime = c(0, 5, 10), - lambda2 = c(0.1, 0.2, 0.8), hazardRatio = 0.8 - ) - expect_equal(pwSurvivalTime2$piecewiseSurvivalTime, c(0, 5, 10)) - expect_equal(pwSurvivalTime2$lambda2, c(0.1, 0.2, 0.8)) - - pwSurvivalTime3 <- getPiecewiseSurvivalTime(c(0, 6), lambda2 = c(0.01, 0.03), hazardRatio = 0.8) - expect_equal(pwSurvivalTime3$piecewiseSurvivalTime, c(0, 6)) - expect_equal(pwSurvivalTime3$lambda2, c(0.01, 0.03)) - - pwSurvivalTime4 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = list("0 - ?" = 0.025), - hazardRatio = 0.8, delayedResponseAllowed = TRUE) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime4' with expected results - expect_equal(pwSurvivalTime4$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime4$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime4$lambda1, 0.02, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime4$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime4$lambda2, 0.025, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime4$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime4$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime4$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime4$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime4$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime4$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime4$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime4$median1, 34.657359, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime4$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime4$median2, 27.725887, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime4$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime4$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime4$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime4$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime4$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime4$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime4$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime4$delayedResponseAllowed, TRUE, label = paste0("c(", paste0(pwSurvivalTime4$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime4$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime4$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime4), NA))) - expect_output(print(pwSurvivalTime4)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime4), NA))) - expect_output(summary(pwSurvivalTime4)$show()) - pwSurvivalTime4CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime4, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime4CodeBased$piecewiseSurvivalTime, pwSurvivalTime4$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime4CodeBased$lambda1, pwSurvivalTime4$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime4CodeBased$lambda2, pwSurvivalTime4$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime4CodeBased$hazardRatio, pwSurvivalTime4$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime4CodeBased$pi1, pwSurvivalTime4$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime4CodeBased$pi2, pwSurvivalTime4$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime4CodeBased$median1, pwSurvivalTime4$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime4CodeBased$median2, pwSurvivalTime4$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime4CodeBased$eventTime, pwSurvivalTime4$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime4CodeBased$kappa, pwSurvivalTime4$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime4CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime4$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime4CodeBased$delayedResponseAllowed, pwSurvivalTime4$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime4CodeBased$delayedResponseEnabled, pwSurvivalTime4$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime4), "character") - df <- as.data.frame(pwSurvivalTime4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime5 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = list("x" = 0.025), - hazardRatio = 0.8, delayedResponseAllowed = TRUE) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime5' with expected results - expect_equal(pwSurvivalTime5$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime5$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime5$lambda1, 0.02, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime5$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime5$lambda2, 0.025, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime5$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime5$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime5$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime5$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime5$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime5$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime5$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime5$median1, 34.657359, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime5$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime5$median2, 27.725887, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime5$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime5$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime5$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime5$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime5$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime5$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime5$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime5$delayedResponseAllowed, TRUE, label = paste0("c(", paste0(pwSurvivalTime5$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime5$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime5$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime5), NA))) - expect_output(print(pwSurvivalTime5)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime5), NA))) - expect_output(summary(pwSurvivalTime5)$show()) - pwSurvivalTime5CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime5, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime5CodeBased$piecewiseSurvivalTime, pwSurvivalTime5$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime5CodeBased$lambda1, pwSurvivalTime5$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime5CodeBased$lambda2, pwSurvivalTime5$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime5CodeBased$hazardRatio, pwSurvivalTime5$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime5CodeBased$pi1, pwSurvivalTime5$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime5CodeBased$pi2, pwSurvivalTime5$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime5CodeBased$median1, pwSurvivalTime5$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime5CodeBased$median2, pwSurvivalTime5$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime5CodeBased$eventTime, pwSurvivalTime5$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime5CodeBased$kappa, pwSurvivalTime5$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime5CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime5$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime5CodeBased$delayedResponseAllowed, pwSurvivalTime5$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime5CodeBased$delayedResponseEnabled, pwSurvivalTime5$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime5), "character") - df <- as.data.frame(pwSurvivalTime5) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime5) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime6 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = list("0 - 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime6) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime7 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = list("x" = 0.025), - hazardRatio = 0.8, delayedResponseAllowed = FALSE) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime7' with expected results - expect_equal(pwSurvivalTime7$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime7$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime7$lambda1, 0.02, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime7$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime7$lambda2, 0.025, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime7$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime7$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime7$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime7$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime7$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime7$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime7$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime7$median1, 34.657359, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime7$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime7$median2, 27.725887, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime7$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime7$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime7$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime7$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime7$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime7$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime7$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime7$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime7$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime7$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime7$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime7), NA))) - expect_output(print(pwSurvivalTime7)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime7), NA))) - expect_output(summary(pwSurvivalTime7)$show()) - pwSurvivalTime7CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime7, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime7CodeBased$piecewiseSurvivalTime, pwSurvivalTime7$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime7CodeBased$lambda1, pwSurvivalTime7$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime7CodeBased$lambda2, pwSurvivalTime7$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime7CodeBased$hazardRatio, pwSurvivalTime7$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime7CodeBased$pi1, pwSurvivalTime7$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime7CodeBased$pi2, pwSurvivalTime7$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime7CodeBased$median1, pwSurvivalTime7$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime7CodeBased$median2, pwSurvivalTime7$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime7CodeBased$eventTime, pwSurvivalTime7$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime7CodeBased$kappa, pwSurvivalTime7$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime7CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime7$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime7CodeBased$delayedResponseAllowed, pwSurvivalTime7$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime7CodeBased$delayedResponseEnabled, pwSurvivalTime7$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime7), "character") - df <- as.data.frame(pwSurvivalTime7) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime7) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime8 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = list("0 - 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime8) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - expect_warning(getPiecewiseSurvivalTime(piecewiseSurvivalTime = list("<6" = 0.025), hazardRatio = 0.8), - "Defined time period \"0 - <6\" will be ignored because 'piecewiseSurvivalTime' list has only 1 entry", - fixed = TRUE - ) - -}) - -test_plan_section("Testing Class 'AccrualTime'") - - -test_that("Testing 'getAccrualTime': isAccrualTimeEnabled()", { - expect_true(getAccrualTime()$isAccrualTimeEnabled()) - expect_true(getAccrualTime(maxNumberOfSubjects = 100)$isAccrualTimeEnabled()) - -}) - -test_that("Testing 'getAccrualTime': vector based definition", { - - accrualTime1 <- getAccrualTime( - accrualTime = c(0, 6, 9, 15), - accrualIntensity = c(15, 21, 27), maxNumberOfSubjects = 315 - ) - expect_equal(accrualTime1$accrualTime, c(0, 6, 9, 15)) - expect_equal(accrualTime1$accrualIntensity, c(15, 21, 27)) - expect_equal(accrualTime1$remainingTime, NA_real_) - - accrualTime2 <- getAccrualTime( - accrualTime = c(0, 6, 9), - accrualIntensity = c(15, 21, 27), maxNumberOfSubjects = 1000 - ) - expect_equal(accrualTime2$accrualTime, c(0, 6, 9, 40.37037)) - expect_equal(accrualTime2$accrualIntensity, c(15, 21, 27)) - expect_equal(accrualTime2$remainingTime, 31.37037) - - .skipTestIfDisabled() - - accrualTime3 <- getAccrualTime( - accrualTime = c(0, 12, 13, 14, 15, 16), - accrualIntensity = c(15, 21, 27, 33, 39, 45), maxNumberOfSubjects = 1405 - ) - expect_equal(accrualTime3$accrualTime, c(0, 12, 13, 14, 15, 16, 40.55555556)) - expect_equal(accrualTime3$accrualIntensity, c(15, 21, 27, 33, 39, 45)) - expect_equal(accrualTime3$remainingTime, 24.55555556) - - accrualTime4 <- getAccrualTime( - accrualTime = c(0, 24), - accrualIntensity = c(30), maxNumberOfSubjects = 720 - ) - - ## Comparison of the results of AccrualTime object 'accrualTime4' with expected results - expect_equal(accrualTime4$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime4$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime4$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime4$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime4$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime4$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime4$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime4$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime4$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime4$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime4$accrualTime, c(0, 24), label = paste0("c(", paste0(accrualTime4$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime4$accrualIntensity, 30, label = paste0("c(", paste0(accrualTime4$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime4$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime4$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime4$maxNumberOfSubjects, 720, label = paste0("c(", paste0(accrualTime4$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime4$remainingTime, NA_real_, label = paste0("c(", paste0(accrualTime4$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime4$piecewiseAccrualEnabled, FALSE, label = paste0("c(", paste0(accrualTime4$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime4), NA))) - expect_output(print(accrualTime4)$show()) - invisible(capture.output(expect_error(summary(accrualTime4), NA))) - expect_output(summary(accrualTime4)$show()) - accrualTime4CodeBased <- eval(parse(text = getObjectRCode(accrualTime4, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime4CodeBased$endOfAccrualIsUserDefined, accrualTime4$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$followUpTimeMustBeUserDefined, accrualTime4$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime4$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime4$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$absoluteAccrualIntensityEnabled, accrualTime4$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$accrualTime, accrualTime4$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$accrualIntensity, accrualTime4$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$accrualIntensityRelative, accrualTime4$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$maxNumberOfSubjects, accrualTime4$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$remainingTime, accrualTime4$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$piecewiseAccrualEnabled, accrualTime4$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime4), "character") - df <- as.data.frame(accrualTime4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime5 <- getAccrualTime( - accrualTime = c(0, 24, 30), - accrualIntensity = c(30, 45) - ) - - ## Comparison of the results of AccrualTime object 'accrualTime5' with expected results - expect_equal(accrualTime5$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime5$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime5$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime5$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime5$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime5$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime5$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime5$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime5$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime5$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime5$accrualTime, c(0, 24, 30), label = paste0("c(", paste0(accrualTime5$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime5$accrualIntensity, c(30, 45), label = paste0("c(", paste0(accrualTime5$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime5$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime5$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime5$maxNumberOfSubjects, 990, label = paste0("c(", paste0(accrualTime5$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime5$remainingTime, 6, label = paste0("c(", paste0(accrualTime5$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime5$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime5$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime5), NA))) - expect_output(print(accrualTime5)$show()) - invisible(capture.output(expect_error(summary(accrualTime5), NA))) - expect_output(summary(accrualTime5)$show()) - accrualTime5CodeBased <- eval(parse(text = getObjectRCode(accrualTime5, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime5CodeBased$endOfAccrualIsUserDefined, accrualTime5$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$followUpTimeMustBeUserDefined, accrualTime5$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime5$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime5$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$absoluteAccrualIntensityEnabled, accrualTime5$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$accrualTime, accrualTime5$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$accrualIntensity, accrualTime5$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$accrualIntensityRelative, accrualTime5$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$maxNumberOfSubjects, accrualTime5$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$remainingTime, accrualTime5$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$piecewiseAccrualEnabled, accrualTime5$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime5), "character") - df <- as.data.frame(accrualTime5) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime5) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime6 <- getAccrualTime( - accrualTime = c(0, 24, 30), - accrualIntensity = c(20, 25, 45), maxNumberOfSubjects = 720 - ) - - ## Comparison of the results of AccrualTime object 'accrualTime6' with expected results - expect_equal(accrualTime6$endOfAccrualIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime6$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime6$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime6$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime6$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime6$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime6$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime6$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime6$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime6$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime6$accrualTime, c(0, 24, 30, 32), label = paste0("c(", paste0(accrualTime6$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime6$accrualIntensity, c(20, 25, 45), label = paste0("c(", paste0(accrualTime6$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime6$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime6$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime6$maxNumberOfSubjects, 720, label = paste0("c(", paste0(accrualTime6$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime6$remainingTime, 2, label = paste0("c(", paste0(accrualTime6$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime6$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime6$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime6), NA))) - expect_output(print(accrualTime6)$show()) - invisible(capture.output(expect_error(summary(accrualTime6), NA))) - expect_output(summary(accrualTime6)$show()) - accrualTime6CodeBased <- eval(parse(text = getObjectRCode(accrualTime6, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime6CodeBased$endOfAccrualIsUserDefined, accrualTime6$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$followUpTimeMustBeUserDefined, accrualTime6$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime6$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime6$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$absoluteAccrualIntensityEnabled, accrualTime6$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$accrualTime, accrualTime6$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$accrualIntensity, accrualTime6$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$accrualIntensityRelative, accrualTime6$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$maxNumberOfSubjects, accrualTime6$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$remainingTime, accrualTime6$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$piecewiseAccrualEnabled, accrualTime6$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime6), "character") - df <- as.data.frame(accrualTime6) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime6) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime8 <- getAccrualTime(accrualTime = 0, accrualIntensity = 15, maxNumberOfSubjects = 1000) - - ## Comparison of the results of AccrualTime object 'accrualTime8' with expected results - expect_equal(accrualTime8$endOfAccrualIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime8$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime8$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime8$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime8$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime8$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime8$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime8$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime8$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime8$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime8$accrualTime, c(0, 66.666667), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime8$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime8$accrualIntensity, 15, label = paste0("c(", paste0(accrualTime8$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime8$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime8$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime8$maxNumberOfSubjects, 1000, label = paste0("c(", paste0(accrualTime8$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime8$remainingTime, 66.666667, tolerance = 1e-07, label = paste0("c(", paste0(accrualTime8$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime8$piecewiseAccrualEnabled, FALSE, label = paste0("c(", paste0(accrualTime8$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime8), NA))) - expect_output(print(accrualTime8)$show()) - invisible(capture.output(expect_error(summary(accrualTime8), NA))) - expect_output(summary(accrualTime8)$show()) - accrualTime8CodeBased <- eval(parse(text = getObjectRCode(accrualTime8, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime8CodeBased$endOfAccrualIsUserDefined, accrualTime8$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$followUpTimeMustBeUserDefined, accrualTime8$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime8$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime8$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$absoluteAccrualIntensityEnabled, accrualTime8$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$accrualTime, accrualTime8$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$accrualIntensity, accrualTime8$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$accrualIntensityRelative, accrualTime8$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$maxNumberOfSubjects, accrualTime8$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$remainingTime, accrualTime8$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$piecewiseAccrualEnabled, accrualTime8$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime8), "character") - df <- as.data.frame(accrualTime8) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime8) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime9 <- getAccrualTime(accrualTime = c(0, 5), accrualIntensity = 15) - - ## Comparison of the results of AccrualTime object 'accrualTime9' with expected results - expect_equal(accrualTime9$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime9$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime9$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime9$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime9$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime9$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime9$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime9$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime9$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime9$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime9$accrualTime, c(0, 5), label = paste0("c(", paste0(accrualTime9$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime9$accrualIntensity, 15, label = paste0("c(", paste0(accrualTime9$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime9$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime9$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime9$maxNumberOfSubjects, 75, label = paste0("c(", paste0(accrualTime9$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime9$remainingTime, 5, label = paste0("c(", paste0(accrualTime9$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime9$piecewiseAccrualEnabled, FALSE, label = paste0("c(", paste0(accrualTime9$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime9), NA))) - expect_output(print(accrualTime9)$show()) - invisible(capture.output(expect_error(summary(accrualTime9), NA))) - expect_output(summary(accrualTime9)$show()) - accrualTime9CodeBased <- eval(parse(text = getObjectRCode(accrualTime9, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime9CodeBased$endOfAccrualIsUserDefined, accrualTime9$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$followUpTimeMustBeUserDefined, accrualTime9$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime9$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime9$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$absoluteAccrualIntensityEnabled, accrualTime9$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$accrualTime, accrualTime9$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$accrualIntensity, accrualTime9$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$accrualIntensityRelative, accrualTime9$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$maxNumberOfSubjects, accrualTime9$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$remainingTime, accrualTime9$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$piecewiseAccrualEnabled, accrualTime9$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime9), "character") - df <- as.data.frame(accrualTime9) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime9) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime10 <- getAccrualTime(accrualTime = 0, accrualIntensity = 15, maxNumberOfSubjects = 10) - - ## Comparison of the results of AccrualTime object 'accrualTime10' with expected results - expect_equal(accrualTime10$endOfAccrualIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime10$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime10$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime10$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime10$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime10$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime10$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime10$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime10$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime10$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime10$accrualTime, c(0, 0.66666667), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime10$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime10$accrualIntensity, 15, label = paste0("c(", paste0(accrualTime10$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime10$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime10$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime10$maxNumberOfSubjects, 10, label = paste0("c(", paste0(accrualTime10$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime10$remainingTime, 0.66666667, tolerance = 1e-07, label = paste0("c(", paste0(accrualTime10$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime10$piecewiseAccrualEnabled, FALSE, label = paste0("c(", paste0(accrualTime10$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime10), NA))) - expect_output(print(accrualTime10)$show()) - invisible(capture.output(expect_error(summary(accrualTime10), NA))) - expect_output(summary(accrualTime10)$show()) - accrualTime10CodeBased <- eval(parse(text = getObjectRCode(accrualTime10, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime10CodeBased$endOfAccrualIsUserDefined, accrualTime10$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$followUpTimeMustBeUserDefined, accrualTime10$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime10$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime10$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$absoluteAccrualIntensityEnabled, accrualTime10$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$accrualTime, accrualTime10$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$accrualIntensity, accrualTime10$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$accrualIntensityRelative, accrualTime10$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$maxNumberOfSubjects, accrualTime10$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$remainingTime, accrualTime10$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$piecewiseAccrualEnabled, accrualTime10$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime10), "character") - df <- as.data.frame(accrualTime10) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime10) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime11 <- getAccrualTime(accrualTime = c(0, 5), accrualIntensity = 15, maxNumberOfSubjects = 75) - - ## Comparison of the results of AccrualTime object 'accrualTime11' with expected results - expect_equal(accrualTime11$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime11$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime11$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime11$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime11$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime11$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime11$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime11$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime11$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime11$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime11$accrualTime, c(0, 5), label = paste0("c(", paste0(accrualTime11$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime11$accrualIntensity, 15, label = paste0("c(", paste0(accrualTime11$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime11$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime11$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime11$maxNumberOfSubjects, 75, label = paste0("c(", paste0(accrualTime11$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime11$remainingTime, NA_real_, label = paste0("c(", paste0(accrualTime11$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime11$piecewiseAccrualEnabled, FALSE, label = paste0("c(", paste0(accrualTime11$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime11), NA))) - expect_output(print(accrualTime11)$show()) - invisible(capture.output(expect_error(summary(accrualTime11), NA))) - expect_output(summary(accrualTime11)$show()) - accrualTime11CodeBased <- eval(parse(text = getObjectRCode(accrualTime11, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime11CodeBased$endOfAccrualIsUserDefined, accrualTime11$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime11CodeBased$followUpTimeMustBeUserDefined, accrualTime11$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime11CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime11$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime11CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime11$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime11CodeBased$absoluteAccrualIntensityEnabled, accrualTime11$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime11CodeBased$accrualTime, accrualTime11$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime11CodeBased$accrualIntensity, accrualTime11$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime11CodeBased$accrualIntensityRelative, accrualTime11$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime11CodeBased$maxNumberOfSubjects, accrualTime11$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime11CodeBased$remainingTime, accrualTime11$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime11CodeBased$piecewiseAccrualEnabled, accrualTime11$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime11), "character") - df <- as.data.frame(accrualTime11) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime11) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime12 <- getAccrualTime(accrualTime = c(0, 6, 15, 25), accrualIntensity = c(22, 0, 33)) - - ## Comparison of the results of AccrualTime object 'accrualTime12' with expected results - expect_equal(accrualTime12$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime12$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime12$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime12$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime12$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime12$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime12$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime12$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime12$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime12$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime12$accrualTime, c(0, 6, 15, 25), label = paste0("c(", paste0(accrualTime12$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime12$accrualIntensity, c(22, 0, 33), label = paste0("c(", paste0(accrualTime12$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime12$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime12$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime12$maxNumberOfSubjects, 462, label = paste0("c(", paste0(accrualTime12$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime12$remainingTime, 10, label = paste0("c(", paste0(accrualTime12$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime12$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime12$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime12), NA))) - expect_output(print(accrualTime12)$show()) - invisible(capture.output(expect_error(summary(accrualTime12), NA))) - expect_output(summary(accrualTime12)$show()) - accrualTime12CodeBased <- eval(parse(text = getObjectRCode(accrualTime12, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime12CodeBased$endOfAccrualIsUserDefined, accrualTime12$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$followUpTimeMustBeUserDefined, accrualTime12$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime12$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime12$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$absoluteAccrualIntensityEnabled, accrualTime12$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$accrualTime, accrualTime12$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$accrualIntensity, accrualTime12$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$accrualIntensityRelative, accrualTime12$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$maxNumberOfSubjects, accrualTime12$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$remainingTime, accrualTime12$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$piecewiseAccrualEnabled, accrualTime12$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime12), "character") - df <- as.data.frame(accrualTime12) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime12) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime13 <- getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(22, 33), maxNumberOfSubjects = 1000) - - ## Comparison of the results of AccrualTime object 'accrualTime13' with expected results - expect_equal(accrualTime13$endOfAccrualIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime13$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime13$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime13$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime13$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime13$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime13$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime13$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime13$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime13$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime13$accrualTime, c(0, 6, 32.30303), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime13$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime13$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime13$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime13$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime13$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime13$maxNumberOfSubjects, 1000, label = paste0("c(", paste0(accrualTime13$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime13$remainingTime, 26.30303, tolerance = 1e-07, label = paste0("c(", paste0(accrualTime13$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime13$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime13$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime13), NA))) - expect_output(print(accrualTime13)$show()) - invisible(capture.output(expect_error(summary(accrualTime13), NA))) - expect_output(summary(accrualTime13)$show()) - accrualTime13CodeBased <- eval(parse(text = getObjectRCode(accrualTime13, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime13CodeBased$endOfAccrualIsUserDefined, accrualTime13$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$followUpTimeMustBeUserDefined, accrualTime13$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime13$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime13$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$absoluteAccrualIntensityEnabled, accrualTime13$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$accrualTime, accrualTime13$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$accrualIntensity, accrualTime13$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$accrualIntensityRelative, accrualTime13$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$maxNumberOfSubjects, accrualTime13$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$remainingTime, accrualTime13$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$piecewiseAccrualEnabled, accrualTime13$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime13), "character") - df <- as.data.frame(accrualTime13) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime13) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("Testing 'getAccrualTime': test absolute and relative definition", { - - # @refFS[Tab.]{fs:tab:output:getAccrualTime} - accrualTime1 <- getAccrualTime( - accrualTime = c(0, 6, 30), - accrualIntensity = c(22, 33), maxNumberOfSubjects = 924 - ) - - ## Comparison of the results of AccrualTime object 'accrualTime1' with expected results - expect_equal(accrualTime1$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime1$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime1$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime1$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime1$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime1$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime1$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime1$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime1$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime1$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime1$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime1$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime1$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime1$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime1$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime1$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime1$maxNumberOfSubjects, 924, label = paste0("c(", paste0(accrualTime1$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime1$remainingTime, NA_real_, label = paste0("c(", paste0(accrualTime1$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime1$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime1$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime1), NA))) - expect_output(print(accrualTime1)$show()) - invisible(capture.output(expect_error(summary(accrualTime1), NA))) - expect_output(summary(accrualTime1)$show()) - accrualTime1CodeBased <- eval(parse(text = getObjectRCode(accrualTime1, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime1CodeBased$endOfAccrualIsUserDefined, accrualTime1$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime1CodeBased$followUpTimeMustBeUserDefined, accrualTime1$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime1CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime1$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime1CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime1$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime1CodeBased$absoluteAccrualIntensityEnabled, accrualTime1$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime1CodeBased$accrualTime, accrualTime1$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime1CodeBased$accrualIntensity, accrualTime1$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime1CodeBased$accrualIntensityRelative, accrualTime1$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime1CodeBased$maxNumberOfSubjects, accrualTime1$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime1CodeBased$remainingTime, accrualTime1$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime1CodeBased$piecewiseAccrualEnabled, accrualTime1$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime1), "character") - df <- as.data.frame(accrualTime1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime2 <- getAccrualTime(list( - "0 - <6" = 22, - "6 - <=30" = 33 - ), - maxNumberOfSubjects = 924 - ) - - ## Comparison of the results of AccrualTime object 'accrualTime2' with expected results - expect_equal(accrualTime2$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime2$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime2$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime2$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime2$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime2$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime2$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime2$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime2$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime2$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime2$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime2$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime2$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime2$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime2$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime2$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime2$maxNumberOfSubjects, 924, label = paste0("c(", paste0(accrualTime2$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime2$remainingTime, NA_real_, label = paste0("c(", paste0(accrualTime2$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime2$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime2$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime2), NA))) - expect_output(print(accrualTime2)$show()) - invisible(capture.output(expect_error(summary(accrualTime2), NA))) - expect_output(summary(accrualTime2)$show()) - accrualTime2CodeBased <- eval(parse(text = getObjectRCode(accrualTime2, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime2CodeBased$endOfAccrualIsUserDefined, accrualTime2$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime2CodeBased$followUpTimeMustBeUserDefined, accrualTime2$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime2CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime2$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime2CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime2$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime2CodeBased$absoluteAccrualIntensityEnabled, accrualTime2$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime2CodeBased$accrualTime, accrualTime2$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime2CodeBased$accrualIntensity, accrualTime2$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime2CodeBased$accrualIntensityRelative, accrualTime2$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime2CodeBased$maxNumberOfSubjects, accrualTime2$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime2CodeBased$remainingTime, accrualTime2$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime2CodeBased$piecewiseAccrualEnabled, accrualTime2$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime2), "character") - df <- as.data.frame(accrualTime2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - .skipTestIfDisabled() - - accrualTime3 <- getAccrualTime( - accrualTime = c(0, 6, 30), - accrualIntensity = c(0.22, 0.33), maxNumberOfSubjects = 1000 - ) - - ## Comparison of the results of AccrualTime object 'accrualTime3' with expected results - expect_equal(accrualTime3$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime3$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime3$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime3$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime3$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime3$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime3$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime3$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime3$absoluteAccrualIntensityEnabled, FALSE, label = paste0("c(", paste0(accrualTime3$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime3$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime3$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime3$accrualIntensity, c(23.809524, 35.714286), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime3$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime3$accrualIntensityRelative, c(0.22, 0.33), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime3$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime3$maxNumberOfSubjects, 1000, label = paste0("c(", paste0(accrualTime3$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime3$remainingTime, 24, label = paste0("c(", paste0(accrualTime3$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime3$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime3$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime3), NA))) - expect_output(print(accrualTime3)$show()) - invisible(capture.output(expect_error(summary(accrualTime3), NA))) - expect_output(summary(accrualTime3)$show()) - accrualTime3CodeBased <- eval(parse(text = getObjectRCode(accrualTime3, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime3CodeBased$endOfAccrualIsUserDefined, accrualTime3$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime3CodeBased$followUpTimeMustBeUserDefined, accrualTime3$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime3CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime3$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime3CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime3$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime3CodeBased$absoluteAccrualIntensityEnabled, accrualTime3$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime3CodeBased$accrualTime, accrualTime3$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime3CodeBased$accrualIntensity, accrualTime3$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime3CodeBased$accrualIntensityRelative, accrualTime3$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime3CodeBased$maxNumberOfSubjects, accrualTime3$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime3CodeBased$remainingTime, accrualTime3$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime3CodeBased$piecewiseAccrualEnabled, accrualTime3$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime3), "character") - df <- as.data.frame(accrualTime3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime4 <- getAccrualTime(list( - "0 - <6" = 0.22, - "6 - <=30" = 0.33 - ), - maxNumberOfSubjects = 1000 - ) - - ## Comparison of the results of AccrualTime object 'accrualTime4' with expected results - expect_equal(accrualTime4$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime4$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime4$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime4$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime4$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime4$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime4$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime4$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime4$absoluteAccrualIntensityEnabled, FALSE, label = paste0("c(", paste0(accrualTime4$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime4$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime4$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime4$accrualIntensity, c(23.809524, 35.714286), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime4$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime4$accrualIntensityRelative, c(0.22, 0.33), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime4$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime4$maxNumberOfSubjects, 1000, label = paste0("c(", paste0(accrualTime4$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime4$remainingTime, 24, label = paste0("c(", paste0(accrualTime4$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime4$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime4$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime4), NA))) - expect_output(print(accrualTime4)$show()) - invisible(capture.output(expect_error(summary(accrualTime4), NA))) - expect_output(summary(accrualTime4)$show()) - accrualTime4CodeBased <- eval(parse(text = getObjectRCode(accrualTime4, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime4CodeBased$endOfAccrualIsUserDefined, accrualTime4$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$followUpTimeMustBeUserDefined, accrualTime4$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime4$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime4$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$absoluteAccrualIntensityEnabled, accrualTime4$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$accrualTime, accrualTime4$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$accrualIntensity, accrualTime4$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$accrualIntensityRelative, accrualTime4$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$maxNumberOfSubjects, accrualTime4$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$remainingTime, accrualTime4$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime4CodeBased$piecewiseAccrualEnabled, accrualTime4$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime4), "character") - df <- as.data.frame(accrualTime4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime5 <- getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(22, 33)) - - ## Comparison of the results of AccrualTime object 'accrualTime5' with expected results - expect_equal(accrualTime5$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime5$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime5$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime5$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime5$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime5$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime5$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime5$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime5$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime5$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime5$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime5$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime5$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime5$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime5$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime5$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime5$maxNumberOfSubjects, 924, label = paste0("c(", paste0(accrualTime5$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime5$remainingTime, 24, label = paste0("c(", paste0(accrualTime5$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime5$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime5$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime5), NA))) - expect_output(print(accrualTime5)$show()) - invisible(capture.output(expect_error(summary(accrualTime5), NA))) - expect_output(summary(accrualTime5)$show()) - accrualTime5CodeBased <- eval(parse(text = getObjectRCode(accrualTime5, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime5CodeBased$endOfAccrualIsUserDefined, accrualTime5$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$followUpTimeMustBeUserDefined, accrualTime5$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime5$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime5$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$absoluteAccrualIntensityEnabled, accrualTime5$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$accrualTime, accrualTime5$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$accrualIntensity, accrualTime5$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$accrualIntensityRelative, accrualTime5$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$maxNumberOfSubjects, accrualTime5$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$remainingTime, accrualTime5$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime5CodeBased$piecewiseAccrualEnabled, accrualTime5$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime5), "character") - df <- as.data.frame(accrualTime5) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime5) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime6 <- getAccrualTime(list( - "0 - <6" = 22, - "6 - <=30" = 33 - )) - - ## Comparison of the results of AccrualTime object 'accrualTime6' with expected results - expect_equal(accrualTime6$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime6$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime6$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime6$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime6$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime6$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime6$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime6$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime6$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime6$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime6$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime6$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime6$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime6$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime6$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime6$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime6$maxNumberOfSubjects, 924, label = paste0("c(", paste0(accrualTime6$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime6$remainingTime, 24, label = paste0("c(", paste0(accrualTime6$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime6$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime6$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime6), NA))) - expect_output(print(accrualTime6)$show()) - invisible(capture.output(expect_error(summary(accrualTime6), NA))) - expect_output(summary(accrualTime6)$show()) - accrualTime6CodeBased <- eval(parse(text = getObjectRCode(accrualTime6, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime6CodeBased$endOfAccrualIsUserDefined, accrualTime6$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$followUpTimeMustBeUserDefined, accrualTime6$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime6$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime6$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$absoluteAccrualIntensityEnabled, accrualTime6$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$accrualTime, accrualTime6$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$accrualIntensity, accrualTime6$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$accrualIntensityRelative, accrualTime6$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$maxNumberOfSubjects, accrualTime6$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$remainingTime, accrualTime6$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime6CodeBased$piecewiseAccrualEnabled, accrualTime6$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime6), "character") - df <- as.data.frame(accrualTime6) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime6) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime7 <- getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(0.22, 0.33)) - - ## Comparison of the results of AccrualTime object 'accrualTime7' with expected results - expect_equal(accrualTime7$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime7$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime7$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime7$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime7$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime7$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime7$maxNumberOfSubjectsCanBeCalculatedDirectly, FALSE, label = paste0("c(", paste0(accrualTime7$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime7$absoluteAccrualIntensityEnabled, FALSE, label = paste0("c(", paste0(accrualTime7$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime7$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime7$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime7$accrualIntensity, c(0.22, 0.33), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime7$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime7$accrualIntensityRelative, c(0.22, 0.33), label = paste0("c(", paste0(accrualTime7$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime7$maxNumberOfSubjects, NA_real_, label = paste0("c(", paste0(accrualTime7$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime7$remainingTime, NA_real_, label = paste0("c(", paste0(accrualTime7$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime7$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime7$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime7), NA))) - expect_output(print(accrualTime7)$show()) - invisible(capture.output(expect_error(summary(accrualTime7), NA))) - expect_output(summary(accrualTime7)$show()) - accrualTime7CodeBased <- eval(parse(text = getObjectRCode(accrualTime7, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime7CodeBased$endOfAccrualIsUserDefined, accrualTime7$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime7CodeBased$followUpTimeMustBeUserDefined, accrualTime7$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime7CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime7$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime7CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime7$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime7CodeBased$absoluteAccrualIntensityEnabled, accrualTime7$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime7CodeBased$accrualTime, accrualTime7$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime7CodeBased$accrualIntensity, accrualTime7$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime7CodeBased$accrualIntensityRelative, accrualTime7$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime7CodeBased$maxNumberOfSubjects, accrualTime7$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime7CodeBased$remainingTime, accrualTime7$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime7CodeBased$piecewiseAccrualEnabled, accrualTime7$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime7), "character") - df <- as.data.frame(accrualTime7) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime7) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime8 <- getAccrualTime(list( - "0 - <6" = 0.22, - "6 - <=30" = 0.33 - )) - - ## Comparison of the results of AccrualTime object 'accrualTime8' with expected results - expect_equal(accrualTime8$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime8$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime8$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime8$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime8$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime8$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime8$maxNumberOfSubjectsCanBeCalculatedDirectly, FALSE, label = paste0("c(", paste0(accrualTime8$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime8$absoluteAccrualIntensityEnabled, FALSE, label = paste0("c(", paste0(accrualTime8$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime8$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime8$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime8$accrualIntensity, c(0.22, 0.33), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime8$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime8$accrualIntensityRelative, c(0.22, 0.33), label = paste0("c(", paste0(accrualTime8$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime8$maxNumberOfSubjects, NA_real_, label = paste0("c(", paste0(accrualTime8$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime8$remainingTime, NA_real_, label = paste0("c(", paste0(accrualTime8$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime8$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime8$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime8), NA))) - expect_output(print(accrualTime8)$show()) - invisible(capture.output(expect_error(summary(accrualTime8), NA))) - expect_output(summary(accrualTime8)$show()) - accrualTime8CodeBased <- eval(parse(text = getObjectRCode(accrualTime8, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime8CodeBased$endOfAccrualIsUserDefined, accrualTime8$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$followUpTimeMustBeUserDefined, accrualTime8$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime8$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime8$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$absoluteAccrualIntensityEnabled, accrualTime8$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$accrualTime, accrualTime8$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$accrualIntensity, accrualTime8$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$accrualIntensityRelative, accrualTime8$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$maxNumberOfSubjects, accrualTime8$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$remainingTime, accrualTime8$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime8CodeBased$piecewiseAccrualEnabled, accrualTime8$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime8), "character") - df <- as.data.frame(accrualTime8) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime8) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime9 <- getAccrualTime( - accrualTime = c(0, 6), - accrualIntensity = c(22, 33), maxNumberOfSubjects = 1000 - ) - - ## Comparison of the results of AccrualTime object 'accrualTime9' with expected results - expect_equal(accrualTime9$endOfAccrualIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime9$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime9$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime9$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime9$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime9$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime9$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime9$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime9$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime9$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime9$accrualTime, c(0, 6, 32.30303), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime9$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime9$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime9$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime9$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime9$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime9$maxNumberOfSubjects, 1000, label = paste0("c(", paste0(accrualTime9$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime9$remainingTime, 26.30303, tolerance = 1e-07, label = paste0("c(", paste0(accrualTime9$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime9$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime9$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime9), NA))) - expect_output(print(accrualTime9)$show()) - invisible(capture.output(expect_error(summary(accrualTime9), NA))) - expect_output(summary(accrualTime9)$show()) - accrualTime9CodeBased <- eval(parse(text = getObjectRCode(accrualTime9, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime9CodeBased$endOfAccrualIsUserDefined, accrualTime9$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$followUpTimeMustBeUserDefined, accrualTime9$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime9$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime9$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$absoluteAccrualIntensityEnabled, accrualTime9$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$accrualTime, accrualTime9$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$accrualIntensity, accrualTime9$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$accrualIntensityRelative, accrualTime9$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$maxNumberOfSubjects, accrualTime9$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$remainingTime, accrualTime9$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime9CodeBased$piecewiseAccrualEnabled, accrualTime9$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime9), "character") - df <- as.data.frame(accrualTime9) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime9) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime10 <- getAccrualTime(list( - "0 - <6" = 22, - "6" = 33 - ), - maxNumberOfSubjects = 1000 - ) - - ## Comparison of the results of AccrualTime object 'accrualTime10' with expected results - expect_equal(accrualTime10$endOfAccrualIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime10$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime10$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime10$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime10$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime10$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime10$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime10$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime10$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime10$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime10$accrualTime, c(0, 6, 32.30303), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime10$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime10$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime10$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime10$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime10$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime10$maxNumberOfSubjects, 1000, label = paste0("c(", paste0(accrualTime10$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime10$remainingTime, 26.30303, tolerance = 1e-07, label = paste0("c(", paste0(accrualTime10$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime10$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime10$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime10), NA))) - expect_output(print(accrualTime10)$show()) - invisible(capture.output(expect_error(summary(accrualTime10), NA))) - expect_output(summary(accrualTime10)$show()) - accrualTime10CodeBased <- eval(parse(text = getObjectRCode(accrualTime10, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime10CodeBased$endOfAccrualIsUserDefined, accrualTime10$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$followUpTimeMustBeUserDefined, accrualTime10$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime10$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime10$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$absoluteAccrualIntensityEnabled, accrualTime10$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$accrualTime, accrualTime10$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$accrualIntensity, accrualTime10$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$accrualIntensityRelative, accrualTime10$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$maxNumberOfSubjects, accrualTime10$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$remainingTime, accrualTime10$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime10CodeBased$piecewiseAccrualEnabled, accrualTime10$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime10), "character") - df <- as.data.frame(accrualTime10) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime10) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime12 <- getAccrualTime(list( - "0 - <6" = 0.22, - "6 - <=30" = 0.33 - ), - maxNumberOfSubjects = 1000 - ) - - ## Comparison of the results of AccrualTime object 'accrualTime12' with expected results - expect_equal(accrualTime12$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime12$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime12$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime12$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime12$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime12$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime12$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime12$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime12$absoluteAccrualIntensityEnabled, FALSE, label = paste0("c(", paste0(accrualTime12$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime12$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime12$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime12$accrualIntensity, c(23.809524, 35.714286), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime12$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime12$accrualIntensityRelative, c(0.22, 0.33), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime12$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime12$maxNumberOfSubjects, 1000, label = paste0("c(", paste0(accrualTime12$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime12$remainingTime, 24, label = paste0("c(", paste0(accrualTime12$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime12$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime12$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime12), NA))) - expect_output(print(accrualTime12)$show()) - invisible(capture.output(expect_error(summary(accrualTime12), NA))) - expect_output(summary(accrualTime12)$show()) - accrualTime12CodeBased <- eval(parse(text = getObjectRCode(accrualTime12, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime12CodeBased$endOfAccrualIsUserDefined, accrualTime12$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$followUpTimeMustBeUserDefined, accrualTime12$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime12$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime12$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$absoluteAccrualIntensityEnabled, accrualTime12$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$accrualTime, accrualTime12$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$accrualIntensity, accrualTime12$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$accrualIntensityRelative, accrualTime12$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$maxNumberOfSubjects, accrualTime12$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$remainingTime, accrualTime12$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime12CodeBased$piecewiseAccrualEnabled, accrualTime12$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime12), "character") - df <- as.data.frame(accrualTime12) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime12) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime13 <- getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(22, 33)) - - ## Comparison of the results of AccrualTime object 'accrualTime13' with expected results - expect_equal(accrualTime13$endOfAccrualIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime13$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime13$followUpTimeMustBeUserDefined, TRUE, label = paste0("c(", paste0(accrualTime13$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime13$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime13$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime13$maxNumberOfSubjectsCanBeCalculatedDirectly, FALSE, label = paste0("c(", paste0(accrualTime13$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime13$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime13$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime13$accrualTime, c(0, 6), label = paste0("c(", paste0(accrualTime13$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime13$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime13$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime13$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime13$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime13$maxNumberOfSubjects, NA_real_, label = paste0("c(", paste0(accrualTime13$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime13$remainingTime, NA_real_, label = paste0("c(", paste0(accrualTime13$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime13$piecewiseAccrualEnabled, FALSE, label = paste0("c(", paste0(accrualTime13$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime13), NA))) - expect_output(print(accrualTime13)$show()) - invisible(capture.output(expect_error(summary(accrualTime13), NA))) - expect_output(summary(accrualTime13)$show()) - accrualTime13CodeBased <- eval(parse(text = getObjectRCode(accrualTime13, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime13CodeBased$endOfAccrualIsUserDefined, accrualTime13$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$followUpTimeMustBeUserDefined, accrualTime13$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime13$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime13$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$absoluteAccrualIntensityEnabled, accrualTime13$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$accrualTime, accrualTime13$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$accrualIntensity, accrualTime13$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$accrualIntensityRelative, accrualTime13$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$maxNumberOfSubjects, accrualTime13$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$remainingTime, accrualTime13$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime13CodeBased$piecewiseAccrualEnabled, accrualTime13$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime13), "character") - df <- as.data.frame(accrualTime13) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime13) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - accrualTime14 <- getAccrualTime(list( - "0 - <6" = 22, - "6 - <=30" = 33 - )) - - ## Comparison of the results of AccrualTime object 'accrualTime14' with expected results - expect_equal(accrualTime14$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime14$endOfAccrualIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime14$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime14$followUpTimeMustBeUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime14$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime14$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) - expect_equal(accrualTime14$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime14$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) - expect_equal(accrualTime14$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime14$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) - expect_equal(accrualTime14$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime14$accrualTime, collapse = ", "), ")")) - expect_equal(accrualTime14$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime14$accrualIntensity, collapse = ", "), ")")) - expect_equal(accrualTime14$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime14$accrualIntensityRelative, collapse = ", "), ")")) - expect_equal(accrualTime14$maxNumberOfSubjects, 924, label = paste0("c(", paste0(accrualTime14$maxNumberOfSubjects, collapse = ", "), ")")) - expect_equal(accrualTime14$remainingTime, 24, label = paste0("c(", paste0(accrualTime14$remainingTime, collapse = ", "), ")")) - expect_equal(accrualTime14$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime14$piecewiseAccrualEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(accrualTime14), NA))) - expect_output(print(accrualTime14)$show()) - invisible(capture.output(expect_error(summary(accrualTime14), NA))) - expect_output(summary(accrualTime14)$show()) - accrualTime14CodeBased <- eval(parse(text = getObjectRCode(accrualTime14, stringWrapParagraphWidth = NULL))) - expect_equal(accrualTime14CodeBased$endOfAccrualIsUserDefined, accrualTime14$endOfAccrualIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime14CodeBased$followUpTimeMustBeUserDefined, accrualTime14$followUpTimeMustBeUserDefined, tolerance = 1e-07) - expect_equal(accrualTime14CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime14$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) - expect_equal(accrualTime14CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime14$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) - expect_equal(accrualTime14CodeBased$absoluteAccrualIntensityEnabled, accrualTime14$absoluteAccrualIntensityEnabled, tolerance = 1e-07) - expect_equal(accrualTime14CodeBased$accrualTime, accrualTime14$accrualTime, tolerance = 1e-07) - expect_equal(accrualTime14CodeBased$accrualIntensity, accrualTime14$accrualIntensity, tolerance = 1e-07) - expect_equal(accrualTime14CodeBased$accrualIntensityRelative, accrualTime14$accrualIntensityRelative, tolerance = 1e-07) - expect_equal(accrualTime14CodeBased$maxNumberOfSubjects, accrualTime14$maxNumberOfSubjects, tolerance = 1e-07) - expect_equal(accrualTime14CodeBased$remainingTime, accrualTime14$remainingTime, tolerance = 1e-07) - expect_equal(accrualTime14CodeBased$piecewiseAccrualEnabled, accrualTime14$piecewiseAccrualEnabled, tolerance = 1e-07) - expect_type(names(accrualTime14), "character") - df <- as.data.frame(accrualTime14) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(accrualTime14) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("Testing 'getAccrualTime': check expected warnings and errors", { - - # @refFS[Tab.]{fs:tab:output:getAccrualTime} - expect_warning(getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(0.22, 0.33)), - paste0("The specified accrual time and intensity cannot be supplemented ", - "automatically with the missing information; therefore further calculations are not possible"), - fixed = TRUE - ) - - expect_warning(getAccrualTime(accrualTime = c(0, 24), accrualIntensity = c(30, 45), maxNumberOfSubjects = 720), - "Last accrual intensity value (45) ignored", - fixed = TRUE - ) - - .skipTestIfDisabled() - - suppressWarnings(expect_warning(getAccrualTime(accrualTime = c(0, 24, 30), - accrualIntensity = c(30, 45, 55), maxNumberOfSubjects = 720), - "Last 2 accrual intensity values (45, 55) ignored", - fixed = TRUE - )) - - suppressWarnings(expect_warning(getAccrualTime(accrualTime = c(0, 24, 30, 40), - accrualIntensity = c(30, 45, 55, 66), maxNumberOfSubjects = 720), - "Last 2 accrual time values (30, 40) ignored", - fixed = TRUE - )) - - suppressWarnings(expect_warning(getAccrualTime(accrualTime = c(0, 24, 30, 40), - accrualIntensity = c(30, 45, 55, 66), maxNumberOfSubjects = 720), - "Last 3 accrual intensity values (45, 55, 66) ignored", - fixed = TRUE - )) - - expect_warning(getAccrualTime(accrualTime = c(0, 6, 15, 25), accrualIntensity = c(0, 22, 33)), - "It makes no sense to start 'accrualIntensity' (0, 22, 33) with 0", - fixed = TRUE - ) - - expect_error(getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(0)), - "Illegal argument: at least one 'accrualIntensity' value must be > 0", - fixed = TRUE - ) - - expect_error(getAccrualTime( - accrualTime = c(0, 6, 30), accrualIntensity = c(22, 33), - maxNumberOfSubjects = 1000 - ), - paste0( - "Conflicting arguments: 'maxNumberOfSubjects' (1000) disagrees with the defined ", - "accrual time (0, 6, 30) and intensity: 6 * 22 + 24 * 33 = 924" - ), - fixed = TRUE - ) - -}) - -test_that("Testing 'getAccrualTime': list-wise definition", { - - accrualTime1 <- list( - "0 - <12" = 15, - "12 - <13" = 21, - "13 - <14" = 27, - "14 - <15" = 33, - "15 - <16" = 39, - ">=16" = 45 - ) - - # @refFS[Tab.]{fs:tab:output:getAccrualTime} - accrualTime4 <- getAccrualTime(accrualTime = accrualTime1, maxNumberOfSubjects = 1405) - expect_equal(accrualTime4$accrualTime, c(0, 12, 13, 14, 15, 16, 40.55555556)) - expect_equal(accrualTime4$accrualIntensity, c(15, 21, 27, 33, 39, 45)) - expect_equal(accrualTime4$remainingTime, 24.55555556) - - .skipTestIfDisabled() - - accrualTime2 <- list( - "0 - <12" = 15, - "12 - <13" = 21, - "13 - <14" = 27, - "14 - <15" = 33, - "15 - <16" = 39, - "16 - ?" = 45 - ) - accrualTime5 <- getAccrualTime(accrualTime = accrualTime2, maxNumberOfSubjects = 1405) - expect_equal(accrualTime5$accrualTime, c(0, 12, 13, 14, 15, 16, 40.55555556)) - expect_equal(accrualTime5$accrualIntensity, c(15, 21, 27, 33, 39, 45)) - expect_equal(accrualTime5$remainingTime, 24.55555556) - - accrualTime3 <- list( - "0 - <11" = 20, - "11 - <16" = 40, - ">=16" = 60 - ) - accrualTime6 <- getAccrualTime(accrualTime = accrualTime3, maxNumberOfSubjects = 800) - expect_equal(accrualTime6$accrualTime, c(0, 11, 16, 22.3333333)) - expect_equal(accrualTime6$accrualIntensity, c(20, 40, 60)) - expect_equal(accrualTime6$remainingTime, 6.33333333) - - accrualTime7 <- list( - "0 - <11" = 20, - "11 - <16" = 40, - "16 - ?" = 60 - ) - accrualTime8 <- getAccrualTime(accrualTime = accrualTime7, maxNumberOfSubjects = 800) - expect_equal(accrualTime8$accrualTime, c(0, 11, 16, 22.3333333)) - expect_equal(accrualTime8$accrualIntensity, c(20, 40, 60)) - expect_equal(accrualTime8$remainingTime, 6.33333333) - -}) - -test_that("Testing 'getPiecewiseSurvivalTime': mixed arguments", { - - # @refFS[Tab.]{fs:tab:output:getPiecewiseSurvivalTime} - pwSurvivalTime1 <- getPiecewiseSurvivalTime(median1 = 37, hazardRatio = 0.8) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime1' with expected results - expect_equal(pwSurvivalTime1$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime1$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$lambda1, 0.018733708, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$lambda2, 0.023417134, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime1$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime1$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$median1, 37, label = paste0("c(", paste0(pwSurvivalTime1$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$median2, 29.6, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime1$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime1$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime1$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime1$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime1$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime1$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime1), NA))) - expect_output(print(pwSurvivalTime1)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime1), NA))) - expect_output(summary(pwSurvivalTime1)$show()) - pwSurvivalTime1CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime1, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime1CodeBased$piecewiseSurvivalTime, pwSurvivalTime1$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$lambda1, pwSurvivalTime1$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$lambda2, pwSurvivalTime1$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$hazardRatio, pwSurvivalTime1$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$pi1, pwSurvivalTime1$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$pi2, pwSurvivalTime1$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$median1, pwSurvivalTime1$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$median2, pwSurvivalTime1$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$eventTime, pwSurvivalTime1$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$kappa, pwSurvivalTime1$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime1$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$delayedResponseAllowed, pwSurvivalTime1$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime1CodeBased$delayedResponseEnabled, pwSurvivalTime1$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime1), "character") - df <- as.data.frame(pwSurvivalTime1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime2 <- getPiecewiseSurvivalTime(lambda1 = 0.01873371, median2 = 29.6) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime2' with expected results - expect_equal(pwSurvivalTime2$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime2$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$lambda1, 0.01873371, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$lambda2, 0.023417134, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$hazardRatio, 0.8000001, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime2$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime2$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$median1, 36.999995, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$median2, 29.6, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime2$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime2$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime2$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime2), NA))) - expect_output(print(pwSurvivalTime2)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime2), NA))) - expect_output(summary(pwSurvivalTime2)$show()) - pwSurvivalTime2CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime2, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalTime, pwSurvivalTime2$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$lambda1, pwSurvivalTime2$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$lambda2, pwSurvivalTime2$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$hazardRatio, pwSurvivalTime2$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$pi1, pwSurvivalTime2$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$pi2, pwSurvivalTime2$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$median1, pwSurvivalTime2$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$median2, pwSurvivalTime2$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$eventTime, pwSurvivalTime2$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$kappa, pwSurvivalTime2$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime2$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$delayedResponseAllowed, pwSurvivalTime2$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime2CodeBased$delayedResponseEnabled, pwSurvivalTime2$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime2), "character") - df <- as.data.frame(pwSurvivalTime2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - pwSurvivalTime3 <- getPiecewiseSurvivalTime(median1 = 37, lambda2 = 0.02341713) - - ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime3' with expected results - expect_equal(pwSurvivalTime3$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime3$piecewiseSurvivalTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$lambda1, 0.018733708, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$lambda1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$lambda2, 0.02341713, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$lambda2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$hazardRatio, 0.80000015, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$hazardRatio, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime3$pi1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime3$pi2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$median1, 37, label = paste0("c(", paste0(pwSurvivalTime3$median1, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$median2, 29.600006, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$median2, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime3$eventTime, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime3$kappa, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime3$piecewiseSurvivalEnabled, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime3$delayedResponseAllowed, collapse = ", "), ")")) - expect_equal(pwSurvivalTime3$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime3$delayedResponseEnabled, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(pwSurvivalTime3), NA))) - expect_output(print(pwSurvivalTime3)$show()) - invisible(capture.output(expect_error(summary(pwSurvivalTime3), NA))) - expect_output(summary(pwSurvivalTime3)$show()) - pwSurvivalTime3CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime3, stringWrapParagraphWidth = NULL))) - expect_equal(pwSurvivalTime3CodeBased$piecewiseSurvivalTime, pwSurvivalTime3$piecewiseSurvivalTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$lambda1, pwSurvivalTime3$lambda1, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$lambda2, pwSurvivalTime3$lambda2, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$hazardRatio, pwSurvivalTime3$hazardRatio, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$pi1, pwSurvivalTime3$pi1, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$pi2, pwSurvivalTime3$pi2, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$median1, pwSurvivalTime3$median1, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$median2, pwSurvivalTime3$median2, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$eventTime, pwSurvivalTime3$eventTime, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$kappa, pwSurvivalTime3$kappa, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime3$piecewiseSurvivalEnabled, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$delayedResponseAllowed, pwSurvivalTime3$delayedResponseAllowed, tolerance = 1e-07) - expect_equal(pwSurvivalTime3CodeBased$delayedResponseEnabled, pwSurvivalTime3$delayedResponseEnabled, tolerance = 1e-07) - expect_type(names(pwSurvivalTime3), "character") - df <- as.data.frame(pwSurvivalTime3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(pwSurvivalTime3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - expect_warning(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), pi1 = 0.3), - "'hazardRatio' (0.6, 0.8) will be ignored because it will be calculated", - fixed = TRUE - ) - -}) - +## | +## | *Unit tests* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | RPACT package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File name: test-class_time.R +## | Creation date: 08 November 2023, 08:49:49 +## | File version: $Revision: 7665 $ +## | Last changed: $Date: 2024-02-23 17:33:46 +0100 (Fr, 23 Feb 2024) $ +## | Last changed by: $Author: pahlke $ +## | + +test_plan_section("Testing Class 'PiecewiseSurvivalTime'") + + +test_that("Testing 'getPiecewiseSurvivalTime': isPiecewiseSurvivalEnabled()", { + # @refFS[Tab.]{fs:tab:output:getPiecewiseSurvivalTime} + expect_false(getPiecewiseSurvivalTime()$isPiecewiseSurvivalEnabled()) + expect_false(getPiecewiseSurvivalTime(piecewiseSurvivalTime = NA)$isPiecewiseSurvivalEnabled()) + +}) + +test_that("Testing 'getPiecewiseSurvivalTime': simple vector based definition", { + + # @refFS[Tab.]{fs:tab:output:getPiecewiseSurvivalTime} + pwSurvivalTime1 <- getPiecewiseSurvivalTime(lambda2 = 0.5, hazardRatio = 0.8) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime1' with expected results + expect_equal(pwSurvivalTime1$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime1$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$lambda1, 0.4, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$lambda2, 0.5, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime1$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime1$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$median1, 1.732868, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$median2, 1.3862944, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime1$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime1$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime1$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime1$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime1$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime1), NA))) + expect_output(print(pwSurvivalTime1)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime1), NA))) + expect_output(summary(pwSurvivalTime1)$show()) + pwSurvivalTime1CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime1, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime1CodeBased$piecewiseSurvivalTime, pwSurvivalTime1$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$lambda1, pwSurvivalTime1$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$lambda2, pwSurvivalTime1$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$hazardRatio, pwSurvivalTime1$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$pi1, pwSurvivalTime1$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$pi2, pwSurvivalTime1$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$median1, pwSurvivalTime1$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$median2, pwSurvivalTime1$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$eventTime, pwSurvivalTime1$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$kappa, pwSurvivalTime1$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime1$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$delayedResponseAllowed, pwSurvivalTime1$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$delayedResponseEnabled, pwSurvivalTime1$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime1), "character") + df <- as.data.frame(pwSurvivalTime1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime2 <- getPiecewiseSurvivalTime(lambda2 = 0.5, lambda1 = 0.4) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime2' with expected results + expect_equal(pwSurvivalTime2$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime2$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$lambda1, 0.4, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$lambda2, 0.5, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime2$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime2$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$median1, 1.732868, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$median2, 1.3862944, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime2$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime2$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime2), NA))) + expect_output(print(pwSurvivalTime2)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime2), NA))) + expect_output(summary(pwSurvivalTime2)$show()) + pwSurvivalTime2CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime2, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalTime, pwSurvivalTime2$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$lambda1, pwSurvivalTime2$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$lambda2, pwSurvivalTime2$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$hazardRatio, pwSurvivalTime2$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$pi1, pwSurvivalTime2$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$pi2, pwSurvivalTime2$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$median1, pwSurvivalTime2$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$median2, pwSurvivalTime2$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$eventTime, pwSurvivalTime2$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$kappa, pwSurvivalTime2$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime2$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$delayedResponseAllowed, pwSurvivalTime2$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$delayedResponseEnabled, pwSurvivalTime2$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime2), "character") + df <- as.data.frame(pwSurvivalTime2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + .skipTestIfDisabled() + + pwSurvivalTime2 <- getPiecewiseSurvivalTime(pi2 = 0.5, hazardRatio = 0.8) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime2' with expected results + expect_equal(pwSurvivalTime2$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime2$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$lambda1, 0.046209812, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$lambda2, 0.057762265, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$pi1, 0.42565082, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$pi2, 0.5, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$median1, 15, label = paste0("c(", paste0(pwSurvivalTime2$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$median2, 12, label = paste0("c(", paste0(pwSurvivalTime2$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$eventTime, 12, label = paste0("c(", paste0(pwSurvivalTime2$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime2$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime2), NA))) + expect_output(print(pwSurvivalTime2)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime2), NA))) + expect_output(summary(pwSurvivalTime2)$show()) + pwSurvivalTime2CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime2, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalTime, pwSurvivalTime2$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$lambda1, pwSurvivalTime2$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$lambda2, pwSurvivalTime2$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$hazardRatio, pwSurvivalTime2$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$pi1, pwSurvivalTime2$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$pi2, pwSurvivalTime2$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$median1, pwSurvivalTime2$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$median2, pwSurvivalTime2$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$eventTime, pwSurvivalTime2$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$kappa, pwSurvivalTime2$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime2$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$delayedResponseAllowed, pwSurvivalTime2$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$delayedResponseEnabled, pwSurvivalTime2$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime2), "character") + df <- as.data.frame(pwSurvivalTime2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime2 <- getPiecewiseSurvivalTime(pi2 = 0.5, pi1 = 0.4) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime2' with expected results + expect_equal(pwSurvivalTime2$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime2$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$lambda1, 0.042568802, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$lambda2, 0.057762265, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$hazardRatio, 0.73696559, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$pi1, 0.4, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$pi2, 0.5, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$median1, 16.282985, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$median2, 12, label = paste0("c(", paste0(pwSurvivalTime2$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$eventTime, 12, label = paste0("c(", paste0(pwSurvivalTime2$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime2$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime2), NA))) + expect_output(print(pwSurvivalTime2)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime2), NA))) + expect_output(summary(pwSurvivalTime2)$show()) + pwSurvivalTime2CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime2, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalTime, pwSurvivalTime2$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$lambda1, pwSurvivalTime2$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$lambda2, pwSurvivalTime2$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$hazardRatio, pwSurvivalTime2$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$pi1, pwSurvivalTime2$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$pi2, pwSurvivalTime2$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$median1, pwSurvivalTime2$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$median2, pwSurvivalTime2$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$eventTime, pwSurvivalTime2$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$kappa, pwSurvivalTime2$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime2$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$delayedResponseAllowed, pwSurvivalTime2$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$delayedResponseEnabled, pwSurvivalTime2$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime2), "character") + df <- as.data.frame(pwSurvivalTime2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime3 <- getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), lambda2 = 0.4) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime3' with expected results + expect_equal(pwSurvivalTime3$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime3$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$lambda1, c(0.24, 0.32), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$lambda2, 0.4, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$hazardRatio, c(0.6, 0.8), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime3$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime3$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$median1, c(2.8881133, 2.1660849), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$median2, 1.732868, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime3$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime3$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime3$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime3$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime3$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime3), NA))) + expect_output(print(pwSurvivalTime3)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime3), NA))) + expect_output(summary(pwSurvivalTime3)$show()) + pwSurvivalTime3CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime3, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime3CodeBased$piecewiseSurvivalTime, pwSurvivalTime3$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$lambda1, pwSurvivalTime3$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$lambda2, pwSurvivalTime3$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$hazardRatio, pwSurvivalTime3$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$pi1, pwSurvivalTime3$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$pi2, pwSurvivalTime3$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$median1, pwSurvivalTime3$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$median2, pwSurvivalTime3$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$eventTime, pwSurvivalTime3$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$kappa, pwSurvivalTime3$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime3$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$delayedResponseAllowed, pwSurvivalTime3$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$delayedResponseEnabled, pwSurvivalTime3$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime3), "character") + df <- as.data.frame(pwSurvivalTime3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime8 <- getPiecewiseSurvivalTime(pi2 = 0.4, pi1 = 0.3) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime8' with expected results + expect_equal(pwSurvivalTime8$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime8$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime8$lambda1, 0.029722912, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime8$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime8$lambda2, 0.042568802, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime8$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime8$hazardRatio, 0.69823229, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime8$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime8$pi1, 0.3, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime8$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime8$pi2, 0.4, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime8$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime8$median1, 23.320299, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime8$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime8$median2, 16.282985, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime8$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime8$eventTime, 12, label = paste0("c(", paste0(pwSurvivalTime8$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime8$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime8$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime8$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime8$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime8$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime8$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime8$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime8$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime8), NA))) + expect_output(print(pwSurvivalTime8)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime8), NA))) + expect_output(summary(pwSurvivalTime8)$show()) + pwSurvivalTime8CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime8, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime8CodeBased$piecewiseSurvivalTime, pwSurvivalTime8$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime8CodeBased$lambda1, pwSurvivalTime8$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime8CodeBased$lambda2, pwSurvivalTime8$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime8CodeBased$hazardRatio, pwSurvivalTime8$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime8CodeBased$pi1, pwSurvivalTime8$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime8CodeBased$pi2, pwSurvivalTime8$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime8CodeBased$median1, pwSurvivalTime8$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime8CodeBased$median2, pwSurvivalTime8$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime8CodeBased$eventTime, pwSurvivalTime8$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime8CodeBased$kappa, pwSurvivalTime8$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime8CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime8$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime8CodeBased$delayedResponseAllowed, pwSurvivalTime8$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime8CodeBased$delayedResponseEnabled, pwSurvivalTime8$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime8), "character") + df <- as.data.frame(pwSurvivalTime8) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime8) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime9 <- getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), pi2 = 0.3) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime9' with expected results + expect_equal(pwSurvivalTime9$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime9$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime9$lambda1, c(0.017833747, 0.02377833), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime9$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime9$lambda2, 0.029722912, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime9$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime9$hazardRatio, c(0.6, 0.8), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime9$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime9$pi1, c(0.19265562, 0.24824135), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime9$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime9$pi2, 0.3, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime9$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime9$median1, c(38.867164, 29.150373), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime9$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime9$median2, 23.320299, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime9$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime9$eventTime, 12, label = paste0("c(", paste0(pwSurvivalTime9$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime9$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime9$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime9$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime9$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime9$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime9$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime9$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime9$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime9), NA))) + expect_output(print(pwSurvivalTime9)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime9), NA))) + expect_output(summary(pwSurvivalTime9)$show()) + pwSurvivalTime9CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime9, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime9CodeBased$piecewiseSurvivalTime, pwSurvivalTime9$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime9CodeBased$lambda1, pwSurvivalTime9$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime9CodeBased$lambda2, pwSurvivalTime9$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime9CodeBased$hazardRatio, pwSurvivalTime9$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime9CodeBased$pi1, pwSurvivalTime9$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime9CodeBased$pi2, pwSurvivalTime9$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime9CodeBased$median1, pwSurvivalTime9$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime9CodeBased$median2, pwSurvivalTime9$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime9CodeBased$eventTime, pwSurvivalTime9$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime9CodeBased$kappa, pwSurvivalTime9$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime9CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime9$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime9CodeBased$delayedResponseAllowed, pwSurvivalTime9$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime9CodeBased$delayedResponseEnabled, pwSurvivalTime9$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime9), "character") + df <- as.data.frame(pwSurvivalTime9) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime9) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime10 <- getPiecewiseSurvivalTime(median2 = 1.386294, hazardRatio = 0.8) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime10' with expected results + expect_equal(pwSurvivalTime10$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime10$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$lambda1, 0.4000001, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$lambda2, 0.50000013, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime10$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime10$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$median1, 1.7328675, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$median2, 1.386294, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime10$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime10$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime10$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime10$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime10$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime10), NA))) + expect_output(print(pwSurvivalTime10)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime10), NA))) + expect_output(summary(pwSurvivalTime10)$show()) + pwSurvivalTime10CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime10, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime10CodeBased$piecewiseSurvivalTime, pwSurvivalTime10$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$lambda1, pwSurvivalTime10$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$lambda2, pwSurvivalTime10$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$hazardRatio, pwSurvivalTime10$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$pi1, pwSurvivalTime10$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$pi2, pwSurvivalTime10$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$median1, pwSurvivalTime10$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$median2, pwSurvivalTime10$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$eventTime, pwSurvivalTime10$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$kappa, pwSurvivalTime10$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime10$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$delayedResponseAllowed, pwSurvivalTime10$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$delayedResponseEnabled, pwSurvivalTime10$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime10), "character") + df <- as.data.frame(pwSurvivalTime10) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime10) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime11 <- getPiecewiseSurvivalTime(median2 = 1.386294, lambda1 = 0.4) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime11' with expected results + expect_equal(pwSurvivalTime11$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime11$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$lambda1, 0.4, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$lambda2, 0.50000013, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$hazardRatio, 0.79999979, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime11$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime11$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$median1, 1.732868, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$median2, 1.386294, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime11$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime11$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime11$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime11$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime11$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime11), NA))) + expect_output(print(pwSurvivalTime11)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime11), NA))) + expect_output(summary(pwSurvivalTime11)$show()) + pwSurvivalTime11CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime11, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime11CodeBased$piecewiseSurvivalTime, pwSurvivalTime11$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$lambda1, pwSurvivalTime11$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$lambda2, pwSurvivalTime11$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$hazardRatio, pwSurvivalTime11$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$pi1, pwSurvivalTime11$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$pi2, pwSurvivalTime11$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$median1, pwSurvivalTime11$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$median2, pwSurvivalTime11$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$eventTime, pwSurvivalTime11$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$kappa, pwSurvivalTime11$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime11$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$delayedResponseAllowed, pwSurvivalTime11$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$delayedResponseEnabled, pwSurvivalTime11$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime11), "character") + df <- as.data.frame(pwSurvivalTime11) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime11) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime12 <- getPiecewiseSurvivalTime(median2 = 5, median1 = 6) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime12' with expected results + expect_equal(pwSurvivalTime12$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$lambda1, 0.11552453, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime12$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$lambda2, 0.13862944, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime12$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$hazardRatio, 0.83333333, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime12$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$median1, 6, label = paste0("c(", paste0(pwSurvivalTime12$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$median2, 5, label = paste0("c(", paste0(pwSurvivalTime12$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime12$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime12$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime12$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime12$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime12), NA))) + expect_output(print(pwSurvivalTime12)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime12), NA))) + expect_output(summary(pwSurvivalTime12)$show()) + pwSurvivalTime12CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime12, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime12CodeBased$piecewiseSurvivalTime, pwSurvivalTime12$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$lambda1, pwSurvivalTime12$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$lambda2, pwSurvivalTime12$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$hazardRatio, pwSurvivalTime12$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$pi1, pwSurvivalTime12$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$pi2, pwSurvivalTime12$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$median1, pwSurvivalTime12$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$median2, pwSurvivalTime12$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$eventTime, pwSurvivalTime12$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$kappa, pwSurvivalTime12$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime12$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$delayedResponseAllowed, pwSurvivalTime12$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$delayedResponseEnabled, pwSurvivalTime12$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime12), "character") + df <- as.data.frame(pwSurvivalTime12) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime12) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime13 <- getPiecewiseSurvivalTime(median2 = 1.386294, lambda1 = c(0.3, 0.4)) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime13' with expected results + expect_equal(pwSurvivalTime13$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime13$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$lambda1, c(0.3, 0.4), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime13$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$lambda2, 0.50000013, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime13$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$hazardRatio, c(0.59999984, 0.79999979), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime13$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime13$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime13$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$median1, c(2.3104906, 1.732868), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime13$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$median2, 1.386294, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime13$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime13$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime13$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime13$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime13$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime13$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime13), NA))) + expect_output(print(pwSurvivalTime13)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime13), NA))) + expect_output(summary(pwSurvivalTime13)$show()) + pwSurvivalTime13CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime13, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime13CodeBased$piecewiseSurvivalTime, pwSurvivalTime13$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$lambda1, pwSurvivalTime13$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$lambda2, pwSurvivalTime13$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$hazardRatio, pwSurvivalTime13$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$pi1, pwSurvivalTime13$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$pi2, pwSurvivalTime13$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$median1, pwSurvivalTime13$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$median2, pwSurvivalTime13$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$eventTime, pwSurvivalTime13$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$kappa, pwSurvivalTime13$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime13$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$delayedResponseAllowed, pwSurvivalTime13$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$delayedResponseEnabled, pwSurvivalTime13$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime13), "character") + df <- as.data.frame(pwSurvivalTime13) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime13) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime14 <- getPiecewiseSurvivalTime(median2 = 5, median1 = c(6:8)) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime14' with expected results + expect_equal(pwSurvivalTime14$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime14$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime14$lambda1, c(0.11552453, 0.099021026, 0.086643398), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime14$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime14$lambda2, 0.13862944, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime14$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime14$hazardRatio, c(0.83333333, 0.71428571, 0.625), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime14$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime14$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime14$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime14$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime14$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime14$median1, c(6, 7, 8), label = paste0("c(", paste0(pwSurvivalTime14$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime14$median2, 5, label = paste0("c(", paste0(pwSurvivalTime14$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime14$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime14$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime14$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime14$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime14$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime14$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime14$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime14$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime14$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime14$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime14), NA))) + expect_output(print(pwSurvivalTime14)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime14), NA))) + expect_output(summary(pwSurvivalTime14)$show()) + pwSurvivalTime14CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime14, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime14CodeBased$piecewiseSurvivalTime, pwSurvivalTime14$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime14CodeBased$lambda1, pwSurvivalTime14$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime14CodeBased$lambda2, pwSurvivalTime14$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime14CodeBased$hazardRatio, pwSurvivalTime14$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime14CodeBased$pi1, pwSurvivalTime14$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime14CodeBased$pi2, pwSurvivalTime14$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime14CodeBased$median1, pwSurvivalTime14$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime14CodeBased$median2, pwSurvivalTime14$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime14CodeBased$eventTime, pwSurvivalTime14$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime14CodeBased$kappa, pwSurvivalTime14$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime14CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime14$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime14CodeBased$delayedResponseAllowed, pwSurvivalTime14$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime14CodeBased$delayedResponseEnabled, pwSurvivalTime14$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime14), "character") + df <- as.data.frame(pwSurvivalTime14) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime14) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime15 <- getPiecewiseSurvivalTime(median2 = 2, hazardRatio = 0.8) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime15' with expected results + expect_equal(pwSurvivalTime15$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime15$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime15$lambda1, 0.27725887, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime15$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime15$lambda2, 0.34657359, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime15$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime15$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime15$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime15$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime15$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime15$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime15$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime15$median1, 2.5, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime15$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime15$median2, 2, label = paste0("c(", paste0(pwSurvivalTime15$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime15$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime15$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime15$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime15$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime15$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime15$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime15$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime15$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime15$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime15$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime15), NA))) + expect_output(print(pwSurvivalTime15)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime15), NA))) + expect_output(summary(pwSurvivalTime15)$show()) + pwSurvivalTime15CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime15, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime15CodeBased$piecewiseSurvivalTime, pwSurvivalTime15$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime15CodeBased$lambda1, pwSurvivalTime15$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime15CodeBased$lambda2, pwSurvivalTime15$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime15CodeBased$hazardRatio, pwSurvivalTime15$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime15CodeBased$pi1, pwSurvivalTime15$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime15CodeBased$pi2, pwSurvivalTime15$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime15CodeBased$median1, pwSurvivalTime15$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime15CodeBased$median2, pwSurvivalTime15$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime15CodeBased$eventTime, pwSurvivalTime15$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime15CodeBased$kappa, pwSurvivalTime15$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime15CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime15$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime15CodeBased$delayedResponseAllowed, pwSurvivalTime15$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime15CodeBased$delayedResponseEnabled, pwSurvivalTime15$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime15), "character") + df <- as.data.frame(pwSurvivalTime15) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime15) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime16 <- getPiecewiseSurvivalTime(median1 = c(2, 2), hazardRatio = c(1.4, 1.4)) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime16' with expected results + expect_equal(pwSurvivalTime16$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime16$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime16$lambda1, c(0.34657359, 0.34657359), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime16$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime16$lambda2, c(0.24755256, 0.24755256), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime16$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime16$hazardRatio, c(1.4, 1.4), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime16$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime16$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime16$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime16$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime16$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime16$median1, c(2, 2), label = paste0("c(", paste0(pwSurvivalTime16$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime16$median2, c(2.8, 2.8), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime16$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime16$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime16$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime16$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime16$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime16$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime16$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime16$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime16$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime16$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime16$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime16), NA))) + expect_output(print(pwSurvivalTime16)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime16), NA))) + expect_output(summary(pwSurvivalTime16)$show()) + pwSurvivalTime16CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime16, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime16CodeBased$piecewiseSurvivalTime, pwSurvivalTime16$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime16CodeBased$lambda1, pwSurvivalTime16$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime16CodeBased$lambda2, pwSurvivalTime16$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime16CodeBased$hazardRatio, pwSurvivalTime16$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime16CodeBased$pi1, pwSurvivalTime16$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime16CodeBased$pi2, pwSurvivalTime16$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime16CodeBased$median1, pwSurvivalTime16$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime16CodeBased$median2, pwSurvivalTime16$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime16CodeBased$eventTime, pwSurvivalTime16$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime16CodeBased$kappa, pwSurvivalTime16$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime16CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime16$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime16CodeBased$delayedResponseAllowed, pwSurvivalTime16$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime16CodeBased$delayedResponseEnabled, pwSurvivalTime16$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime16), "character") + df <- as.data.frame(pwSurvivalTime16) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime16) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime17 <- getPiecewiseSurvivalTime(median1 = c(2, 3), median2 = 4) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime17' with expected results + expect_equal(pwSurvivalTime17$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime17$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime17$lambda1, c(0.34657359, 0.23104906), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime17$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime17$lambda2, 0.1732868, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime17$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime17$hazardRatio, c(2, 1.3333333), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime17$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime17$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime17$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime17$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime17$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime17$median1, c(2, 3), label = paste0("c(", paste0(pwSurvivalTime17$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime17$median2, 4, label = paste0("c(", paste0(pwSurvivalTime17$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime17$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime17$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime17$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime17$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime17$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime17$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime17$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime17$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime17$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime17$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime17), NA))) + expect_output(print(pwSurvivalTime17)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime17), NA))) + expect_output(summary(pwSurvivalTime17)$show()) + pwSurvivalTime17CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime17, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime17CodeBased$piecewiseSurvivalTime, pwSurvivalTime17$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime17CodeBased$lambda1, pwSurvivalTime17$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime17CodeBased$lambda2, pwSurvivalTime17$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime17CodeBased$hazardRatio, pwSurvivalTime17$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime17CodeBased$pi1, pwSurvivalTime17$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime17CodeBased$pi2, pwSurvivalTime17$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime17CodeBased$median1, pwSurvivalTime17$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime17CodeBased$median2, pwSurvivalTime17$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime17CodeBased$eventTime, pwSurvivalTime17$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime17CodeBased$kappa, pwSurvivalTime17$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime17CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime17$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime17CodeBased$delayedResponseAllowed, pwSurvivalTime17$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime17CodeBased$delayedResponseEnabled, pwSurvivalTime17$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime17), "character") + df <- as.data.frame(pwSurvivalTime17) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime17) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime18 <- getPiecewiseSurvivalTime(median1 = c(2, 3), lambda2 = 0.4) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime18' with expected results + expect_equal(pwSurvivalTime18$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime18$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime18$lambda1, c(0.34657359, 0.23104906), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime18$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime18$lambda2, 0.4, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime18$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime18$hazardRatio, c(0.86643398, 0.57762265), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime18$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime18$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime18$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime18$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime18$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime18$median1, c(2, 3), label = paste0("c(", paste0(pwSurvivalTime18$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime18$median2, 1.732868, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime18$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime18$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime18$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime18$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime18$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime18$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime18$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime18$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime18$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime18$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime18$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime18), NA))) + expect_output(print(pwSurvivalTime18)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime18), NA))) + expect_output(summary(pwSurvivalTime18)$show()) + pwSurvivalTime18CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime18, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime18CodeBased$piecewiseSurvivalTime, pwSurvivalTime18$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime18CodeBased$lambda1, pwSurvivalTime18$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime18CodeBased$lambda2, pwSurvivalTime18$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime18CodeBased$hazardRatio, pwSurvivalTime18$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime18CodeBased$pi1, pwSurvivalTime18$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime18CodeBased$pi2, pwSurvivalTime18$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime18CodeBased$median1, pwSurvivalTime18$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime18CodeBased$median2, pwSurvivalTime18$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime18CodeBased$eventTime, pwSurvivalTime18$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime18CodeBased$kappa, pwSurvivalTime18$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime18CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime18$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime18CodeBased$delayedResponseAllowed, pwSurvivalTime18$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime18CodeBased$delayedResponseEnabled, pwSurvivalTime18$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime18), "character") + df <- as.data.frame(pwSurvivalTime18) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime18) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime19 <- getPiecewiseSurvivalTime(pi1 = 0.45) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime19' with expected results + expect_equal(pwSurvivalTime19$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime19$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime19$lambda1, 0.04981975, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime19$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime19$lambda2, 0.018595296, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime19$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime19$hazardRatio, 2.6791588, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime19$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime19$pi1, 0.45, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime19$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime19$pi2, 0.2, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime19$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime19$median1, 13.9131, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime19$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime19$median2, 37.275405, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime19$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime19$eventTime, 12, label = paste0("c(", paste0(pwSurvivalTime19$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime19$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime19$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime19$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime19$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime19$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime19$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime19$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime19$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime19), NA))) + expect_output(print(pwSurvivalTime19)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime19), NA))) + expect_output(summary(pwSurvivalTime19)$show()) + pwSurvivalTime19CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime19, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime19CodeBased$piecewiseSurvivalTime, pwSurvivalTime19$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime19CodeBased$lambda1, pwSurvivalTime19$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime19CodeBased$lambda2, pwSurvivalTime19$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime19CodeBased$hazardRatio, pwSurvivalTime19$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime19CodeBased$pi1, pwSurvivalTime19$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime19CodeBased$pi2, pwSurvivalTime19$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime19CodeBased$median1, pwSurvivalTime19$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime19CodeBased$median2, pwSurvivalTime19$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime19CodeBased$eventTime, pwSurvivalTime19$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime19CodeBased$kappa, pwSurvivalTime19$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime19CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime19$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime19CodeBased$delayedResponseAllowed, pwSurvivalTime19$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime19CodeBased$delayedResponseEnabled, pwSurvivalTime19$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime19), "character") + df <- as.data.frame(pwSurvivalTime19) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime19) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime20 <- getPiecewiseSurvivalTime(median1 = c(2, 4), hazardRatio = c(1.4, 0.7)) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime20' with expected results + expect_equal(pwSurvivalTime20$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime20$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime20$lambda1, c(0.34657359, 0.1732868), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime20$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime20$lambda2, c(0.24755256, 0.24755256), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime20$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime20$hazardRatio, c(1.4, 0.7), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime20$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime20$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime20$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime20$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime20$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime20$median1, c(2, 4), label = paste0("c(", paste0(pwSurvivalTime20$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime20$median2, c(2.8, 2.8), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime20$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime20$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime20$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime20$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime20$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime20$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime20$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime20$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime20$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime20$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime20$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime20), NA))) + expect_output(print(pwSurvivalTime20)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime20), NA))) + expect_output(summary(pwSurvivalTime20)$show()) + pwSurvivalTime20CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime20, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime20CodeBased$piecewiseSurvivalTime, pwSurvivalTime20$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime20CodeBased$lambda1, pwSurvivalTime20$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime20CodeBased$lambda2, pwSurvivalTime20$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime20CodeBased$hazardRatio, pwSurvivalTime20$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime20CodeBased$pi1, pwSurvivalTime20$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime20CodeBased$pi2, pwSurvivalTime20$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime20CodeBased$median1, pwSurvivalTime20$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime20CodeBased$median2, pwSurvivalTime20$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime20CodeBased$eventTime, pwSurvivalTime20$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime20CodeBased$kappa, pwSurvivalTime20$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime20CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime20$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime20CodeBased$delayedResponseAllowed, pwSurvivalTime20$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime20CodeBased$delayedResponseEnabled, pwSurvivalTime20$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime20), "character") + df <- as.data.frame(pwSurvivalTime20) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime20) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime21 <- getPiecewiseSurvivalTime(median1 = 3, hazardRatio = 0.8) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime21' with expected results + expect_equal(pwSurvivalTime21$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime21$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime21$lambda1, 0.23104906, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime21$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime21$lambda2, 0.28881133, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime21$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime21$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime21$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime21$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime21$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime21$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime21$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime21$median1, 3, label = paste0("c(", paste0(pwSurvivalTime21$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime21$median2, 2.4, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime21$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime21$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime21$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime21$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime21$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime21$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime21$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime21$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime21$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime21$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime21$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime21), NA))) + expect_output(print(pwSurvivalTime21)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime21), NA))) + expect_output(summary(pwSurvivalTime21)$show()) + pwSurvivalTime21CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime21, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime21CodeBased$piecewiseSurvivalTime, pwSurvivalTime21$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime21CodeBased$lambda1, pwSurvivalTime21$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime21CodeBased$lambda2, pwSurvivalTime21$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime21CodeBased$hazardRatio, pwSurvivalTime21$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime21CodeBased$pi1, pwSurvivalTime21$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime21CodeBased$pi2, pwSurvivalTime21$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime21CodeBased$median1, pwSurvivalTime21$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime21CodeBased$median2, pwSurvivalTime21$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime21CodeBased$eventTime, pwSurvivalTime21$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime21CodeBased$kappa, pwSurvivalTime21$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime21CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime21$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime21CodeBased$delayedResponseAllowed, pwSurvivalTime21$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime21CodeBased$delayedResponseEnabled, pwSurvivalTime21$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime21), "character") + df <- as.data.frame(pwSurvivalTime21) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime21) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + expect_error(getPiecewiseSurvivalTime(median2 = 1.386294, lambda2 = 0.4, hazardRatio = 0.8)) + expect_error(getPiecewiseSurvivalTime(median2 = c(1.5, 1.7), lambda1 = c(0.3, 0.4))) + expect_error(getPiecewiseSurvivalTime(median1 = c(2, 4), hazardRatio = c(1, 0.7))) + expect_error(getPiecewiseSurvivalTime(median1 = c(2, 4), hazardRatio = 0.7)) + +}) + +test_that("Testing 'getPiecewiseSurvivalTime': vector based definition", { + + # @refFS[Tab.]{fs:tab:output:getPiecewiseSurvivalTime} + pwSurvivalTime1 <- getPiecewiseSurvivalTime( + piecewiseSurvivalTime = c(0, 6, 9), + lambda2 = c(0.025, 0.04, 0.015), hazardRatio = 0.8 + ) + expect_equal(pwSurvivalTime1$hazardRatio, 0.8) + expect_equal(pwSurvivalTime1$lambda1, c(0.025, 0.04, 0.015) * 0.8) + expect_false(pwSurvivalTime1$isDelayedResponseEnabled()) + + .skipTestIfDisabled() + + pwSurvivalTime2 <- getPiecewiseSurvivalTime( + piecewiseSurvivalTime = c(0, 5, 10), + lambda2 = c(0.1, 0.2, 0.8), hazardRatio = 0.8 + ) + expect_true(pwSurvivalTime2$isPiecewiseSurvivalEnabled()) + expect_false(pwSurvivalTime2$isDelayedResponseEnabled()) + expect_equal(pwSurvivalTime2$hazardRatio, 0.8) + expect_equal(pwSurvivalTime2$piecewiseSurvivalTime, c(0, 5, 10)) + expect_equal(pwSurvivalTime2$lambda2, c(0.1, 0.2, 0.8)) + + pwSurvivalTime3 <- getPiecewiseSurvivalTime(c(0, 6), lambda2 = c(0.01, 0.03), hazardRatio = 0.8) + expect_true(pwSurvivalTime3$isPiecewiseSurvivalEnabled()) + expect_false(pwSurvivalTime3$isDelayedResponseEnabled()) + expect_equal(pwSurvivalTime3$hazardRatio, 0.8) + expect_equal(pwSurvivalTime3$piecewiseSurvivalTime, c(0, 6)) + expect_equal(pwSurvivalTime3$lambda2, c(0.01, 0.03)) + + pwSurvivalTime4 <- getPiecewiseSurvivalTime(0, lambda2 = 0.01, hazardRatio = 0.8) + expect_true(pwSurvivalTime4$isPiecewiseSurvivalEnabled()) + expect_false(pwSurvivalTime4$isDelayedResponseEnabled()) + expect_equal(pwSurvivalTime4$hazardRatio, 0.8) + expect_equal(pwSurvivalTime4$piecewiseSurvivalTime, 0) + expect_equal(pwSurvivalTime4$lambda2, 0.01) + expect_equal(pwSurvivalTime4$lambda1, 0.01 * 0.8) + + pwSurvivalTime5 <- getPiecewiseSurvivalTime(NA_real_, lambda2 = 0.01, hazardRatio = 0.8) + expect_true(pwSurvivalTime5$isPiecewiseSurvivalEnabled()) + expect_false(pwSurvivalTime5$isDelayedResponseEnabled()) + expect_equal(pwSurvivalTime5$hazardRatio, 0.8) + expect_equal(pwSurvivalTime5$piecewiseSurvivalTime, 0) + expect_equal(pwSurvivalTime5$lambda2, 0.01) + expect_equal(pwSurvivalTime5$lambda1, 0.01 * 0.8) + + pwSurvivalTime6 <- getPiecewiseSurvivalTime(0, lambda2 = 0.01, lambda1 = 0.008) + expect_true(pwSurvivalTime6$isPiecewiseSurvivalEnabled()) + expect_false(pwSurvivalTime6$isDelayedResponseEnabled()) + expect_equal(pwSurvivalTime6$hazardRatio, 0.8) + expect_equal(pwSurvivalTime6$piecewiseSurvivalTime, 0) + expect_equal(pwSurvivalTime6$lambda2, 0.01) + expect_equal(pwSurvivalTime6$lambda1, 0.008) + + pwSurvivalTime7 <- getPiecewiseSurvivalTime(NA_real_, lambda2 = 0.01, lambda1 = 0.008) + expect_true(pwSurvivalTime7$isPiecewiseSurvivalEnabled()) + expect_false(pwSurvivalTime7$isDelayedResponseEnabled()) + expect_equal(pwSurvivalTime7$hazardRatio, 0.8) + expect_equal(pwSurvivalTime7$piecewiseSurvivalTime, 0) + expect_equal(pwSurvivalTime7$lambda2, 0.01) + expect_equal(pwSurvivalTime7$lambda1, 0.008) + + # case 2.2 + pwSurvivalTime9 <- getPiecewiseSurvivalTime( + piecewiseSurvivalTime = c(0, 6, 9), + lambda2 = c(0.025, 0.04, 0.015), + lambda1 = c(0.025, 0.04, 0.015) * 0.8 + ) + expect_true(pwSurvivalTime9$isPiecewiseSurvivalEnabled()) + expect_false(pwSurvivalTime9$isDelayedResponseEnabled()) + expect_equal(pwSurvivalTime9$hazardRatio, 0.8) + + pwSurvivalTime10 <- getPiecewiseSurvivalTime(lambda2 = 0.025, hazardRatio = 0.8) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime10' with expected results + expect_equal(pwSurvivalTime10$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime10$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$lambda1, 0.02, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$lambda2, 0.025, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime10$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime10$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$median1, 34.657359, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$median2, 27.725887, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime10$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime10$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime10$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime10$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime10$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime10$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime10$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime10), NA))) + expect_output(print(pwSurvivalTime10)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime10), NA))) + expect_output(summary(pwSurvivalTime10)$show()) + pwSurvivalTime10CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime10, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime10CodeBased$piecewiseSurvivalTime, pwSurvivalTime10$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$lambda1, pwSurvivalTime10$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$lambda2, pwSurvivalTime10$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$hazardRatio, pwSurvivalTime10$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$pi1, pwSurvivalTime10$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$pi2, pwSurvivalTime10$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$median1, pwSurvivalTime10$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$median2, pwSurvivalTime10$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$eventTime, pwSurvivalTime10$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$kappa, pwSurvivalTime10$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime10$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$delayedResponseAllowed, pwSurvivalTime10$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime10CodeBased$delayedResponseEnabled, pwSurvivalTime10$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime10), "character") + df <- as.data.frame(pwSurvivalTime10) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime10) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime11 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = 0, lambda2 = 0.025, hazardRatio = 0.8) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime11' with expected results + expect_equal(pwSurvivalTime11$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime11$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$lambda1, 0.02, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$lambda2, 0.025, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime11$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime11$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$median1, 34.657359, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$median2, 27.725887, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime11$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime11$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime11$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime11$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime11$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime11$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime11$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime11), NA))) + expect_output(print(pwSurvivalTime11)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime11), NA))) + expect_output(summary(pwSurvivalTime11)$show()) + pwSurvivalTime11CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime11, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime11CodeBased$piecewiseSurvivalTime, pwSurvivalTime11$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$lambda1, pwSurvivalTime11$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$lambda2, pwSurvivalTime11$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$hazardRatio, pwSurvivalTime11$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$pi1, pwSurvivalTime11$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$pi2, pwSurvivalTime11$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$median1, pwSurvivalTime11$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$median2, pwSurvivalTime11$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$eventTime, pwSurvivalTime11$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$kappa, pwSurvivalTime11$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime11$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$delayedResponseAllowed, pwSurvivalTime11$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime11CodeBased$delayedResponseEnabled, pwSurvivalTime11$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime11), "character") + df <- as.data.frame(pwSurvivalTime11) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime11) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime12 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 6), lambda2 = c(0.025, 0.01), hazardRatio = c(0.8, 0.9)) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime12' with expected results + expect_equal(pwSurvivalTime12$piecewiseSurvivalTime, c(0, 6), label = paste0("c(", paste0(pwSurvivalTime12$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$lambda1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$lambda2, c(0.025, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime12$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$hazardRatio, c(0.8, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime12$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$median1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$median2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime12$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime12$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$piecewiseSurvivalEnabled, TRUE, label = paste0("c(", paste0(pwSurvivalTime12$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime12$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime12$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime12$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime12), NA))) + expect_output(print(pwSurvivalTime12)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime12), NA))) + expect_output(summary(pwSurvivalTime12)$show()) + pwSurvivalTime12CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime12, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime12CodeBased$piecewiseSurvivalTime, pwSurvivalTime12$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$lambda1, pwSurvivalTime12$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$lambda2, pwSurvivalTime12$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$hazardRatio, pwSurvivalTime12$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$pi1, pwSurvivalTime12$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$pi2, pwSurvivalTime12$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$median1, pwSurvivalTime12$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$median2, pwSurvivalTime12$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$eventTime, pwSurvivalTime12$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$kappa, pwSurvivalTime12$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime12$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$delayedResponseAllowed, pwSurvivalTime12$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime12CodeBased$delayedResponseEnabled, pwSurvivalTime12$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime12), "character") + df <- as.data.frame(pwSurvivalTime12) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime12) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime13 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 6), lambda2 = c(0.025, 0.01), hazardRatio = c(0.8, 0.9), delayedResponseAllowed = TRUE) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime13' with expected results + expect_equal(pwSurvivalTime13$piecewiseSurvivalTime, c(0, 6), label = paste0("c(", paste0(pwSurvivalTime13$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$lambda1, c(0.02, 0.009), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime13$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$lambda2, c(0.025, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime13$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$hazardRatio, c(0.8, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime13$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime13$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime13$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$median1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime13$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$median2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime13$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime13$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime13$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$piecewiseSurvivalEnabled, TRUE, label = paste0("c(", paste0(pwSurvivalTime13$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$delayedResponseAllowed, TRUE, label = paste0("c(", paste0(pwSurvivalTime13$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime13$delayedResponseEnabled, TRUE, label = paste0("c(", paste0(pwSurvivalTime13$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime13), NA))) + expect_output(print(pwSurvivalTime13)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime13), NA))) + expect_output(summary(pwSurvivalTime13)$show()) + pwSurvivalTime13CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime13, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime13CodeBased$piecewiseSurvivalTime, pwSurvivalTime13$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$lambda1, pwSurvivalTime13$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$lambda2, pwSurvivalTime13$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$hazardRatio, pwSurvivalTime13$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$pi1, pwSurvivalTime13$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$pi2, pwSurvivalTime13$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$median1, pwSurvivalTime13$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$median2, pwSurvivalTime13$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$eventTime, pwSurvivalTime13$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$kappa, pwSurvivalTime13$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime13$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$delayedResponseAllowed, pwSurvivalTime13$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime13CodeBased$delayedResponseEnabled, pwSurvivalTime13$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime13), "character") + df <- as.data.frame(pwSurvivalTime13) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime13) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # case 2.2: error expected + expect_error(getPiecewiseSurvivalTime( + piecewiseSurvivalTime = c(0, 6, 9), + lambda2 = c(0.025, 0.04, 0.015), + lambda1 = c(0.03, 0.04, 0.025) + ), + paste0( + "Illegal argument: 'hazardRatio' can only be calculated if ", + "'unique(lambda1 / lambda2)' result in a single value; ", + "current result = c(1.2, 1, 1.667) (e.g., delayed response is not allowed)" + ), + fixed = TRUE + ) + + # case 3 + expect_false(getPiecewiseSurvivalTime(delayedResponseAllowed = TRUE)$isPiecewiseSurvivalEnabled()) + expect_false(getPiecewiseSurvivalTime( + piecewiseSurvivalTime = NA, + delayedResponseAllowed = TRUE + )$isPiecewiseSurvivalEnabled()) + + # case 3.1 + pwSurvivalTimeSim1 <- getPiecewiseSurvivalTime( + piecewiseSurvivalTime = c(0, 6, 9), + lambda2 = c(0.025, 0.04, 0.015), hazardRatio = 0.8, + delayedResponseAllowed = TRUE + ) + expect_equal(pwSurvivalTimeSim1$hazardRatio, 0.8) + expect_equal(pwSurvivalTimeSim1$lambda1, c(0.025, 0.04, 0.015) * 0.8) + expect_false(pwSurvivalTimeSim1$isDelayedResponseEnabled()) + + # case 3.2 + pwSurvivalTimeSim2 <- getPiecewiseSurvivalTime( + piecewiseSurvivalTime = c(0, 6, 9), + lambda2 = c(0.025, 0.04, 0.015), + lambda1 = c(0.03, 0.04, 0.025), delayedResponseAllowed = TRUE + ) + expect_true(pwSurvivalTimeSim2$isPiecewiseSurvivalEnabled()) + expect_true(pwSurvivalTimeSim2$isDelayedResponseEnabled()) + expect_equal(pwSurvivalTimeSim2$hazardRatio, c(1.2, 1, 5 / 3)) + + pwsTime1 <- getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), lambda2 = 0.4) + expect_equal(pwsTime1$.isLambdaBased(minNumberOfLambdas = 1), TRUE) + +}) + +test_that("Testing 'getPiecewiseSurvivalTime': check error and warnings", { + + # @refFS[Tab.]{fs:tab:output:getPiecewiseSurvivalTime} + expect_error(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), lambda2 = 0.4, pi2 = 0.4), + "Conflicting arguments: it is not allowed to specify 'pi2' (0.4) and 'lambda2' (0.4) concurrently", + fixed = TRUE + ) + + expect_error(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), lambda2 = 0.4, pi2 = 0.4, pi1 = 0.3), + "Conflicting arguments: it is not allowed to specify 'pi1' (0.3) and 'lambda2' (0.4) concurrently", + fixed = TRUE + ) + + expect_error(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), lambda2 = 0.4, pi2 = 0.4, pi1 = 0.3), + "Conflicting arguments: it is not allowed to specify 'pi1' (0.3) and 'lambda2' (0.4) concurrently", + fixed = TRUE + ) + + expect_error(getPiecewiseSurvivalTime(lambda2 = 0.4, lambda1 = 0.3, pi2 = 0.4, pi1 = 0.3), + "Conflicting arguments: it is not allowed to specify 'pi1' (0.3) and 'lambda1' (0.3) concurrently", + fixed = TRUE + ) + + expect_error(getPiecewiseSurvivalTime(lambda2 = 0.4, lambda1 = 0.3, pi2 = 0.4, pi1 = 0.3), + "Conflicting arguments: it is not allowed to specify 'pi1' (0.3) and 'lambda1' (0.3) concurrently", + fixed = TRUE + ) + + expect_equal(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), pi2 = 0.4)$.isPiBased(), TRUE) + + expect_warning(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), pi2 = 0.4, pi1 = 0.3), + "'hazardRatio' (0.6, 0.8) will be ignored because it will be calculated", + fixed = TRUE + ) + + expect_warning(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), pi1 = 0.3), + "'hazardRatio' (0.6, 0.8) will be ignored because it will be calculated", + fixed = TRUE + ) + + expect_error(getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 6), lambda2 = 0.025, hazardRatio = 0.8, delayedResponseAllowed = TRUE), + "Illegal argument: length of 'piecewiseSurvivalTime' (2) and length of 'lambda2' (1) must be equal", + fixed = TRUE + ) + + expect_error(getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 6, 12), lambda2 = 0.025, hazardRatio = 0.8, delayedResponseAllowed = TRUE), + "Illegal argument: length of 'piecewiseSurvivalTime' (3) and length of 'lambda2' (1) must be equal", + fixed = TRUE + ) + + expect_error(getPiecewiseSurvivalTime(piecewiseSurvivalTime = c(0, 6), lambda2 = 0.025, hazardRatio = 0.8), + "Illegal argument: length of 'piecewiseSurvivalTime' (2) and length of 'lambda2' (1) must be equal", + fixed = TRUE + ) + +}) + +test_that("Testing 'getPiecewiseSurvivalTime': list-wise definition", { + + # @refFS[Tab.]{fs:tab:output:getPiecewiseSurvivalTime} + pwSurvivalTime8 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = list( + "<6" = 0.025, + "6 - <9" = 0.04, + "9 - <15" = 0.015, + "15 - <21" = 0.01, + ">=21" = 0.007 + ), hazardRatio = 0.6) + expect_true(pwSurvivalTime8$isPiecewiseSurvivalEnabled()) + expect_false(pwSurvivalTime8$isDelayedResponseEnabled()) + expect_equal(pwSurvivalTime8$hazardRatio, 0.6) + expect_equal(pwSurvivalTime8$piecewiseSurvivalTime, c(0, 6, 9, 15, 21)) + expect_equal(pwSurvivalTime8$lambda2, c(0.025, 0.040, 0.015, 0.010, 0.007)) + expect_equal(pwSurvivalTime8$lambda1, c(0.0150, 0.0240, 0.0090, 0.0060, 0.0042)) + + .skipTestIfDisabled() + + result1 <- getPiecewiseSurvivalTime(list( + "<5" = 0.1, + "5 - <10" = 0.2, + ">=10" = 0.8 + ), hazardRatio = 0.8) + expect_equal(result1$piecewiseSurvivalTime, c(0, 5, 10)) + expect_equal(result1$lambda2, c(0.1, 0.2, 0.8)) + + result2 <- getPiecewiseSurvivalTime(list( + "0 - <5" = 0.1, + "5 - <10" = 0.2, + "10 - Inf" = 0.8 + ), hazardRatio = 0.8) + expect_equal(result2$piecewiseSurvivalTime, c(0, 5, 10)) + expect_equal(result2$lambda2, c(0.1, 0.2, 0.8)) + + pwSurvivalTime2 <- getPiecewiseSurvivalTime( + piecewiseSurvivalTime = c(0, 5, 10), + lambda2 = c(0.1, 0.2, 0.8), hazardRatio = 0.8 + ) + expect_equal(pwSurvivalTime2$piecewiseSurvivalTime, c(0, 5, 10)) + expect_equal(pwSurvivalTime2$lambda2, c(0.1, 0.2, 0.8)) + + pwSurvivalTime3 <- getPiecewiseSurvivalTime(c(0, 6), lambda2 = c(0.01, 0.03), hazardRatio = 0.8) + expect_equal(pwSurvivalTime3$piecewiseSurvivalTime, c(0, 6)) + expect_equal(pwSurvivalTime3$lambda2, c(0.01, 0.03)) + + pwSurvivalTime4 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = list("0 - ?" = 0.025), + hazardRatio = 0.8, delayedResponseAllowed = TRUE) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime4' with expected results + expect_equal(pwSurvivalTime4$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime4$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime4$lambda1, 0.02, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime4$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime4$lambda2, 0.025, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime4$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime4$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime4$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime4$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime4$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime4$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime4$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime4$median1, 34.657359, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime4$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime4$median2, 27.725887, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime4$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime4$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime4$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime4$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime4$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime4$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime4$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime4$delayedResponseAllowed, TRUE, label = paste0("c(", paste0(pwSurvivalTime4$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime4$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime4$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime4), NA))) + expect_output(print(pwSurvivalTime4)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime4), NA))) + expect_output(summary(pwSurvivalTime4)$show()) + pwSurvivalTime4CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime4, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime4CodeBased$piecewiseSurvivalTime, pwSurvivalTime4$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime4CodeBased$lambda1, pwSurvivalTime4$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime4CodeBased$lambda2, pwSurvivalTime4$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime4CodeBased$hazardRatio, pwSurvivalTime4$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime4CodeBased$pi1, pwSurvivalTime4$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime4CodeBased$pi2, pwSurvivalTime4$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime4CodeBased$median1, pwSurvivalTime4$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime4CodeBased$median2, pwSurvivalTime4$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime4CodeBased$eventTime, pwSurvivalTime4$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime4CodeBased$kappa, pwSurvivalTime4$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime4CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime4$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime4CodeBased$delayedResponseAllowed, pwSurvivalTime4$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime4CodeBased$delayedResponseEnabled, pwSurvivalTime4$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime4), "character") + df <- as.data.frame(pwSurvivalTime4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime5 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = list("x" = 0.025), + hazardRatio = 0.8, delayedResponseAllowed = TRUE) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime5' with expected results + expect_equal(pwSurvivalTime5$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime5$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime5$lambda1, 0.02, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime5$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime5$lambda2, 0.025, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime5$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime5$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime5$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime5$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime5$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime5$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime5$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime5$median1, 34.657359, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime5$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime5$median2, 27.725887, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime5$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime5$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime5$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime5$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime5$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime5$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime5$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime5$delayedResponseAllowed, TRUE, label = paste0("c(", paste0(pwSurvivalTime5$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime5$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime5$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime5), NA))) + expect_output(print(pwSurvivalTime5)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime5), NA))) + expect_output(summary(pwSurvivalTime5)$show()) + pwSurvivalTime5CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime5, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime5CodeBased$piecewiseSurvivalTime, pwSurvivalTime5$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime5CodeBased$lambda1, pwSurvivalTime5$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime5CodeBased$lambda2, pwSurvivalTime5$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime5CodeBased$hazardRatio, pwSurvivalTime5$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime5CodeBased$pi1, pwSurvivalTime5$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime5CodeBased$pi2, pwSurvivalTime5$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime5CodeBased$median1, pwSurvivalTime5$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime5CodeBased$median2, pwSurvivalTime5$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime5CodeBased$eventTime, pwSurvivalTime5$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime5CodeBased$kappa, pwSurvivalTime5$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime5CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime5$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime5CodeBased$delayedResponseAllowed, pwSurvivalTime5$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime5CodeBased$delayedResponseEnabled, pwSurvivalTime5$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime5), "character") + df <- as.data.frame(pwSurvivalTime5) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime5) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime6 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = list("0 - 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime6) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime7 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = list("x" = 0.025), + hazardRatio = 0.8, delayedResponseAllowed = FALSE) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime7' with expected results + expect_equal(pwSurvivalTime7$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime7$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime7$lambda1, 0.02, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime7$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime7$lambda2, 0.025, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime7$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime7$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime7$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime7$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime7$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime7$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime7$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime7$median1, 34.657359, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime7$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime7$median2, 27.725887, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime7$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime7$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime7$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime7$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime7$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime7$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime7$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime7$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime7$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime7$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime7$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime7), NA))) + expect_output(print(pwSurvivalTime7)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime7), NA))) + expect_output(summary(pwSurvivalTime7)$show()) + pwSurvivalTime7CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime7, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime7CodeBased$piecewiseSurvivalTime, pwSurvivalTime7$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime7CodeBased$lambda1, pwSurvivalTime7$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime7CodeBased$lambda2, pwSurvivalTime7$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime7CodeBased$hazardRatio, pwSurvivalTime7$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime7CodeBased$pi1, pwSurvivalTime7$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime7CodeBased$pi2, pwSurvivalTime7$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime7CodeBased$median1, pwSurvivalTime7$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime7CodeBased$median2, pwSurvivalTime7$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime7CodeBased$eventTime, pwSurvivalTime7$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime7CodeBased$kappa, pwSurvivalTime7$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime7CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime7$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime7CodeBased$delayedResponseAllowed, pwSurvivalTime7$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime7CodeBased$delayedResponseEnabled, pwSurvivalTime7$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime7), "character") + df <- as.data.frame(pwSurvivalTime7) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime7) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime8 <- getPiecewiseSurvivalTime(piecewiseSurvivalTime = list("0 - 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime8) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + expect_warning(getPiecewiseSurvivalTime(piecewiseSurvivalTime = list("<6" = 0.025), hazardRatio = 0.8), + "Defined time period \"0 - <6\" will be ignored because 'piecewiseSurvivalTime' list has only 1 entry", + fixed = TRUE + ) + +}) + +test_plan_section("Testing Class 'AccrualTime'") + + +test_that("Testing 'getAccrualTime': isAccrualTimeEnabled()", { + expect_true(getAccrualTime()$isAccrualTimeEnabled()) + expect_true(getAccrualTime(maxNumberOfSubjects = 100)$isAccrualTimeEnabled()) + +}) + +test_that("Testing 'getAccrualTime': vector based definition", { + + accrualTime1 <- getAccrualTime( + accrualTime = c(0, 6, 9, 15), + accrualIntensity = c(15, 21, 27), maxNumberOfSubjects = 315 + ) + expect_equal(accrualTime1$accrualTime, c(0, 6, 9, 15)) + expect_equal(accrualTime1$accrualIntensity, c(15, 21, 27)) + expect_equal(accrualTime1$remainingTime, NA_real_) + + accrualTime2 <- getAccrualTime( + accrualTime = c(0, 6, 9), + accrualIntensity = c(15, 21, 27), maxNumberOfSubjects = 1000 + ) + expect_equal(accrualTime2$accrualTime, c(0, 6, 9, 40.37037)) + expect_equal(accrualTime2$accrualIntensity, c(15, 21, 27)) + expect_equal(accrualTime2$remainingTime, 31.37037) + + .skipTestIfDisabled() + + accrualTime3 <- getAccrualTime( + accrualTime = c(0, 12, 13, 14, 15, 16), + accrualIntensity = c(15, 21, 27, 33, 39, 45), maxNumberOfSubjects = 1405 + ) + expect_equal(accrualTime3$accrualTime, c(0, 12, 13, 14, 15, 16, 40.55555556)) + expect_equal(accrualTime3$accrualIntensity, c(15, 21, 27, 33, 39, 45)) + expect_equal(accrualTime3$remainingTime, 24.55555556) + + accrualTime4 <- getAccrualTime( + accrualTime = c(0, 24), + accrualIntensity = c(30), maxNumberOfSubjects = 720 + ) + + ## Comparison of the results of AccrualTime object 'accrualTime4' with expected results + expect_equal(accrualTime4$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime4$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime4$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime4$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime4$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime4$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime4$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime4$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime4$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime4$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime4$accrualTime, c(0, 24), label = paste0("c(", paste0(accrualTime4$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime4$accrualIntensity, 30, label = paste0("c(", paste0(accrualTime4$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime4$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime4$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime4$maxNumberOfSubjects, 720, label = paste0("c(", paste0(accrualTime4$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime4$remainingTime, NA_real_, label = paste0("c(", paste0(accrualTime4$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime4$piecewiseAccrualEnabled, FALSE, label = paste0("c(", paste0(accrualTime4$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime4), NA))) + expect_output(print(accrualTime4)$show()) + invisible(capture.output(expect_error(summary(accrualTime4), NA))) + expect_output(summary(accrualTime4)$show()) + accrualTime4CodeBased <- eval(parse(text = getObjectRCode(accrualTime4, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime4CodeBased$endOfAccrualIsUserDefined, accrualTime4$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$followUpTimeMustBeUserDefined, accrualTime4$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime4$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime4$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$absoluteAccrualIntensityEnabled, accrualTime4$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$accrualTime, accrualTime4$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$accrualIntensity, accrualTime4$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$accrualIntensityRelative, accrualTime4$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$maxNumberOfSubjects, accrualTime4$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$remainingTime, accrualTime4$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$piecewiseAccrualEnabled, accrualTime4$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime4), "character") + df <- as.data.frame(accrualTime4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime5 <- getAccrualTime( + accrualTime = c(0, 24, 30), + accrualIntensity = c(30, 45) + ) + + ## Comparison of the results of AccrualTime object 'accrualTime5' with expected results + expect_equal(accrualTime5$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime5$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime5$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime5$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime5$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime5$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime5$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime5$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime5$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime5$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime5$accrualTime, c(0, 24, 30), label = paste0("c(", paste0(accrualTime5$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime5$accrualIntensity, c(30, 45), label = paste0("c(", paste0(accrualTime5$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime5$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime5$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime5$maxNumberOfSubjects, 990, label = paste0("c(", paste0(accrualTime5$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime5$remainingTime, 6, label = paste0("c(", paste0(accrualTime5$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime5$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime5$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime5), NA))) + expect_output(print(accrualTime5)$show()) + invisible(capture.output(expect_error(summary(accrualTime5), NA))) + expect_output(summary(accrualTime5)$show()) + accrualTime5CodeBased <- eval(parse(text = getObjectRCode(accrualTime5, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime5CodeBased$endOfAccrualIsUserDefined, accrualTime5$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$followUpTimeMustBeUserDefined, accrualTime5$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime5$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime5$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$absoluteAccrualIntensityEnabled, accrualTime5$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$accrualTime, accrualTime5$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$accrualIntensity, accrualTime5$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$accrualIntensityRelative, accrualTime5$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$maxNumberOfSubjects, accrualTime5$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$remainingTime, accrualTime5$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$piecewiseAccrualEnabled, accrualTime5$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime5), "character") + df <- as.data.frame(accrualTime5) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime5) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime6 <- getAccrualTime( + accrualTime = c(0, 24, 30), + accrualIntensity = c(20, 25, 45), maxNumberOfSubjects = 720 + ) + + ## Comparison of the results of AccrualTime object 'accrualTime6' with expected results + expect_equal(accrualTime6$endOfAccrualIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime6$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime6$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime6$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime6$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime6$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime6$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime6$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime6$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime6$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime6$accrualTime, c(0, 24, 30, 32), label = paste0("c(", paste0(accrualTime6$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime6$accrualIntensity, c(20, 25, 45), label = paste0("c(", paste0(accrualTime6$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime6$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime6$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime6$maxNumberOfSubjects, 720, label = paste0("c(", paste0(accrualTime6$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime6$remainingTime, 2, label = paste0("c(", paste0(accrualTime6$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime6$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime6$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime6), NA))) + expect_output(print(accrualTime6)$show()) + invisible(capture.output(expect_error(summary(accrualTime6), NA))) + expect_output(summary(accrualTime6)$show()) + accrualTime6CodeBased <- eval(parse(text = getObjectRCode(accrualTime6, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime6CodeBased$endOfAccrualIsUserDefined, accrualTime6$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$followUpTimeMustBeUserDefined, accrualTime6$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime6$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime6$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$absoluteAccrualIntensityEnabled, accrualTime6$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$accrualTime, accrualTime6$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$accrualIntensity, accrualTime6$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$accrualIntensityRelative, accrualTime6$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$maxNumberOfSubjects, accrualTime6$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$remainingTime, accrualTime6$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$piecewiseAccrualEnabled, accrualTime6$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime6), "character") + df <- as.data.frame(accrualTime6) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime6) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime8 <- getAccrualTime(accrualTime = 0, accrualIntensity = 15, maxNumberOfSubjects = 1000) + + ## Comparison of the results of AccrualTime object 'accrualTime8' with expected results + expect_equal(accrualTime8$endOfAccrualIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime8$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime8$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime8$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime8$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime8$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime8$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime8$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime8$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime8$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime8$accrualTime, c(0, 66.666667), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime8$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime8$accrualIntensity, 15, label = paste0("c(", paste0(accrualTime8$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime8$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime8$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime8$maxNumberOfSubjects, 1000, label = paste0("c(", paste0(accrualTime8$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime8$remainingTime, 66.666667, tolerance = 1e-07, label = paste0("c(", paste0(accrualTime8$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime8$piecewiseAccrualEnabled, FALSE, label = paste0("c(", paste0(accrualTime8$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime8), NA))) + expect_output(print(accrualTime8)$show()) + invisible(capture.output(expect_error(summary(accrualTime8), NA))) + expect_output(summary(accrualTime8)$show()) + accrualTime8CodeBased <- eval(parse(text = getObjectRCode(accrualTime8, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime8CodeBased$endOfAccrualIsUserDefined, accrualTime8$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$followUpTimeMustBeUserDefined, accrualTime8$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime8$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime8$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$absoluteAccrualIntensityEnabled, accrualTime8$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$accrualTime, accrualTime8$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$accrualIntensity, accrualTime8$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$accrualIntensityRelative, accrualTime8$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$maxNumberOfSubjects, accrualTime8$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$remainingTime, accrualTime8$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$piecewiseAccrualEnabled, accrualTime8$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime8), "character") + df <- as.data.frame(accrualTime8) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime8) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime9 <- getAccrualTime(accrualTime = c(0, 5), accrualIntensity = 15) + + ## Comparison of the results of AccrualTime object 'accrualTime9' with expected results + expect_equal(accrualTime9$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime9$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime9$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime9$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime9$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime9$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime9$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime9$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime9$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime9$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime9$accrualTime, c(0, 5), label = paste0("c(", paste0(accrualTime9$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime9$accrualIntensity, 15, label = paste0("c(", paste0(accrualTime9$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime9$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime9$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime9$maxNumberOfSubjects, 75, label = paste0("c(", paste0(accrualTime9$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime9$remainingTime, 5, label = paste0("c(", paste0(accrualTime9$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime9$piecewiseAccrualEnabled, FALSE, label = paste0("c(", paste0(accrualTime9$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime9), NA))) + expect_output(print(accrualTime9)$show()) + invisible(capture.output(expect_error(summary(accrualTime9), NA))) + expect_output(summary(accrualTime9)$show()) + accrualTime9CodeBased <- eval(parse(text = getObjectRCode(accrualTime9, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime9CodeBased$endOfAccrualIsUserDefined, accrualTime9$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$followUpTimeMustBeUserDefined, accrualTime9$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime9$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime9$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$absoluteAccrualIntensityEnabled, accrualTime9$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$accrualTime, accrualTime9$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$accrualIntensity, accrualTime9$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$accrualIntensityRelative, accrualTime9$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$maxNumberOfSubjects, accrualTime9$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$remainingTime, accrualTime9$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$piecewiseAccrualEnabled, accrualTime9$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime9), "character") + df <- as.data.frame(accrualTime9) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime9) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime10 <- getAccrualTime(accrualTime = 0, accrualIntensity = 15, maxNumberOfSubjects = 10) + + ## Comparison of the results of AccrualTime object 'accrualTime10' with expected results + expect_equal(accrualTime10$endOfAccrualIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime10$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime10$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime10$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime10$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime10$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime10$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime10$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime10$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime10$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime10$accrualTime, c(0, 0.66666667), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime10$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime10$accrualIntensity, 15, label = paste0("c(", paste0(accrualTime10$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime10$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime10$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime10$maxNumberOfSubjects, 10, label = paste0("c(", paste0(accrualTime10$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime10$remainingTime, 0.66666667, tolerance = 1e-07, label = paste0("c(", paste0(accrualTime10$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime10$piecewiseAccrualEnabled, FALSE, label = paste0("c(", paste0(accrualTime10$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime10), NA))) + expect_output(print(accrualTime10)$show()) + invisible(capture.output(expect_error(summary(accrualTime10), NA))) + expect_output(summary(accrualTime10)$show()) + accrualTime10CodeBased <- eval(parse(text = getObjectRCode(accrualTime10, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime10CodeBased$endOfAccrualIsUserDefined, accrualTime10$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$followUpTimeMustBeUserDefined, accrualTime10$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime10$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime10$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$absoluteAccrualIntensityEnabled, accrualTime10$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$accrualTime, accrualTime10$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$accrualIntensity, accrualTime10$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$accrualIntensityRelative, accrualTime10$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$maxNumberOfSubjects, accrualTime10$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$remainingTime, accrualTime10$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$piecewiseAccrualEnabled, accrualTime10$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime10), "character") + df <- as.data.frame(accrualTime10) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime10) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime11 <- getAccrualTime(accrualTime = c(0, 5), accrualIntensity = 15, maxNumberOfSubjects = 75) + + ## Comparison of the results of AccrualTime object 'accrualTime11' with expected results + expect_equal(accrualTime11$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime11$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime11$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime11$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime11$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime11$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime11$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime11$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime11$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime11$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime11$accrualTime, c(0, 5), label = paste0("c(", paste0(accrualTime11$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime11$accrualIntensity, 15, label = paste0("c(", paste0(accrualTime11$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime11$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime11$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime11$maxNumberOfSubjects, 75, label = paste0("c(", paste0(accrualTime11$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime11$remainingTime, NA_real_, label = paste0("c(", paste0(accrualTime11$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime11$piecewiseAccrualEnabled, FALSE, label = paste0("c(", paste0(accrualTime11$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime11), NA))) + expect_output(print(accrualTime11)$show()) + invisible(capture.output(expect_error(summary(accrualTime11), NA))) + expect_output(summary(accrualTime11)$show()) + accrualTime11CodeBased <- eval(parse(text = getObjectRCode(accrualTime11, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime11CodeBased$endOfAccrualIsUserDefined, accrualTime11$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime11CodeBased$followUpTimeMustBeUserDefined, accrualTime11$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime11CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime11$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime11CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime11$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime11CodeBased$absoluteAccrualIntensityEnabled, accrualTime11$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime11CodeBased$accrualTime, accrualTime11$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime11CodeBased$accrualIntensity, accrualTime11$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime11CodeBased$accrualIntensityRelative, accrualTime11$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime11CodeBased$maxNumberOfSubjects, accrualTime11$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime11CodeBased$remainingTime, accrualTime11$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime11CodeBased$piecewiseAccrualEnabled, accrualTime11$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime11), "character") + df <- as.data.frame(accrualTime11) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime11) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime12 <- getAccrualTime(accrualTime = c(0, 6, 15, 25), accrualIntensity = c(22, 0, 33)) + + ## Comparison of the results of AccrualTime object 'accrualTime12' with expected results + expect_equal(accrualTime12$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime12$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime12$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime12$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime12$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime12$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime12$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime12$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime12$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime12$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime12$accrualTime, c(0, 6, 15, 25), label = paste0("c(", paste0(accrualTime12$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime12$accrualIntensity, c(22, 0, 33), label = paste0("c(", paste0(accrualTime12$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime12$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime12$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime12$maxNumberOfSubjects, 462, label = paste0("c(", paste0(accrualTime12$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime12$remainingTime, 10, label = paste0("c(", paste0(accrualTime12$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime12$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime12$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime12), NA))) + expect_output(print(accrualTime12)$show()) + invisible(capture.output(expect_error(summary(accrualTime12), NA))) + expect_output(summary(accrualTime12)$show()) + accrualTime12CodeBased <- eval(parse(text = getObjectRCode(accrualTime12, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime12CodeBased$endOfAccrualIsUserDefined, accrualTime12$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$followUpTimeMustBeUserDefined, accrualTime12$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime12$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime12$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$absoluteAccrualIntensityEnabled, accrualTime12$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$accrualTime, accrualTime12$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$accrualIntensity, accrualTime12$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$accrualIntensityRelative, accrualTime12$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$maxNumberOfSubjects, accrualTime12$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$remainingTime, accrualTime12$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$piecewiseAccrualEnabled, accrualTime12$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime12), "character") + df <- as.data.frame(accrualTime12) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime12) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime13 <- getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(22, 33), maxNumberOfSubjects = 1000) + + ## Comparison of the results of AccrualTime object 'accrualTime13' with expected results + expect_equal(accrualTime13$endOfAccrualIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime13$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime13$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime13$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime13$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime13$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime13$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime13$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime13$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime13$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime13$accrualTime, c(0, 6, 32.30303), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime13$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime13$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime13$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime13$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime13$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime13$maxNumberOfSubjects, 1000, label = paste0("c(", paste0(accrualTime13$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime13$remainingTime, 26.30303, tolerance = 1e-07, label = paste0("c(", paste0(accrualTime13$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime13$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime13$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime13), NA))) + expect_output(print(accrualTime13)$show()) + invisible(capture.output(expect_error(summary(accrualTime13), NA))) + expect_output(summary(accrualTime13)$show()) + accrualTime13CodeBased <- eval(parse(text = getObjectRCode(accrualTime13, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime13CodeBased$endOfAccrualIsUserDefined, accrualTime13$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$followUpTimeMustBeUserDefined, accrualTime13$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime13$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime13$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$absoluteAccrualIntensityEnabled, accrualTime13$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$accrualTime, accrualTime13$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$accrualIntensity, accrualTime13$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$accrualIntensityRelative, accrualTime13$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$maxNumberOfSubjects, accrualTime13$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$remainingTime, accrualTime13$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$piecewiseAccrualEnabled, accrualTime13$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime13), "character") + df <- as.data.frame(accrualTime13) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime13) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("Testing 'getAccrualTime': test absolute and relative definition", { + + # @refFS[Tab.]{fs:tab:output:getAccrualTime} + accrualTime1 <- getAccrualTime( + accrualTime = c(0, 6, 30), + accrualIntensity = c(22, 33), maxNumberOfSubjects = 924 + ) + + ## Comparison of the results of AccrualTime object 'accrualTime1' with expected results + expect_equal(accrualTime1$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime1$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime1$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime1$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime1$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime1$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime1$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime1$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime1$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime1$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime1$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime1$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime1$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime1$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime1$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime1$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime1$maxNumberOfSubjects, 924, label = paste0("c(", paste0(accrualTime1$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime1$remainingTime, NA_real_, label = paste0("c(", paste0(accrualTime1$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime1$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime1$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime1), NA))) + expect_output(print(accrualTime1)$show()) + invisible(capture.output(expect_error(summary(accrualTime1), NA))) + expect_output(summary(accrualTime1)$show()) + accrualTime1CodeBased <- eval(parse(text = getObjectRCode(accrualTime1, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime1CodeBased$endOfAccrualIsUserDefined, accrualTime1$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime1CodeBased$followUpTimeMustBeUserDefined, accrualTime1$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime1CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime1$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime1CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime1$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime1CodeBased$absoluteAccrualIntensityEnabled, accrualTime1$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime1CodeBased$accrualTime, accrualTime1$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime1CodeBased$accrualIntensity, accrualTime1$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime1CodeBased$accrualIntensityRelative, accrualTime1$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime1CodeBased$maxNumberOfSubjects, accrualTime1$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime1CodeBased$remainingTime, accrualTime1$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime1CodeBased$piecewiseAccrualEnabled, accrualTime1$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime1), "character") + df <- as.data.frame(accrualTime1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime2 <- getAccrualTime(list( + "0 - <6" = 22, + "6 - <=30" = 33 + ), + maxNumberOfSubjects = 924 + ) + + ## Comparison of the results of AccrualTime object 'accrualTime2' with expected results + expect_equal(accrualTime2$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime2$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime2$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime2$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime2$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime2$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime2$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime2$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime2$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime2$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime2$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime2$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime2$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime2$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime2$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime2$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime2$maxNumberOfSubjects, 924, label = paste0("c(", paste0(accrualTime2$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime2$remainingTime, NA_real_, label = paste0("c(", paste0(accrualTime2$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime2$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime2$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime2), NA))) + expect_output(print(accrualTime2)$show()) + invisible(capture.output(expect_error(summary(accrualTime2), NA))) + expect_output(summary(accrualTime2)$show()) + accrualTime2CodeBased <- eval(parse(text = getObjectRCode(accrualTime2, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime2CodeBased$endOfAccrualIsUserDefined, accrualTime2$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime2CodeBased$followUpTimeMustBeUserDefined, accrualTime2$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime2CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime2$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime2CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime2$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime2CodeBased$absoluteAccrualIntensityEnabled, accrualTime2$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime2CodeBased$accrualTime, accrualTime2$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime2CodeBased$accrualIntensity, accrualTime2$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime2CodeBased$accrualIntensityRelative, accrualTime2$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime2CodeBased$maxNumberOfSubjects, accrualTime2$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime2CodeBased$remainingTime, accrualTime2$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime2CodeBased$piecewiseAccrualEnabled, accrualTime2$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime2), "character") + df <- as.data.frame(accrualTime2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + .skipTestIfDisabled() + + accrualTime3 <- getAccrualTime( + accrualTime = c(0, 6, 30), + accrualIntensity = c(0.22, 0.33), maxNumberOfSubjects = 1000 + ) + + ## Comparison of the results of AccrualTime object 'accrualTime3' with expected results + expect_equal(accrualTime3$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime3$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime3$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime3$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime3$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime3$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime3$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime3$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime3$absoluteAccrualIntensityEnabled, FALSE, label = paste0("c(", paste0(accrualTime3$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime3$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime3$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime3$accrualIntensity, c(23.809524, 35.714286), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime3$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime3$accrualIntensityRelative, c(0.22, 0.33), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime3$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime3$maxNumberOfSubjects, 1000, label = paste0("c(", paste0(accrualTime3$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime3$remainingTime, 24, label = paste0("c(", paste0(accrualTime3$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime3$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime3$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime3), NA))) + expect_output(print(accrualTime3)$show()) + invisible(capture.output(expect_error(summary(accrualTime3), NA))) + expect_output(summary(accrualTime3)$show()) + accrualTime3CodeBased <- eval(parse(text = getObjectRCode(accrualTime3, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime3CodeBased$endOfAccrualIsUserDefined, accrualTime3$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime3CodeBased$followUpTimeMustBeUserDefined, accrualTime3$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime3CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime3$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime3CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime3$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime3CodeBased$absoluteAccrualIntensityEnabled, accrualTime3$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime3CodeBased$accrualTime, accrualTime3$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime3CodeBased$accrualIntensity, accrualTime3$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime3CodeBased$accrualIntensityRelative, accrualTime3$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime3CodeBased$maxNumberOfSubjects, accrualTime3$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime3CodeBased$remainingTime, accrualTime3$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime3CodeBased$piecewiseAccrualEnabled, accrualTime3$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime3), "character") + df <- as.data.frame(accrualTime3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime4 <- getAccrualTime(list( + "0 - <6" = 0.22, + "6 - <=30" = 0.33 + ), + maxNumberOfSubjects = 1000 + ) + + ## Comparison of the results of AccrualTime object 'accrualTime4' with expected results + expect_equal(accrualTime4$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime4$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime4$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime4$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime4$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime4$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime4$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime4$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime4$absoluteAccrualIntensityEnabled, FALSE, label = paste0("c(", paste0(accrualTime4$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime4$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime4$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime4$accrualIntensity, c(23.809524, 35.714286), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime4$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime4$accrualIntensityRelative, c(0.22, 0.33), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime4$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime4$maxNumberOfSubjects, 1000, label = paste0("c(", paste0(accrualTime4$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime4$remainingTime, 24, label = paste0("c(", paste0(accrualTime4$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime4$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime4$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime4), NA))) + expect_output(print(accrualTime4)$show()) + invisible(capture.output(expect_error(summary(accrualTime4), NA))) + expect_output(summary(accrualTime4)$show()) + accrualTime4CodeBased <- eval(parse(text = getObjectRCode(accrualTime4, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime4CodeBased$endOfAccrualIsUserDefined, accrualTime4$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$followUpTimeMustBeUserDefined, accrualTime4$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime4$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime4$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$absoluteAccrualIntensityEnabled, accrualTime4$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$accrualTime, accrualTime4$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$accrualIntensity, accrualTime4$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$accrualIntensityRelative, accrualTime4$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$maxNumberOfSubjects, accrualTime4$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$remainingTime, accrualTime4$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime4CodeBased$piecewiseAccrualEnabled, accrualTime4$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime4), "character") + df <- as.data.frame(accrualTime4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime5 <- getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(22, 33)) + + ## Comparison of the results of AccrualTime object 'accrualTime5' with expected results + expect_equal(accrualTime5$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime5$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime5$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime5$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime5$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime5$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime5$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime5$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime5$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime5$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime5$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime5$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime5$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime5$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime5$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime5$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime5$maxNumberOfSubjects, 924, label = paste0("c(", paste0(accrualTime5$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime5$remainingTime, 24, label = paste0("c(", paste0(accrualTime5$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime5$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime5$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime5), NA))) + expect_output(print(accrualTime5)$show()) + invisible(capture.output(expect_error(summary(accrualTime5), NA))) + expect_output(summary(accrualTime5)$show()) + accrualTime5CodeBased <- eval(parse(text = getObjectRCode(accrualTime5, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime5CodeBased$endOfAccrualIsUserDefined, accrualTime5$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$followUpTimeMustBeUserDefined, accrualTime5$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime5$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime5$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$absoluteAccrualIntensityEnabled, accrualTime5$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$accrualTime, accrualTime5$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$accrualIntensity, accrualTime5$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$accrualIntensityRelative, accrualTime5$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$maxNumberOfSubjects, accrualTime5$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$remainingTime, accrualTime5$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime5CodeBased$piecewiseAccrualEnabled, accrualTime5$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime5), "character") + df <- as.data.frame(accrualTime5) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime5) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime6 <- getAccrualTime(list( + "0 - <6" = 22, + "6 - <=30" = 33 + )) + + ## Comparison of the results of AccrualTime object 'accrualTime6' with expected results + expect_equal(accrualTime6$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime6$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime6$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime6$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime6$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime6$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime6$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime6$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime6$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime6$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime6$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime6$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime6$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime6$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime6$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime6$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime6$maxNumberOfSubjects, 924, label = paste0("c(", paste0(accrualTime6$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime6$remainingTime, 24, label = paste0("c(", paste0(accrualTime6$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime6$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime6$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime6), NA))) + expect_output(print(accrualTime6)$show()) + invisible(capture.output(expect_error(summary(accrualTime6), NA))) + expect_output(summary(accrualTime6)$show()) + accrualTime6CodeBased <- eval(parse(text = getObjectRCode(accrualTime6, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime6CodeBased$endOfAccrualIsUserDefined, accrualTime6$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$followUpTimeMustBeUserDefined, accrualTime6$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime6$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime6$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$absoluteAccrualIntensityEnabled, accrualTime6$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$accrualTime, accrualTime6$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$accrualIntensity, accrualTime6$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$accrualIntensityRelative, accrualTime6$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$maxNumberOfSubjects, accrualTime6$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$remainingTime, accrualTime6$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime6CodeBased$piecewiseAccrualEnabled, accrualTime6$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime6), "character") + df <- as.data.frame(accrualTime6) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime6) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime7 <- getAccrualTime(accrualTime = c(0, 6, 30), accrualIntensity = c(0.22, 0.33)) + + ## Comparison of the results of AccrualTime object 'accrualTime7' with expected results + expect_equal(accrualTime7$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime7$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime7$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime7$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime7$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime7$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime7$maxNumberOfSubjectsCanBeCalculatedDirectly, FALSE, label = paste0("c(", paste0(accrualTime7$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime7$absoluteAccrualIntensityEnabled, FALSE, label = paste0("c(", paste0(accrualTime7$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime7$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime7$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime7$accrualIntensity, c(0.22, 0.33), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime7$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime7$accrualIntensityRelative, c(0.22, 0.33), label = paste0("c(", paste0(accrualTime7$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime7$maxNumberOfSubjects, NA_real_, label = paste0("c(", paste0(accrualTime7$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime7$remainingTime, NA_real_, label = paste0("c(", paste0(accrualTime7$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime7$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime7$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime7), NA))) + expect_output(print(accrualTime7)$show()) + invisible(capture.output(expect_error(summary(accrualTime7), NA))) + expect_output(summary(accrualTime7)$show()) + accrualTime7CodeBased <- eval(parse(text = getObjectRCode(accrualTime7, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime7CodeBased$endOfAccrualIsUserDefined, accrualTime7$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime7CodeBased$followUpTimeMustBeUserDefined, accrualTime7$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime7CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime7$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime7CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime7$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime7CodeBased$absoluteAccrualIntensityEnabled, accrualTime7$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime7CodeBased$accrualTime, accrualTime7$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime7CodeBased$accrualIntensity, accrualTime7$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime7CodeBased$accrualIntensityRelative, accrualTime7$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime7CodeBased$maxNumberOfSubjects, accrualTime7$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime7CodeBased$remainingTime, accrualTime7$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime7CodeBased$piecewiseAccrualEnabled, accrualTime7$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime7), "character") + df <- as.data.frame(accrualTime7) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime7) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime8 <- getAccrualTime(list( + "0 - <6" = 0.22, + "6 - <=30" = 0.33 + )) + + ## Comparison of the results of AccrualTime object 'accrualTime8' with expected results + expect_equal(accrualTime8$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime8$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime8$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime8$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime8$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime8$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime8$maxNumberOfSubjectsCanBeCalculatedDirectly, FALSE, label = paste0("c(", paste0(accrualTime8$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime8$absoluteAccrualIntensityEnabled, FALSE, label = paste0("c(", paste0(accrualTime8$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime8$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime8$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime8$accrualIntensity, c(0.22, 0.33), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime8$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime8$accrualIntensityRelative, c(0.22, 0.33), label = paste0("c(", paste0(accrualTime8$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime8$maxNumberOfSubjects, NA_real_, label = paste0("c(", paste0(accrualTime8$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime8$remainingTime, NA_real_, label = paste0("c(", paste0(accrualTime8$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime8$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime8$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime8), NA))) + expect_output(print(accrualTime8)$show()) + invisible(capture.output(expect_error(summary(accrualTime8), NA))) + expect_output(summary(accrualTime8)$show()) + accrualTime8CodeBased <- eval(parse(text = getObjectRCode(accrualTime8, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime8CodeBased$endOfAccrualIsUserDefined, accrualTime8$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$followUpTimeMustBeUserDefined, accrualTime8$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime8$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime8$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$absoluteAccrualIntensityEnabled, accrualTime8$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$accrualTime, accrualTime8$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$accrualIntensity, accrualTime8$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$accrualIntensityRelative, accrualTime8$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$maxNumberOfSubjects, accrualTime8$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$remainingTime, accrualTime8$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime8CodeBased$piecewiseAccrualEnabled, accrualTime8$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime8), "character") + df <- as.data.frame(accrualTime8) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime8) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime9 <- getAccrualTime( + accrualTime = c(0, 6), + accrualIntensity = c(22, 33), maxNumberOfSubjects = 1000 + ) + + ## Comparison of the results of AccrualTime object 'accrualTime9' with expected results + expect_equal(accrualTime9$endOfAccrualIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime9$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime9$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime9$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime9$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime9$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime9$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime9$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime9$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime9$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime9$accrualTime, c(0, 6, 32.30303), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime9$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime9$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime9$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime9$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime9$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime9$maxNumberOfSubjects, 1000, label = paste0("c(", paste0(accrualTime9$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime9$remainingTime, 26.30303, tolerance = 1e-07, label = paste0("c(", paste0(accrualTime9$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime9$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime9$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime9), NA))) + expect_output(print(accrualTime9)$show()) + invisible(capture.output(expect_error(summary(accrualTime9), NA))) + expect_output(summary(accrualTime9)$show()) + accrualTime9CodeBased <- eval(parse(text = getObjectRCode(accrualTime9, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime9CodeBased$endOfAccrualIsUserDefined, accrualTime9$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$followUpTimeMustBeUserDefined, accrualTime9$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime9$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime9$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$absoluteAccrualIntensityEnabled, accrualTime9$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$accrualTime, accrualTime9$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$accrualIntensity, accrualTime9$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$accrualIntensityRelative, accrualTime9$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$maxNumberOfSubjects, accrualTime9$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$remainingTime, accrualTime9$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime9CodeBased$piecewiseAccrualEnabled, accrualTime9$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime9), "character") + df <- as.data.frame(accrualTime9) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime9) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime10 <- getAccrualTime(list( + "0 - <6" = 22, + "6" = 33 + ), + maxNumberOfSubjects = 1000 + ) + + ## Comparison of the results of AccrualTime object 'accrualTime10' with expected results + expect_equal(accrualTime10$endOfAccrualIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime10$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime10$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime10$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime10$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime10$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime10$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime10$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime10$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime10$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime10$accrualTime, c(0, 6, 32.30303), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime10$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime10$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime10$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime10$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime10$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime10$maxNumberOfSubjects, 1000, label = paste0("c(", paste0(accrualTime10$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime10$remainingTime, 26.30303, tolerance = 1e-07, label = paste0("c(", paste0(accrualTime10$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime10$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime10$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime10), NA))) + expect_output(print(accrualTime10)$show()) + invisible(capture.output(expect_error(summary(accrualTime10), NA))) + expect_output(summary(accrualTime10)$show()) + accrualTime10CodeBased <- eval(parse(text = getObjectRCode(accrualTime10, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime10CodeBased$endOfAccrualIsUserDefined, accrualTime10$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$followUpTimeMustBeUserDefined, accrualTime10$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime10$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime10$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$absoluteAccrualIntensityEnabled, accrualTime10$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$accrualTime, accrualTime10$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$accrualIntensity, accrualTime10$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$accrualIntensityRelative, accrualTime10$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$maxNumberOfSubjects, accrualTime10$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$remainingTime, accrualTime10$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime10CodeBased$piecewiseAccrualEnabled, accrualTime10$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime10), "character") + df <- as.data.frame(accrualTime10) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime10) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime12 <- getAccrualTime(list( + "0 - <6" = 0.22, + "6 - <=30" = 0.33 + ), + maxNumberOfSubjects = 1000 + ) + + ## Comparison of the results of AccrualTime object 'accrualTime12' with expected results + expect_equal(accrualTime12$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime12$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime12$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime12$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime12$maxNumberOfSubjectsIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime12$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime12$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime12$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime12$absoluteAccrualIntensityEnabled, FALSE, label = paste0("c(", paste0(accrualTime12$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime12$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime12$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime12$accrualIntensity, c(23.809524, 35.714286), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime12$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime12$accrualIntensityRelative, c(0.22, 0.33), tolerance = 1e-07, label = paste0("c(", paste0(accrualTime12$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime12$maxNumberOfSubjects, 1000, label = paste0("c(", paste0(accrualTime12$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime12$remainingTime, 24, label = paste0("c(", paste0(accrualTime12$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime12$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime12$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime12), NA))) + expect_output(print(accrualTime12)$show()) + invisible(capture.output(expect_error(summary(accrualTime12), NA))) + expect_output(summary(accrualTime12)$show()) + accrualTime12CodeBased <- eval(parse(text = getObjectRCode(accrualTime12, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime12CodeBased$endOfAccrualIsUserDefined, accrualTime12$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$followUpTimeMustBeUserDefined, accrualTime12$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime12$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime12$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$absoluteAccrualIntensityEnabled, accrualTime12$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$accrualTime, accrualTime12$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$accrualIntensity, accrualTime12$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$accrualIntensityRelative, accrualTime12$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$maxNumberOfSubjects, accrualTime12$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$remainingTime, accrualTime12$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime12CodeBased$piecewiseAccrualEnabled, accrualTime12$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime12), "character") + df <- as.data.frame(accrualTime12) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime12) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime13 <- getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(22, 33)) + + ## Comparison of the results of AccrualTime object 'accrualTime13' with expected results + expect_equal(accrualTime13$endOfAccrualIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime13$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime13$followUpTimeMustBeUserDefined, TRUE, label = paste0("c(", paste0(accrualTime13$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime13$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime13$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime13$maxNumberOfSubjectsCanBeCalculatedDirectly, FALSE, label = paste0("c(", paste0(accrualTime13$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime13$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime13$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime13$accrualTime, c(0, 6), label = paste0("c(", paste0(accrualTime13$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime13$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime13$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime13$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime13$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime13$maxNumberOfSubjects, NA_real_, label = paste0("c(", paste0(accrualTime13$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime13$remainingTime, NA_real_, label = paste0("c(", paste0(accrualTime13$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime13$piecewiseAccrualEnabled, FALSE, label = paste0("c(", paste0(accrualTime13$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime13), NA))) + expect_output(print(accrualTime13)$show()) + invisible(capture.output(expect_error(summary(accrualTime13), NA))) + expect_output(summary(accrualTime13)$show()) + accrualTime13CodeBased <- eval(parse(text = getObjectRCode(accrualTime13, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime13CodeBased$endOfAccrualIsUserDefined, accrualTime13$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$followUpTimeMustBeUserDefined, accrualTime13$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime13$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime13$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$absoluteAccrualIntensityEnabled, accrualTime13$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$accrualTime, accrualTime13$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$accrualIntensity, accrualTime13$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$accrualIntensityRelative, accrualTime13$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$maxNumberOfSubjects, accrualTime13$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$remainingTime, accrualTime13$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime13CodeBased$piecewiseAccrualEnabled, accrualTime13$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime13), "character") + df <- as.data.frame(accrualTime13) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime13) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + accrualTime14 <- getAccrualTime(list( + "0 - <6" = 22, + "6 - <=30" = 33 + )) + + ## Comparison of the results of AccrualTime object 'accrualTime14' with expected results + expect_equal(accrualTime14$endOfAccrualIsUserDefined, TRUE, label = paste0("c(", paste0(accrualTime14$endOfAccrualIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime14$followUpTimeMustBeUserDefined, FALSE, label = paste0("c(", paste0(accrualTime14$followUpTimeMustBeUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime14$maxNumberOfSubjectsIsUserDefined, FALSE, label = paste0("c(", paste0(accrualTime14$maxNumberOfSubjectsIsUserDefined, collapse = ", "), ")")) + expect_equal(accrualTime14$maxNumberOfSubjectsCanBeCalculatedDirectly, TRUE, label = paste0("c(", paste0(accrualTime14$maxNumberOfSubjectsCanBeCalculatedDirectly, collapse = ", "), ")")) + expect_equal(accrualTime14$absoluteAccrualIntensityEnabled, TRUE, label = paste0("c(", paste0(accrualTime14$absoluteAccrualIntensityEnabled, collapse = ", "), ")")) + expect_equal(accrualTime14$accrualTime, c(0, 6, 30), label = paste0("c(", paste0(accrualTime14$accrualTime, collapse = ", "), ")")) + expect_equal(accrualTime14$accrualIntensity, c(22, 33), label = paste0("c(", paste0(accrualTime14$accrualIntensity, collapse = ", "), ")")) + expect_equal(accrualTime14$accrualIntensityRelative, NA_real_, label = paste0("c(", paste0(accrualTime14$accrualIntensityRelative, collapse = ", "), ")")) + expect_equal(accrualTime14$maxNumberOfSubjects, 924, label = paste0("c(", paste0(accrualTime14$maxNumberOfSubjects, collapse = ", "), ")")) + expect_equal(accrualTime14$remainingTime, 24, label = paste0("c(", paste0(accrualTime14$remainingTime, collapse = ", "), ")")) + expect_equal(accrualTime14$piecewiseAccrualEnabled, TRUE, label = paste0("c(", paste0(accrualTime14$piecewiseAccrualEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(accrualTime14), NA))) + expect_output(print(accrualTime14)$show()) + invisible(capture.output(expect_error(summary(accrualTime14), NA))) + expect_output(summary(accrualTime14)$show()) + accrualTime14CodeBased <- eval(parse(text = getObjectRCode(accrualTime14, stringWrapParagraphWidth = NULL))) + expect_equal(accrualTime14CodeBased$endOfAccrualIsUserDefined, accrualTime14$endOfAccrualIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime14CodeBased$followUpTimeMustBeUserDefined, accrualTime14$followUpTimeMustBeUserDefined, tolerance = 1e-07) + expect_equal(accrualTime14CodeBased$maxNumberOfSubjectsIsUserDefined, accrualTime14$maxNumberOfSubjectsIsUserDefined, tolerance = 1e-07) + expect_equal(accrualTime14CodeBased$maxNumberOfSubjectsCanBeCalculatedDirectly, accrualTime14$maxNumberOfSubjectsCanBeCalculatedDirectly, tolerance = 1e-07) + expect_equal(accrualTime14CodeBased$absoluteAccrualIntensityEnabled, accrualTime14$absoluteAccrualIntensityEnabled, tolerance = 1e-07) + expect_equal(accrualTime14CodeBased$accrualTime, accrualTime14$accrualTime, tolerance = 1e-07) + expect_equal(accrualTime14CodeBased$accrualIntensity, accrualTime14$accrualIntensity, tolerance = 1e-07) + expect_equal(accrualTime14CodeBased$accrualIntensityRelative, accrualTime14$accrualIntensityRelative, tolerance = 1e-07) + expect_equal(accrualTime14CodeBased$maxNumberOfSubjects, accrualTime14$maxNumberOfSubjects, tolerance = 1e-07) + expect_equal(accrualTime14CodeBased$remainingTime, accrualTime14$remainingTime, tolerance = 1e-07) + expect_equal(accrualTime14CodeBased$piecewiseAccrualEnabled, accrualTime14$piecewiseAccrualEnabled, tolerance = 1e-07) + expect_type(names(accrualTime14), "character") + df <- as.data.frame(accrualTime14) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(accrualTime14) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("Testing 'getAccrualTime': check expected warnings and errors", { + + # @refFS[Tab.]{fs:tab:output:getAccrualTime} + expect_warning(getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(0.22, 0.33)), + paste0("The specified accrual time and intensity cannot be supplemented ", + "automatically with the missing information; therefore further calculations are not possible"), + fixed = TRUE + ) + + expect_warning(getAccrualTime(accrualTime = c(0, 24), accrualIntensity = c(30, 45), maxNumberOfSubjects = 720), + "Last accrual intensity value (45) ignored", + fixed = TRUE + ) + + .skipTestIfDisabled() + + suppressWarnings(expect_warning(getAccrualTime(accrualTime = c(0, 24, 30), + accrualIntensity = c(30, 45, 55), maxNumberOfSubjects = 720), + "Last 2 accrual intensity values (45, 55) ignored", + fixed = TRUE + )) + + suppressWarnings(expect_warning(getAccrualTime(accrualTime = c(0, 24, 30, 40), + accrualIntensity = c(30, 45, 55, 66), maxNumberOfSubjects = 720), + "Last 2 accrual time values (30, 40) ignored", + fixed = TRUE + )) + + suppressWarnings(expect_warning(getAccrualTime(accrualTime = c(0, 24, 30, 40), + accrualIntensity = c(30, 45, 55, 66), maxNumberOfSubjects = 720), + "Last 3 accrual intensity values (45, 55, 66) ignored", + fixed = TRUE + )) + + expect_warning(getAccrualTime(accrualTime = c(0, 6, 15, 25), accrualIntensity = c(0, 22, 33)), + "It makes no sense to start 'accrualIntensity' (0, 22, 33) with 0", + fixed = TRUE + ) + + expect_error(getAccrualTime(accrualTime = c(0, 6), accrualIntensity = c(0)), + "Illegal argument: at least one 'accrualIntensity' value must be > 0", + fixed = TRUE + ) + + expect_error(getAccrualTime( + accrualTime = c(0, 6, 30), accrualIntensity = c(22, 33), + maxNumberOfSubjects = 1000 + ), + paste0( + "Conflicting arguments: 'maxNumberOfSubjects' (1000) disagrees with the defined ", + "accrual time (0, 6, 30) and intensity: 6 * 22 + 24 * 33 = 924" + ), + fixed = TRUE + ) + +}) + +test_that("Testing 'getAccrualTime': list-wise definition", { + + accrualTime1 <- list( + "0 - <12" = 15, + "12 - <13" = 21, + "13 - <14" = 27, + "14 - <15" = 33, + "15 - <16" = 39, + ">=16" = 45 + ) + + # @refFS[Tab.]{fs:tab:output:getAccrualTime} + accrualTime4 <- getAccrualTime(accrualTime = accrualTime1, maxNumberOfSubjects = 1405) + expect_equal(accrualTime4$accrualTime, c(0, 12, 13, 14, 15, 16, 40.55555556)) + expect_equal(accrualTime4$accrualIntensity, c(15, 21, 27, 33, 39, 45)) + expect_equal(accrualTime4$remainingTime, 24.55555556) + + .skipTestIfDisabled() + + accrualTime2 <- list( + "0 - <12" = 15, + "12 - <13" = 21, + "13 - <14" = 27, + "14 - <15" = 33, + "15 - <16" = 39, + "16 - ?" = 45 + ) + accrualTime5 <- getAccrualTime(accrualTime = accrualTime2, maxNumberOfSubjects = 1405) + expect_equal(accrualTime5$accrualTime, c(0, 12, 13, 14, 15, 16, 40.55555556)) + expect_equal(accrualTime5$accrualIntensity, c(15, 21, 27, 33, 39, 45)) + expect_equal(accrualTime5$remainingTime, 24.55555556) + + accrualTime3 <- list( + "0 - <11" = 20, + "11 - <16" = 40, + ">=16" = 60 + ) + accrualTime6 <- getAccrualTime(accrualTime = accrualTime3, maxNumberOfSubjects = 800) + expect_equal(accrualTime6$accrualTime, c(0, 11, 16, 22.3333333)) + expect_equal(accrualTime6$accrualIntensity, c(20, 40, 60)) + expect_equal(accrualTime6$remainingTime, 6.33333333) + + accrualTime7 <- list( + "0 - <11" = 20, + "11 - <16" = 40, + "16 - ?" = 60 + ) + accrualTime8 <- getAccrualTime(accrualTime = accrualTime7, maxNumberOfSubjects = 800) + expect_equal(accrualTime8$accrualTime, c(0, 11, 16, 22.3333333)) + expect_equal(accrualTime8$accrualIntensity, c(20, 40, 60)) + expect_equal(accrualTime8$remainingTime, 6.33333333) + +}) + +test_that("Testing 'getPiecewiseSurvivalTime': mixed arguments", { + + # @refFS[Tab.]{fs:tab:output:getPiecewiseSurvivalTime} + pwSurvivalTime1 <- getPiecewiseSurvivalTime(median1 = 37, hazardRatio = 0.8) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime1' with expected results + expect_equal(pwSurvivalTime1$piecewiseSurvivalTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime1$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$lambda1, 0.018733708, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$lambda2, 0.023417134, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$hazardRatio, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime1$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime1$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$median1, 37, label = paste0("c(", paste0(pwSurvivalTime1$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$median2, 29.6, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime1$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime1$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime1$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime1$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime1$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime1$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime1$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime1), NA))) + expect_output(print(pwSurvivalTime1)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime1), NA))) + expect_output(summary(pwSurvivalTime1)$show()) + pwSurvivalTime1CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime1, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime1CodeBased$piecewiseSurvivalTime, pwSurvivalTime1$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$lambda1, pwSurvivalTime1$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$lambda2, pwSurvivalTime1$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$hazardRatio, pwSurvivalTime1$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$pi1, pwSurvivalTime1$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$pi2, pwSurvivalTime1$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$median1, pwSurvivalTime1$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$median2, pwSurvivalTime1$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$eventTime, pwSurvivalTime1$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$kappa, pwSurvivalTime1$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime1$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$delayedResponseAllowed, pwSurvivalTime1$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime1CodeBased$delayedResponseEnabled, pwSurvivalTime1$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime1), "character") + df <- as.data.frame(pwSurvivalTime1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime2 <- getPiecewiseSurvivalTime(lambda1 = 0.01873371, median2 = 29.6) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime2' with expected results + expect_equal(pwSurvivalTime2$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime2$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$lambda1, 0.01873371, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$lambda2, 0.023417134, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$hazardRatio, 0.8000001, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime2$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime2$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$median1, 36.999995, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$median2, 29.6, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime2$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime2$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime2$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime2$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime2$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime2), NA))) + expect_output(print(pwSurvivalTime2)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime2), NA))) + expect_output(summary(pwSurvivalTime2)$show()) + pwSurvivalTime2CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime2, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalTime, pwSurvivalTime2$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$lambda1, pwSurvivalTime2$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$lambda2, pwSurvivalTime2$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$hazardRatio, pwSurvivalTime2$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$pi1, pwSurvivalTime2$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$pi2, pwSurvivalTime2$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$median1, pwSurvivalTime2$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$median2, pwSurvivalTime2$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$eventTime, pwSurvivalTime2$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$kappa, pwSurvivalTime2$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime2$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$delayedResponseAllowed, pwSurvivalTime2$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime2CodeBased$delayedResponseEnabled, pwSurvivalTime2$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime2), "character") + df <- as.data.frame(pwSurvivalTime2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + pwSurvivalTime3 <- getPiecewiseSurvivalTime(median1 = 37, lambda2 = 0.02341713) + + ## Comparison of the results of PiecewiseSurvivalTime object 'pwSurvivalTime3' with expected results + expect_equal(pwSurvivalTime3$piecewiseSurvivalTime, 0, label = paste0("c(", paste0(pwSurvivalTime3$piecewiseSurvivalTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$lambda1, 0.018733708, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$lambda1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$lambda2, 0.02341713, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$lambda2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$hazardRatio, 0.80000015, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$hazardRatio, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$pi1, NA_real_, label = paste0("c(", paste0(pwSurvivalTime3$pi1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$pi2, NA_real_, label = paste0("c(", paste0(pwSurvivalTime3$pi2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$median1, 37, label = paste0("c(", paste0(pwSurvivalTime3$median1, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$median2, 29.600006, tolerance = 1e-07, label = paste0("c(", paste0(pwSurvivalTime3$median2, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$eventTime, NA_real_, label = paste0("c(", paste0(pwSurvivalTime3$eventTime, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$kappa, 1, label = paste0("c(", paste0(pwSurvivalTime3$kappa, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$piecewiseSurvivalEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime3$piecewiseSurvivalEnabled, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$delayedResponseAllowed, FALSE, label = paste0("c(", paste0(pwSurvivalTime3$delayedResponseAllowed, collapse = ", "), ")")) + expect_equal(pwSurvivalTime3$delayedResponseEnabled, FALSE, label = paste0("c(", paste0(pwSurvivalTime3$delayedResponseEnabled, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(pwSurvivalTime3), NA))) + expect_output(print(pwSurvivalTime3)$show()) + invisible(capture.output(expect_error(summary(pwSurvivalTime3), NA))) + expect_output(summary(pwSurvivalTime3)$show()) + pwSurvivalTime3CodeBased <- eval(parse(text = getObjectRCode(pwSurvivalTime3, stringWrapParagraphWidth = NULL))) + expect_equal(pwSurvivalTime3CodeBased$piecewiseSurvivalTime, pwSurvivalTime3$piecewiseSurvivalTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$lambda1, pwSurvivalTime3$lambda1, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$lambda2, pwSurvivalTime3$lambda2, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$hazardRatio, pwSurvivalTime3$hazardRatio, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$pi1, pwSurvivalTime3$pi1, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$pi2, pwSurvivalTime3$pi2, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$median1, pwSurvivalTime3$median1, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$median2, pwSurvivalTime3$median2, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$eventTime, pwSurvivalTime3$eventTime, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$kappa, pwSurvivalTime3$kappa, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$piecewiseSurvivalEnabled, pwSurvivalTime3$piecewiseSurvivalEnabled, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$delayedResponseAllowed, pwSurvivalTime3$delayedResponseAllowed, tolerance = 1e-07) + expect_equal(pwSurvivalTime3CodeBased$delayedResponseEnabled, pwSurvivalTime3$delayedResponseEnabled, tolerance = 1e-07) + expect_type(names(pwSurvivalTime3), "character") + df <- as.data.frame(pwSurvivalTime3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(pwSurvivalTime3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + expect_warning(getPiecewiseSurvivalTime(hazardRatio = c(0.6, 0.8), pi1 = 0.3), + "'hazardRatio' (0.6, 0.8) will be ignored because it will be calculated", + fixed = TRUE + ) +}) + diff --git a/tests/testthat/test-f_analysis_base_rates.R b/tests/testthat/test-f_analysis_base_rates.R index 1743491c..e725c25d 100644 --- a/tests/testthat/test-f_analysis_base_rates.R +++ b/tests/testthat/test-f_analysis_base_rates.R @@ -1,2434 +1,2433 @@ -## | -## | *Unit tests* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | RPACT package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File name: test-f_analysis_base_rates.R -## | Creation date: 08 November 2023, 08:51:06 -## | File version: $Revision$ -## | Last changed: $Date$ -## | Last changed by: $Author$ -## | - -test_plan_section("Testing the Analysis Rates Functionality for One Treatment") - - -test_that("'getAnalysisResults' for a group sequential design and one treatment", { - .skipTestIfDisabled() - - design0 <- getDesignGroupSequential( - kMax = 2, alpha = 0.025, informationRates = c(0.2, 1), - typeOfDesign = "asKD", gammaA = 2.8 - ) - - dataExample0 <- getDataset( - n = c(33), - events = c(23) - ) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateAlternativeSmaller} - # @refFS[Formula]{fs:testStatisticGroupSequential} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - x0 <- getAnalysisResults( - design = design0, dataInput = dataExample0, - thetaH0 = 0.4, normalApproximation = FALSE, directionUpper = TRUE - ) - - ## Comparison of the results of AnalysisResultsGroupSequential object 'x0' with expected results - expect_equal(x0$pi1, 0.6969697, tolerance = 1e-06, label = paste0("c(", paste0(x0$pi1, collapse = ", "), ")")) - expect_equal(x0$testActions, c("continue", NA_character_), label = paste0("c(", paste0(x0$testActions, collapse = ", "), ")")) - expect_equal(x0$conditionalRejectionProbabilities, c(0.28801679, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(x0$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x0$conditionalPower, c(NA_real_, NA_real_), label = paste0("c(", paste0(x0$conditionalPower, collapse = ", "), ")")) - expect_equal(x0$repeatedConfidenceIntervalLowerBounds, c(0.38475339, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(x0$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x0$repeatedConfidenceIntervalUpperBounds, c(0.91556361, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(x0$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x0$repeatedPValues, c(0.048557231, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(x0$repeatedPValues, collapse = ", "), ")")) - expect_equal(x0$finalStage, NA_integer_, label = paste0("c(", paste0(x0$finalStage, collapse = ", "), ")")) - expect_equal(x0$finalPValues, c(NA_real_, NA_real_), label = paste0("c(", paste0(x0$finalPValues, collapse = ", "), ")")) - expect_equal(x0$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_), label = paste0("c(", paste0(x0$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x0$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_), label = paste0("c(", paste0(x0$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x0$medianUnbiasedEstimates, c(NA_real_, NA_real_), label = paste0("c(", paste0(x0$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x0), NA))) - expect_output(print(x0)$show()) - invisible(capture.output(expect_error(summary(x0), NA))) - expect_output(summary(x0)$show()) - x0CodeBased <- eval(parse(text = getObjectRCode(x0, stringWrapParagraphWidth = NULL))) - expect_equal(x0CodeBased$pi1, x0$pi1, tolerance = 1e-06) - expect_equal(x0CodeBased$testActions, x0$testActions, tolerance = 1e-06) - expect_equal(x0CodeBased$conditionalRejectionProbabilities, x0$conditionalRejectionProbabilities, tolerance = 1e-06) - expect_equal(x0CodeBased$conditionalPower, x0$conditionalPower, tolerance = 1e-06) - expect_equal(x0CodeBased$repeatedConfidenceIntervalLowerBounds, x0$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(x0CodeBased$repeatedConfidenceIntervalUpperBounds, x0$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(x0CodeBased$repeatedPValues, x0$repeatedPValues, tolerance = 1e-06) - expect_equal(x0CodeBased$finalStage, x0$finalStage, tolerance = 1e-06) - expect_equal(x0CodeBased$finalPValues, x0$finalPValues, tolerance = 1e-06) - expect_equal(x0CodeBased$finalConfidenceIntervalLowerBounds, x0$finalConfidenceIntervalLowerBounds, tolerance = 1e-06) - expect_equal(x0CodeBased$finalConfidenceIntervalUpperBounds, x0$finalConfidenceIntervalUpperBounds, tolerance = 1e-06) - expect_equal(x0CodeBased$medianUnbiasedEstimates, x0$medianUnbiasedEstimates, tolerance = 1e-06) - expect_type(names(x0), "character") - df <- as.data.frame(x0) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x0) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getAnalysisResults' for a four-stage group sequential design and one treatment", { - - .skipTestIfDisabled() - - design1 <- getDesignGroupSequential( - kMax = 4, alpha = 0.025, informationRates = c(0.2, 0.4, 0.8, 1), - futilityBounds = c(-0.5, 0, 0.5), typeOfDesign = "asKD", gammaA = 2.8 - ) - - dataExample1 <- getDataset( - n = c(10, 10, 20, 11), - events = c(4, 5, 5, 6) - ) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateAlternativeSmaller} - # @refFS[Formula]{fs:testStatisticGroupSequential} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - x1 <- getAnalysisResults( - design = design1, dataInput = dataExample1, - stage = 2, thetaH0 = 0.75, normalApproximation = FALSE, directionUpper = FALSE - ) - - ## Comparison of the results of AnalysisResultsGroupSequential object 'x1' with expected results - expect_equal(x1$pi1, 0.45, tolerance = 1e-07, label = paste0("c(", paste0(x1$pi1, collapse = ", "), ")")) - expect_equal(x1$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x1$testActions, collapse = ", "), ")")) - expect_equal(x1$conditionalRejectionProbabilities, c(0.13502024, 0.39663603, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x1$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower, collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(0.035340833, 0.15564775, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.88809209, 0.77284164, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x1$repeatedPValues, c(0.49999905, 0.056127482, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues, collapse = ", "), ")")) - expect_equal(x1$finalStage, NA_integer_, label = paste0("c(", paste0(x1$finalStage, collapse = ", "), ")")) - expect_equal(x1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalPValues, collapse = ", "), ")")) - expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x1), NA))) - expect_output(print(x1)$show()) - invisible(capture.output(expect_error(summary(x1), NA))) - expect_output(summary(x1)$show()) - x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) - expect_equal(x1CodeBased$pi1, x1$pi1, tolerance = 1e-07) - expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-07) - expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x1), "character") - df <- as.data.frame(x1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeSmaller} - # @refFS[Formula]{fs:testStatisticGroupSequential} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:orderingPValueUpper} - # @refFS[Formula]{fs:finalCIOneRate} - # @refFS[Formula]{fs:medianUnbiasedEstimate} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - x2 <- getAnalysisResults( - design = design1, dataInput = dataExample1, - stage = 3, thetaH0 = 0.75, normalApproximation = TRUE, directionUpper = FALSE - ) - - ## Comparison of the results of AnalysisResultsGroupSequential object 'x2' with expected results - expect_equal(x2$pi1, 0.35, tolerance = 1e-07, label = paste0("c(", paste0(x2$pi1, collapse = ", "), ")")) - expect_equal(x2$testActions, c("continue", "reject and stop", "reject and stop", NA_character_), label = paste0("c(", paste0(x2$testActions, collapse = ", "), ")")) - expect_equal(x2$conditionalRejectionProbabilities, c(0.21465031, 0.55995383, 1, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x2$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower, collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(0.08898791, 0.19243551, 0.206358, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.81981977, 0.73748168, 0.52720845, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x2$repeatedPValues, c(0.47958473, 0.014066714, 1.9536724e-06, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues, collapse = ", "), ")")) - expect_equal(x2$finalStage, 2, label = paste0("c(", paste0(x2$finalStage, collapse = ", "), ")")) - expect_equal(x2$finalPValues, c(NA_real_, 0.0011783609, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalPValues, collapse = ", "), ")")) - expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, 0.18821106, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, 0.62661997, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, 0.40681825, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x2), NA))) - expect_output(print(x2)$show()) - invisible(capture.output(expect_error(summary(x2), NA))) - expect_output(summary(x2)$show()) - x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) - expect_equal(x2CodeBased$pi1, x2$pi1, tolerance = 1e-07) - expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) - expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-07) - expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-07) - expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x2), "character") - df <- as.data.frame(x2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateAlternativeSmaller} - # @refFS[Formula]{fs:testStatisticGroupSequential} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerOneRateEffect} - x3 <- getAnalysisResults( - design = design1, dataInput = dataExample1, - stage = 2, thetaH0 = 0.75, nPlanned = c(12, 6), pi1 = 0.5, - normalApproximation = FALSE, directionUpper = FALSE - ) - - ## Comparison of the results of AnalysisResultsGroupSequential object 'x3' with expected results - expect_equal(x3$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x3$testActions, collapse = ", "), ")")) - expect_equal(x3$conditionalRejectionProbabilities, c(0.13502024, 0.39663603, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x3$conditionalPower, c(NA_real_, NA_real_, 0.85193241, 0.94869662), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalPower, collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalLowerBounds, c(0.035340833, 0.15564775, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalUpperBounds, c(0.88809209, 0.77284164, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x3$repeatedPValues, c(0.49999905, 0.056127482, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues, collapse = ", "), ")")) - expect_equal(x3$finalStage, NA_integer_, label = paste0("c(", paste0(x3$finalStage, collapse = ", "), ")")) - expect_equal(x3$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalPValues, collapse = ", "), ")")) - expect_equal(x3$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x3$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x3$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x3), NA))) - expect_output(print(x3)$show()) - invisible(capture.output(expect_error(summary(x3), NA))) - expect_output(summary(x3)$show()) - x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) - expect_equal(x3CodeBased$testActions, x3$testActions, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) - expect_equal(x3CodeBased$finalStage, x3$finalStage, tolerance = 1e-07) - expect_equal(x3CodeBased$finalPValues, x3$finalPValues, tolerance = 1e-07) - expect_equal(x3CodeBased$finalConfidenceIntervalLowerBounds, x3$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$finalConfidenceIntervalUpperBounds, x3$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$medianUnbiasedEstimates, x3$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x3), "character") - df <- as.data.frame(x3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData1 <- testGetAnalysisResultsPlotData(x3, piTreatmentRange = seq(0.45, 0.75, 0.05)) - - ## Comparison of the results of list object 'plotData1' with expected results - expect_equal(plotData1$xValues, c(0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$xValues, collapse = ", "), ")")) - expect_equal(plotData1$condPowerValues, c(0.98024945, 0.94869662, 0.88988709, 0.79611571, 0.66506207, 0.50313626, 0.32784789), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData1$likelihoodValues, c(1, 0.9039239, 0.66761715, 0.40289032, 0.19865977, 0.080038099, 0.026347981), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData1$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData1$main, collapse = ", "), ")")) - expect_equal(plotData1$xlab, "pi1", label = paste0("c(", paste0(plotData1$xlab, collapse = ", "), ")")) - expect_equal(plotData1$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData1$ylab, collapse = ", "), ")")) - expect_equal(plotData1$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData1$sub, collapse = ", "), ")")) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeSmaller} - # @refFS[Formula]{fs:testStatisticGroupSequential} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:orderingPValueUpper} - # @refFS[Formula]{fs:medianUnbiasedEstimate} - # @refFS[Formula]{fs:finalCIOneRate} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerOneRateEffect} - x4 <- getAnalysisResults( - design = design1, dataInput = dataExample1, - stage = 2, thetaH0 = 0.75, nPlanned = c(12, 6), pi1 = 0.5, - normalApproximation = TRUE, directionUpper = FALSE - ) - - ## Comparison of the results of AnalysisResultsGroupSequential object 'x4' with expected results - expect_equal(x4$testActions, c("continue", "reject and stop", NA_character_, NA_character_), label = paste0("c(", paste0(x4$testActions, collapse = ", "), ")")) - expect_equal(x4$conditionalRejectionProbabilities, c(0.21465031, 0.55995383, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x4$conditionalPower, c(NA_real_, NA_real_, 0.9494174, 0.9843063), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalPower, collapse = ", "), ")")) - expect_equal(x4$repeatedConfidenceIntervalLowerBounds, c(0.08898791, 0.19243551, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x4$repeatedConfidenceIntervalUpperBounds, c(0.81981977, 0.73748168, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x4$repeatedPValues, c(0.47958473, 0.014066714, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedPValues, collapse = ", "), ")")) - expect_equal(x4$finalStage, 2, label = paste0("c(", paste0(x4$finalStage, collapse = ", "), ")")) - expect_equal(x4$finalPValues, c(NA_real_, 0.0011783609, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$finalPValues, collapse = ", "), ")")) - expect_equal(x4$finalConfidenceIntervalLowerBounds, c(NA_real_, 0.18821106, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x4$finalConfidenceIntervalUpperBounds, c(NA_real_, 0.62661997, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x4$medianUnbiasedEstimates, c(NA_real_, 0.40681825, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x4), NA))) - expect_output(print(x4)$show()) - invisible(capture.output(expect_error(summary(x4), NA))) - expect_output(summary(x4)$show()) - x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) - expect_equal(x4CodeBased$testActions, x4$testActions, tolerance = 1e-07) - expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-07) - expect_equal(x4CodeBased$finalStage, x4$finalStage, tolerance = 1e-07) - expect_equal(x4CodeBased$finalPValues, x4$finalPValues, tolerance = 1e-07) - expect_equal(x4CodeBased$finalConfidenceIntervalLowerBounds, x4$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$finalConfidenceIntervalUpperBounds, x4$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$medianUnbiasedEstimates, x4$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x4), "character") - df <- as.data.frame(x4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData2 <- testGetAnalysisResultsPlotData(x4, piTreatmentRange = seq(0.45, 0.75, 0.05)) - - ## Comparison of the results of list object 'plotData2' with expected results - expect_equal(plotData2$xValues, c(0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$xValues, collapse = ", "), ")")) - expect_equal(plotData2$condPowerValues, c(0.99501417, 0.9843063, 0.96005739, 0.91353722, 0.83535366, 0.71802165, 0.55995335), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData2$likelihoodValues, c(1, 0.9039239, 0.66761715, 0.40289032, 0.19865977, 0.080038099, 0.026347981), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData2$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData2$main, collapse = ", "), ")")) - expect_equal(plotData2$xlab, "pi1", label = paste0("c(", paste0(plotData2$xlab, collapse = ", "), ")")) - expect_equal(plotData2$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData2$ylab, collapse = ", "), ")")) - expect_equal(plotData2$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData2$sub, collapse = ", "), ")")) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} - # @refFS[Formula]{fs:testStatisticGroupSequential} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerOneRateEffect} - x5 <- getAnalysisResults( - design = design1, dataInput = dataExample1, - stage = 3, thetaH0 = 0.25, normalApproximation = FALSE, directionUpper = TRUE - ) - - ## Comparison of the results of AnalysisResultsGroupSequential object 'x5' with expected results - expect_equal(x5$pi1, 0.35, tolerance = 1e-07, label = paste0("c(", paste0(x5$pi1, collapse = ", "), ")")) - expect_equal(x5$testActions, c("continue", "continue", "continue", NA_character_), label = paste0("c(", paste0(x5$testActions, collapse = ", "), ")")) - expect_equal(x5$conditionalRejectionProbabilities, c(0.033369687, 0.13517192, 0.020135528, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x5$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$conditionalPower, collapse = ", "), ")")) - expect_equal(x5$repeatedConfidenceIntervalLowerBounds, c(0.035340833, 0.15564775, 0.18966473, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x5$repeatedConfidenceIntervalUpperBounds, c(0.88809209, 0.77284164, 0.53925561, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x5$repeatedPValues, c(0.49999905, 0.49999905, 0.20027888, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedPValues, collapse = ", "), ")")) - expect_equal(x5$finalStage, NA_integer_, label = paste0("c(", paste0(x5$finalStage, collapse = ", "), ")")) - expect_equal(x5$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$finalPValues, collapse = ", "), ")")) - expect_equal(x5$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x5$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x5$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x5), NA))) - expect_output(print(x5)$show()) - invisible(capture.output(expect_error(summary(x5), NA))) - expect_output(summary(x5)$show()) - x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) - expect_equal(x5CodeBased$pi1, x5$pi1, tolerance = 1e-07) - expect_equal(x5CodeBased$testActions, x5$testActions, tolerance = 1e-07) - expect_equal(x5CodeBased$conditionalRejectionProbabilities, x5$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x5CodeBased$conditionalPower, x5$conditionalPower, tolerance = 1e-07) - expect_equal(x5CodeBased$repeatedConfidenceIntervalLowerBounds, x5$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x5CodeBased$repeatedConfidenceIntervalUpperBounds, x5$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x5CodeBased$repeatedPValues, x5$repeatedPValues, tolerance = 1e-07) - expect_equal(x5CodeBased$finalStage, x5$finalStage, tolerance = 1e-07) - expect_equal(x5CodeBased$finalPValues, x5$finalPValues, tolerance = 1e-07) - expect_equal(x5CodeBased$finalConfidenceIntervalLowerBounds, x5$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x5CodeBased$finalConfidenceIntervalUpperBounds, x5$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x5CodeBased$medianUnbiasedEstimates, x5$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x5), "character") - df <- as.data.frame(x5) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x5) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} - # @refFS[Formula]{fs:testStatisticGroupSequential} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerOneRateEffect} - x6 <- getAnalysisResults( - design = design1, dataInput = dataExample1, - stage = 3, thetaH0 = 0.25, normalApproximation = TRUE, directionUpper = TRUE - ) - - ## Comparison of the results of AnalysisResultsGroupSequential object 'x6' with expected results - expect_equal(x6$pi1, 0.35, tolerance = 1e-07, label = paste0("c(", paste0(x6$pi1, collapse = ", "), ")")) - expect_equal(x6$testActions, c("continue", "continue", "continue", NA_character_), label = paste0("c(", paste0(x6$testActions, collapse = ", "), ")")) - expect_equal(x6$conditionalRejectionProbabilities, c(0.049321562, 0.20984263, 0.048813267, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x6$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$conditionalPower, collapse = ", "), ")")) - expect_equal(x6$repeatedConfidenceIntervalLowerBounds, c(0.08898791, 0.19243551, 0.206358, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x6$repeatedConfidenceIntervalUpperBounds, c(0.81981977, 0.73748168, 0.52720845, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x6$repeatedPValues, c(0.49999905, 0.27035282, 0.14086509, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedPValues, collapse = ", "), ")")) - expect_equal(x6$finalStage, NA_integer_, label = paste0("c(", paste0(x6$finalStage, collapse = ", "), ")")) - expect_equal(x6$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$finalPValues, collapse = ", "), ")")) - expect_equal(x6$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x6$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x6$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x6), NA))) - expect_output(print(x6)$show()) - invisible(capture.output(expect_error(summary(x6), NA))) - expect_output(summary(x6)$show()) - x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) - expect_equal(x6CodeBased$pi1, x6$pi1, tolerance = 1e-07) - expect_equal(x6CodeBased$testActions, x6$testActions, tolerance = 1e-07) - expect_equal(x6CodeBased$conditionalRejectionProbabilities, x6$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x6CodeBased$conditionalPower, x6$conditionalPower, tolerance = 1e-07) - expect_equal(x6CodeBased$repeatedConfidenceIntervalLowerBounds, x6$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x6CodeBased$repeatedConfidenceIntervalUpperBounds, x6$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x6CodeBased$repeatedPValues, x6$repeatedPValues, tolerance = 1e-07) - expect_equal(x6CodeBased$finalStage, x6$finalStage, tolerance = 1e-07) - expect_equal(x6CodeBased$finalPValues, x6$finalPValues, tolerance = 1e-07) - expect_equal(x6CodeBased$finalConfidenceIntervalLowerBounds, x6$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x6CodeBased$finalConfidenceIntervalUpperBounds, x6$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x6CodeBased$medianUnbiasedEstimates, x6$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x6), "character") - df <- as.data.frame(x6) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x6) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} - # @refFS[Formula]{fs:testStatisticGroupSequential} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerOneRateEffect} - x7 <- getAnalysisResults( - design = design1, dataInput = dataExample1, - stage = 2, thetaH0 = 0.25, nPlanned = c(12, 6), pi1 = 0.5, - normalApproximation = FALSE, directionUpper = TRUE - ) - - ## Comparison of the results of AnalysisResultsGroupSequential object 'x7' with expected results - expect_equal(x7$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x7$testActions, collapse = ", "), ")")) - expect_equal(x7$conditionalRejectionProbabilities, c(0.033369687, 0.13517192, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x7$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x7$conditionalPower, c(NA_real_, NA_real_, 0.58576815, 0.82581584), tolerance = 1e-07, label = paste0("c(", paste0(x7$conditionalPower, collapse = ", "), ")")) - expect_equal(x7$repeatedConfidenceIntervalLowerBounds, c(0.035340833, 0.15564775, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x7$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x7$repeatedConfidenceIntervalUpperBounds, c(0.88809209, 0.77284164, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x7$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x7$repeatedPValues, c(0.49999905, 0.49999905, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x7$repeatedPValues, collapse = ", "), ")")) - expect_equal(x7$finalStage, NA_integer_, label = paste0("c(", paste0(x7$finalStage, collapse = ", "), ")")) - expect_equal(x7$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$finalPValues, collapse = ", "), ")")) - expect_equal(x7$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x7$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x7$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x7), NA))) - expect_output(print(x7)$show()) - invisible(capture.output(expect_error(summary(x7), NA))) - expect_output(summary(x7)$show()) - x7CodeBased <- eval(parse(text = getObjectRCode(x7, stringWrapParagraphWidth = NULL))) - expect_equal(x7CodeBased$testActions, x7$testActions, tolerance = 1e-07) - expect_equal(x7CodeBased$conditionalRejectionProbabilities, x7$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x7CodeBased$conditionalPower, x7$conditionalPower, tolerance = 1e-07) - expect_equal(x7CodeBased$repeatedConfidenceIntervalLowerBounds, x7$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x7CodeBased$repeatedConfidenceIntervalUpperBounds, x7$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x7CodeBased$repeatedPValues, x7$repeatedPValues, tolerance = 1e-07) - expect_equal(x7CodeBased$finalStage, x7$finalStage, tolerance = 1e-07) - expect_equal(x7CodeBased$finalPValues, x7$finalPValues, tolerance = 1e-07) - expect_equal(x7CodeBased$finalConfidenceIntervalLowerBounds, x7$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x7CodeBased$finalConfidenceIntervalUpperBounds, x7$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x7CodeBased$medianUnbiasedEstimates, x7$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x7), "character") - df <- as.data.frame(x7) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x7) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData3 <- testGetAnalysisResultsPlotData(x7, piTreatmentRange = seq(0.25, 0.55, 0.05)) - - ## Comparison of the results of list object 'plotData3' with expected results - expect_equal(plotData3$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55), tolerance = 1e-07, label = paste0("c(", paste0(plotData3$xValues, collapse = ", "), ")")) - expect_equal(plotData3$condPowerValues, c(0.099723848, 0.21903134, 0.37478113, 0.54310492, 0.6994843, 0.82581584, 0.91388884), tolerance = 1e-07, label = paste0("c(", paste0(plotData3$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData3$likelihoodValues, c(0.19865977, 0.40289032, 0.66761715, 0.9039239, 1, 0.9039239, 0.66761715), tolerance = 1e-07, label = paste0("c(", paste0(plotData3$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData3$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData3$main, collapse = ", "), ")")) - expect_equal(plotData3$xlab, "pi1", label = paste0("c(", paste0(plotData3$xlab, collapse = ", "), ")")) - expect_equal(plotData3$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData3$ylab, collapse = ", "), ")")) - expect_equal(plotData3$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData3$sub, collapse = ", "), ")")) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} - # @refFS[Formula]{fs:testStatisticGroupSequential} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerOneRateEffect} - x8 <- getAnalysisResults( - design = design1, dataInput = dataExample1, - stage = 2, thetaH0 = 0.25, nPlanned = c(12, 6), pi1 = 0.5, - normalApproximation = TRUE, directionUpper = TRUE - ) - - ## Comparison of the results of AnalysisResultsGroupSequential object 'x8' with expected results - expect_equal(x8$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x8$testActions, collapse = ", "), ")")) - expect_equal(x8$conditionalRejectionProbabilities, c(0.049321562, 0.20984263, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x8$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x8$conditionalPower, c(NA_real_, NA_real_, 0.76152324, 0.91259792), tolerance = 1e-07, label = paste0("c(", paste0(x8$conditionalPower, collapse = ", "), ")")) - expect_equal(x8$repeatedConfidenceIntervalLowerBounds, c(0.08898791, 0.19243551, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x8$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x8$repeatedConfidenceIntervalUpperBounds, c(0.81981977, 0.73748168, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x8$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x8$repeatedPValues, c(0.49999905, 0.27035282, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x8$repeatedPValues, collapse = ", "), ")")) - expect_equal(x8$finalStage, NA_integer_, label = paste0("c(", paste0(x8$finalStage, collapse = ", "), ")")) - expect_equal(x8$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$finalPValues, collapse = ", "), ")")) - expect_equal(x8$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x8$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x8$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x8), NA))) - expect_output(print(x8)$show()) - invisible(capture.output(expect_error(summary(x8), NA))) - expect_output(summary(x8)$show()) - x8CodeBased <- eval(parse(text = getObjectRCode(x8, stringWrapParagraphWidth = NULL))) - expect_equal(x8CodeBased$testActions, x8$testActions, tolerance = 1e-07) - expect_equal(x8CodeBased$conditionalRejectionProbabilities, x8$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x8CodeBased$conditionalPower, x8$conditionalPower, tolerance = 1e-07) - expect_equal(x8CodeBased$repeatedConfidenceIntervalLowerBounds, x8$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x8CodeBased$repeatedConfidenceIntervalUpperBounds, x8$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x8CodeBased$repeatedPValues, x8$repeatedPValues, tolerance = 1e-07) - expect_equal(x8CodeBased$finalStage, x8$finalStage, tolerance = 1e-07) - expect_equal(x8CodeBased$finalPValues, x8$finalPValues, tolerance = 1e-07) - expect_equal(x8CodeBased$finalConfidenceIntervalLowerBounds, x8$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x8CodeBased$finalConfidenceIntervalUpperBounds, x8$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x8CodeBased$medianUnbiasedEstimates, x8$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x8), "character") - df <- as.data.frame(x8) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x8) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData4 <- testGetAnalysisResultsPlotData(x8, piTreatmentRange = seq(0.25, 0.55, 0.05)) - - ## Comparison of the results of list object 'plotData4' with expected results - expect_equal(plotData4$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$xValues, collapse = ", "), ")")) - expect_equal(plotData4$condPowerValues, c(0.20983879, 0.3743042, 0.5481143, 0.70471917, 0.82789376, 0.91259792, 0.96272982), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData4$likelihoodValues, c(0.19865977, 0.40289032, 0.66761715, 0.9039239, 1, 0.9039239, 0.66761715), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData4$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData4$main, collapse = ", "), ")")) - expect_equal(plotData4$xlab, "pi1", label = paste0("c(", paste0(plotData4$xlab, collapse = ", "), ")")) - expect_equal(plotData4$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData4$ylab, collapse = ", "), ")")) - expect_equal(plotData4$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData4$sub, collapse = ", "), ")")) - -}) - -test_that("'getAnalysisResults' for a four-stage inverse sequential design and one treatment", { - - .skipTestIfDisabled() - - design2 <- getDesignInverseNormal( - kMax = 4, alpha = 0.025, informationRates = c(0.2, 0.4, 0.8, 1), - futilityBounds = c(-0.5, 0, 0.5), typeOfDesign = "asKD", gammaA = 2.8 - ) - - dataExample2 <- getDataset( - n = c(8, 10, 9, 11), # cumsum, overall n = (8, 18, 27, 38) - events = c(4, 5, 5, 6) # cumsum, overall events = (4, 9, 14, 20) - ) - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} - # @refFS[Formula]{fs:testStatisticNormalCombinationTest} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - - x1 <- getAnalysisResults( - design = design2, dataInput = dataExample2, - stage = 3, thetaH0 = 0.75, normalApproximation = FALSE, directionUpper = FALSE - ) - - ## Comparison of the results of AnalysisResultsInverseNormal object 'x1' with expected results - expect_equal(x1$pi1, 0.51851852, tolerance = 1e-07, label = paste0("c(", paste0(x1$pi1, collapse = ", "), ")")) - expect_equal(x1$testActions, c("continue", "continue", "continue", NA_character_), label = paste0("c(", paste0(x1$testActions, collapse = ", "), ")")) - expect_equal(x1$conditionalRejectionProbabilities, c(0.055828725, 0.15918316, 0.28098687, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x1$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower, collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(0.046266926, 0.16132369, 0.26858957, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.95373307, 0.83867631, 0.76870127, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x1$repeatedPValues, c(0.49999905, 0.43799317, 0.045574143, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues, collapse = ", "), ")")) - expect_equal(x1$finalStage, NA_integer_, label = paste0("c(", paste0(x1$finalStage, collapse = ", "), ")")) - expect_equal(x1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalPValues, collapse = ", "), ")")) - expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x1), NA))) - expect_output(print(x1)$show()) - invisible(capture.output(expect_error(summary(x1), NA))) - expect_output(summary(x1)$show()) - x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) - expect_equal(x1CodeBased$pi1, x1$pi1, tolerance = 1e-07) - expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-07) - expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x1), "character") - df <- as.data.frame(x1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - .skipTestIfDisabled() - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} - # @refFS[Formula]{fs:testStatisticNormalCombinationTest} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:orderingPValueUpper} - # @refFS[Formula]{fs:finalCIOneRate} - # @refFS[Formula]{fs:medianUnbiasedEstimate} - x2 <- getAnalysisResults( - design = design2, dataInput = dataExample2, - stage = 3, thetaH0 = 0.75, normalApproximation = TRUE, directionUpper = FALSE - ) - - ## Comparison of the results of AnalysisResultsInverseNormal object 'x2' with expected results - expect_equal(x2$pi1, 0.51851852, tolerance = 1e-07, label = paste0("c(", paste0(x2$pi1, collapse = ", "), ")")) - expect_equal(x2$testActions, c("continue", "continue", "reject and stop", NA_character_), label = paste0("c(", paste0(x2$testActions, collapse = ", "), ")")) - expect_equal(x2$conditionalRejectionProbabilities, c(0.08807963, 0.32350578, 0.78413539, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x2$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower, collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(0.11314487, 0.21610036, 0.31861038, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.88685513, 0.78389964, 0.72001945, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x2$repeatedPValues, c(0.49999905, 0.1020964, 0.0075111702, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues, collapse = ", "), ")")) - expect_equal(x2$finalStage, 3, label = paste0("c(", paste0(x2$finalStage, collapse = ", "), ")")) - expect_equal(x2$finalPValues, c(NA_real_, NA_real_, 0.0050707339, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalPValues, collapse = ", "), ")")) - expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, 0.3041323, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, 0.68870859, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, NA_real_, 0.49547717, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x2), NA))) - expect_output(print(x2)$show()) - invisible(capture.output(expect_error(summary(x2), NA))) - expect_output(summary(x2)$show()) - x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) - expect_equal(x2CodeBased$pi1, x2$pi1, tolerance = 1e-07) - expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) - expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-07) - expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-07) - expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x2), "character") - df <- as.data.frame(x2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} - # @refFS[Formula]{fs:testStatisticNormalCombinationTest} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - x3 <- getAnalysisResults( - design = design2, dataInput = dataExample2, - stage = 2, thetaH0 = 0.75, nPlanned = c(12, 6), pi1 = 0.5, - normalApproximation = FALSE, directionUpper = FALSE - ) - - ## Comparison of the results of AnalysisResultsInverseNormal object 'x3' with expected results - expect_equal(x3$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x3$testActions, collapse = ", "), ")")) - expect_equal(x3$conditionalRejectionProbabilities, c(0.055828725, 0.15918316, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x3$conditionalPower, c(NA_real_, NA_real_, 0.69921202, 0.88465983), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalPower, collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalLowerBounds, c(0.046266926, 0.16132369, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalUpperBounds, c(0.95373307, 0.83867631, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x3$repeatedPValues, c(0.49999905, 0.43799317, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues, collapse = ", "), ")")) - expect_equal(x3$finalStage, NA_integer_, label = paste0("c(", paste0(x3$finalStage, collapse = ", "), ")")) - expect_equal(x3$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalPValues, collapse = ", "), ")")) - expect_equal(x3$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x3$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x3$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x3), NA))) - expect_output(print(x3)$show()) - invisible(capture.output(expect_error(summary(x3), NA))) - expect_output(summary(x3)$show()) - x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) - expect_equal(x3CodeBased$testActions, x3$testActions, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) - expect_equal(x3CodeBased$finalStage, x3$finalStage, tolerance = 1e-07) - expect_equal(x3CodeBased$finalPValues, x3$finalPValues, tolerance = 1e-07) - expect_equal(x3CodeBased$finalConfidenceIntervalLowerBounds, x3$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$finalConfidenceIntervalUpperBounds, x3$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$medianUnbiasedEstimates, x3$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x3), "character") - df <- as.data.frame(x3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData1 <- testGetAnalysisResultsPlotData(x3, piTreatmentRange = seq(0.45, 0.75, 0.05)) - - ## Comparison of the results of list object 'plotData1' with expected results - expect_equal(plotData1$xValues, c(0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$xValues, collapse = ", "), ")")) - expect_equal(plotData1$condPowerValues, c(0.94793138, 0.88465983, 0.78396384, 0.64581102, 0.48045808, 0.30888817, 0.15917802), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData1$likelihoodValues, c(0.91393119, 1, 0.91393119, 0.69767633, 0.44485807, 0.23692776, 0.10539922), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData1$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData1$main, collapse = ", "), ")")) - expect_equal(plotData1$xlab, "pi1", label = paste0("c(", paste0(plotData1$xlab, collapse = ", "), ")")) - expect_equal(plotData1$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData1$ylab, collapse = ", "), ")")) - expect_equal(plotData1$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData1$sub, collapse = ", "), ")")) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} - # @refFS[Formula]{fs:testStatisticNormalCombinationTest} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - x4 <- getAnalysisResults( - design = design2, dataInput = dataExample2, - stage = 2, thetaH0 = 0.75, nPlanned = c(12, 6), pi1 = 0.5, - normalApproximation = TRUE, directionUpper = FALSE - ) - - ## Comparison of the results of AnalysisResultsInverseNormal object 'x4' with expected results - expect_equal(x4$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x4$testActions, collapse = ", "), ")")) - expect_equal(x4$conditionalRejectionProbabilities, c(0.08807963, 0.32350578, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x4$conditionalPower, c(NA_real_, NA_real_, 0.85385983, 0.95015898), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalPower, collapse = ", "), ")")) - expect_equal(x4$repeatedConfidenceIntervalLowerBounds, c(0.11314487, 0.21610036, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x4$repeatedConfidenceIntervalUpperBounds, c(0.88685513, 0.78389964, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x4$repeatedPValues, c(0.49999905, 0.1020964, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedPValues, collapse = ", "), ")")) - expect_equal(x4$finalStage, NA_integer_, label = paste0("c(", paste0(x4$finalStage, collapse = ", "), ")")) - expect_equal(x4$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalPValues, collapse = ", "), ")")) - expect_equal(x4$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x4$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x4$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x4), NA))) - expect_output(print(x4)$show()) - invisible(capture.output(expect_error(summary(x4), NA))) - expect_output(summary(x4)$show()) - x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) - expect_equal(x4CodeBased$testActions, x4$testActions, tolerance = 1e-07) - expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-07) - expect_equal(x4CodeBased$finalStage, x4$finalStage, tolerance = 1e-07) - expect_equal(x4CodeBased$finalPValues, x4$finalPValues, tolerance = 1e-07) - expect_equal(x4CodeBased$finalConfidenceIntervalLowerBounds, x4$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$finalConfidenceIntervalUpperBounds, x4$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$medianUnbiasedEstimates, x4$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x4), "character") - df <- as.data.frame(x4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData2 <- testGetAnalysisResultsPlotData(x4, piTreatmentRange = seq(0.45, 0.75, 0.05)) - - ## Comparison of the results of list object 'plotData2' with expected results - expect_equal(plotData2$xValues, c(0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$xValues, collapse = ", "), ")")) - expect_equal(plotData2$condPowerValues, c(0.98088099, 0.95015898, 0.89232289, 0.79901831, 0.66708346, 0.50248974, 0.32350375), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData2$likelihoodValues, c(0.91393119, 1, 0.91393119, 0.69767633, 0.44485807, 0.23692776, 0.10539922), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData2$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData2$main, collapse = ", "), ")")) - expect_equal(plotData2$xlab, "pi1", label = paste0("c(", paste0(plotData2$xlab, collapse = ", "), ")")) - expect_equal(plotData2$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData2$ylab, collapse = ", "), ")")) - expect_equal(plotData2$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData2$sub, collapse = ", "), ")")) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} - # @refFS[Formula]{fs:testStatisticNormalCombinationTest} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - x5 <- getAnalysisResults( - design = design2, dataInput = dataExample2, - stage = 3, thetaH0 = 0.25, normalApproximation = FALSE, directionUpper = TRUE - ) - - ## Comparison of the results of AnalysisResultsInverseNormal object 'x5' with expected results - expect_equal(x5$pi1, 0.51851852, tolerance = 1e-07, label = paste0("c(", paste0(x5$pi1, collapse = ", "), ")")) - expect_equal(x5$testActions, c("continue", "continue", "reject and stop", NA_character_), label = paste0("c(", paste0(x5$testActions, collapse = ", "), ")")) - expect_equal(x5$conditionalRejectionProbabilities, c(0.055828725, 0.15918316, 0.65085211, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x5$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$conditionalPower, collapse = ", "), ")")) - expect_equal(x5$repeatedConfidenceIntervalLowerBounds, c(0.046266926, 0.16132369, 0.26858957, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x5$repeatedConfidenceIntervalUpperBounds, c(0.95373307, 0.83867631, 0.76870127, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x5$repeatedPValues, c(0.49999905, 0.43799317, 0.013282796, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedPValues, collapse = ", "), ")")) - expect_equal(x5$finalStage, 3, label = paste0("c(", paste0(x5$finalStage, collapse = ", "), ")")) - expect_equal(x5$finalPValues, c(NA_real_, NA_real_, 0.007752129, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$finalPValues, collapse = ", "), ")")) - expect_equal(x5$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, 0.29554194, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x5$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, 0.67875285, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x5$medianUnbiasedEstimates, c(NA_real_, NA_real_, 0.48769629, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x5), NA))) - expect_output(print(x5)$show()) - invisible(capture.output(expect_error(summary(x5), NA))) - expect_output(summary(x5)$show()) - x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) - expect_equal(x5CodeBased$pi1, x5$pi1, tolerance = 1e-07) - expect_equal(x5CodeBased$testActions, x5$testActions, tolerance = 1e-07) - expect_equal(x5CodeBased$conditionalRejectionProbabilities, x5$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x5CodeBased$conditionalPower, x5$conditionalPower, tolerance = 1e-07) - expect_equal(x5CodeBased$repeatedConfidenceIntervalLowerBounds, x5$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x5CodeBased$repeatedConfidenceIntervalUpperBounds, x5$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x5CodeBased$repeatedPValues, x5$repeatedPValues, tolerance = 1e-07) - expect_equal(x5CodeBased$finalStage, x5$finalStage, tolerance = 1e-07) - expect_equal(x5CodeBased$finalPValues, x5$finalPValues, tolerance = 1e-07) - expect_equal(x5CodeBased$finalConfidenceIntervalLowerBounds, x5$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x5CodeBased$finalConfidenceIntervalUpperBounds, x5$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x5CodeBased$medianUnbiasedEstimates, x5$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x5), "character") - df <- as.data.frame(x5) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x5) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} - # @refFS[Formula]{fs:testStatisticNormalCombinationTest} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - x6 <- getAnalysisResults( - design = design2, dataInput = dataExample2, - stage = 3, thetaH0 = 0.25, normalApproximation = TRUE, directionUpper = TRUE - ) - - ## Comparison of the results of AnalysisResultsInverseNormal object 'x6' with expected results - expect_equal(x6$pi1, 0.51851852, tolerance = 1e-07, label = paste0("c(", paste0(x6$pi1, collapse = ", "), ")")) - expect_equal(x6$testActions, c("continue", "continue", "reject and stop", NA_character_), label = paste0("c(", paste0(x6$testActions, collapse = ", "), ")")) - expect_equal(x6$conditionalRejectionProbabilities, c(0.08807963, 0.32350578, 0.96959663, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x6$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$conditionalPower, collapse = ", "), ")")) - expect_equal(x6$repeatedConfidenceIntervalLowerBounds, c(0.11314487, 0.21610036, 0.31861038, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x6$repeatedConfidenceIntervalUpperBounds, c(0.88685513, 0.78389964, 0.72001945, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x6$repeatedPValues, c(0.49999905, 0.1020964, 0.0013103922, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedPValues, collapse = ", "), ")")) - expect_equal(x6$finalStage, 3, label = paste0("c(", paste0(x6$finalStage, collapse = ", "), ")")) - expect_equal(x6$finalPValues, c(NA_real_, NA_real_, 0.002378519, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$finalPValues, collapse = ", "), ")")) - expect_equal(x6$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, 0.3437363, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x6$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, 0.73847376, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x6$medianUnbiasedEstimates, c(NA_real_, NA_real_, 0.54446903, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x6), NA))) - expect_output(print(x6)$show()) - invisible(capture.output(expect_error(summary(x6), NA))) - expect_output(summary(x6)$show()) - x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) - expect_equal(x6CodeBased$pi1, x6$pi1, tolerance = 1e-07) - expect_equal(x6CodeBased$testActions, x6$testActions, tolerance = 1e-07) - expect_equal(x6CodeBased$conditionalRejectionProbabilities, x6$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x6CodeBased$conditionalPower, x6$conditionalPower, tolerance = 1e-07) - expect_equal(x6CodeBased$repeatedConfidenceIntervalLowerBounds, x6$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x6CodeBased$repeatedConfidenceIntervalUpperBounds, x6$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x6CodeBased$repeatedPValues, x6$repeatedPValues, tolerance = 1e-07) - expect_equal(x6CodeBased$finalStage, x6$finalStage, tolerance = 1e-07) - expect_equal(x6CodeBased$finalPValues, x6$finalPValues, tolerance = 1e-07) - expect_equal(x6CodeBased$finalConfidenceIntervalLowerBounds, x6$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x6CodeBased$finalConfidenceIntervalUpperBounds, x6$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x6CodeBased$medianUnbiasedEstimates, x6$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x6), "character") - df <- as.data.frame(x6) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x6) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerOneRateEffect} - x7 <- getAnalysisResults( - design = design2, dataInput = dataExample2, - stage = 2, thetaH0 = 0.25, nPlanned = c(12, 6), pi1 = 0.5, - normalApproximation = FALSE, directionUpper = TRUE - ) - - ## Comparison of the results of AnalysisResultsInverseNormal object 'x7' with expected results - expect_equal(x7$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x7$testActions, collapse = ", "), ")")) - expect_equal(x7$conditionalRejectionProbabilities, c(0.055828725, 0.15918316, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x7$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x7$conditionalPower, c(NA_real_, NA_real_, 0.69921202, 0.88465983), tolerance = 1e-07, label = paste0("c(", paste0(x7$conditionalPower, collapse = ", "), ")")) - expect_equal(x7$repeatedConfidenceIntervalLowerBounds, c(0.046266926, 0.16132369, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x7$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x7$repeatedConfidenceIntervalUpperBounds, c(0.95373307, 0.83867631, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x7$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x7$repeatedPValues, c(0.49999905, 0.43799317, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x7$repeatedPValues, collapse = ", "), ")")) - expect_equal(x7$finalStage, NA_integer_, label = paste0("c(", paste0(x7$finalStage, collapse = ", "), ")")) - expect_equal(x7$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$finalPValues, collapse = ", "), ")")) - expect_equal(x7$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x7$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x7$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x7), NA))) - expect_output(print(x7)$show()) - invisible(capture.output(expect_error(summary(x7), NA))) - expect_output(summary(x7)$show()) - x7CodeBased <- eval(parse(text = getObjectRCode(x7, stringWrapParagraphWidth = NULL))) - expect_equal(x7CodeBased$testActions, x7$testActions, tolerance = 1e-07) - expect_equal(x7CodeBased$conditionalRejectionProbabilities, x7$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x7CodeBased$conditionalPower, x7$conditionalPower, tolerance = 1e-07) - expect_equal(x7CodeBased$repeatedConfidenceIntervalLowerBounds, x7$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x7CodeBased$repeatedConfidenceIntervalUpperBounds, x7$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x7CodeBased$repeatedPValues, x7$repeatedPValues, tolerance = 1e-07) - expect_equal(x7CodeBased$finalStage, x7$finalStage, tolerance = 1e-07) - expect_equal(x7CodeBased$finalPValues, x7$finalPValues, tolerance = 1e-07) - expect_equal(x7CodeBased$finalConfidenceIntervalLowerBounds, x7$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x7CodeBased$finalConfidenceIntervalUpperBounds, x7$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x7CodeBased$medianUnbiasedEstimates, x7$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x7), "character") - df <- as.data.frame(x7) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x7) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData3 <- testGetAnalysisResultsPlotData(x7, piTreatmentRange = seq(0.25, 0.55, 0.05)) - - ## Comparison of the results of list object 'plotData3' with expected results - expect_equal(plotData3$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55), tolerance = 1e-07, label = paste0("c(", paste0(plotData3$xValues, collapse = ", "), ")")) - expect_equal(plotData3$condPowerValues, c(0.15917802, 0.30888817, 0.48045808, 0.64581102, 0.78396384, 0.88465983, 0.94793138), tolerance = 1e-07, label = paste0("c(", paste0(plotData3$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData3$likelihoodValues, c(0.10539922, 0.23692776, 0.44485807, 0.69767633, 0.91393119, 1, 0.91393119), tolerance = 1e-07, label = paste0("c(", paste0(plotData3$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData3$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData3$main, collapse = ", "), ")")) - expect_equal(plotData3$xlab, "pi1", label = paste0("c(", paste0(plotData3$xlab, collapse = ", "), ")")) - expect_equal(plotData3$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData3$ylab, collapse = ", "), ")")) - expect_equal(plotData3$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData3$sub, collapse = ", "), ")")) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerOneRateEffect} - x8 <- getAnalysisResults( - design = design2, dataInput = dataExample2, - stage = 2, thetaH0 = 0.25, nPlanned = c(12, 6), pi1 = 0.5, - normalApproximation = TRUE, directionUpper = TRUE - ) - - ## Comparison of the results of AnalysisResultsInverseNormal object 'x8' with expected results - expect_equal(x8$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x8$testActions, collapse = ", "), ")")) - expect_equal(x8$conditionalRejectionProbabilities, c(0.08807963, 0.32350578, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x8$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x8$conditionalPower, c(NA_real_, NA_real_, 0.85385983, 0.95015898), tolerance = 1e-07, label = paste0("c(", paste0(x8$conditionalPower, collapse = ", "), ")")) - expect_equal(x8$repeatedConfidenceIntervalLowerBounds, c(0.11314487, 0.21610036, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x8$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x8$repeatedConfidenceIntervalUpperBounds, c(0.88685513, 0.78389964, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x8$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x8$repeatedPValues, c(0.49999905, 0.1020964, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x8$repeatedPValues, collapse = ", "), ")")) - expect_equal(x8$finalStage, NA_integer_, label = paste0("c(", paste0(x8$finalStage, collapse = ", "), ")")) - expect_equal(x8$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$finalPValues, collapse = ", "), ")")) - expect_equal(x8$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x8$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x8$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x8), NA))) - expect_output(print(x8)$show()) - invisible(capture.output(expect_error(summary(x8), NA))) - expect_output(summary(x8)$show()) - x8CodeBased <- eval(parse(text = getObjectRCode(x8, stringWrapParagraphWidth = NULL))) - expect_equal(x8CodeBased$testActions, x8$testActions, tolerance = 1e-07) - expect_equal(x8CodeBased$conditionalRejectionProbabilities, x8$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x8CodeBased$conditionalPower, x8$conditionalPower, tolerance = 1e-07) - expect_equal(x8CodeBased$repeatedConfidenceIntervalLowerBounds, x8$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x8CodeBased$repeatedConfidenceIntervalUpperBounds, x8$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x8CodeBased$repeatedPValues, x8$repeatedPValues, tolerance = 1e-07) - expect_equal(x8CodeBased$finalStage, x8$finalStage, tolerance = 1e-07) - expect_equal(x8CodeBased$finalPValues, x8$finalPValues, tolerance = 1e-07) - expect_equal(x8CodeBased$finalConfidenceIntervalLowerBounds, x8$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x8CodeBased$finalConfidenceIntervalUpperBounds, x8$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x8CodeBased$medianUnbiasedEstimates, x8$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x8), "character") - df <- as.data.frame(x8) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x8) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData4 <- testGetAnalysisResultsPlotData(x8, piTreatmentRange = seq(0.25, 0.55, 0.05)) - - ## Comparison of the results of list object 'plotData4' with expected results - expect_equal(plotData4$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$xValues, collapse = ", "), ")")) - expect_equal(plotData4$condPowerValues, c(0.32350375, 0.50248974, 0.66708346, 0.79901831, 0.89232289, 0.95015898, 0.98088099), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData4$likelihoodValues, c(0.10539922, 0.23692776, 0.44485807, 0.69767633, 0.91393119, 1, 0.91393119), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData4$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData4$main, collapse = ", "), ")")) - expect_equal(plotData4$xlab, "pi1", label = paste0("c(", paste0(plotData4$xlab, collapse = ", "), ")")) - expect_equal(plotData4$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData4$ylab, collapse = ", "), ")")) - expect_equal(plotData4$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData4$sub, collapse = ", "), ")")) - -}) - -test_that("'getAnalysisResults' for a four-stage Fisher design and one treatment", { - - .skipTestIfDisabled() - - design3 <- getDesignFisher(kMax = 4, alpha = 0.025, informationRates = c(0.2, 0.4, 0.8, 1)) - - dataExample3 <- getDataset( - n = c(8, 10, 9, 11), # cumsum, overall n = (8, 18, 27, 38) - events = c(4, 5, 5, 6) # cumsum, overall events = (4, 9, 14, 20) - ) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} - # @refFS[Formula]{fs:testStatisticFisherCombinationTest} - # @refFS[Formula]{fs:definitionRCIFisherCombination} - # @refFS[Formula]{fs:calculationRepeatedpValue} - x1 <- getAnalysisResults( - design = design3, dataInput = dataExample3, - stage = 3, thetaH0 = 0.75, normalApproximation = FALSE, - directionUpper = FALSE, iterations = 1000, seed = 123 - ) - - ## Comparison of the results of AnalysisResultsFisher object 'x1' with expected results - expect_equal(x1$pi1, 0.51851852, tolerance = 1e-07, label = paste0("c(", paste0(x1$pi1, collapse = ", "), ")")) - expect_equal(x1$testActions, c("continue", "continue", "continue", NA_character_), label = paste0("c(", paste0(x1$testActions, collapse = ", "), ")")) - expect_equal(x1$conditionalRejectionProbabilities, c(0.027980027, 0.040164764, 0.018233808, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x1$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower, collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(0.12025548, 0.19023888, 0.23521677, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.87974452, 0.80976112, 0.79971589, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x1$repeatedPValues, c(0.23393398, 0.11483365, 0.11050779, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues, collapse = ", "), ")")) - expect_equal(x1$finalStage, NA_integer_, label = paste0("c(", paste0(x1$finalStage, collapse = ", "), ")")) - expect_equal(x1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalPValues, collapse = ", "), ")")) - expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x1), NA))) - expect_output(print(x1)$show()) - invisible(capture.output(expect_error(summary(x1), NA))) - expect_output(summary(x1)$show()) - x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) - expect_equal(x1CodeBased$pi1, x1$pi1, tolerance = 1e-07) - expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-07) - expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x1), "character") - df <- as.data.frame(x1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} - # @refFS[Formula]{fs:testStatisticFisherCombinationTest} - # @refFS[Formula]{fs:definitionRCIFisherCombination} - # @refFS[Formula]{fs:calculationRepeatedpValue} - x2 <- getAnalysisResults( - design = design3, dataInput = dataExample3, - stage = 3, thetaH0 = 0.75, normalApproximation = TRUE, - directionUpper = FALSE, iterations = 1000, seed = 123 - ) - - ## Comparison of the results of AnalysisResultsFisher object 'x2' with expected results - expect_equal(x2$pi1, 0.51851852, tolerance = 1e-07, label = paste0("c(", paste0(x2$pi1, collapse = ", "), ")")) - expect_equal(x2$testActions, c("continue", "continue", "reject and stop", NA_character_), label = paste0("c(", paste0(x2$testActions, collapse = ", "), ")")) - expect_equal(x2$conditionalRejectionProbabilities, c(0.051264101, 0.1206033, 1, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x2$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower, collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(0.18175814, 0.2424364, 0.28642867, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.81824186, 0.7575636, 0.7496417, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x2$repeatedPValues, c(0.11554509, 0.032131177, 0.024656293, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues, collapse = ", "), ")")) - expect_equal(x2$finalStage, NA_integer_, label = paste0("c(", paste0(x2$finalStage, collapse = ", "), ")")) - expect_equal(x2$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalPValues, collapse = ", "), ")")) - expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x2), NA))) - expect_output(print(x2)$show()) - invisible(capture.output(expect_error(summary(x2), NA))) - expect_output(summary(x2)$show()) - x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) - expect_equal(x2CodeBased$pi1, x2$pi1, tolerance = 1e-07) - expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) - expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-07) - expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-07) - expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x2), "character") - df <- as.data.frame(x2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} - # @refFS[Formula]{fs:testStatisticFisherCombinationTest} - # @refFS[Formula]{fs:definitionRCIFisherCombination} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionFisherInterim} - x3 <- getAnalysisResults( - design = design3, dataInput = dataExample3, - stage = 2, thetaH0 = 0.75, nPlanned = c(12, 6), pi1 = 0.5, normalApproximation = FALSE, - directionUpper = FALSE, iterations = 1000, seed = 123 - ) - - ## Comparison of the results of AnalysisResultsFisher object 'x3' with expected results - expect_equal(x3$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x3$testActions, collapse = ", "), ")")) - expect_equal(x3$conditionalRejectionProbabilities, c(0.027980027, 0.040164764, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalLowerBounds, c(0.12025548, 0.19023888, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalUpperBounds, c(0.87974452, 0.80976112, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x3$repeatedPValues, c(0.23393398, 0.11483365, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues, collapse = ", "), ")")) - expect_equal(x3$finalStage, NA_integer_, label = paste0("c(", paste0(x3$finalStage, collapse = ", "), ")")) - expect_equal(x3$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalPValues, collapse = ", "), ")")) - expect_equal(x3$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x3$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x3$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$medianUnbiasedEstimates, collapse = ", "), ")")) - expect_equal(x3$conditionalPowerSimulated, c(NA_real_, NA_real_, 0.522, 0.672), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalPowerSimulated, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x3), NA))) - expect_output(print(x3)$show()) - invisible(capture.output(expect_error(summary(x3), NA))) - expect_output(summary(x3)$show()) - x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) - expect_equal(x3CodeBased$testActions, x3$testActions, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) - expect_equal(x3CodeBased$finalStage, x3$finalStage, tolerance = 1e-07) - expect_equal(x3CodeBased$finalPValues, x3$finalPValues, tolerance = 1e-07) - expect_equal(x3CodeBased$finalConfidenceIntervalLowerBounds, x3$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$finalConfidenceIntervalUpperBounds, x3$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$medianUnbiasedEstimates, x3$medianUnbiasedEstimates, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalPowerSimulated, x3$conditionalPowerSimulated, tolerance = 1e-07) - expect_type(names(x3), "character") - df <- as.data.frame(x3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData1 <- testGetAnalysisResultsPlotData(x3, piTreatmentRange = seq(0.25, 0.55, 0.05)) - - ## Comparison of the results of list object 'plotData1' with expected results - expect_equal(plotData1$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$xValues, collapse = ", "), ")")) - expect_equal(plotData1$condPowerValues, c(0.997, 0.99, 0.967, 0.9, 0.822, 0.659, 0.534), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData1$likelihoodValues, c(0.10539922, 0.23692776, 0.44485807, 0.69767633, 0.91393119, 1, 0.91393119), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData1$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData1$main, collapse = ", "), ")")) - expect_equal(plotData1$xlab, "pi1", label = paste0("c(", paste0(plotData1$xlab, collapse = ", "), ")")) - expect_equal(plotData1$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData1$ylab, collapse = ", "), ")")) - expect_equal(plotData1$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData1$sub, collapse = ", "), ")")) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} - # @refFS[Formula]{fs:testStatisticFisherCombinationTest} - # @refFS[Formula]{fs:definitionRCIFisherCombination} - # @refFS[Formula]{fs:calculationRepeatedpValue} - x4 <- getAnalysisResults( - design = design3, dataInput = dataExample3, - stage = 3, thetaH0 = 0.25, normalApproximation = FALSE, - directionUpper = TRUE, iterations = 1000, seed = 123 - ) - - ## Comparison of the results of AnalysisResultsFisher object 'x4' with expected results - expect_equal(x4$pi1, 0.51851852, tolerance = 1e-07, label = paste0("c(", paste0(x4$pi1, collapse = ", "), ")")) - expect_equal(x4$testActions, c("continue", "continue", "continue", NA_character_), label = paste0("c(", paste0(x4$testActions, collapse = ", "), ")")) - expect_equal(x4$conditionalRejectionProbabilities, c(0.027980027, 0.040164764, 0.10237226, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x4$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$conditionalPower, collapse = ", "), ")")) - expect_equal(x4$repeatedConfidenceIntervalLowerBounds, c(0.12025548, 0.19023888, 0.23521677, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x4$repeatedConfidenceIntervalUpperBounds, c(0.87974452, 0.80976112, 0.79971589, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x4$repeatedPValues, c(0.23393398, 0.11483365, 0.040061917, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedPValues, collapse = ", "), ")")) - expect_equal(x4$finalStage, NA_integer_, label = paste0("c(", paste0(x4$finalStage, collapse = ", "), ")")) - expect_equal(x4$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalPValues, collapse = ", "), ")")) - expect_equal(x4$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x4$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x4$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x4), NA))) - expect_output(print(x4)$show()) - invisible(capture.output(expect_error(summary(x4), NA))) - expect_output(summary(x4)$show()) - x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) - expect_equal(x4CodeBased$pi1, x4$pi1, tolerance = 1e-07) - expect_equal(x4CodeBased$testActions, x4$testActions, tolerance = 1e-07) - expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-07) - expect_equal(x4CodeBased$finalStage, x4$finalStage, tolerance = 1e-07) - expect_equal(x4CodeBased$finalPValues, x4$finalPValues, tolerance = 1e-07) - expect_equal(x4CodeBased$finalConfidenceIntervalLowerBounds, x4$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$finalConfidenceIntervalUpperBounds, x4$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$medianUnbiasedEstimates, x4$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x4), "character") - df <- as.data.frame(x4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} - # @refFS[Formula]{fs:testStatisticFisherCombinationTest} - # @refFS[Formula]{fs:definitionRCIFisherCombination} - # @refFS[Formula]{fs:calculationRepeatedpValue} - x5 <- getAnalysisResults( - design = design3, dataInput = dataExample3, - stage = 3, thetaH0 = 0.25, normalApproximation = TRUE, - directionUpper = TRUE, iterations = 1000, seed = 123 - ) - - ## Comparison of the results of AnalysisResultsFisher object 'x5' with expected results - expect_equal(x5$pi1, 0.51851852, tolerance = 1e-07, label = paste0("c(", paste0(x5$pi1, collapse = ", "), ")")) - expect_equal(x5$testActions, c("continue", "continue", "reject and stop", NA_character_), label = paste0("c(", paste0(x5$testActions, collapse = ", "), ")")) - expect_equal(x5$conditionalRejectionProbabilities, c(0.051264101, 0.1206033, 1, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x5$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$conditionalPower, collapse = ", "), ")")) - expect_equal(x5$repeatedConfidenceIntervalLowerBounds, c(0.18175814, 0.2424364, 0.28642867, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x5$repeatedConfidenceIntervalUpperBounds, c(0.81824186, 0.7575636, 0.7496417, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x5$repeatedPValues, c(0.11554509, 0.032131177, 0.0055275316, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedPValues, collapse = ", "), ")")) - expect_equal(x5$finalStage, NA_integer_, label = paste0("c(", paste0(x5$finalStage, collapse = ", "), ")")) - expect_equal(x5$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$finalPValues, collapse = ", "), ")")) - expect_equal(x5$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x5$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x5$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x5), NA))) - expect_output(print(x5)$show()) - invisible(capture.output(expect_error(summary(x5), NA))) - expect_output(summary(x5)$show()) - x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) - expect_equal(x5CodeBased$pi1, x5$pi1, tolerance = 1e-07) - expect_equal(x5CodeBased$testActions, x5$testActions, tolerance = 1e-07) - expect_equal(x5CodeBased$conditionalRejectionProbabilities, x5$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x5CodeBased$conditionalPower, x5$conditionalPower, tolerance = 1e-07) - expect_equal(x5CodeBased$repeatedConfidenceIntervalLowerBounds, x5$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x5CodeBased$repeatedConfidenceIntervalUpperBounds, x5$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x5CodeBased$repeatedPValues, x5$repeatedPValues, tolerance = 1e-07) - expect_equal(x5CodeBased$finalStage, x5$finalStage, tolerance = 1e-07) - expect_equal(x5CodeBased$finalPValues, x5$finalPValues, tolerance = 1e-07) - expect_equal(x5CodeBased$finalConfidenceIntervalLowerBounds, x5$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x5CodeBased$finalConfidenceIntervalUpperBounds, x5$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x5CodeBased$medianUnbiasedEstimates, x5$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x5), "character") - df <- as.data.frame(x5) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x5) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} - # @refFS[Formula]{fs:testStatisticOneRateApproximation} - # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} - # @refFS[Formula]{fs:testStatisticFisherCombinationTest} - # @refFS[Formula]{fs:definitionRCIFisherCombination} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionFisherInterim} - x6 <- getAnalysisResults( - design = design3, dataInput = dataExample3, - stage = 2, thetaH0 = 0.25, nPlanned = c(12, 6), pi1 = 0.5, normalApproximation = FALSE, - directionUpper = TRUE, iterations = 1000, seed = 123 - ) - - ## Comparison of the results of AnalysisResultsFisher object 'x6' with expected results - expect_equal(x6$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x6$testActions, collapse = ", "), ")")) - expect_equal(x6$conditionalRejectionProbabilities, c(0.027980027, 0.040164764, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x6$repeatedConfidenceIntervalLowerBounds, c(0.12025548, 0.19023888, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x6$repeatedConfidenceIntervalUpperBounds, c(0.87974452, 0.80976112, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x6$repeatedPValues, c(0.23393398, 0.11483365, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedPValues, collapse = ", "), ")")) - expect_equal(x6$finalStage, NA_integer_, label = paste0("c(", paste0(x6$finalStage, collapse = ", "), ")")) - expect_equal(x6$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$finalPValues, collapse = ", "), ")")) - expect_equal(x6$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x6$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x6$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$medianUnbiasedEstimates, collapse = ", "), ")")) - expect_equal(x6$conditionalPowerSimulated, c(NA_real_, NA_real_, 0.522, 0.672), tolerance = 1e-07, label = paste0("c(", paste0(x6$conditionalPowerSimulated, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x6), NA))) - expect_output(print(x6)$show()) - invisible(capture.output(expect_error(summary(x6), NA))) - expect_output(summary(x6)$show()) - x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) - expect_equal(x6CodeBased$testActions, x6$testActions, tolerance = 1e-07) - expect_equal(x6CodeBased$conditionalRejectionProbabilities, x6$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x6CodeBased$repeatedConfidenceIntervalLowerBounds, x6$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x6CodeBased$repeatedConfidenceIntervalUpperBounds, x6$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x6CodeBased$repeatedPValues, x6$repeatedPValues, tolerance = 1e-07) - expect_equal(x6CodeBased$finalStage, x6$finalStage, tolerance = 1e-07) - expect_equal(x6CodeBased$finalPValues, x6$finalPValues, tolerance = 1e-07) - expect_equal(x6CodeBased$finalConfidenceIntervalLowerBounds, x6$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x6CodeBased$finalConfidenceIntervalUpperBounds, x6$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x6CodeBased$medianUnbiasedEstimates, x6$medianUnbiasedEstimates, tolerance = 1e-07) - expect_equal(x6CodeBased$conditionalPowerSimulated, x6$conditionalPowerSimulated, tolerance = 1e-07) - expect_type(names(x6), "character") - df <- as.data.frame(x6) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x6) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData2 <- testGetAnalysisResultsPlotData(x6, piTreatmentRange = seq(0.25, 0.55, 0.05)) - - ## Comparison of the results of list object 'plotData2' with expected results - expect_equal(plotData2$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$xValues, collapse = ", "), ")")) - expect_equal(plotData2$condPowerValues, c(0.039, 0.114, 0.208, 0.363, 0.54, 0.659, 0.817), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData2$likelihoodValues, c(0.10539922, 0.23692776, 0.44485807, 0.69767633, 0.91393119, 1, 0.91393119), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData2$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData2$main, collapse = ", "), ")")) - expect_equal(plotData2$xlab, "pi1", label = paste0("c(", paste0(plotData2$xlab, collapse = ", "), ")")) - expect_equal(plotData2$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData2$ylab, collapse = ", "), ")")) - expect_equal(plotData2$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData2$sub, collapse = ", "), ")")) - -}) - -test_plan_section("Testing the Analysis Rates Functionality for Two Treatments") - - -test_that("'getAnalysisResults' for a four-stage group sequential design and two treatments", { - .skipTestIfDisabled() - - design7 <- getDesignGroupSequential( - kMax = 4, alpha = 0.025, - typeOfDesign = "WT", deltaWT = 0.25, informationRates = c(0.2, 0.4, 0.8, 1), - futilityBounds = c(0, 0.5, 0.8), bindingFutility = TRUE - ) - - dataExample5 <- getDataset( - n1 = c(17, 18, 22), - n2 = c(18, 17, 19), - events1 = c(11, 12, 17), - events2 = c(5, 10, 7) - ) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} - # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} - # @refFS[Formula]{fs:testStatisticGroupSequential} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} - # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} - x1 <- getAnalysisResults(design7, dataExample5, - thetaH0 = 0, stage = 2, nPlanned = c(60, 30), - pi2 = 0.4, pi1 = 0.8, directionUpper = TRUE, allocationRatioPlanned = 2 - ) - - ## Comparison of the results of AnalysisResultsGroupSequential object 'x1' with expected results - expect_equal(x1$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x1$testActions, collapse = ", "), ")")) - expect_equal(x1$conditionalRejectionProbabilities, c(0.19002543, 0.18837824, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x1$conditionalPower, c(NA_real_, NA_real_, 0.97639752, 0.99770454), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPower, collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(-0.14000084, -0.07626859, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.72492429, 0.4944942, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x1$repeatedPValues, c(0.083297609, 0.074571507, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues, collapse = ", "), ")")) - expect_equal(x1$finalStage, NA_integer_, label = paste0("c(", paste0(x1$finalStage, collapse = ", "), ")")) - expect_equal(x1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalPValues, collapse = ", "), ")")) - expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x1), NA))) - expect_output(print(x1)$show()) - invisible(capture.output(expect_error(summary(x1), NA))) - expect_output(summary(x1)$show()) - x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) - expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-07) - expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x1), "character") - df <- as.data.frame(x1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData1 <- testGetAnalysisResultsPlotData(x1, piTreatmentRange = seq(0.5, 0.8, 0.05), allocationRatioPlanned = 2) - - ## Comparison of the results of list object 'plotData1' with expected results - expect_equal(plotData1$xValues, c(0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$xValues, collapse = ", "), ")")) - expect_equal(plotData1$condPowerValues, c(0.47726473, 0.64780315, 0.79588169, 0.90153211, 0.96202912, 0.98889368, 0.99770454), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData1$likelihoodValues, c(0.14689674, 0.40998118, 0.77598415, 0.99604498, 0.86704618, 0.51184997, 0.20491809), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData1$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData1$main, collapse = ", "), ")")) - expect_equal(plotData1$xlab, "pi1", label = paste0("c(", paste0(plotData1$xlab, collapse = ", "), ")")) - expect_equal(plotData1$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData1$ylab, collapse = ", "), ")")) - expect_equal(plotData1$sub, "Stage = 2, # of remaining subjects = 90, pi2 = 0.4, allocation ratio = 2", label = paste0("c(", paste0(plotData1$sub, collapse = ", "), ")")) - - # reversed "directionUpper" - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} - # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} - # @refFS[Formula]{fs:testStatisticGroupSequential} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} - # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} - - x2 <- getAnalysisResults(design7, dataExample5, - thetaH0 = 0, stage = 2, nPlanned = c(60, 30), - pi2 = 0.8, pi1 = 0.4, directionUpper = FALSE, allocationRatioPlanned = 0.5 - ) - - ## Comparison of the results of AnalysisResultsGroupSequential object 'x2' with expected results - expect_equal(x2$testActions, c("accept and stop", "accept and stop", NA_character_, NA_character_), label = paste0("c(", paste0(x2$testActions, collapse = ", "), ")")) - expect_equal(x2$conditionalRejectionProbabilities, c(0, 0, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x2$conditionalPower, c(NA_real_, NA_real_, 0.037603851, 0.34743098), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalPower, collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(-0.14000084, -0.07626859, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.72492429, 0.4944942, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x2$repeatedPValues, c(0.49999905, 0.49999905, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues, collapse = ", "), ")")) - expect_equal(x2$finalStage, 1, label = paste0("c(", paste0(x2$finalStage, collapse = ", "), ")")) - expect_equal(x2$finalPValues, c(0.98580558, NA_real_, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalPValues, collapse = ", "), ")")) - expect_equal(x2$finalConfidenceIntervalLowerBounds, c(0.039328966, NA_real_, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x2$finalConfidenceIntervalUpperBounds, c(0.62730979, NA_real_, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x2$medianUnbiasedEstimates, c(0.36928105, NA_real_, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x2), NA))) - expect_output(print(x2)$show()) - invisible(capture.output(expect_error(summary(x2), NA))) - expect_output(summary(x2)$show()) - x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) - expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) - expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-07) - expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-07) - expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x2), "character") - df <- as.data.frame(x2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData2 <- testGetAnalysisResultsPlotData(x2, piTreatmentRange = seq(0.2, 0.5, 0.05), allocationRatioPlanned = 0.5) - - ## Comparison of the results of list object 'plotData2' with expected results - expect_equal(plotData2$xValues, c(0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$xValues, collapse = ", "), ")")) - expect_equal(plotData2$condPowerValues, c(0.98964948, 0.93182725, 0.78360503, 0.56553646, 0.34743098, 0.18277547, 0.082851862), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData2$likelihoodValues, c(8.9244677e-08, 2.5604189e-06, 4.9816924e-05, 0.00065732471, 0.0058819346, 0.035694195, 0.14689674), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData2$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData2$main, collapse = ", "), ")")) - expect_equal(plotData2$xlab, "pi1", label = paste0("c(", paste0(plotData2$xlab, collapse = ", "), ")")) - expect_equal(plotData2$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData2$ylab, collapse = ", "), ")")) - expect_equal(plotData2$sub, "Stage = 2, # of remaining subjects = 90, pi2 = 0.8, allocation ratio = 0.5", label = paste0("c(", paste0(plotData2$sub, collapse = ", "), ")")) - -}) - -test_that("'getAnalysisResults' for a four-stage inverse normal design and two treatments", { - - .skipTestIfDisabled() - - design8 <- getDesignInverseNormal( - kMax = 4, alpha = 0.025, - typeOfDesign = "WT", deltaWT = 0.25, informationRates = c(0.2, 0.4, 0.8, 1), - futilityBounds = c(0, 0.5, 0.8), bindingFutility = TRUE - ) - - dataExample6 <- getDataset( - n1 = c(17, 18, 22), - n2 = c(18, 17, 19), - events1 = c(11, 12, 17), - events2 = c(5, 10, 7) - ) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} - # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} - # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} - # @refFS[Formula]{fs:testStatisticNormalCombinationTest} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} - # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} - x1 <- getAnalysisResults(design8, dataExample6, - thetaH0 = 0.0, stage = 2, nPlanned = c(30, 30), - pi2 = 0.2, pi1 = 0.4, directionUpper = TRUE - ) - - ## Comparison of the results of AnalysisResultsInverseNormal object 'x1' with expected results - expect_equal(x1$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x1$testActions, collapse = ", "), ")")) - expect_equal(x1$conditionalRejectionProbabilities, c(0.19002543, 0.18093983, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x1$conditionalPower, c(NA_real_, NA_real_, 0.51829859, 0.74637814), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPower, collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(-0.14000084, -0.078581193, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.72492429, 0.48870113, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x1$repeatedPValues, c(0.083297609, 0.077943692, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues, collapse = ", "), ")")) - expect_equal(x1$finalStage, NA_integer_, label = paste0("c(", paste0(x1$finalStage, collapse = ", "), ")")) - expect_equal(x1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalPValues, collapse = ", "), ")")) - expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x1), NA))) - expect_output(print(x1)$show()) - invisible(capture.output(expect_error(summary(x1), NA))) - expect_output(summary(x1)$show()) - x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) - expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-07) - expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x1), "character") - df <- as.data.frame(x1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData1 <- testGetAnalysisResultsPlotData(x1, piTreatmentRange = seq(0.4, 0.7, 0.05), nPlanned = c(30, 30)) - - ## Comparison of the results of list object 'plotData1' with expected results - expect_equal(plotData1$xValues, c(0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$xValues, collapse = ", "), ")")) - expect_equal(plotData1$condPowerValues, c(0.74637814, 0.85191228, 0.92421447, 0.96693166, 0.98816058, 0.99670572, 0.99934119), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData1$likelihoodValues, c(0.0058819346, 0.035694195, 0.14689674, 0.40998118, 0.77598415, 0.99604498, 0.86704618), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData1$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData1$main, collapse = ", "), ")")) - expect_equal(plotData1$xlab, "pi1", label = paste0("c(", paste0(plotData1$xlab, collapse = ", "), ")")) - expect_equal(plotData1$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData1$ylab, collapse = ", "), ")")) - expect_equal(plotData1$sub, "Stage = 2, # of remaining subjects = 60, pi2 = 0.2, allocation ratio = 1", label = paste0("c(", paste0(plotData1$sub, collapse = ", "), ")")) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} - # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} - # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} - # @refFS[Formula]{fs:testStatisticNormalCombinationTest} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} - # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} - x3 <- getAnalysisResults(design8, dataExample6, - thetaH0 = 0, stage = 2, nPlanned = c(60, 30), - pi2 = 0.4, pi1 = 0.8, directionUpper = TRUE, allocationRatioPlanned = 2 - ) - - ## Comparison of the results of AnalysisResultsInverseNormal object 'x3' with expected results - expect_equal(x3$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x3$testActions, collapse = ", "), ")")) - expect_equal(x3$conditionalRejectionProbabilities, c(0.19002543, 0.18093983, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x3$conditionalPower, c(NA_real_, NA_real_, 0.97637134, 0.99770045), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalPower, collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalLowerBounds, c(-0.14000084, -0.078581193, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalUpperBounds, c(0.72492429, 0.48870113, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x3$repeatedPValues, c(0.083297609, 0.077943692, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues, collapse = ", "), ")")) - expect_equal(x3$finalStage, NA_integer_, label = paste0("c(", paste0(x3$finalStage, collapse = ", "), ")")) - expect_equal(x3$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalPValues, collapse = ", "), ")")) - expect_equal(x3$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x3$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x3$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x3), NA))) - expect_output(print(x3)$show()) - invisible(capture.output(expect_error(summary(x3), NA))) - expect_output(summary(x3)$show()) - x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) - expect_equal(x3CodeBased$testActions, x3$testActions, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) - expect_equal(x3CodeBased$finalStage, x3$finalStage, tolerance = 1e-07) - expect_equal(x3CodeBased$finalPValues, x3$finalPValues, tolerance = 1e-07) - expect_equal(x3CodeBased$finalConfidenceIntervalLowerBounds, x3$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$finalConfidenceIntervalUpperBounds, x3$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$medianUnbiasedEstimates, x3$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x3), "character") - df <- as.data.frame(x3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData4 <- testGetAnalysisResultsPlotData(x3, piTreatmentRange = seq(0.5, 0.8, 0.05), allocationRatioPlanned = 2) - - ## Comparison of the results of list object 'plotData4' with expected results - expect_equal(plotData4$xValues, c(0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$xValues, collapse = ", "), ")")) - expect_equal(plotData4$condPowerValues, c(0.4771434, 0.64764919, 0.79574037, 0.90143545, 0.96198044, 0.98887633, 0.99770045), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData4$likelihoodValues, c(0.14689674, 0.40998118, 0.77598415, 0.99604498, 0.86704618, 0.51184997, 0.20491809), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData4$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData4$main, collapse = ", "), ")")) - expect_equal(plotData4$xlab, "pi1", label = paste0("c(", paste0(plotData4$xlab, collapse = ", "), ")")) - expect_equal(plotData4$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData4$ylab, collapse = ", "), ")")) - expect_equal(plotData4$sub, "Stage = 2, # of remaining subjects = 90, pi2 = 0.4, allocation ratio = 2", label = paste0("c(", paste0(plotData4$sub, collapse = ", "), ")")) - - # reversed "directionUpper" - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} - # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} - # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} - # @refFS[Formula]{fs:testStatisticNormalCombinationTest} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} - # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} - x4 <- getAnalysisResults(design8, dataExample6, - thetaH0 = 0, stage = 2, nPlanned = c(60, 30), - pi2 = 0.8, pi1 = 0.4, directionUpper = FALSE, allocationRatioPlanned = 0.5 - ) - - ## Comparison of the results of AnalysisResultsInverseNormal object 'x4' with expected results - expect_equal(x4$testActions, c("accept and stop", "accept and stop", NA_character_, NA_character_), label = paste0("c(", paste0(x4$testActions, collapse = ", "), ")")) - expect_equal(x4$conditionalRejectionProbabilities, c(0, 0, NA_real_, NA_real_), label = paste0("c(", paste0(x4$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x4$conditionalPower, c(NA_real_, NA_real_, 0.037603851, 0.34743098), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalPower, collapse = ", "), ")")) - expect_equal(x4$repeatedConfidenceIntervalLowerBounds, c(-0.14000084, -0.078581193, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x4$repeatedConfidenceIntervalUpperBounds, c(0.72492429, 0.48870113, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x4$repeatedPValues, c(0.49999905, 0.49999905, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedPValues, collapse = ", "), ")")) - expect_equal(x4$finalStage, 1, label = paste0("c(", paste0(x4$finalStage, collapse = ", "), ")")) - expect_equal(x4$finalPValues, c(0.98580558, NA_real_, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$finalPValues, collapse = ", "), ")")) - expect_equal(x4$finalConfidenceIntervalLowerBounds, c(0.039328966, NA_real_, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x4$finalConfidenceIntervalUpperBounds, c(0.62730979, NA_real_, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x4$medianUnbiasedEstimates, c(0.36928105, NA_real_, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x4), NA))) - expect_output(print(x4)$show()) - invisible(capture.output(expect_error(summary(x4), NA))) - expect_output(summary(x4)$show()) - x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) - expect_equal(x4CodeBased$testActions, x4$testActions, tolerance = 1e-07) - expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-07) - expect_equal(x4CodeBased$finalStage, x4$finalStage, tolerance = 1e-07) - expect_equal(x4CodeBased$finalPValues, x4$finalPValues, tolerance = 1e-07) - expect_equal(x4CodeBased$finalConfidenceIntervalLowerBounds, x4$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$finalConfidenceIntervalUpperBounds, x4$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$medianUnbiasedEstimates, x4$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x4), "character") - df <- as.data.frame(x4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData5 <- testGetAnalysisResultsPlotData(x4, piTreatmentRange = seq(0.2, 0.5, 0.05), allocationRatioPlanned = 0.5) - - ## Comparison of the results of list object 'plotData5' with expected results - expect_equal(plotData5$xValues, c(0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5), tolerance = 1e-07, label = paste0("c(", paste0(plotData5$xValues, collapse = ", "), ")")) - expect_equal(plotData5$condPowerValues, c(0.98964948, 0.93182725, 0.78360503, 0.56553646, 0.34743098, 0.18277547, 0.082851862), tolerance = 1e-07, label = paste0("c(", paste0(plotData5$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData5$likelihoodValues, c(8.9244677e-08, 2.5604189e-06, 4.9816924e-05, 0.00065732471, 0.0058819346, 0.035694195, 0.14689674), tolerance = 1e-07, label = paste0("c(", paste0(plotData5$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData5$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData5$main, collapse = ", "), ")")) - expect_equal(plotData5$xlab, "pi1", label = paste0("c(", paste0(plotData5$xlab, collapse = ", "), ")")) - expect_equal(plotData5$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData5$ylab, collapse = ", "), ")")) - expect_equal(plotData5$sub, "Stage = 2, # of remaining subjects = 90, pi2 = 0.8, allocation ratio = 0.5", label = paste0("c(", paste0(plotData5$sub, collapse = ", "), ")")) - -}) - -test_that("'getAnalysisResults' for a four-stage Fisher design and two treatments", { - - .skipTestIfDisabled() - - design9 <- getDesignFisher( - kMax = 4, alpha = 0.025, method = "equalAlpha", - informationRates = c(0.2, 0.4, 0.8, 1) - ) - - dataExample7 <- getDataset( - n1 = c(17, 23, 22), - n2 = c(18, 20, 19), - events1 = c(11, 12, 17), - events2 = c(5, 10, 7) - ) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} - # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} - # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} - # @refFS[Formula]{fs:testStatisticFisherCombinationTest} - # @refFS[Formula]{fs:definitionRCIFisherCombination} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionFisherInterim} - # @refFS[Formula]{fs:conditionalRejectionFisherLastInterim} - # @refFS[Formula]{fs:conditionalRejectionFisherweights} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} - # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} - x1 <- getAnalysisResults(design9, dataExample7, - thetaH0 = 0, stage = 2, nPlanned = c(60, 30), - pi2 = 0.4, pi1 = 0.8, directionUpper = TRUE, allocationRatioPlanned = 2, seed = 123 - ) - - ## Comparison of the results of AnalysisResultsFisher object 'x1' with expected results - expect_equal(x1$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x1$testActions, collapse = ", "), ")")) - expect_equal(x1$conditionalRejectionProbabilities, c(0.13898608, 0.050808351, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(-0.023853561, -0.068378457, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.66428984, 0.40418869, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x1$repeatedPValues, c(0.035427069, 0.088523734, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues, collapse = ", "), ")")) - expect_equal(x1$finalStage, NA_integer_, label = paste0("c(", paste0(x1$finalStage, collapse = ", "), ")")) - expect_equal(x1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalPValues, collapse = ", "), ")")) - expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$medianUnbiasedEstimates, collapse = ", "), ")")) - expect_equal(x1$conditionalPowerSimulated, c(NA_real_, NA_real_, 0.925, 0.972), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPowerSimulated, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x1), NA))) - expect_output(print(x1)$show()) - invisible(capture.output(expect_error(summary(x1), NA))) - expect_output(summary(x1)$show()) - x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) - expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-07) - expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalPowerSimulated, x1$conditionalPowerSimulated, tolerance = 1e-07) - expect_type(names(x1), "character") - df <- as.data.frame(x1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData1 <- testGetAnalysisResultsPlotData(x1, piTreatmentRange = seq(0.5, 0.8, 0.05), allocationRatioPlanned = 2) - - ## Comparison of the results of list object 'plotData1' with expected results - expect_equal(plotData1$xValues, c(0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$xValues, collapse = ", "), ")")) - expect_equal(plotData1$condPowerValues, c(0.199, 0.364, 0.506, 0.686, 0.839, 0.927, 0.979), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData1$likelihoodValues, c(0.63105765, 0.95013529, 0.95013529, 0.63105765, 0.27837883, 0.081561833, 0.015871623), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData1$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData1$main, collapse = ", "), ")")) - expect_equal(plotData1$xlab, "pi1", label = paste0("c(", paste0(plotData1$xlab, collapse = ", "), ")")) - expect_equal(plotData1$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData1$ylab, collapse = ", "), ")")) - expect_equal(plotData1$sub, "Stage = 2, # of remaining subjects = 90, pi2 = 0.4, allocation ratio = 2", label = paste0("c(", paste0(plotData1$sub, collapse = ", "), ")")) - - # reversed "directionUpper" - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} - # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} - # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} - # @refFS[Formula]{fs:testStatisticFisherCombinationTest} - # @refFS[Formula]{fs:definitionRCIFisherCombination} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionFisherInterim} - # @refFS[Formula]{fs:conditionalRejectionFisherLastInterim} - # @refFS[Formula]{fs:conditionalRejectionFisherweights} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} - # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} - - x2 <- getAnalysisResults(design9, dataExample7, - thetaH0 = 0, stage = 2, nPlanned = c(60, 30), - pi2 = 0.8, pi1 = 0.4, directionUpper = FALSE, allocationRatioPlanned = 0.5, seed = 123 - ) - - ## Comparison of the results of AnalysisResultsFisher object 'x2' with expected results - expect_equal(x2$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x2$testActions, collapse = ", "), ")")) - expect_equal(x2$conditionalRejectionProbabilities, c(0.0056634595, 0.0023089469, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(-0.023853561, -0.068378457, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.66428984, 0.40418869, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x2$repeatedPValues, c(0.49999905, 0.49999905, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues, collapse = ", "), ")")) - expect_equal(x2$finalStage, NA_integer_, label = paste0("c(", paste0(x2$finalStage, collapse = ", "), ")")) - expect_equal(x2$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalPValues, collapse = ", "), ")")) - expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$medianUnbiasedEstimates, collapse = ", "), ")")) - expect_equal(x2$conditionalPowerSimulated, c(NA_real_, NA_real_, 0.591, 0.788), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalPowerSimulated, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x2), NA))) - expect_output(print(x2)$show()) - invisible(capture.output(expect_error(summary(x2), NA))) - expect_output(summary(x2)$show()) - x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) - expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) - expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-07) - expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-07) - expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalPowerSimulated, x2$conditionalPowerSimulated, tolerance = 1e-07) - expect_type(names(x2), "character") - df <- as.data.frame(x2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData2 <- testGetAnalysisResultsPlotData(x2, piTreatmentRange = seq(0.2, 0.5, 0.05), allocationRatioPlanned = 0.5) - - ## Comparison of the results of list object 'plotData2' with expected results - expect_equal(plotData2$xValues, c(0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$xValues, collapse = ", "), ")")) - expect_equal(plotData2$condPowerValues, c(0.998, 0.992, 0.967, 0.892, 0.807, 0.623, 0.493), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData2$likelihoodValues, c(1.003982e-05, 0.00017609247, 0.0020513476, 0.015871623, 0.081561833, 0.27837883, 0.63105765), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData2$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData2$main, collapse = ", "), ")")) - expect_equal(plotData2$xlab, "pi1", label = paste0("c(", paste0(plotData2$xlab, collapse = ", "), ")")) - expect_equal(plotData2$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData2$ylab, collapse = ", "), ")")) - expect_equal(plotData2$sub, "Stage = 2, # of remaining subjects = 90, pi2 = 0.8, allocation ratio = 0.5", label = paste0("c(", paste0(plotData2$sub, collapse = ", "), ")")) - -}) - -test_that("'getAnalysisResults' produces the correct exact tests and final CIs", { - - .skipTestIfDisabled() - - dataExample8 <- getDataset( - n2 = c(31, 72), - n1 = c(30, 69), - events2 = c(8, 54), - events1 = c(6, 45) - ) - - design10 <- getDesignGroupSequential( - kMax = 2, alpha = 0.025, - typeOfDesign = "WT", deltaWT = 0.1, informationRates = c(0.3, 1) - ) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} - # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} - # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} - # @refFS[Formula]{fs:testStatisticNormalCombinationTest} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} - # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} - # @refFS[Formula]{fs:orderingPValueUpper} - # @refFS[Formula]{fs:finalCITwoRates} - # @refFS[Formula]{fs:medianUnbiasedEstimate} - x1 <- getAnalysisResults(design10, dataExample8, - thetaH0 = 0, stage = 2, directionUpper = FALSE, - normalApproximation = FALSE - ) - - ## Comparison of the results of AnalysisResultsGroupSequential object 'x1' with expected results - expect_equal(x1$pi1, 0.51515152, tolerance = 1e-07, label = paste0("c(", paste0(x1$pi1, collapse = ", "), ")")) - expect_equal(x1$pi2, 0.60194175, tolerance = 1e-07, label = paste0("c(", paste0(x1$pi2, collapse = ", "), ")")) - expect_equal(x1$testActions, c("continue", "accept"), label = paste0("c(", paste0(x1$testActions, collapse = ", "), ")")) - expect_equal(x1$conditionalRejectionProbabilities, c(0.013966781, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x1$conditionalPower, c(NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower, collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(-0.39509356, -0.22101238), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.29306133, 0.050448655), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x1$repeatedPValues, c(0.49999905, 0.15271161), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues, collapse = ", "), ")")) - expect_equal(x1$finalStage, 2, label = paste0("c(", paste0(x1$finalStage, collapse = ", "), ")")) - expect_equal(x1$finalPValues, c(NA_real_, 0.13570939), tolerance = 1e-07, label = paste0("c(", paste0(x1$finalPValues, collapse = ", "), ")")) - expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, -0.21309581), tolerance = 1e-07, label = paste0("c(", paste0(x1$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, 0.059922132), tolerance = 1e-07, label = paste0("c(", paste0(x1$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, -0.076600295), tolerance = 1e-07, label = paste0("c(", paste0(x1$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x1), NA))) - expect_output(print(x1)$show()) - invisible(capture.output(expect_error(summary(x1), NA))) - expect_output(summary(x1)$show()) - x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) - expect_equal(x1CodeBased$pi1, x1$pi1, tolerance = 1e-07) - expect_equal(x1CodeBased$pi2, x1$pi2, tolerance = 1e-07) - expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-07) - expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x1), "character") - df <- as.data.frame(x1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - design11 <- getDesignInverseNormal( - kMax = 2, alpha = 0.025, - typeOfDesign = "WT", deltaWT = 0.1, informationRates = c(0.3, 1) - ) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} - # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} - # @refFS[Formula]{fs:testStatisticNormalCombinationTest} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} - # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} - x2 <- getAnalysisResults(design11, dataExample8, - thetaH0 = 0, stage = 2, directionUpper = FALSE, - normalApproximation = FALSE - ) - - ## Comparison of the results of AnalysisResultsInverseNormal object 'x2' with expected results - expect_equal(x2$pi1, 0.51515152, tolerance = 1e-07, label = paste0("c(", paste0(x2$pi1, collapse = ", "), ")")) - expect_equal(x2$pi2, 0.60194175, tolerance = 1e-07, label = paste0("c(", paste0(x2$pi2, collapse = ", "), ")")) - expect_equal(x2$testActions, c("continue", "accept"), label = paste0("c(", paste0(x2$testActions, collapse = ", "), ")")) - expect_equal(x2$conditionalRejectionProbabilities, c(0.013966781, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x2$conditionalPower, c(NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower, collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(-0.39509356, -0.20744977), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.29306133, 0.038390636), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x2$repeatedPValues, c(0.49999905, 0.171251), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues, collapse = ", "), ")")) - expect_equal(x2$finalStage, 2, label = paste0("c(", paste0(x2$finalStage, collapse = ", "), ")")) - expect_equal(x2$finalPValues, c(NA_real_, 0.15026298), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalPValues, collapse = ", "), ")")) - expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, -0.20860056), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, 0.064410651), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, -0.072106168), tolerance = 1e-07, label = paste0("c(", paste0(x2$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x2), NA))) - expect_output(print(x2)$show()) - invisible(capture.output(expect_error(summary(x2), NA))) - expect_output(summary(x2)$show()) - x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) - expect_equal(x2CodeBased$pi1, x2$pi1, tolerance = 1e-07) - expect_equal(x2CodeBased$pi2, x2$pi2, tolerance = 1e-07) - expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) - expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-07) - expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-07) - expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x2), "character") - df <- as.data.frame(x2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - design12 <- getDesignFisher( - kMax = 2, alpha = 0.025, method = "fullAlpha", - informationRates = c(0.3, 1) - ) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} - # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} - # @refFS[Formula]{fs:testStatisticFisherCombinationTest} - # @refFS[Formula]{fs:definitionRCIFisherCombination} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:conditionalRejectionFisherInterim} - # @refFS[Formula]{fs:conditionalRejectionFisherLastInterim} - # @refFS[Formula]{fs:conditionalRejectionFisherweights} - # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} - # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} - # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} - x3 <- getAnalysisResults(design12, dataExample8, - thetaH0 = 0, stage = 2, directionUpper = FALSE, - normalApproximation = FALSE, seed = 123 - ) - - ## Comparison of the results of AnalysisResultsFisher object 'x3' with expected results - expect_equal(x3$pi1, 0.51515152, tolerance = 1e-07, label = paste0("c(", paste0(x3$pi1, collapse = ", "), ")")) - expect_equal(x3$pi2, 0.60194175, tolerance = 1e-07, label = paste0("c(", paste0(x3$pi2, collapse = ", "), ")")) - expect_equal(x3$testActions, c("continue", "accept"), label = paste0("c(", paste0(x3$testActions, collapse = ", "), ")")) - expect_equal(x3$conditionalRejectionProbabilities, c(0.016431334, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x3$conditionalPower, c(NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPower, collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalLowerBounds, c(-0.39357809, -0.2198965), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalUpperBounds, c(0.29140184, 0.047490149), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x3$repeatedPValues, c(0.49999905, 0.18563047), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues, collapse = ", "), ")")) - expect_equal(x3$finalStage, 2, label = paste0("c(", paste0(x3$finalStage, collapse = ", "), ")")) - expect_equal(x3$finalPValues, c(NA_real_, 0.18562957), tolerance = 1e-07, label = paste0("c(", paste0(x3$finalPValues, collapse = ", "), ")")) - expect_equal(x3$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x3$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x3$medianUnbiasedEstimates, c(NA_real_, NA_real_), label = paste0("c(", paste0(x3$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x3), NA))) - expect_output(print(x3)$show()) - invisible(capture.output(expect_error(summary(x3), NA))) - expect_output(summary(x3)$show()) - x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) - expect_equal(x3CodeBased$pi1, x3$pi1, tolerance = 1e-07) - expect_equal(x3CodeBased$pi2, x3$pi2, tolerance = 1e-07) - expect_equal(x3CodeBased$testActions, x3$testActions, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) - expect_equal(x3CodeBased$finalStage, x3$finalStage, tolerance = 1e-07) - expect_equal(x3CodeBased$finalPValues, x3$finalPValues, tolerance = 1e-07) - expect_equal(x3CodeBased$finalConfidenceIntervalLowerBounds, x3$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$finalConfidenceIntervalUpperBounds, x3$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$medianUnbiasedEstimates, x3$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x3), "character") - df <- as.data.frame(x3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getAnalysisResults' produces the correct non-inferiority results for a group sequential design", { - - .skipTestIfDisabled() - - design13 <- getDesignGroupSequential( - kMax = 2, alpha = 0.025, - typeOfDesign = "WT", deltaWT = 0.1, informationRates = c(0.3, 1) - ) - - dataExample9 <- getDataset( - n1 = c(29, 70), - n2 = c(31, 71), - events1 = c(8, 54), - events2 = c(6, 45) - ) - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} - # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} - # @refFS[Formula]{fs:testStatisticGroupSequential} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:EstimatesDiffFarringtonManning} - x1 <- getAnalysisResults(design13, dataExample9, - thetaH0 = -0.1, stage = 2, directionUpper = TRUE, - normalApproximation = TRUE - ) - - ## Comparison of the results of AnalysisResultsGroupSequential object 'x1' with expected results - expect_equal(x1$pi1, 0.62626263, tolerance = 1e-07, label = paste0("c(", paste0(x1$pi1, collapse = ", "), ")")) - expect_equal(x1$pi2, 0.5, tolerance = 1e-07, label = paste0("c(", paste0(x1$pi2, collapse = ", "), ")")) - expect_equal(x1$testActions, c("continue", "reject"), label = paste0("c(", paste0(x1$testActions, collapse = ", "), ")")) - expect_equal(x1$conditionalRejectionProbabilities, c(0.1027905, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x1$conditionalPower, c(NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower, collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(-0.26992436, -0.011398056), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.42527258, 0.25916391), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x1$repeatedPValues, c(0.17488831, 0.00058560119), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues, collapse = ", "), ")")) - expect_equal(x1$finalStage, 2, label = paste0("c(", paste0(x1$finalStage, collapse = ", "), ")")) - expect_equal(x1$finalPValues, c(NA_real_, 0.0012732763), tolerance = 1e-07, label = paste0("c(", paste0(x1$finalPValues, collapse = ", "), ")")) - expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, -0.016122347), tolerance = 1e-07, label = paste0("c(", paste0(x1$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, 0.26034096), tolerance = 1e-07, label = paste0("c(", paste0(x1$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, 0.12355576), tolerance = 1e-07, label = paste0("c(", paste0(x1$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x1), NA))) - expect_output(print(x1)$show()) - invisible(capture.output(expect_error(summary(x1), NA))) - expect_output(summary(x1)$show()) - x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) - expect_equal(x1CodeBased$pi1, x1$pi1, tolerance = 1e-07) - expect_equal(x1CodeBased$pi2, x1$pi2, tolerance = 1e-07) - expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-07) - expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x1), "character") - df <- as.data.frame(x1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} - # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} - # @refFS[Formula]{fs:testStatisticGroupSequential} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:EstimatesDiffFarringtonManning} - x2 <- getAnalysisResults(design13, dataExample9, - thetaH0 = -0.1, stage = 1, nPlanned = 40, - pi1 = 0.45, pi2 = 0.4, directionUpper = TRUE, normalApproximation = TRUE - ) - - ## Comparison of the results of AnalysisResultsGroupSequential object 'x2' with expected results - expect_equal(x2$testActions, c("continue", NA_character_), label = paste0("c(", paste0(x2$testActions, collapse = ", "), ")")) - expect_equal(x2$conditionalRejectionProbabilities, c(0.1027905, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x2$conditionalPower, c(NA_real_, 0.38169554), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalPower, collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(-0.26992436, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.42527258, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x2$repeatedPValues, c(0.17488831, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues, collapse = ", "), ")")) - expect_equal(x2$finalStage, NA_integer_, label = paste0("c(", paste0(x2$finalStage, collapse = ", "), ")")) - expect_equal(x2$finalPValues, c(NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalPValues, collapse = ", "), ")")) - expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, NA_real_), label = paste0("c(", paste0(x2$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x2), NA))) - expect_output(print(x2)$show()) - invisible(capture.output(expect_error(summary(x2), NA))) - expect_output(summary(x2)$show()) - x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) - expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) - expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-07) - expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-07) - expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x2), "character") - df <- as.data.frame(x2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - plotData1 <- testGetAnalysisResultsPlotData(x2, piTreatmentRange = seq(0.25, 0.7, 0.05)) - - ## Comparison of the results of list object 'plotData1' with expected results - expect_equal(plotData1$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$xValues, collapse = ", "), ")")) - expect_equal(plotData1$condPowerValues, c(0.053165998, 0.1027905, 0.17500031, 0.26934912, 0.38169554, 0.50456648, 0.62825352, 0.74249459, 0.83846571, 0.91065807), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$condPowerValues, collapse = ", "), ")")) - expect_equal(plotData1$likelihoodValues, c(0.95261056, 0.95859015, 0.67101367, 0.32674624, 0.11068039, 0.026080239, 0.0042749722, 0.00048745649, 3.866511e-05, 2.1334549e-06), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$likelihoodValues, collapse = ", "), ")")) - expect_equal(plotData1$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData1$main, collapse = ", "), ")")) - expect_equal(plotData1$xlab, "pi1", label = paste0("c(", paste0(plotData1$xlab, collapse = ", "), ")")) - expect_equal(plotData1$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData1$ylab, collapse = ", "), ")")) - expect_equal(plotData1$sub, "Stage = 1, # of remaining subjects = 40, pi2 = 0.4, allocation ratio = 1", label = paste0("c(", paste0(plotData1$sub, collapse = ", "), ")")) - - # non-inferiority, reversed "directionUpper" - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} - # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} - # @refFS[Formula]{fs:testStatisticGroupSequential} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:EstimatesDiffFarringtonManning} - x3 <- getAnalysisResults(design13, dataExample9, - thetaH0 = 0.1, stage = 2, directionUpper = FALSE, - normalApproximation = TRUE - ) - - ## Comparison of the results of AnalysisResultsGroupSequential object 'x3' with expected results - expect_equal(x3$pi1, 0.62626263, tolerance = 1e-07, label = paste0("c(", paste0(x3$pi1, collapse = ", "), ")")) - expect_equal(x3$pi2, 0.5, tolerance = 1e-07, label = paste0("c(", paste0(x3$pi2, collapse = ", "), ")")) - expect_equal(x3$testActions, c("continue", "accept"), label = paste0("c(", paste0(x3$testActions, collapse = ", "), ")")) - expect_equal(x3$conditionalRejectionProbabilities, c(0.012395218, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x3$conditionalPower, c(NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPower, collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalLowerBounds, c(-0.26992436, -0.011398056), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalUpperBounds, c(0.42527258, 0.25916391), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x3$repeatedPValues, c(0.49999905, 0.49999905), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues, collapse = ", "), ")")) - expect_equal(x3$finalStage, 2, label = paste0("c(", paste0(x3$finalStage, collapse = ", "), ")")) - expect_equal(x3$finalPValues, c(NA_real_, 0.64703032), tolerance = 1e-07, label = paste0("c(", paste0(x3$finalPValues, collapse = ", "), ")")) - expect_equal(x3$finalConfidenceIntervalLowerBounds, c(NA_real_, -0.0098227441), tolerance = 1e-07, label = paste0("c(", paste0(x3$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x3$finalConfidenceIntervalUpperBounds, c(NA_real_, 0.26218829), tolerance = 1e-07, label = paste0("c(", paste0(x3$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x3$medianUnbiasedEstimates, c(NA_real_, 0.12618258), tolerance = 1e-07, label = paste0("c(", paste0(x3$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x3), NA))) - expect_output(print(x3)$show()) - invisible(capture.output(expect_error(summary(x3), NA))) - expect_output(summary(x3)$show()) - x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) - expect_equal(x3CodeBased$pi1, x3$pi1, tolerance = 1e-07) - expect_equal(x3CodeBased$pi2, x3$pi2, tolerance = 1e-07) - expect_equal(x3CodeBased$testActions, x3$testActions, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) - expect_equal(x3CodeBased$finalStage, x3$finalStage, tolerance = 1e-07) - expect_equal(x3CodeBased$finalPValues, x3$finalPValues, tolerance = 1e-07) - expect_equal(x3CodeBased$finalConfidenceIntervalLowerBounds, x3$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$finalConfidenceIntervalUpperBounds, x3$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$medianUnbiasedEstimates, x3$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x3), "character") - df <- as.data.frame(x3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} - # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} - # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} - # @refFS[Formula]{fs:testStatisticGroupSequential} - # @refFS[Formula]{fs:definitionRCIInverseNormal} - # @refFS[Formula]{fs:calculationRepeatedpValue} - # @refFS[Formula]{fs:EstimatesDiffFarringtonManning} - x4 <- getAnalysisResults(design13, dataExample9, - thetaH0 = 0.1, stage = 1, nPlanned = 40, - pi1 = 0.4, pi2 = 0.45, directionUpper = FALSE, normalApproximation = TRUE - ) - - ## Comparison of the results of AnalysisResultsGroupSequential object 'x4' with expected results - expect_equal(x4$testActions, c("continue", NA_character_), label = paste0("c(", paste0(x4$testActions, collapse = ", "), ")")) - expect_equal(x4$conditionalRejectionProbabilities, c(0.012395218, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalRejectionProbabilities, collapse = ", "), ")")) - expect_equal(x4$conditionalPower, c(NA_real_, 0.10084143), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalPower, collapse = ", "), ")")) - expect_equal(x4$repeatedConfidenceIntervalLowerBounds, c(-0.26992436, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x4$repeatedConfidenceIntervalUpperBounds, c(0.42527258, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x4$repeatedPValues, c(0.49999905, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedPValues, collapse = ", "), ")")) - expect_equal(x4$finalStage, NA_integer_, label = paste0("c(", paste0(x4$finalStage, collapse = ", "), ")")) - expect_equal(x4$finalPValues, c(NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalPValues, collapse = ", "), ")")) - expect_equal(x4$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(x4$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(x4$medianUnbiasedEstimates, c(NA_real_, NA_real_), label = paste0("c(", paste0(x4$medianUnbiasedEstimates, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x4), NA))) - expect_output(print(x4)$show()) - invisible(capture.output(expect_error(summary(x4), NA))) - expect_output(summary(x4)$show()) - x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) - expect_equal(x4CodeBased$testActions, x4$testActions, tolerance = 1e-07) - expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-07) - expect_equal(x4CodeBased$finalStage, x4$finalStage, tolerance = 1e-07) - expect_equal(x4CodeBased$finalPValues, x4$finalPValues, tolerance = 1e-07) - expect_equal(x4CodeBased$finalConfidenceIntervalLowerBounds, x4$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$finalConfidenceIntervalUpperBounds, x4$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$medianUnbiasedEstimates, x4$medianUnbiasedEstimates, tolerance = 1e-07) - expect_type(names(x4), "character") - df <- as.data.frame(x4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getAnalysisResults' with a dataset of rates and without defining a design", { - - .skipTestIfDisabled() - - data <- getDataset( - n1 = c(10), - n2 = c(15), - events1 = c(8), - events2 = c(6) - ) - - # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} - # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} - analysisResults1 <- getAnalysisResults(data, alpha = 0.02) - - ## Comparison of the results of AnalysisResultsInverseNormal object 'analysisResults1' with expected results - expect_equal(analysisResults1$pi1, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(analysisResults1$pi1, collapse = ", "), ")")) - expect_equal(analysisResults1$pi2, 0.4, tolerance = 1e-07, label = paste0("c(", paste0(analysisResults1$pi2, collapse = ", "), ")")) - expect_equal(analysisResults1$testActions, "accept", label = paste0("c(", paste0(analysisResults1$testActions, collapse = ", "), ")")) - expect_equal(analysisResults1$repeatedConfidenceIntervalLowerBounds, -0.016534109, tolerance = 1e-07, label = paste0("c(", paste0(analysisResults1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) - expect_equal(analysisResults1$repeatedConfidenceIntervalUpperBounds, 0.68698828, tolerance = 1e-07, label = paste0("c(", paste0(analysisResults1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) - expect_equal(analysisResults1$repeatedPValues, 0.024199112, tolerance = 1e-07, label = paste0("c(", paste0(analysisResults1$repeatedPValues, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(analysisResults1), NA))) - expect_output(print(analysisResults1)$show()) - invisible(capture.output(expect_error(summary(analysisResults1), NA))) - expect_output(summary(analysisResults1)$show()) - analysisResults1CodeBased <- eval(parse(text = getObjectRCode(analysisResults1, stringWrapParagraphWidth = NULL))) - expect_equal(analysisResults1CodeBased$pi1, analysisResults1$pi1, tolerance = 1e-07) - expect_equal(analysisResults1CodeBased$pi2, analysisResults1$pi2, tolerance = 1e-07) - expect_equal(analysisResults1CodeBased$testActions, analysisResults1$testActions, tolerance = 1e-07) - expect_equal(analysisResults1CodeBased$repeatedConfidenceIntervalLowerBounds, analysisResults1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(analysisResults1CodeBased$repeatedConfidenceIntervalUpperBounds, analysisResults1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(analysisResults1CodeBased$repeatedPValues, analysisResults1$repeatedPValues, tolerance = 1e-07) - expect_type(names(analysisResults1), "character") - df <- as.data.frame(analysisResults1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(analysisResults1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getAnalysisResults' produces the correct critical values for a boundary recalculation at the last stage", { - - .skipTestIfDisabled() - - data1 <- getDataset( - overallN = c(22, 33, 45), - overallEvents = c(11, 18, 28) - ) - data2 <- getDataset( - overallN = c(22, 33, 40), - overallEvents = c(11, 18, 23) - ) - data3 <- getDataset( - overallN = c(22, 33, 38), - overallEvents = c(11, 18, 21) - ) - design <- getDesignGroupSequential( - typeOfDesign = "asP" - ) - - # @refFS[Formula]{fs:getAnalysisResults:maxInformation} - # @refFS[Formula]{fs:getAnalysisResults:maxInformation:methods} - expect_warning(result1 <- getAnalysisResults(design, data1, - thetaH0 = 0.5, maxInformation = 40 - )) - result2 <- getAnalysisResults(design, data2, - thetaH0 = 0.5, maxInformation = 40 - ) - expect_warning(result3 <- getAnalysisResults(design, data3, - thetaH0 = 0.5, maxInformation = 40, informationEpsilon = 2 - )) - expect_equal(result1$.design$criticalValues[1:2], result2$.design$criticalValues[1:2], tolerance = 1e-07) - expect_equal(result1$.design$criticalValues[1:2], result3$.design$criticalValues[1:2], tolerance = 1e-07) - expect_equal(result2$.design$criticalValues[1:2], result3$.design$criticalValues[1:2], tolerance = 1e-07) - -}) - +## | +## | *Unit tests* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | RPACT package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File name: test-f_analysis_base_rates.R +## | Creation date: 08 November 2023, 08:51:06 +## | File version: $Revision$ +## | Last changed: $Date$ +## | Last changed by: $Author$ +## | + +test_plan_section("Testing the Analysis Rates Functionality for One Treatment") + + +test_that("'getAnalysisResults' for a group sequential design and one treatment", { + .skipTestIfDisabled() + + design0 <- getDesignGroupSequential( + kMax = 2, alpha = 0.025, informationRates = c(0.2, 1), + typeOfDesign = "asKD", gammaA = 2.8 + ) + + dataExample0 <- getDataset( + n = c(33), + events = c(23) + ) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateAlternativeSmaller} + # @refFS[Formula]{fs:testStatisticGroupSequential} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + x0 <- getAnalysisResults( + design = design0, dataInput = dataExample0, + thetaH0 = 0.4, normalApproximation = FALSE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsGroupSequential object 'x0' with expected results + expect_equal(x0$pi1, 0.6969697, tolerance = 1e-06, label = paste0("c(", paste0(x0$pi1, collapse = ", "), ")")) + expect_equal(x0$testActions, c("continue", NA_character_), label = paste0("c(", paste0(x0$testActions, collapse = ", "), ")")) + expect_equal(x0$conditionalRejectionProbabilities, c(0.28801679, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(x0$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x0$conditionalPower, c(NA_real_, NA_real_), label = paste0("c(", paste0(x0$conditionalPower, collapse = ", "), ")")) + expect_equal(x0$repeatedConfidenceIntervalLowerBounds, c(0.38475339, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(x0$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x0$repeatedConfidenceIntervalUpperBounds, c(0.91556361, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(x0$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x0$repeatedPValues, c(0.048557231, NA_real_), tolerance = 1e-06, label = paste0("c(", paste0(x0$repeatedPValues, collapse = ", "), ")")) + expect_equal(x0$finalStage, NA_integer_, label = paste0("c(", paste0(x0$finalStage, collapse = ", "), ")")) + expect_equal(x0$finalPValues, c(NA_real_, NA_real_), label = paste0("c(", paste0(x0$finalPValues, collapse = ", "), ")")) + expect_equal(x0$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_), label = paste0("c(", paste0(x0$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x0$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_), label = paste0("c(", paste0(x0$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x0$medianUnbiasedEstimates, c(NA_real_, NA_real_), label = paste0("c(", paste0(x0$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x0), NA))) + expect_output(print(x0)$show()) + invisible(capture.output(expect_error(summary(x0), NA))) + expect_output(summary(x0)$show()) + x0CodeBased <- eval(parse(text = getObjectRCode(x0, stringWrapParagraphWidth = NULL))) + expect_equal(x0CodeBased$pi1, x0$pi1, tolerance = 1e-06) + expect_equal(x0CodeBased$testActions, x0$testActions, tolerance = 1e-06) + expect_equal(x0CodeBased$conditionalRejectionProbabilities, x0$conditionalRejectionProbabilities, tolerance = 1e-06) + expect_equal(x0CodeBased$conditionalPower, x0$conditionalPower, tolerance = 1e-06) + expect_equal(x0CodeBased$repeatedConfidenceIntervalLowerBounds, x0$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(x0CodeBased$repeatedConfidenceIntervalUpperBounds, x0$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(x0CodeBased$repeatedPValues, x0$repeatedPValues, tolerance = 1e-06) + expect_equal(x0CodeBased$finalStage, x0$finalStage, tolerance = 1e-06) + expect_equal(x0CodeBased$finalPValues, x0$finalPValues, tolerance = 1e-06) + expect_equal(x0CodeBased$finalConfidenceIntervalLowerBounds, x0$finalConfidenceIntervalLowerBounds, tolerance = 1e-06) + expect_equal(x0CodeBased$finalConfidenceIntervalUpperBounds, x0$finalConfidenceIntervalUpperBounds, tolerance = 1e-06) + expect_equal(x0CodeBased$medianUnbiasedEstimates, x0$medianUnbiasedEstimates, tolerance = 1e-06) + expect_type(names(x0), "character") + df <- as.data.frame(x0) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x0) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getAnalysisResults' for a four-stage group sequential design and one treatment", { + + .skipTestIfDisabled() + + design1 <- getDesignGroupSequential( + kMax = 4, alpha = 0.025, informationRates = c(0.2, 0.4, 0.8, 1), + futilityBounds = c(-0.5, 0, 0.5), typeOfDesign = "asKD", gammaA = 2.8 + ) + + dataExample1 <- getDataset( + n = c(10, 10, 20, 11), + events = c(4, 5, 5, 6) + ) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateAlternativeSmaller} + # @refFS[Formula]{fs:testStatisticGroupSequential} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + x1 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + stage = 2, thetaH0 = 0.75, normalApproximation = FALSE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsGroupSequential object 'x1' with expected results + expect_equal(x1$pi1, 0.45, tolerance = 1e-07, label = paste0("c(", paste0(x1$pi1, collapse = ", "), ")")) + expect_equal(x1$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x1$testActions, collapse = ", "), ")")) + expect_equal(x1$conditionalRejectionProbabilities, c(0.13502024, 0.39663603, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x1$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower, collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(0.035340833, 0.15564775, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.88809209, 0.77284164, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x1$repeatedPValues, c(0.49999905, 0.056127482, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues, collapse = ", "), ")")) + expect_equal(x1$finalStage, NA_integer_, label = paste0("c(", paste0(x1$finalStage, collapse = ", "), ")")) + expect_equal(x1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalPValues, collapse = ", "), ")")) + expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x1), NA))) + expect_output(print(x1)$show()) + invisible(capture.output(expect_error(summary(x1), NA))) + expect_output(summary(x1)$show()) + x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) + expect_equal(x1CodeBased$pi1, x1$pi1, tolerance = 1e-07) + expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-07) + expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x1), "character") + df <- as.data.frame(x1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeSmaller} + # @refFS[Formula]{fs:testStatisticGroupSequential} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:orderingPValueUpper} + # @refFS[Formula]{fs:finalCIOneRate} + # @refFS[Formula]{fs:medianUnbiasedEstimate} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + x2 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + stage = 3, thetaH0 = 0.75, normalApproximation = TRUE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsGroupSequential object 'x2' with expected results + expect_equal(x2$pi1, 0.35, tolerance = 1e-07, label = paste0("c(", paste0(x2$pi1, collapse = ", "), ")")) + expect_equal(x2$testActions, c("continue", "reject and stop", "reject and stop", NA_character_), label = paste0("c(", paste0(x2$testActions, collapse = ", "), ")")) + expect_equal(x2$conditionalRejectionProbabilities, c(0.21465031, 0.55995383, 1, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x2$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower, collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(0.08898791, 0.19243551, 0.206358, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.81981977, 0.73748168, 0.52720845, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x2$repeatedPValues, c(0.47958473, 0.014066714, 1.9536724e-06, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues, collapse = ", "), ")")) + expect_equal(x2$finalStage, 2, label = paste0("c(", paste0(x2$finalStage, collapse = ", "), ")")) + expect_equal(x2$finalPValues, c(NA_real_, 0.0011783609, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalPValues, collapse = ", "), ")")) + expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, 0.18821106, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, 0.62661997, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, 0.40681825, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x2), NA))) + expect_output(print(x2)$show()) + invisible(capture.output(expect_error(summary(x2), NA))) + expect_output(summary(x2)$show()) + x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) + expect_equal(x2CodeBased$pi1, x2$pi1, tolerance = 1e-07) + expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) + expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-07) + expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-07) + expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x2), "character") + df <- as.data.frame(x2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateAlternativeSmaller} + # @refFS[Formula]{fs:testStatisticGroupSequential} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerOneRateEffect} + x3 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + stage = 2, thetaH0 = 0.75, nPlanned = c(12, 6), pi1 = 0.5, + normalApproximation = FALSE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsGroupSequential object 'x3' with expected results + expect_equal(x3$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x3$testActions, collapse = ", "), ")")) + expect_equal(x3$conditionalRejectionProbabilities, c(0.13502024, 0.39663603, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x3$conditionalPower, c(NA_real_, NA_real_, 0.85193241, 0.94869662), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalPower, collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalLowerBounds, c(0.035340833, 0.15564775, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalUpperBounds, c(0.88809209, 0.77284164, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x3$repeatedPValues, c(0.49999905, 0.056127482, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues, collapse = ", "), ")")) + expect_equal(x3$finalStage, NA_integer_, label = paste0("c(", paste0(x3$finalStage, collapse = ", "), ")")) + expect_equal(x3$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalPValues, collapse = ", "), ")")) + expect_equal(x3$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x3$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x3$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x3), NA))) + expect_output(print(x3)$show()) + invisible(capture.output(expect_error(summary(x3), NA))) + expect_output(summary(x3)$show()) + x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) + expect_equal(x3CodeBased$testActions, x3$testActions, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) + expect_equal(x3CodeBased$finalStage, x3$finalStage, tolerance = 1e-07) + expect_equal(x3CodeBased$finalPValues, x3$finalPValues, tolerance = 1e-07) + expect_equal(x3CodeBased$finalConfidenceIntervalLowerBounds, x3$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$finalConfidenceIntervalUpperBounds, x3$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$medianUnbiasedEstimates, x3$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x3), "character") + df <- as.data.frame(x3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData1 <- testGetAnalysisResultsPlotData(x3, piTreatmentRange = seq(0.45, 0.75, 0.05)) + + ## Comparison of the results of list object 'plotData1' with expected results + expect_equal(plotData1$xValues, c(0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$xValues, collapse = ", "), ")")) + expect_equal(plotData1$condPowerValues, c(0.98024945, 0.94869662, 0.88988709, 0.79611571, 0.66506207, 0.50313626, 0.32784789), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData1$likelihoodValues, c(1, 0.9039239, 0.66761715, 0.40289032, 0.19865977, 0.080038099, 0.026347981), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData1$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData1$main, collapse = ", "), ")")) + expect_equal(plotData1$xlab, "pi1", label = paste0("c(", paste0(plotData1$xlab, collapse = ", "), ")")) + expect_equal(plotData1$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData1$ylab, collapse = ", "), ")")) + expect_equal(plotData1$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData1$sub, collapse = ", "), ")")) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeSmaller} + # @refFS[Formula]{fs:testStatisticGroupSequential} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:orderingPValueUpper} + # @refFS[Formula]{fs:medianUnbiasedEstimate} + # @refFS[Formula]{fs:finalCIOneRate} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerOneRateEffect} + x4 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + stage = 2, thetaH0 = 0.75, nPlanned = c(12, 6), pi1 = 0.5, + normalApproximation = TRUE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsGroupSequential object 'x4' with expected results + expect_equal(x4$testActions, c("continue", "reject and stop", NA_character_, NA_character_), label = paste0("c(", paste0(x4$testActions, collapse = ", "), ")")) + expect_equal(x4$conditionalRejectionProbabilities, c(0.21465031, 0.55995383, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x4$conditionalPower, c(NA_real_, NA_real_, 0.9494174, 0.9843063), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalPower, collapse = ", "), ")")) + expect_equal(x4$repeatedConfidenceIntervalLowerBounds, c(0.08898791, 0.19243551, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x4$repeatedConfidenceIntervalUpperBounds, c(0.81981977, 0.73748168, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x4$repeatedPValues, c(0.47958473, 0.014066714, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedPValues, collapse = ", "), ")")) + expect_equal(x4$finalStage, 2, label = paste0("c(", paste0(x4$finalStage, collapse = ", "), ")")) + expect_equal(x4$finalPValues, c(NA_real_, 0.0011783609, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$finalPValues, collapse = ", "), ")")) + expect_equal(x4$finalConfidenceIntervalLowerBounds, c(NA_real_, 0.18821106, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x4$finalConfidenceIntervalUpperBounds, c(NA_real_, 0.62661997, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x4$medianUnbiasedEstimates, c(NA_real_, 0.40681825, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x4), NA))) + expect_output(print(x4)$show()) + invisible(capture.output(expect_error(summary(x4), NA))) + expect_output(summary(x4)$show()) + x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) + expect_equal(x4CodeBased$testActions, x4$testActions, tolerance = 1e-07) + expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-07) + expect_equal(x4CodeBased$finalStage, x4$finalStage, tolerance = 1e-07) + expect_equal(x4CodeBased$finalPValues, x4$finalPValues, tolerance = 1e-07) + expect_equal(x4CodeBased$finalConfidenceIntervalLowerBounds, x4$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$finalConfidenceIntervalUpperBounds, x4$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$medianUnbiasedEstimates, x4$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x4), "character") + df <- as.data.frame(x4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData2 <- testGetAnalysisResultsPlotData(x4, piTreatmentRange = seq(0.45, 0.75, 0.05)) + + ## Comparison of the results of list object 'plotData2' with expected results + expect_equal(plotData2$xValues, c(0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$xValues, collapse = ", "), ")")) + expect_equal(plotData2$condPowerValues, c(0.99501417, 0.9843063, 0.96005739, 0.91353722, 0.83535366, 0.71802165, 0.55995335), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData2$likelihoodValues, c(1, 0.9039239, 0.66761715, 0.40289032, 0.19865977, 0.080038099, 0.026347981), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData2$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData2$main, collapse = ", "), ")")) + expect_equal(plotData2$xlab, "pi1", label = paste0("c(", paste0(plotData2$xlab, collapse = ", "), ")")) + expect_equal(plotData2$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData2$ylab, collapse = ", "), ")")) + expect_equal(plotData2$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData2$sub, collapse = ", "), ")")) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} + # @refFS[Formula]{fs:testStatisticGroupSequential} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerOneRateEffect} + x5 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + stage = 3, thetaH0 = 0.25, normalApproximation = FALSE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsGroupSequential object 'x5' with expected results + expect_equal(x5$pi1, 0.35, tolerance = 1e-07, label = paste0("c(", paste0(x5$pi1, collapse = ", "), ")")) + expect_equal(x5$testActions, c("continue", "continue", "continue", NA_character_), label = paste0("c(", paste0(x5$testActions, collapse = ", "), ")")) + expect_equal(x5$conditionalRejectionProbabilities, c(0.033369687, 0.13517192, 0.020135528, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x5$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$conditionalPower, collapse = ", "), ")")) + expect_equal(x5$repeatedConfidenceIntervalLowerBounds, c(0.035340833, 0.15564775, 0.18966473, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x5$repeatedConfidenceIntervalUpperBounds, c(0.88809209, 0.77284164, 0.53925561, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x5$repeatedPValues, c(0.49999905, 0.49999905, 0.20027888, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedPValues, collapse = ", "), ")")) + expect_equal(x5$finalStage, NA_integer_, label = paste0("c(", paste0(x5$finalStage, collapse = ", "), ")")) + expect_equal(x5$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$finalPValues, collapse = ", "), ")")) + expect_equal(x5$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x5$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x5$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x5), NA))) + expect_output(print(x5)$show()) + invisible(capture.output(expect_error(summary(x5), NA))) + expect_output(summary(x5)$show()) + x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) + expect_equal(x5CodeBased$pi1, x5$pi1, tolerance = 1e-07) + expect_equal(x5CodeBased$testActions, x5$testActions, tolerance = 1e-07) + expect_equal(x5CodeBased$conditionalRejectionProbabilities, x5$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x5CodeBased$conditionalPower, x5$conditionalPower, tolerance = 1e-07) + expect_equal(x5CodeBased$repeatedConfidenceIntervalLowerBounds, x5$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x5CodeBased$repeatedConfidenceIntervalUpperBounds, x5$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x5CodeBased$repeatedPValues, x5$repeatedPValues, tolerance = 1e-07) + expect_equal(x5CodeBased$finalStage, x5$finalStage, tolerance = 1e-07) + expect_equal(x5CodeBased$finalPValues, x5$finalPValues, tolerance = 1e-07) + expect_equal(x5CodeBased$finalConfidenceIntervalLowerBounds, x5$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x5CodeBased$finalConfidenceIntervalUpperBounds, x5$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x5CodeBased$medianUnbiasedEstimates, x5$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x5), "character") + df <- as.data.frame(x5) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x5) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} + # @refFS[Formula]{fs:testStatisticGroupSequential} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerOneRateEffect} + x6 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + stage = 3, thetaH0 = 0.25, normalApproximation = TRUE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsGroupSequential object 'x6' with expected results + expect_equal(x6$pi1, 0.35, tolerance = 1e-07, label = paste0("c(", paste0(x6$pi1, collapse = ", "), ")")) + expect_equal(x6$testActions, c("continue", "continue", "continue", NA_character_), label = paste0("c(", paste0(x6$testActions, collapse = ", "), ")")) + expect_equal(x6$conditionalRejectionProbabilities, c(0.049321562, 0.20984263, 0.048813267, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x6$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$conditionalPower, collapse = ", "), ")")) + expect_equal(x6$repeatedConfidenceIntervalLowerBounds, c(0.08898791, 0.19243551, 0.206358, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x6$repeatedConfidenceIntervalUpperBounds, c(0.81981977, 0.73748168, 0.52720845, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x6$repeatedPValues, c(0.49999905, 0.27035282, 0.14086509, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedPValues, collapse = ", "), ")")) + expect_equal(x6$finalStage, NA_integer_, label = paste0("c(", paste0(x6$finalStage, collapse = ", "), ")")) + expect_equal(x6$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$finalPValues, collapse = ", "), ")")) + expect_equal(x6$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x6$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x6$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x6), NA))) + expect_output(print(x6)$show()) + invisible(capture.output(expect_error(summary(x6), NA))) + expect_output(summary(x6)$show()) + x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) + expect_equal(x6CodeBased$pi1, x6$pi1, tolerance = 1e-07) + expect_equal(x6CodeBased$testActions, x6$testActions, tolerance = 1e-07) + expect_equal(x6CodeBased$conditionalRejectionProbabilities, x6$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x6CodeBased$conditionalPower, x6$conditionalPower, tolerance = 1e-07) + expect_equal(x6CodeBased$repeatedConfidenceIntervalLowerBounds, x6$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x6CodeBased$repeatedConfidenceIntervalUpperBounds, x6$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x6CodeBased$repeatedPValues, x6$repeatedPValues, tolerance = 1e-07) + expect_equal(x6CodeBased$finalStage, x6$finalStage, tolerance = 1e-07) + expect_equal(x6CodeBased$finalPValues, x6$finalPValues, tolerance = 1e-07) + expect_equal(x6CodeBased$finalConfidenceIntervalLowerBounds, x6$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x6CodeBased$finalConfidenceIntervalUpperBounds, x6$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x6CodeBased$medianUnbiasedEstimates, x6$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x6), "character") + df <- as.data.frame(x6) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x6) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} + # @refFS[Formula]{fs:testStatisticGroupSequential} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerOneRateEffect} + x7 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + stage = 2, thetaH0 = 0.25, nPlanned = c(12, 6), pi1 = 0.5, + normalApproximation = FALSE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsGroupSequential object 'x7' with expected results + expect_equal(x7$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x7$testActions, collapse = ", "), ")")) + expect_equal(x7$conditionalRejectionProbabilities, c(0.033369687, 0.13517192, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x7$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x7$conditionalPower, c(NA_real_, NA_real_, 0.58576815, 0.82581584), tolerance = 1e-07, label = paste0("c(", paste0(x7$conditionalPower, collapse = ", "), ")")) + expect_equal(x7$repeatedConfidenceIntervalLowerBounds, c(0.035340833, 0.15564775, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x7$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x7$repeatedConfidenceIntervalUpperBounds, c(0.88809209, 0.77284164, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x7$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x7$repeatedPValues, c(0.49999905, 0.49999905, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x7$repeatedPValues, collapse = ", "), ")")) + expect_equal(x7$finalStage, NA_integer_, label = paste0("c(", paste0(x7$finalStage, collapse = ", "), ")")) + expect_equal(x7$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$finalPValues, collapse = ", "), ")")) + expect_equal(x7$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x7$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x7$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x7), NA))) + expect_output(print(x7)$show()) + invisible(capture.output(expect_error(summary(x7), NA))) + expect_output(summary(x7)$show()) + x7CodeBased <- eval(parse(text = getObjectRCode(x7, stringWrapParagraphWidth = NULL))) + expect_equal(x7CodeBased$testActions, x7$testActions, tolerance = 1e-07) + expect_equal(x7CodeBased$conditionalRejectionProbabilities, x7$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x7CodeBased$conditionalPower, x7$conditionalPower, tolerance = 1e-07) + expect_equal(x7CodeBased$repeatedConfidenceIntervalLowerBounds, x7$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x7CodeBased$repeatedConfidenceIntervalUpperBounds, x7$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x7CodeBased$repeatedPValues, x7$repeatedPValues, tolerance = 1e-07) + expect_equal(x7CodeBased$finalStage, x7$finalStage, tolerance = 1e-07) + expect_equal(x7CodeBased$finalPValues, x7$finalPValues, tolerance = 1e-07) + expect_equal(x7CodeBased$finalConfidenceIntervalLowerBounds, x7$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x7CodeBased$finalConfidenceIntervalUpperBounds, x7$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x7CodeBased$medianUnbiasedEstimates, x7$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x7), "character") + df <- as.data.frame(x7) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x7) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData3 <- testGetAnalysisResultsPlotData(x7, piTreatmentRange = seq(0.25, 0.55, 0.05)) + + ## Comparison of the results of list object 'plotData3' with expected results + expect_equal(plotData3$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55), tolerance = 1e-07, label = paste0("c(", paste0(plotData3$xValues, collapse = ", "), ")")) + expect_equal(plotData3$condPowerValues, c(0.099723848, 0.21903134, 0.37478113, 0.54310492, 0.6994843, 0.82581584, 0.91388884), tolerance = 1e-07, label = paste0("c(", paste0(plotData3$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData3$likelihoodValues, c(0.19865977, 0.40289032, 0.66761715, 0.9039239, 1, 0.9039239, 0.66761715), tolerance = 1e-07, label = paste0("c(", paste0(plotData3$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData3$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData3$main, collapse = ", "), ")")) + expect_equal(plotData3$xlab, "pi1", label = paste0("c(", paste0(plotData3$xlab, collapse = ", "), ")")) + expect_equal(plotData3$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData3$ylab, collapse = ", "), ")")) + expect_equal(plotData3$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData3$sub, collapse = ", "), ")")) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} + # @refFS[Formula]{fs:testStatisticGroupSequential} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerOneRateEffect} + x8 <- getAnalysisResults( + design = design1, dataInput = dataExample1, + stage = 2, thetaH0 = 0.25, nPlanned = c(12, 6), pi1 = 0.5, + normalApproximation = TRUE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsGroupSequential object 'x8' with expected results + expect_equal(x8$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x8$testActions, collapse = ", "), ")")) + expect_equal(x8$conditionalRejectionProbabilities, c(0.049321562, 0.20984263, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x8$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x8$conditionalPower, c(NA_real_, NA_real_, 0.76152324, 0.91259792), tolerance = 1e-07, label = paste0("c(", paste0(x8$conditionalPower, collapse = ", "), ")")) + expect_equal(x8$repeatedConfidenceIntervalLowerBounds, c(0.08898791, 0.19243551, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x8$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x8$repeatedConfidenceIntervalUpperBounds, c(0.81981977, 0.73748168, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x8$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x8$repeatedPValues, c(0.49999905, 0.27035282, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x8$repeatedPValues, collapse = ", "), ")")) + expect_equal(x8$finalStage, NA_integer_, label = paste0("c(", paste0(x8$finalStage, collapse = ", "), ")")) + expect_equal(x8$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$finalPValues, collapse = ", "), ")")) + expect_equal(x8$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x8$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x8$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x8), NA))) + expect_output(print(x8)$show()) + invisible(capture.output(expect_error(summary(x8), NA))) + expect_output(summary(x8)$show()) + x8CodeBased <- eval(parse(text = getObjectRCode(x8, stringWrapParagraphWidth = NULL))) + expect_equal(x8CodeBased$testActions, x8$testActions, tolerance = 1e-07) + expect_equal(x8CodeBased$conditionalRejectionProbabilities, x8$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x8CodeBased$conditionalPower, x8$conditionalPower, tolerance = 1e-07) + expect_equal(x8CodeBased$repeatedConfidenceIntervalLowerBounds, x8$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x8CodeBased$repeatedConfidenceIntervalUpperBounds, x8$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x8CodeBased$repeatedPValues, x8$repeatedPValues, tolerance = 1e-07) + expect_equal(x8CodeBased$finalStage, x8$finalStage, tolerance = 1e-07) + expect_equal(x8CodeBased$finalPValues, x8$finalPValues, tolerance = 1e-07) + expect_equal(x8CodeBased$finalConfidenceIntervalLowerBounds, x8$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x8CodeBased$finalConfidenceIntervalUpperBounds, x8$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x8CodeBased$medianUnbiasedEstimates, x8$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x8), "character") + df <- as.data.frame(x8) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x8) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData4 <- testGetAnalysisResultsPlotData(x8, piTreatmentRange = seq(0.25, 0.55, 0.05)) + + ## Comparison of the results of list object 'plotData4' with expected results + expect_equal(plotData4$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$xValues, collapse = ", "), ")")) + expect_equal(plotData4$condPowerValues, c(0.20983879, 0.3743042, 0.5481143, 0.70471917, 0.82789376, 0.91259792, 0.96272982), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData4$likelihoodValues, c(0.19865977, 0.40289032, 0.66761715, 0.9039239, 1, 0.9039239, 0.66761715), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData4$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData4$main, collapse = ", "), ")")) + expect_equal(plotData4$xlab, "pi1", label = paste0("c(", paste0(plotData4$xlab, collapse = ", "), ")")) + expect_equal(plotData4$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData4$ylab, collapse = ", "), ")")) + expect_equal(plotData4$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData4$sub, collapse = ", "), ")")) + +}) + +test_that("'getAnalysisResults' for a four-stage inverse sequential design and one treatment", { + + .skipTestIfDisabled() + + design2 <- getDesignInverseNormal( + kMax = 4, alpha = 0.025, informationRates = c(0.2, 0.4, 0.8, 1), + futilityBounds = c(-0.5, 0, 0.5), typeOfDesign = "asKD", gammaA = 2.8 + ) + + dataExample2 <- getDataset( + n = c(8, 10, 9, 11), # cumsum, overall n = (8, 18, 27, 38) + events = c(4, 5, 5, 6) # cumsum, overall events = (4, 9, 14, 20) + ) + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} + # @refFS[Formula]{fs:testStatisticNormalCombinationTest} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + + x1 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + stage = 3, thetaH0 = 0.75, normalApproximation = FALSE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsInverseNormal object 'x1' with expected results + expect_equal(x1$pi1, 0.51851852, tolerance = 1e-07, label = paste0("c(", paste0(x1$pi1, collapse = ", "), ")")) + expect_equal(x1$testActions, c("continue", "continue", "continue", NA_character_), label = paste0("c(", paste0(x1$testActions, collapse = ", "), ")")) + expect_equal(x1$conditionalRejectionProbabilities, c(0.055828725, 0.15918316, 0.28098687, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x1$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower, collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(0.046266926, 0.16132369, 0.26858957, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.95373307, 0.83867631, 0.76870127, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x1$repeatedPValues, c(0.49999905, 0.43799317, 0.045574143, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues, collapse = ", "), ")")) + expect_equal(x1$finalStage, NA_integer_, label = paste0("c(", paste0(x1$finalStage, collapse = ", "), ")")) + expect_equal(x1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalPValues, collapse = ", "), ")")) + expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x1), NA))) + expect_output(print(x1)$show()) + invisible(capture.output(expect_error(summary(x1), NA))) + expect_output(summary(x1)$show()) + x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) + expect_equal(x1CodeBased$pi1, x1$pi1, tolerance = 1e-07) + expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-07) + expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x1), "character") + df <- as.data.frame(x1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + .skipTestIfDisabled() + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} + # @refFS[Formula]{fs:testStatisticNormalCombinationTest} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:orderingPValueUpper} + # @refFS[Formula]{fs:finalCIOneRate} + # @refFS[Formula]{fs:medianUnbiasedEstimate} + x2 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + stage = 3, thetaH0 = 0.75, normalApproximation = TRUE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsInverseNormal object 'x2' with expected results + expect_equal(x2$pi1, 0.51851852, tolerance = 1e-07, label = paste0("c(", paste0(x2$pi1, collapse = ", "), ")")) + expect_equal(x2$testActions, c("continue", "continue", "reject and stop", NA_character_), label = paste0("c(", paste0(x2$testActions, collapse = ", "), ")")) + expect_equal(x2$conditionalRejectionProbabilities, c(0.08807963, 0.32350578, 0.78413539, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x2$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower, collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(0.11314487, 0.21610036, 0.31861038, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.88685513, 0.78389964, 0.72001945, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x2$repeatedPValues, c(0.49999905, 0.1020964, 0.0075111702, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues, collapse = ", "), ")")) + expect_equal(x2$finalStage, 3, label = paste0("c(", paste0(x2$finalStage, collapse = ", "), ")")) + expect_equal(x2$finalPValues, c(NA_real_, NA_real_, 0.0050707339, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalPValues, collapse = ", "), ")")) + expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, 0.3041323, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, 0.68870859, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, NA_real_, 0.49547717, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x2), NA))) + expect_output(print(x2)$show()) + invisible(capture.output(expect_error(summary(x2), NA))) + expect_output(summary(x2)$show()) + x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) + expect_equal(x2CodeBased$pi1, x2$pi1, tolerance = 1e-07) + expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) + expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-07) + expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-07) + expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x2), "character") + df <- as.data.frame(x2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} + # @refFS[Formula]{fs:testStatisticNormalCombinationTest} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + x3 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + stage = 2, thetaH0 = 0.75, nPlanned = c(12, 6), pi1 = 0.5, + normalApproximation = FALSE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsInverseNormal object 'x3' with expected results + expect_equal(x3$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x3$testActions, collapse = ", "), ")")) + expect_equal(x3$conditionalRejectionProbabilities, c(0.055828725, 0.15918316, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x3$conditionalPower, c(NA_real_, NA_real_, 0.69921202, 0.88465983), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalPower, collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalLowerBounds, c(0.046266926, 0.16132369, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalUpperBounds, c(0.95373307, 0.83867631, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x3$repeatedPValues, c(0.49999905, 0.43799317, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues, collapse = ", "), ")")) + expect_equal(x3$finalStage, NA_integer_, label = paste0("c(", paste0(x3$finalStage, collapse = ", "), ")")) + expect_equal(x3$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalPValues, collapse = ", "), ")")) + expect_equal(x3$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x3$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x3$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x3), NA))) + expect_output(print(x3)$show()) + invisible(capture.output(expect_error(summary(x3), NA))) + expect_output(summary(x3)$show()) + x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) + expect_equal(x3CodeBased$testActions, x3$testActions, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) + expect_equal(x3CodeBased$finalStage, x3$finalStage, tolerance = 1e-07) + expect_equal(x3CodeBased$finalPValues, x3$finalPValues, tolerance = 1e-07) + expect_equal(x3CodeBased$finalConfidenceIntervalLowerBounds, x3$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$finalConfidenceIntervalUpperBounds, x3$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$medianUnbiasedEstimates, x3$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x3), "character") + df <- as.data.frame(x3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData1 <- testGetAnalysisResultsPlotData(x3, piTreatmentRange = seq(0.45, 0.75, 0.05)) + + ## Comparison of the results of list object 'plotData1' with expected results + expect_equal(plotData1$xValues, c(0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$xValues, collapse = ", "), ")")) + expect_equal(plotData1$condPowerValues, c(0.94793138, 0.88465983, 0.78396384, 0.64581102, 0.48045808, 0.30888817, 0.15917802), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData1$likelihoodValues, c(0.91393119, 1, 0.91393119, 0.69767633, 0.44485807, 0.23692776, 0.10539922), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData1$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData1$main, collapse = ", "), ")")) + expect_equal(plotData1$xlab, "pi1", label = paste0("c(", paste0(plotData1$xlab, collapse = ", "), ")")) + expect_equal(plotData1$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData1$ylab, collapse = ", "), ")")) + expect_equal(plotData1$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData1$sub, collapse = ", "), ")")) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} + # @refFS[Formula]{fs:testStatisticNormalCombinationTest} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + x4 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + stage = 2, thetaH0 = 0.75, nPlanned = c(12, 6), pi1 = 0.5, + normalApproximation = TRUE, directionUpper = FALSE + ) + + ## Comparison of the results of AnalysisResultsInverseNormal object 'x4' with expected results + expect_equal(x4$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x4$testActions, collapse = ", "), ")")) + expect_equal(x4$conditionalRejectionProbabilities, c(0.08807963, 0.32350578, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x4$conditionalPower, c(NA_real_, NA_real_, 0.85385983, 0.95015898), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalPower, collapse = ", "), ")")) + expect_equal(x4$repeatedConfidenceIntervalLowerBounds, c(0.11314487, 0.21610036, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x4$repeatedConfidenceIntervalUpperBounds, c(0.88685513, 0.78389964, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x4$repeatedPValues, c(0.49999905, 0.1020964, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedPValues, collapse = ", "), ")")) + expect_equal(x4$finalStage, NA_integer_, label = paste0("c(", paste0(x4$finalStage, collapse = ", "), ")")) + expect_equal(x4$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalPValues, collapse = ", "), ")")) + expect_equal(x4$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x4$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x4$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x4), NA))) + expect_output(print(x4)$show()) + invisible(capture.output(expect_error(summary(x4), NA))) + expect_output(summary(x4)$show()) + x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) + expect_equal(x4CodeBased$testActions, x4$testActions, tolerance = 1e-07) + expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-07) + expect_equal(x4CodeBased$finalStage, x4$finalStage, tolerance = 1e-07) + expect_equal(x4CodeBased$finalPValues, x4$finalPValues, tolerance = 1e-07) + expect_equal(x4CodeBased$finalConfidenceIntervalLowerBounds, x4$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$finalConfidenceIntervalUpperBounds, x4$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$medianUnbiasedEstimates, x4$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x4), "character") + df <- as.data.frame(x4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData2 <- testGetAnalysisResultsPlotData(x4, piTreatmentRange = seq(0.45, 0.75, 0.05)) + + ## Comparison of the results of list object 'plotData2' with expected results + expect_equal(plotData2$xValues, c(0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$xValues, collapse = ", "), ")")) + expect_equal(plotData2$condPowerValues, c(0.98088099, 0.95015898, 0.89232289, 0.79901831, 0.66708346, 0.50248974, 0.32350375), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData2$likelihoodValues, c(0.91393119, 1, 0.91393119, 0.69767633, 0.44485807, 0.23692776, 0.10539922), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData2$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData2$main, collapse = ", "), ")")) + expect_equal(plotData2$xlab, "pi1", label = paste0("c(", paste0(plotData2$xlab, collapse = ", "), ")")) + expect_equal(plotData2$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData2$ylab, collapse = ", "), ")")) + expect_equal(plotData2$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData2$sub, collapse = ", "), ")")) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} + # @refFS[Formula]{fs:testStatisticNormalCombinationTest} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + x5 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + stage = 3, thetaH0 = 0.25, normalApproximation = FALSE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsInverseNormal object 'x5' with expected results + expect_equal(x5$pi1, 0.51851852, tolerance = 1e-07, label = paste0("c(", paste0(x5$pi1, collapse = ", "), ")")) + expect_equal(x5$testActions, c("continue", "continue", "reject and stop", NA_character_), label = paste0("c(", paste0(x5$testActions, collapse = ", "), ")")) + expect_equal(x5$conditionalRejectionProbabilities, c(0.055828725, 0.15918316, 0.65085211, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x5$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$conditionalPower, collapse = ", "), ")")) + expect_equal(x5$repeatedConfidenceIntervalLowerBounds, c(0.046266926, 0.16132369, 0.26858957, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x5$repeatedConfidenceIntervalUpperBounds, c(0.95373307, 0.83867631, 0.76870127, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x5$repeatedPValues, c(0.49999905, 0.43799317, 0.013282796, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedPValues, collapse = ", "), ")")) + expect_equal(x5$finalStage, 3, label = paste0("c(", paste0(x5$finalStage, collapse = ", "), ")")) + expect_equal(x5$finalPValues, c(NA_real_, NA_real_, 0.007752129, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$finalPValues, collapse = ", "), ")")) + expect_equal(x5$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, 0.29554194, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x5$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, 0.67875285, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x5$medianUnbiasedEstimates, c(NA_real_, NA_real_, 0.48769629, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x5), NA))) + expect_output(print(x5)$show()) + invisible(capture.output(expect_error(summary(x5), NA))) + expect_output(summary(x5)$show()) + x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) + expect_equal(x5CodeBased$pi1, x5$pi1, tolerance = 1e-07) + expect_equal(x5CodeBased$testActions, x5$testActions, tolerance = 1e-07) + expect_equal(x5CodeBased$conditionalRejectionProbabilities, x5$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x5CodeBased$conditionalPower, x5$conditionalPower, tolerance = 1e-07) + expect_equal(x5CodeBased$repeatedConfidenceIntervalLowerBounds, x5$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x5CodeBased$repeatedConfidenceIntervalUpperBounds, x5$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x5CodeBased$repeatedPValues, x5$repeatedPValues, tolerance = 1e-07) + expect_equal(x5CodeBased$finalStage, x5$finalStage, tolerance = 1e-07) + expect_equal(x5CodeBased$finalPValues, x5$finalPValues, tolerance = 1e-07) + expect_equal(x5CodeBased$finalConfidenceIntervalLowerBounds, x5$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x5CodeBased$finalConfidenceIntervalUpperBounds, x5$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x5CodeBased$medianUnbiasedEstimates, x5$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x5), "character") + df <- as.data.frame(x5) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x5) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} + # @refFS[Formula]{fs:testStatisticNormalCombinationTest} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + x6 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + stage = 3, thetaH0 = 0.25, normalApproximation = TRUE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsInverseNormal object 'x6' with expected results + expect_equal(x6$pi1, 0.51851852, tolerance = 1e-07, label = paste0("c(", paste0(x6$pi1, collapse = ", "), ")")) + expect_equal(x6$testActions, c("continue", "continue", "reject and stop", NA_character_), label = paste0("c(", paste0(x6$testActions, collapse = ", "), ")")) + expect_equal(x6$conditionalRejectionProbabilities, c(0.08807963, 0.32350578, 0.96959663, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x6$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$conditionalPower, collapse = ", "), ")")) + expect_equal(x6$repeatedConfidenceIntervalLowerBounds, c(0.11314487, 0.21610036, 0.31861038, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x6$repeatedConfidenceIntervalUpperBounds, c(0.88685513, 0.78389964, 0.72001945, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x6$repeatedPValues, c(0.49999905, 0.1020964, 0.0013103922, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedPValues, collapse = ", "), ")")) + expect_equal(x6$finalStage, 3, label = paste0("c(", paste0(x6$finalStage, collapse = ", "), ")")) + expect_equal(x6$finalPValues, c(NA_real_, NA_real_, 0.002378519, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$finalPValues, collapse = ", "), ")")) + expect_equal(x6$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, 0.3437363, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x6$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, 0.73847376, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x6$medianUnbiasedEstimates, c(NA_real_, NA_real_, 0.54446903, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x6), NA))) + expect_output(print(x6)$show()) + invisible(capture.output(expect_error(summary(x6), NA))) + expect_output(summary(x6)$show()) + x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) + expect_equal(x6CodeBased$pi1, x6$pi1, tolerance = 1e-07) + expect_equal(x6CodeBased$testActions, x6$testActions, tolerance = 1e-07) + expect_equal(x6CodeBased$conditionalRejectionProbabilities, x6$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x6CodeBased$conditionalPower, x6$conditionalPower, tolerance = 1e-07) + expect_equal(x6CodeBased$repeatedConfidenceIntervalLowerBounds, x6$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x6CodeBased$repeatedConfidenceIntervalUpperBounds, x6$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x6CodeBased$repeatedPValues, x6$repeatedPValues, tolerance = 1e-07) + expect_equal(x6CodeBased$finalStage, x6$finalStage, tolerance = 1e-07) + expect_equal(x6CodeBased$finalPValues, x6$finalPValues, tolerance = 1e-07) + expect_equal(x6CodeBased$finalConfidenceIntervalLowerBounds, x6$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x6CodeBased$finalConfidenceIntervalUpperBounds, x6$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x6CodeBased$medianUnbiasedEstimates, x6$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x6), "character") + df <- as.data.frame(x6) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x6) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerOneRateEffect} + x7 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + stage = 2, thetaH0 = 0.25, nPlanned = c(12, 6), pi1 = 0.5, + normalApproximation = FALSE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsInverseNormal object 'x7' with expected results + expect_equal(x7$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x7$testActions, collapse = ", "), ")")) + expect_equal(x7$conditionalRejectionProbabilities, c(0.055828725, 0.15918316, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x7$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x7$conditionalPower, c(NA_real_, NA_real_, 0.69921202, 0.88465983), tolerance = 1e-07, label = paste0("c(", paste0(x7$conditionalPower, collapse = ", "), ")")) + expect_equal(x7$repeatedConfidenceIntervalLowerBounds, c(0.046266926, 0.16132369, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x7$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x7$repeatedConfidenceIntervalUpperBounds, c(0.95373307, 0.83867631, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x7$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x7$repeatedPValues, c(0.49999905, 0.43799317, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x7$repeatedPValues, collapse = ", "), ")")) + expect_equal(x7$finalStage, NA_integer_, label = paste0("c(", paste0(x7$finalStage, collapse = ", "), ")")) + expect_equal(x7$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$finalPValues, collapse = ", "), ")")) + expect_equal(x7$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x7$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x7$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x7$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x7), NA))) + expect_output(print(x7)$show()) + invisible(capture.output(expect_error(summary(x7), NA))) + expect_output(summary(x7)$show()) + x7CodeBased <- eval(parse(text = getObjectRCode(x7, stringWrapParagraphWidth = NULL))) + expect_equal(x7CodeBased$testActions, x7$testActions, tolerance = 1e-07) + expect_equal(x7CodeBased$conditionalRejectionProbabilities, x7$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x7CodeBased$conditionalPower, x7$conditionalPower, tolerance = 1e-07) + expect_equal(x7CodeBased$repeatedConfidenceIntervalLowerBounds, x7$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x7CodeBased$repeatedConfidenceIntervalUpperBounds, x7$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x7CodeBased$repeatedPValues, x7$repeatedPValues, tolerance = 1e-07) + expect_equal(x7CodeBased$finalStage, x7$finalStage, tolerance = 1e-07) + expect_equal(x7CodeBased$finalPValues, x7$finalPValues, tolerance = 1e-07) + expect_equal(x7CodeBased$finalConfidenceIntervalLowerBounds, x7$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x7CodeBased$finalConfidenceIntervalUpperBounds, x7$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x7CodeBased$medianUnbiasedEstimates, x7$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x7), "character") + df <- as.data.frame(x7) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x7) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData3 <- testGetAnalysisResultsPlotData(x7, piTreatmentRange = seq(0.25, 0.55, 0.05)) + + ## Comparison of the results of list object 'plotData3' with expected results + expect_equal(plotData3$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55), tolerance = 1e-07, label = paste0("c(", paste0(plotData3$xValues, collapse = ", "), ")")) + expect_equal(plotData3$condPowerValues, c(0.15917802, 0.30888817, 0.48045808, 0.64581102, 0.78396384, 0.88465983, 0.94793138), tolerance = 1e-07, label = paste0("c(", paste0(plotData3$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData3$likelihoodValues, c(0.10539922, 0.23692776, 0.44485807, 0.69767633, 0.91393119, 1, 0.91393119), tolerance = 1e-07, label = paste0("c(", paste0(plotData3$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData3$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData3$main, collapse = ", "), ")")) + expect_equal(plotData3$xlab, "pi1", label = paste0("c(", paste0(plotData3$xlab, collapse = ", "), ")")) + expect_equal(plotData3$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData3$ylab, collapse = ", "), ")")) + expect_equal(plotData3$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData3$sub, collapse = ", "), ")")) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerOneRateEffect} + x8 <- getAnalysisResults( + design = design2, dataInput = dataExample2, + stage = 2, thetaH0 = 0.25, nPlanned = c(12, 6), pi1 = 0.5, + normalApproximation = TRUE, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsInverseNormal object 'x8' with expected results + expect_equal(x8$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x8$testActions, collapse = ", "), ")")) + expect_equal(x8$conditionalRejectionProbabilities, c(0.08807963, 0.32350578, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x8$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x8$conditionalPower, c(NA_real_, NA_real_, 0.85385983, 0.95015898), tolerance = 1e-07, label = paste0("c(", paste0(x8$conditionalPower, collapse = ", "), ")")) + expect_equal(x8$repeatedConfidenceIntervalLowerBounds, c(0.11314487, 0.21610036, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x8$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x8$repeatedConfidenceIntervalUpperBounds, c(0.88685513, 0.78389964, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x8$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x8$repeatedPValues, c(0.49999905, 0.1020964, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x8$repeatedPValues, collapse = ", "), ")")) + expect_equal(x8$finalStage, NA_integer_, label = paste0("c(", paste0(x8$finalStage, collapse = ", "), ")")) + expect_equal(x8$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$finalPValues, collapse = ", "), ")")) + expect_equal(x8$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x8$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x8$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x8$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x8), NA))) + expect_output(print(x8)$show()) + invisible(capture.output(expect_error(summary(x8), NA))) + expect_output(summary(x8)$show()) + x8CodeBased <- eval(parse(text = getObjectRCode(x8, stringWrapParagraphWidth = NULL))) + expect_equal(x8CodeBased$testActions, x8$testActions, tolerance = 1e-07) + expect_equal(x8CodeBased$conditionalRejectionProbabilities, x8$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x8CodeBased$conditionalPower, x8$conditionalPower, tolerance = 1e-07) + expect_equal(x8CodeBased$repeatedConfidenceIntervalLowerBounds, x8$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x8CodeBased$repeatedConfidenceIntervalUpperBounds, x8$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x8CodeBased$repeatedPValues, x8$repeatedPValues, tolerance = 1e-07) + expect_equal(x8CodeBased$finalStage, x8$finalStage, tolerance = 1e-07) + expect_equal(x8CodeBased$finalPValues, x8$finalPValues, tolerance = 1e-07) + expect_equal(x8CodeBased$finalConfidenceIntervalLowerBounds, x8$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x8CodeBased$finalConfidenceIntervalUpperBounds, x8$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x8CodeBased$medianUnbiasedEstimates, x8$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x8), "character") + df <- as.data.frame(x8) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x8) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData4 <- testGetAnalysisResultsPlotData(x8, piTreatmentRange = seq(0.25, 0.55, 0.05)) + + ## Comparison of the results of list object 'plotData4' with expected results + expect_equal(plotData4$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$xValues, collapse = ", "), ")")) + expect_equal(plotData4$condPowerValues, c(0.32350375, 0.50248974, 0.66708346, 0.79901831, 0.89232289, 0.95015898, 0.98088099), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData4$likelihoodValues, c(0.10539922, 0.23692776, 0.44485807, 0.69767633, 0.91393119, 1, 0.91393119), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData4$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData4$main, collapse = ", "), ")")) + expect_equal(plotData4$xlab, "pi1", label = paste0("c(", paste0(plotData4$xlab, collapse = ", "), ")")) + expect_equal(plotData4$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData4$ylab, collapse = ", "), ")")) + expect_equal(plotData4$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData4$sub, collapse = ", "), ")")) + +}) + +test_that("'getAnalysisResults' for a four-stage Fisher design and one treatment", { + + .skipTestIfDisabled() + + design3 <- getDesignFisher(kMax = 4, alpha = 0.025, informationRates = c(0.2, 0.4, 0.8, 1)) + + dataExample3 <- getDataset( + n = c(8, 10, 9, 11), # cumsum, overall n = (8, 18, 27, 38) + events = c(4, 5, 5, 6) # cumsum, overall events = (4, 9, 14, 20) + ) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} + # @refFS[Formula]{fs:testStatisticFisherCombinationTest} + # @refFS[Formula]{fs:definitionRCIFisherCombination} + # @refFS[Formula]{fs:calculationRepeatedpValue} + x1 <- getAnalysisResults( + design = design3, dataInput = dataExample3, + stage = 3, thetaH0 = 0.75, normalApproximation = FALSE, + directionUpper = FALSE, iterations = 1000, seed = 123 + ) + + ## Comparison of the results of AnalysisResultsFisher object 'x1' with expected results + expect_equal(x1$pi1, 0.51851852, tolerance = 1e-07, label = paste0("c(", paste0(x1$pi1, collapse = ", "), ")")) + expect_equal(x1$testActions, c("continue", "continue", "continue", NA_character_), label = paste0("c(", paste0(x1$testActions, collapse = ", "), ")")) + expect_equal(x1$conditionalRejectionProbabilities, c(0.027980027, 0.040164764, 0.018233808, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x1$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower, collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(0.12025548, 0.19023888, 0.23521677, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.87974452, 0.80976112, 0.79971589, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x1$repeatedPValues, c(0.23393398, 0.11483365, 0.11050779, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues, collapse = ", "), ")")) + expect_equal(x1$finalStage, NA_integer_, label = paste0("c(", paste0(x1$finalStage, collapse = ", "), ")")) + expect_equal(x1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalPValues, collapse = ", "), ")")) + expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x1), NA))) + expect_output(print(x1)$show()) + invisible(capture.output(expect_error(summary(x1), NA))) + expect_output(summary(x1)$show()) + x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) + expect_equal(x1CodeBased$pi1, x1$pi1, tolerance = 1e-07) + expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-07) + expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x1), "character") + df <- as.data.frame(x1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} + # @refFS[Formula]{fs:testStatisticFisherCombinationTest} + # @refFS[Formula]{fs:definitionRCIFisherCombination} + # @refFS[Formula]{fs:calculationRepeatedpValue} + x2 <- getAnalysisResults( + design = design3, dataInput = dataExample3, + stage = 3, thetaH0 = 0.75, normalApproximation = TRUE, + directionUpper = FALSE, iterations = 1000, seed = 123 + ) + + ## Comparison of the results of AnalysisResultsFisher object 'x2' with expected results + expect_equal(x2$pi1, 0.51851852, tolerance = 1e-07, label = paste0("c(", paste0(x2$pi1, collapse = ", "), ")")) + expect_equal(x2$testActions, c("continue", "continue", "reject and stop", NA_character_), label = paste0("c(", paste0(x2$testActions, collapse = ", "), ")")) + expect_equal(x2$conditionalRejectionProbabilities, c(0.051264101, 0.1206033, 1, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x2$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower, collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(0.18175814, 0.2424364, 0.28642867, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.81824186, 0.7575636, 0.7496417, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x2$repeatedPValues, c(0.11554509, 0.032131177, 0.024656293, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues, collapse = ", "), ")")) + expect_equal(x2$finalStage, NA_integer_, label = paste0("c(", paste0(x2$finalStage, collapse = ", "), ")")) + expect_equal(x2$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalPValues, collapse = ", "), ")")) + expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x2), NA))) + expect_output(print(x2)$show()) + invisible(capture.output(expect_error(summary(x2), NA))) + expect_output(summary(x2)$show()) + x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) + expect_equal(x2CodeBased$pi1, x2$pi1, tolerance = 1e-07) + expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) + expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-07) + expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-07) + expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x2), "character") + df <- as.data.frame(x2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} + # @refFS[Formula]{fs:testStatisticFisherCombinationTest} + # @refFS[Formula]{fs:definitionRCIFisherCombination} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionFisherInterim} + x3 <- getAnalysisResults( + design = design3, dataInput = dataExample3, + stage = 2, thetaH0 = 0.75, nPlanned = c(12, 6), pi1 = 0.5, normalApproximation = FALSE, + directionUpper = FALSE, iterations = 1000, seed = 123 + ) + + ## Comparison of the results of AnalysisResultsFisher object 'x3' with expected results + expect_equal(x3$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x3$testActions, collapse = ", "), ")")) + expect_equal(x3$conditionalRejectionProbabilities, c(0.027980027, 0.040164764, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalLowerBounds, c(0.12025548, 0.19023888, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalUpperBounds, c(0.87974452, 0.80976112, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x3$repeatedPValues, c(0.23393398, 0.11483365, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues, collapse = ", "), ")")) + expect_equal(x3$finalStage, NA_integer_, label = paste0("c(", paste0(x3$finalStage, collapse = ", "), ")")) + expect_equal(x3$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalPValues, collapse = ", "), ")")) + expect_equal(x3$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x3$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x3$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$medianUnbiasedEstimates, collapse = ", "), ")")) + expect_equal(x3$conditionalPowerSimulated, c(NA_real_, NA_real_, 0.522, 0.672), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalPowerSimulated, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x3), NA))) + expect_output(print(x3)$show()) + invisible(capture.output(expect_error(summary(x3), NA))) + expect_output(summary(x3)$show()) + x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) + expect_equal(x3CodeBased$testActions, x3$testActions, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) + expect_equal(x3CodeBased$finalStage, x3$finalStage, tolerance = 1e-07) + expect_equal(x3CodeBased$finalPValues, x3$finalPValues, tolerance = 1e-07) + expect_equal(x3CodeBased$finalConfidenceIntervalLowerBounds, x3$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$finalConfidenceIntervalUpperBounds, x3$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$medianUnbiasedEstimates, x3$medianUnbiasedEstimates, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalPowerSimulated, x3$conditionalPowerSimulated, tolerance = 1e-07) + expect_type(names(x3), "character") + df <- as.data.frame(x3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData1 <- testGetAnalysisResultsPlotData(x3, piTreatmentRange = seq(0.25, 0.55, 0.05)) + + ## Comparison of the results of list object 'plotData1' with expected results + expect_equal(plotData1$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$xValues, collapse = ", "), ")")) + expect_equal(plotData1$condPowerValues, c(0.997, 0.99, 0.967, 0.9, 0.822, 0.659, 0.534), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData1$likelihoodValues, c(0.10539922, 0.23692776, 0.44485807, 0.69767633, 0.91393119, 1, 0.91393119), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData1$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData1$main, collapse = ", "), ")")) + expect_equal(plotData1$xlab, "pi1", label = paste0("c(", paste0(plotData1$xlab, collapse = ", "), ")")) + expect_equal(plotData1$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData1$ylab, collapse = ", "), ")")) + expect_equal(plotData1$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData1$sub, collapse = ", "), ")")) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} + # @refFS[Formula]{fs:testStatisticFisherCombinationTest} + # @refFS[Formula]{fs:definitionRCIFisherCombination} + # @refFS[Formula]{fs:calculationRepeatedpValue} + x4 <- getAnalysisResults( + design = design3, dataInput = dataExample3, + stage = 3, thetaH0 = 0.25, normalApproximation = FALSE, + directionUpper = TRUE, iterations = 1000, seed = 123 + ) + + ## Comparison of the results of AnalysisResultsFisher object 'x4' with expected results + expect_equal(x4$pi1, 0.51851852, tolerance = 1e-07, label = paste0("c(", paste0(x4$pi1, collapse = ", "), ")")) + expect_equal(x4$testActions, c("continue", "continue", "continue", NA_character_), label = paste0("c(", paste0(x4$testActions, collapse = ", "), ")")) + expect_equal(x4$conditionalRejectionProbabilities, c(0.027980027, 0.040164764, 0.10237226, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x4$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$conditionalPower, collapse = ", "), ")")) + expect_equal(x4$repeatedConfidenceIntervalLowerBounds, c(0.12025548, 0.19023888, 0.23521677, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x4$repeatedConfidenceIntervalUpperBounds, c(0.87974452, 0.80976112, 0.79971589, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x4$repeatedPValues, c(0.23393398, 0.11483365, 0.040061917, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedPValues, collapse = ", "), ")")) + expect_equal(x4$finalStage, NA_integer_, label = paste0("c(", paste0(x4$finalStage, collapse = ", "), ")")) + expect_equal(x4$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalPValues, collapse = ", "), ")")) + expect_equal(x4$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x4$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x4$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x4), NA))) + expect_output(print(x4)$show()) + invisible(capture.output(expect_error(summary(x4), NA))) + expect_output(summary(x4)$show()) + x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) + expect_equal(x4CodeBased$pi1, x4$pi1, tolerance = 1e-07) + expect_equal(x4CodeBased$testActions, x4$testActions, tolerance = 1e-07) + expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-07) + expect_equal(x4CodeBased$finalStage, x4$finalStage, tolerance = 1e-07) + expect_equal(x4CodeBased$finalPValues, x4$finalPValues, tolerance = 1e-07) + expect_equal(x4CodeBased$finalConfidenceIntervalLowerBounds, x4$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$finalConfidenceIntervalUpperBounds, x4$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$medianUnbiasedEstimates, x4$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x4), "character") + df <- as.data.frame(x4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateApproximationAlternativeGreater} + # @refFS[Formula]{fs:testStatisticFisherCombinationTest} + # @refFS[Formula]{fs:definitionRCIFisherCombination} + # @refFS[Formula]{fs:calculationRepeatedpValue} + x5 <- getAnalysisResults( + design = design3, dataInput = dataExample3, + stage = 3, thetaH0 = 0.25, normalApproximation = TRUE, + directionUpper = TRUE, iterations = 1000, seed = 123 + ) + + ## Comparison of the results of AnalysisResultsFisher object 'x5' with expected results + expect_equal(x5$pi1, 0.51851852, tolerance = 1e-07, label = paste0("c(", paste0(x5$pi1, collapse = ", "), ")")) + expect_equal(x5$testActions, c("continue", "continue", "reject and stop", NA_character_), label = paste0("c(", paste0(x5$testActions, collapse = ", "), ")")) + expect_equal(x5$conditionalRejectionProbabilities, c(0.051264101, 0.1206033, 1, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x5$conditionalPower, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$conditionalPower, collapse = ", "), ")")) + expect_equal(x5$repeatedConfidenceIntervalLowerBounds, c(0.18175814, 0.2424364, 0.28642867, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x5$repeatedConfidenceIntervalUpperBounds, c(0.81824186, 0.7575636, 0.7496417, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x5$repeatedPValues, c(0.11554509, 0.032131177, 0.0055275316, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x5$repeatedPValues, collapse = ", "), ")")) + expect_equal(x5$finalStage, NA_integer_, label = paste0("c(", paste0(x5$finalStage, collapse = ", "), ")")) + expect_equal(x5$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$finalPValues, collapse = ", "), ")")) + expect_equal(x5$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x5$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x5$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x5$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x5), NA))) + expect_output(print(x5)$show()) + invisible(capture.output(expect_error(summary(x5), NA))) + expect_output(summary(x5)$show()) + x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) + expect_equal(x5CodeBased$pi1, x5$pi1, tolerance = 1e-07) + expect_equal(x5CodeBased$testActions, x5$testActions, tolerance = 1e-07) + expect_equal(x5CodeBased$conditionalRejectionProbabilities, x5$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x5CodeBased$conditionalPower, x5$conditionalPower, tolerance = 1e-07) + expect_equal(x5CodeBased$repeatedConfidenceIntervalLowerBounds, x5$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x5CodeBased$repeatedConfidenceIntervalUpperBounds, x5$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x5CodeBased$repeatedPValues, x5$repeatedPValues, tolerance = 1e-07) + expect_equal(x5CodeBased$finalStage, x5$finalStage, tolerance = 1e-07) + expect_equal(x5CodeBased$finalPValues, x5$finalPValues, tolerance = 1e-07) + expect_equal(x5CodeBased$finalConfidenceIntervalLowerBounds, x5$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x5CodeBased$finalConfidenceIntervalUpperBounds, x5$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x5CodeBased$medianUnbiasedEstimates, x5$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x5), "character") + df <- as.data.frame(x5) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x5) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} + # @refFS[Formula]{fs:testStatisticOneRateApproximation} + # @refFS[Formula]{fs:pValuesOneRateAlternativeGreater} + # @refFS[Formula]{fs:testStatisticFisherCombinationTest} + # @refFS[Formula]{fs:definitionRCIFisherCombination} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionFisherInterim} + x6 <- getAnalysisResults( + design = design3, dataInput = dataExample3, + stage = 2, thetaH0 = 0.25, nPlanned = c(12, 6), pi1 = 0.5, normalApproximation = FALSE, + directionUpper = TRUE, iterations = 1000, seed = 123 + ) + + ## Comparison of the results of AnalysisResultsFisher object 'x6' with expected results + expect_equal(x6$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x6$testActions, collapse = ", "), ")")) + expect_equal(x6$conditionalRejectionProbabilities, c(0.027980027, 0.040164764, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x6$repeatedConfidenceIntervalLowerBounds, c(0.12025548, 0.19023888, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x6$repeatedConfidenceIntervalUpperBounds, c(0.87974452, 0.80976112, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x6$repeatedPValues, c(0.23393398, 0.11483365, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x6$repeatedPValues, collapse = ", "), ")")) + expect_equal(x6$finalStage, NA_integer_, label = paste0("c(", paste0(x6$finalStage, collapse = ", "), ")")) + expect_equal(x6$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$finalPValues, collapse = ", "), ")")) + expect_equal(x6$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x6$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x6$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x6$medianUnbiasedEstimates, collapse = ", "), ")")) + expect_equal(x6$conditionalPowerSimulated, c(NA_real_, NA_real_, 0.522, 0.672), tolerance = 1e-07, label = paste0("c(", paste0(x6$conditionalPowerSimulated, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x6), NA))) + expect_output(print(x6)$show()) + invisible(capture.output(expect_error(summary(x6), NA))) + expect_output(summary(x6)$show()) + x6CodeBased <- eval(parse(text = getObjectRCode(x6, stringWrapParagraphWidth = NULL))) + expect_equal(x6CodeBased$testActions, x6$testActions, tolerance = 1e-07) + expect_equal(x6CodeBased$conditionalRejectionProbabilities, x6$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x6CodeBased$repeatedConfidenceIntervalLowerBounds, x6$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x6CodeBased$repeatedConfidenceIntervalUpperBounds, x6$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x6CodeBased$repeatedPValues, x6$repeatedPValues, tolerance = 1e-07) + expect_equal(x6CodeBased$finalStage, x6$finalStage, tolerance = 1e-07) + expect_equal(x6CodeBased$finalPValues, x6$finalPValues, tolerance = 1e-07) + expect_equal(x6CodeBased$finalConfidenceIntervalLowerBounds, x6$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x6CodeBased$finalConfidenceIntervalUpperBounds, x6$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x6CodeBased$medianUnbiasedEstimates, x6$medianUnbiasedEstimates, tolerance = 1e-07) + expect_equal(x6CodeBased$conditionalPowerSimulated, x6$conditionalPowerSimulated, tolerance = 1e-07) + expect_type(names(x6), "character") + df <- as.data.frame(x6) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x6) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData2 <- testGetAnalysisResultsPlotData(x6, piTreatmentRange = seq(0.25, 0.55, 0.05)) + + ## Comparison of the results of list object 'plotData2' with expected results + expect_equal(plotData2$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$xValues, collapse = ", "), ")")) + expect_equal(plotData2$condPowerValues, c(0.039, 0.114, 0.208, 0.363, 0.54, 0.659, 0.817), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData2$likelihoodValues, c(0.10539922, 0.23692776, 0.44485807, 0.69767633, 0.91393119, 1, 0.91393119), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData2$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData2$main, collapse = ", "), ")")) + expect_equal(plotData2$xlab, "pi1", label = paste0("c(", paste0(plotData2$xlab, collapse = ", "), ")")) + expect_equal(plotData2$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData2$ylab, collapse = ", "), ")")) + expect_equal(plotData2$sub, "Stage = 2, # of remaining subjects = 18", label = paste0("c(", paste0(plotData2$sub, collapse = ", "), ")")) + +}) + +test_plan_section("Testing the Analysis Rates Functionality for Two Treatments") + + +test_that("'getAnalysisResults' for a four-stage group sequential design and two treatments", { + .skipTestIfDisabled() + + design7 <- getDesignGroupSequential( + kMax = 4, alpha = 0.025, + typeOfDesign = "WT", deltaWT = 0.25, informationRates = c(0.2, 0.4, 0.8, 1), + futilityBounds = c(0, 0.5, 0.8), bindingFutility = TRUE + ) + + dataExample5 <- getDataset( + n1 = c(17, 18, 22), + n2 = c(18, 17, 19), + events1 = c(11, 12, 17), + events2 = c(5, 10, 7) + ) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} + # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} + # @refFS[Formula]{fs:testStatisticGroupSequential} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} + # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} + x1 <- getAnalysisResults(design7, dataExample5, + thetaH0 = 0, stage = 2, nPlanned = c(60, 30), + pi2 = 0.4, pi1 = 0.8, directionUpper = TRUE, allocationRatioPlanned = 2 + ) + + ## Comparison of the results of AnalysisResultsGroupSequential object 'x1' with expected results + expect_equal(x1$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x1$testActions, collapse = ", "), ")")) + expect_equal(x1$conditionalRejectionProbabilities, c(0.19002543, 0.18837824, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x1$conditionalPower, c(NA_real_, NA_real_, 0.97639752, 0.99770454), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPower, collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(-0.14000084, -0.07626859, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.72492429, 0.4944942, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x1$repeatedPValues, c(0.083297609, 0.074571507, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues, collapse = ", "), ")")) + expect_equal(x1$finalStage, NA_integer_, label = paste0("c(", paste0(x1$finalStage, collapse = ", "), ")")) + expect_equal(x1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalPValues, collapse = ", "), ")")) + expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x1), NA))) + expect_output(print(x1)$show()) + invisible(capture.output(expect_error(summary(x1), NA))) + expect_output(summary(x1)$show()) + x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) + expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-07) + expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x1), "character") + df <- as.data.frame(x1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData1 <- testGetAnalysisResultsPlotData(x1, piTreatmentRange = seq(0.5, 0.8, 0.05), allocationRatioPlanned = 2) + + ## Comparison of the results of list object 'plotData1' with expected results + expect_equal(plotData1$xValues, c(0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$xValues, collapse = ", "), ")")) + expect_equal(plotData1$condPowerValues, c(0.47726473, 0.64780315, 0.79588169, 0.90153211, 0.96202912, 0.98889368, 0.99770454), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData1$likelihoodValues, c(0.14689674, 0.40998118, 0.77598415, 0.99604498, 0.86704618, 0.51184997, 0.20491809), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData1$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData1$main, collapse = ", "), ")")) + expect_equal(plotData1$xlab, "pi1", label = paste0("c(", paste0(plotData1$xlab, collapse = ", "), ")")) + expect_equal(plotData1$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData1$ylab, collapse = ", "), ")")) + expect_equal(plotData1$sub, "Stage = 2, # of remaining subjects = 90, pi2 = 0.4, allocation ratio = 2", label = paste0("c(", paste0(plotData1$sub, collapse = ", "), ")")) + + # reversed "directionUpper" + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} + # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} + # @refFS[Formula]{fs:testStatisticGroupSequential} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} + # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} + + x2 <- getAnalysisResults(design7, dataExample5, + thetaH0 = 0, stage = 2, nPlanned = c(60, 30), + pi2 = 0.8, pi1 = 0.4, directionUpper = FALSE, allocationRatioPlanned = 0.5 + ) + + ## Comparison of the results of AnalysisResultsGroupSequential object 'x2' with expected results + expect_equal(x2$testActions, c("accept and stop", "accept and stop", NA_character_, NA_character_), label = paste0("c(", paste0(x2$testActions, collapse = ", "), ")")) + expect_equal(x2$conditionalRejectionProbabilities, c(0, 0, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x2$conditionalPower, c(NA_real_, NA_real_, 0.037603851, 0.34743098), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalPower, collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(-0.14000084, -0.07626859, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.72492429, 0.4944942, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x2$repeatedPValues, c(0.49999905, 0.49999905, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues, collapse = ", "), ")")) + expect_equal(x2$finalStage, 1, label = paste0("c(", paste0(x2$finalStage, collapse = ", "), ")")) + expect_equal(x2$finalPValues, c(0.98580558, NA_real_, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalPValues, collapse = ", "), ")")) + expect_equal(x2$finalConfidenceIntervalLowerBounds, c(0.039328966, NA_real_, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x2$finalConfidenceIntervalUpperBounds, c(0.62730979, NA_real_, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x2$medianUnbiasedEstimates, c(0.36928105, NA_real_, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x2), NA))) + expect_output(print(x2)$show()) + invisible(capture.output(expect_error(summary(x2), NA))) + expect_output(summary(x2)$show()) + x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) + expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) + expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-07) + expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-07) + expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x2), "character") + df <- as.data.frame(x2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData2 <- testGetAnalysisResultsPlotData(x2, piTreatmentRange = seq(0.2, 0.5, 0.05), allocationRatioPlanned = 0.5) + + ## Comparison of the results of list object 'plotData2' with expected results + expect_equal(plotData2$xValues, c(0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$xValues, collapse = ", "), ")")) + expect_equal(plotData2$condPowerValues, c(0.98964948, 0.93182725, 0.78360503, 0.56553646, 0.34743098, 0.18277547, 0.082851862), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData2$likelihoodValues, c(8.9244677e-08, 2.5604189e-06, 4.9816924e-05, 0.00065732471, 0.0058819346, 0.035694195, 0.14689674), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData2$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData2$main, collapse = ", "), ")")) + expect_equal(plotData2$xlab, "pi1", label = paste0("c(", paste0(plotData2$xlab, collapse = ", "), ")")) + expect_equal(plotData2$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData2$ylab, collapse = ", "), ")")) + expect_equal(plotData2$sub, "Stage = 2, # of remaining subjects = 90, pi2 = 0.8, allocation ratio = 0.5", label = paste0("c(", paste0(plotData2$sub, collapse = ", "), ")")) + +}) + +test_that("'getAnalysisResults' for a four-stage inverse normal design and two treatments", { + + .skipTestIfDisabled() + + design8 <- getDesignInverseNormal( + kMax = 4, alpha = 0.025, + typeOfDesign = "WT", deltaWT = 0.25, informationRates = c(0.2, 0.4, 0.8, 1), + futilityBounds = c(0, 0.5, 0.8), bindingFutility = TRUE + ) + + dataExample6 <- getDataset( + n1 = c(17, 18, 22), + n2 = c(18, 17, 19), + events1 = c(11, 12, 17), + events2 = c(5, 10, 7) + ) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} + # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} + # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} + # @refFS[Formula]{fs:testStatisticNormalCombinationTest} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} + # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} + x1 <- getAnalysisResults(design8, dataExample6, + thetaH0 = 0.0, stage = 2, nPlanned = c(30, 30), + pi2 = 0.2, pi1 = 0.4, directionUpper = TRUE + ) + + ## Comparison of the results of AnalysisResultsInverseNormal object 'x1' with expected results + expect_equal(x1$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x1$testActions, collapse = ", "), ")")) + expect_equal(x1$conditionalRejectionProbabilities, c(0.19002543, 0.18093983, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x1$conditionalPower, c(NA_real_, NA_real_, 0.51829859, 0.74637814), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPower, collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(-0.14000084, -0.078581193, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.72492429, 0.48870113, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x1$repeatedPValues, c(0.083297609, 0.077943692, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues, collapse = ", "), ")")) + expect_equal(x1$finalStage, NA_integer_, label = paste0("c(", paste0(x1$finalStage, collapse = ", "), ")")) + expect_equal(x1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalPValues, collapse = ", "), ")")) + expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x1), NA))) + expect_output(print(x1)$show()) + invisible(capture.output(expect_error(summary(x1), NA))) + expect_output(summary(x1)$show()) + x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) + expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-07) + expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x1), "character") + df <- as.data.frame(x1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData1 <- testGetAnalysisResultsPlotData(x1, piTreatmentRange = seq(0.4, 0.7, 0.05), nPlanned = c(30, 30)) + + ## Comparison of the results of list object 'plotData1' with expected results + expect_equal(plotData1$xValues, c(0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$xValues, collapse = ", "), ")")) + expect_equal(plotData1$condPowerValues, c(0.74637814, 0.85191228, 0.92421447, 0.96693166, 0.98816058, 0.99670572, 0.99934119), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData1$likelihoodValues, c(0.0058819346, 0.035694195, 0.14689674, 0.40998118, 0.77598415, 0.99604498, 0.86704618), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData1$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData1$main, collapse = ", "), ")")) + expect_equal(plotData1$xlab, "pi1", label = paste0("c(", paste0(plotData1$xlab, collapse = ", "), ")")) + expect_equal(plotData1$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData1$ylab, collapse = ", "), ")")) + expect_equal(plotData1$sub, "Stage = 2, # of remaining subjects = 60, pi2 = 0.2, allocation ratio = 1", label = paste0("c(", paste0(plotData1$sub, collapse = ", "), ")")) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} + # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} + # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} + # @refFS[Formula]{fs:testStatisticNormalCombinationTest} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} + # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} + x3 <- getAnalysisResults(design8, dataExample6, + thetaH0 = 0, stage = 2, nPlanned = c(60, 30), + pi2 = 0.4, pi1 = 0.8, directionUpper = TRUE, allocationRatioPlanned = 2 + ) + + ## Comparison of the results of AnalysisResultsInverseNormal object 'x3' with expected results + expect_equal(x3$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x3$testActions, collapse = ", "), ")")) + expect_equal(x3$conditionalRejectionProbabilities, c(0.19002543, 0.18093983, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x3$conditionalPower, c(NA_real_, NA_real_, 0.97637134, 0.99770045), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalPower, collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalLowerBounds, c(-0.14000084, -0.078581193, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalUpperBounds, c(0.72492429, 0.48870113, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x3$repeatedPValues, c(0.083297609, 0.077943692, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues, collapse = ", "), ")")) + expect_equal(x3$finalStage, NA_integer_, label = paste0("c(", paste0(x3$finalStage, collapse = ", "), ")")) + expect_equal(x3$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalPValues, collapse = ", "), ")")) + expect_equal(x3$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x3$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x3$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x3), NA))) + expect_output(print(x3)$show()) + invisible(capture.output(expect_error(summary(x3), NA))) + expect_output(summary(x3)$show()) + x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) + expect_equal(x3CodeBased$testActions, x3$testActions, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) + expect_equal(x3CodeBased$finalStage, x3$finalStage, tolerance = 1e-07) + expect_equal(x3CodeBased$finalPValues, x3$finalPValues, tolerance = 1e-07) + expect_equal(x3CodeBased$finalConfidenceIntervalLowerBounds, x3$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$finalConfidenceIntervalUpperBounds, x3$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$medianUnbiasedEstimates, x3$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x3), "character") + df <- as.data.frame(x3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData4 <- testGetAnalysisResultsPlotData(x3, piTreatmentRange = seq(0.5, 0.8, 0.05), allocationRatioPlanned = 2) + + ## Comparison of the results of list object 'plotData4' with expected results + expect_equal(plotData4$xValues, c(0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$xValues, collapse = ", "), ")")) + expect_equal(plotData4$condPowerValues, c(0.4771434, 0.64764919, 0.79574037, 0.90143545, 0.96198044, 0.98887633, 0.99770045), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData4$likelihoodValues, c(0.14689674, 0.40998118, 0.77598415, 0.99604498, 0.86704618, 0.51184997, 0.20491809), tolerance = 1e-07, label = paste0("c(", paste0(plotData4$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData4$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData4$main, collapse = ", "), ")")) + expect_equal(plotData4$xlab, "pi1", label = paste0("c(", paste0(plotData4$xlab, collapse = ", "), ")")) + expect_equal(plotData4$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData4$ylab, collapse = ", "), ")")) + expect_equal(plotData4$sub, "Stage = 2, # of remaining subjects = 90, pi2 = 0.4, allocation ratio = 2", label = paste0("c(", paste0(plotData4$sub, collapse = ", "), ")")) + + # reversed "directionUpper" + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} + # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} + # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} + # @refFS[Formula]{fs:testStatisticNormalCombinationTest} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} + # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} + x4 <- getAnalysisResults(design8, dataExample6, + thetaH0 = 0, stage = 2, nPlanned = c(60, 30), + pi2 = 0.8, pi1 = 0.4, directionUpper = FALSE, allocationRatioPlanned = 0.5 + ) + + ## Comparison of the results of AnalysisResultsInverseNormal object 'x4' with expected results + expect_equal(x4$testActions, c("accept and stop", "accept and stop", NA_character_, NA_character_), label = paste0("c(", paste0(x4$testActions, collapse = ", "), ")")) + expect_equal(x4$conditionalRejectionProbabilities, c(0, 0, NA_real_, NA_real_), label = paste0("c(", paste0(x4$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x4$conditionalPower, c(NA_real_, NA_real_, 0.037603851, 0.34743098), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalPower, collapse = ", "), ")")) + expect_equal(x4$repeatedConfidenceIntervalLowerBounds, c(-0.14000084, -0.078581193, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x4$repeatedConfidenceIntervalUpperBounds, c(0.72492429, 0.48870113, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x4$repeatedPValues, c(0.49999905, 0.49999905, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedPValues, collapse = ", "), ")")) + expect_equal(x4$finalStage, 1, label = paste0("c(", paste0(x4$finalStage, collapse = ", "), ")")) + expect_equal(x4$finalPValues, c(0.98580558, NA_real_, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$finalPValues, collapse = ", "), ")")) + expect_equal(x4$finalConfidenceIntervalLowerBounds, c(0.039328966, NA_real_, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x4$finalConfidenceIntervalUpperBounds, c(0.62730979, NA_real_, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x4$medianUnbiasedEstimates, c(0.36928105, NA_real_, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x4), NA))) + expect_output(print(x4)$show()) + invisible(capture.output(expect_error(summary(x4), NA))) + expect_output(summary(x4)$show()) + x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) + expect_equal(x4CodeBased$testActions, x4$testActions, tolerance = 1e-07) + expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-07) + expect_equal(x4CodeBased$finalStage, x4$finalStage, tolerance = 1e-07) + expect_equal(x4CodeBased$finalPValues, x4$finalPValues, tolerance = 1e-07) + expect_equal(x4CodeBased$finalConfidenceIntervalLowerBounds, x4$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$finalConfidenceIntervalUpperBounds, x4$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$medianUnbiasedEstimates, x4$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x4), "character") + df <- as.data.frame(x4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData5 <- testGetAnalysisResultsPlotData(x4, piTreatmentRange = seq(0.2, 0.5, 0.05), allocationRatioPlanned = 0.5) + + ## Comparison of the results of list object 'plotData5' with expected results + expect_equal(plotData5$xValues, c(0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5), tolerance = 1e-07, label = paste0("c(", paste0(plotData5$xValues, collapse = ", "), ")")) + expect_equal(plotData5$condPowerValues, c(0.98964948, 0.93182725, 0.78360503, 0.56553646, 0.34743098, 0.18277547, 0.082851862), tolerance = 1e-07, label = paste0("c(", paste0(plotData5$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData5$likelihoodValues, c(8.9244677e-08, 2.5604189e-06, 4.9816924e-05, 0.00065732471, 0.0058819346, 0.035694195, 0.14689674), tolerance = 1e-07, label = paste0("c(", paste0(plotData5$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData5$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData5$main, collapse = ", "), ")")) + expect_equal(plotData5$xlab, "pi1", label = paste0("c(", paste0(plotData5$xlab, collapse = ", "), ")")) + expect_equal(plotData5$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData5$ylab, collapse = ", "), ")")) + expect_equal(plotData5$sub, "Stage = 2, # of remaining subjects = 90, pi2 = 0.8, allocation ratio = 0.5", label = paste0("c(", paste0(plotData5$sub, collapse = ", "), ")")) + +}) + +test_that("'getAnalysisResults' for a four-stage Fisher design and two treatments", { + + .skipTestIfDisabled() + + design9 <- getDesignFisher( + kMax = 4, alpha = 0.025, method = "equalAlpha", + informationRates = c(0.2, 0.4, 0.8, 1) + ) + + dataExample7 <- getDataset( + n1 = c(17, 23, 22), + n2 = c(18, 20, 19), + events1 = c(11, 12, 17), + events2 = c(5, 10, 7) + ) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} + # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} + # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} + # @refFS[Formula]{fs:testStatisticFisherCombinationTest} + # @refFS[Formula]{fs:definitionRCIFisherCombination} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionFisherInterim} + # @refFS[Formula]{fs:conditionalRejectionFisherLastInterim} + # @refFS[Formula]{fs:conditionalRejectionFisherweights} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} + # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} + x1 <- getAnalysisResults(design9, dataExample7, + thetaH0 = 0, stage = 2, nPlanned = c(60, 30), + pi2 = 0.4, pi1 = 0.8, directionUpper = TRUE, allocationRatioPlanned = 2, seed = 123 + ) + + ## Comparison of the results of AnalysisResultsFisher object 'x1' with expected results + expect_equal(x1$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x1$testActions, collapse = ", "), ")")) + expect_equal(x1$conditionalRejectionProbabilities, c(0.13898608, 0.050808351, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(-0.023853561, -0.068378457, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.66428984, 0.40418869, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x1$repeatedPValues, c(0.035427069, 0.088523734, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues, collapse = ", "), ")")) + expect_equal(x1$finalStage, NA_integer_, label = paste0("c(", paste0(x1$finalStage, collapse = ", "), ")")) + expect_equal(x1$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalPValues, collapse = ", "), ")")) + expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$medianUnbiasedEstimates, collapse = ", "), ")")) + expect_equal(x1$conditionalPowerSimulated, c(NA_real_, NA_real_, 0.925, 0.972), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPowerSimulated, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x1), NA))) + expect_output(print(x1)$show()) + invisible(capture.output(expect_error(summary(x1), NA))) + expect_output(summary(x1)$show()) + x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) + expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-07) + expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalPowerSimulated, x1$conditionalPowerSimulated, tolerance = 1e-07) + expect_type(names(x1), "character") + df <- as.data.frame(x1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData1 <- testGetAnalysisResultsPlotData(x1, piTreatmentRange = seq(0.5, 0.8, 0.05), allocationRatioPlanned = 2) + + ## Comparison of the results of list object 'plotData1' with expected results + expect_equal(plotData1$xValues, c(0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$xValues, collapse = ", "), ")")) + expect_equal(plotData1$condPowerValues, c(0.199, 0.364, 0.506, 0.686, 0.839, 0.927, 0.979), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData1$likelihoodValues, c(0.63105765, 0.95013529, 0.95013529, 0.63105765, 0.27837883, 0.081561833, 0.015871623), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData1$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData1$main, collapse = ", "), ")")) + expect_equal(plotData1$xlab, "pi1", label = paste0("c(", paste0(plotData1$xlab, collapse = ", "), ")")) + expect_equal(plotData1$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData1$ylab, collapse = ", "), ")")) + expect_equal(plotData1$sub, "Stage = 2, # of remaining subjects = 90, pi2 = 0.4, allocation ratio = 2", label = paste0("c(", paste0(plotData1$sub, collapse = ", "), ")")) + + # reversed "directionUpper" + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} + # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} + # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} + # @refFS[Formula]{fs:testStatisticFisherCombinationTest} + # @refFS[Formula]{fs:definitionRCIFisherCombination} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionFisherInterim} + # @refFS[Formula]{fs:conditionalRejectionFisherLastInterim} + # @refFS[Formula]{fs:conditionalRejectionFisherweights} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} + # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} + + x2 <- getAnalysisResults(design9, dataExample7, + thetaH0 = 0, stage = 2, nPlanned = c(60, 30), + pi2 = 0.8, pi1 = 0.4, directionUpper = FALSE, allocationRatioPlanned = 0.5, seed = 123 + ) + + ## Comparison of the results of AnalysisResultsFisher object 'x2' with expected results + expect_equal(x2$testActions, c("continue", "continue", NA_character_, NA_character_), label = paste0("c(", paste0(x2$testActions, collapse = ", "), ")")) + expect_equal(x2$conditionalRejectionProbabilities, c(0.0056634595, 0.0023089469, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(-0.023853561, -0.068378457, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.66428984, 0.40418869, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x2$repeatedPValues, c(0.49999905, 0.49999905, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues, collapse = ", "), ")")) + expect_equal(x2$finalStage, NA_integer_, label = paste0("c(", paste0(x2$finalStage, collapse = ", "), ")")) + expect_equal(x2$finalPValues, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalPValues, collapse = ", "), ")")) + expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$medianUnbiasedEstimates, collapse = ", "), ")")) + expect_equal(x2$conditionalPowerSimulated, c(NA_real_, NA_real_, 0.591, 0.788), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalPowerSimulated, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x2), NA))) + expect_output(print(x2)$show()) + invisible(capture.output(expect_error(summary(x2), NA))) + expect_output(summary(x2)$show()) + x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) + expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) + expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-07) + expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-07) + expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalPowerSimulated, x2$conditionalPowerSimulated, tolerance = 1e-07) + expect_type(names(x2), "character") + df <- as.data.frame(x2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData2 <- testGetAnalysisResultsPlotData(x2, piTreatmentRange = seq(0.2, 0.5, 0.05), allocationRatioPlanned = 0.5) + + ## Comparison of the results of list object 'plotData2' with expected results + expect_equal(plotData2$xValues, c(0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$xValues, collapse = ", "), ")")) + expect_equal(plotData2$condPowerValues, c(0.998, 0.992, 0.967, 0.892, 0.807, 0.623, 0.493), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData2$likelihoodValues, c(1.003982e-05, 0.00017609247, 0.0020513476, 0.015871623, 0.081561833, 0.27837883, 0.63105765), tolerance = 1e-07, label = paste0("c(", paste0(plotData2$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData2$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData2$main, collapse = ", "), ")")) + expect_equal(plotData2$xlab, "pi1", label = paste0("c(", paste0(plotData2$xlab, collapse = ", "), ")")) + expect_equal(plotData2$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData2$ylab, collapse = ", "), ")")) + expect_equal(plotData2$sub, "Stage = 2, # of remaining subjects = 90, pi2 = 0.8, allocation ratio = 0.5", label = paste0("c(", paste0(plotData2$sub, collapse = ", "), ")")) + +}) + +test_that("'getAnalysisResults' produces the correct exact tests and final CIs", { + + .skipTestIfDisabled() + + dataExample8 <- getDataset( + n2 = c(31, 72), + n1 = c(30, 69), + events2 = c(8, 54), + events1 = c(6, 45) + ) + + design10 <- getDesignGroupSequential( + kMax = 2, alpha = 0.025, + typeOfDesign = "WT", deltaWT = 0.1, informationRates = c(0.3, 1) + ) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} + # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} + # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} + # @refFS[Formula]{fs:testStatisticNormalCombinationTest} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} + # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} + # @refFS[Formula]{fs:orderingPValueUpper} + # @refFS[Formula]{fs:finalCITwoRates} + # @refFS[Formula]{fs:medianUnbiasedEstimate} + x1 <- getAnalysisResults(design10, dataExample8, + thetaH0 = 0, stage = 2, directionUpper = FALSE, + normalApproximation = FALSE + ) + + ## Comparison of the results of AnalysisResultsGroupSequential object 'x1' with expected results + expect_equal(x1$pi1, 0.51515152, tolerance = 1e-07, label = paste0("c(", paste0(x1$pi1, collapse = ", "), ")")) + expect_equal(x1$pi2, 0.60194175, tolerance = 1e-07, label = paste0("c(", paste0(x1$pi2, collapse = ", "), ")")) + expect_equal(x1$testActions, c("continue", "accept"), label = paste0("c(", paste0(x1$testActions, collapse = ", "), ")")) + expect_equal(x1$conditionalRejectionProbabilities, c(0.013966781, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x1$conditionalPower, c(NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower, collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(-0.39509356, -0.22101238), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.29306133, 0.050448655), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x1$repeatedPValues, c(0.49999905, 0.15271161), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues, collapse = ", "), ")")) + expect_equal(x1$finalStage, 2, label = paste0("c(", paste0(x1$finalStage, collapse = ", "), ")")) + expect_equal(x1$finalPValues, c(NA_real_, 0.13570939), tolerance = 1e-07, label = paste0("c(", paste0(x1$finalPValues, collapse = ", "), ")")) + expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, -0.21309581), tolerance = 1e-07, label = paste0("c(", paste0(x1$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, 0.059922132), tolerance = 1e-07, label = paste0("c(", paste0(x1$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, -0.076600295), tolerance = 1e-07, label = paste0("c(", paste0(x1$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x1), NA))) + expect_output(print(x1)$show()) + invisible(capture.output(expect_error(summary(x1), NA))) + expect_output(summary(x1)$show()) + x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) + expect_equal(x1CodeBased$pi1, x1$pi1, tolerance = 1e-07) + expect_equal(x1CodeBased$pi2, x1$pi2, tolerance = 1e-07) + expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-07) + expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x1), "character") + df <- as.data.frame(x1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + design11 <- getDesignInverseNormal( + kMax = 2, alpha = 0.025, + typeOfDesign = "WT", deltaWT = 0.1, informationRates = c(0.3, 1) + ) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsInverseNormal} + # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} + # @refFS[Formula]{fs:testStatisticNormalCombinationTest} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionUnderNullGroupSequential} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} + # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} + x2 <- getAnalysisResults(design11, dataExample8, + thetaH0 = 0, stage = 2, directionUpper = FALSE, + normalApproximation = FALSE + ) + + ## Comparison of the results of AnalysisResultsInverseNormal object 'x2' with expected results + expect_equal(x2$pi1, 0.51515152, tolerance = 1e-07, label = paste0("c(", paste0(x2$pi1, collapse = ", "), ")")) + expect_equal(x2$pi2, 0.60194175, tolerance = 1e-07, label = paste0("c(", paste0(x2$pi2, collapse = ", "), ")")) + expect_equal(x2$testActions, c("continue", "accept"), label = paste0("c(", paste0(x2$testActions, collapse = ", "), ")")) + expect_equal(x2$conditionalRejectionProbabilities, c(0.013966781, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x2$conditionalPower, c(NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower, collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(-0.39509356, -0.20744977), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.29306133, 0.038390636), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x2$repeatedPValues, c(0.49999905, 0.171251), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues, collapse = ", "), ")")) + expect_equal(x2$finalStage, 2, label = paste0("c(", paste0(x2$finalStage, collapse = ", "), ")")) + expect_equal(x2$finalPValues, c(NA_real_, 0.15026298), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalPValues, collapse = ", "), ")")) + expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, -0.20860056), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, 0.064410651), tolerance = 1e-07, label = paste0("c(", paste0(x2$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, -0.072106168), tolerance = 1e-07, label = paste0("c(", paste0(x2$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x2), NA))) + expect_output(print(x2)$show()) + invisible(capture.output(expect_error(summary(x2), NA))) + expect_output(summary(x2)$show()) + x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) + expect_equal(x2CodeBased$pi1, x2$pi1, tolerance = 1e-07) + expect_equal(x2CodeBased$pi2, x2$pi2, tolerance = 1e-07) + expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) + expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-07) + expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-07) + expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x2), "character") + df <- as.data.frame(x2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + design12 <- getDesignFisher( + kMax = 2, alpha = 0.025, method = "fullAlpha", + informationRates = c(0.3, 1) + ) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsFisher} + # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} + # @refFS[Formula]{fs:testStatisticFisherCombinationTest} + # @refFS[Formula]{fs:definitionRCIFisherCombination} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:conditionalRejectionFisherInterim} + # @refFS[Formula]{fs:conditionalRejectionFisherLastInterim} + # @refFS[Formula]{fs:conditionalRejectionFisherweights} + # @refFS[Formula]{fs:conditionalRejectionProbabilityShiftedBoundaries} + # @refFS[Formula]{fs:conditionalPowerTwoRatesEffect} + # @refFS[Formula]{fs:conditionalPowerTwoRatesSampleSizes} + x3 <- getAnalysisResults(design12, dataExample8, + thetaH0 = 0, stage = 2, directionUpper = FALSE, + normalApproximation = FALSE, seed = 123 + ) + + ## Comparison of the results of AnalysisResultsFisher object 'x3' with expected results + expect_equal(x3$pi1, 0.51515152, tolerance = 1e-07, label = paste0("c(", paste0(x3$pi1, collapse = ", "), ")")) + expect_equal(x3$pi2, 0.60194175, tolerance = 1e-07, label = paste0("c(", paste0(x3$pi2, collapse = ", "), ")")) + expect_equal(x3$testActions, c("continue", "accept"), label = paste0("c(", paste0(x3$testActions, collapse = ", "), ")")) + expect_equal(x3$conditionalRejectionProbabilities, c(0.016431334, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x3$conditionalPower, c(NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPower, collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalLowerBounds, c(-0.39357809, -0.2198965), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalUpperBounds, c(0.29140184, 0.047490149), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x3$repeatedPValues, c(0.49999905, 0.18563047), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues, collapse = ", "), ")")) + expect_equal(x3$finalStage, 2, label = paste0("c(", paste0(x3$finalStage, collapse = ", "), ")")) + expect_equal(x3$finalPValues, c(NA_real_, 0.18562957), tolerance = 1e-07, label = paste0("c(", paste0(x3$finalPValues, collapse = ", "), ")")) + expect_equal(x3$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x3$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_), label = paste0("c(", paste0(x3$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x3$medianUnbiasedEstimates, c(NA_real_, NA_real_), label = paste0("c(", paste0(x3$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x3), NA))) + expect_output(print(x3)$show()) + invisible(capture.output(expect_error(summary(x3), NA))) + expect_output(summary(x3)$show()) + x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) + expect_equal(x3CodeBased$pi1, x3$pi1, tolerance = 1e-07) + expect_equal(x3CodeBased$pi2, x3$pi2, tolerance = 1e-07) + expect_equal(x3CodeBased$testActions, x3$testActions, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) + expect_equal(x3CodeBased$finalStage, x3$finalStage, tolerance = 1e-07) + expect_equal(x3CodeBased$finalPValues, x3$finalPValues, tolerance = 1e-07) + expect_equal(x3CodeBased$finalConfidenceIntervalLowerBounds, x3$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$finalConfidenceIntervalUpperBounds, x3$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$medianUnbiasedEstimates, x3$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x3), "character") + df <- as.data.frame(x3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getAnalysisResults' produces the correct non-inferiority results for a group sequential design", { + + .skipTestIfDisabled() + + design13 <- getDesignGroupSequential( + kMax = 2, alpha = 0.025, + typeOfDesign = "WT", deltaWT = 0.1, informationRates = c(0.3, 1) + ) + + dataExample9 <- getDataset( + n1 = c(29, 70), + n2 = c(31, 71), + events1 = c(8, 54), + events2 = c(6, 45) + ) + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} + # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} + # @refFS[Formula]{fs:testStatisticGroupSequential} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:EstimatesDiffFarringtonManning} + x1 <- getAnalysisResults(design13, dataExample9, + thetaH0 = -0.1, stage = 2, directionUpper = TRUE, + normalApproximation = TRUE + ) + + ## Comparison of the results of AnalysisResultsGroupSequential object 'x1' with expected results + expect_equal(x1$pi1, 0.62626263, tolerance = 1e-07, label = paste0("c(", paste0(x1$pi1, collapse = ", "), ")")) + expect_equal(x1$pi2, 0.5, tolerance = 1e-07, label = paste0("c(", paste0(x1$pi2, collapse = ", "), ")")) + expect_equal(x1$testActions, c("continue", "reject"), label = paste0("c(", paste0(x1$testActions, collapse = ", "), ")")) + expect_equal(x1$conditionalRejectionProbabilities, c(0.1027905, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x1$conditionalPower, c(NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower, collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalLowerBounds, c(-0.26992436, -0.011398056), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalUpperBounds, c(0.42527258, 0.25916391), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x1$repeatedPValues, c(0.17488831, 0.00058560119), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues, collapse = ", "), ")")) + expect_equal(x1$finalStage, 2, label = paste0("c(", paste0(x1$finalStage, collapse = ", "), ")")) + expect_equal(x1$finalPValues, c(NA_real_, 0.0012732763), tolerance = 1e-07, label = paste0("c(", paste0(x1$finalPValues, collapse = ", "), ")")) + expect_equal(x1$finalConfidenceIntervalLowerBounds, c(NA_real_, -0.016122347), tolerance = 1e-07, label = paste0("c(", paste0(x1$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x1$finalConfidenceIntervalUpperBounds, c(NA_real_, 0.26034096), tolerance = 1e-07, label = paste0("c(", paste0(x1$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x1$medianUnbiasedEstimates, c(NA_real_, 0.12355576), tolerance = 1e-07, label = paste0("c(", paste0(x1$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x1), NA))) + expect_output(print(x1)$show()) + invisible(capture.output(expect_error(summary(x1), NA))) + expect_output(summary(x1)$show()) + x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) + expect_equal(x1CodeBased$pi1, x1$pi1, tolerance = 1e-07) + expect_equal(x1CodeBased$pi2, x1$pi2, tolerance = 1e-07) + expect_equal(x1CodeBased$testActions, x1$testActions, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$finalStage, x1$finalStage, tolerance = 1e-07) + expect_equal(x1CodeBased$finalPValues, x1$finalPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$finalConfidenceIntervalLowerBounds, x1$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$finalConfidenceIntervalUpperBounds, x1$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$medianUnbiasedEstimates, x1$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x1), "character") + df <- as.data.frame(x1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} + # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} + # @refFS[Formula]{fs:testStatisticGroupSequential} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:EstimatesDiffFarringtonManning} + x2 <- getAnalysisResults(design13, dataExample9, + thetaH0 = -0.1, stage = 1, nPlanned = 40, + pi1 = 0.45, pi2 = 0.4, directionUpper = TRUE, normalApproximation = TRUE + ) + + ## Comparison of the results of AnalysisResultsGroupSequential object 'x2' with expected results + expect_equal(x2$testActions, c("continue", NA_character_), label = paste0("c(", paste0(x2$testActions, collapse = ", "), ")")) + expect_equal(x2$conditionalRejectionProbabilities, c(0.1027905, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x2$conditionalPower, c(NA_real_, 0.38169554), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalPower, collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalLowerBounds, c(-0.26992436, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalUpperBounds, c(0.42527258, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x2$repeatedPValues, c(0.17488831, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues, collapse = ", "), ")")) + expect_equal(x2$finalStage, NA_integer_, label = paste0("c(", paste0(x2$finalStage, collapse = ", "), ")")) + expect_equal(x2$finalPValues, c(NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalPValues, collapse = ", "), ")")) + expect_equal(x2$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x2$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_), label = paste0("c(", paste0(x2$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x2$medianUnbiasedEstimates, c(NA_real_, NA_real_), label = paste0("c(", paste0(x2$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x2), NA))) + expect_output(print(x2)$show()) + invisible(capture.output(expect_error(summary(x2), NA))) + expect_output(summary(x2)$show()) + x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) + expect_equal(x2CodeBased$testActions, x2$testActions, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) + expect_equal(x2CodeBased$finalStage, x2$finalStage, tolerance = 1e-07) + expect_equal(x2CodeBased$finalPValues, x2$finalPValues, tolerance = 1e-07) + expect_equal(x2CodeBased$finalConfidenceIntervalLowerBounds, x2$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$finalConfidenceIntervalUpperBounds, x2$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$medianUnbiasedEstimates, x2$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x2), "character") + df <- as.data.frame(x2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + plotData1 <- testGetAnalysisResultsPlotData(x2, piTreatmentRange = seq(0.25, 0.7, 0.05)) + + ## Comparison of the results of list object 'plotData1' with expected results + expect_equal(plotData1$xValues, c(0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$xValues, collapse = ", "), ")")) + expect_equal(plotData1$condPowerValues, c(0.053165998, 0.1027905, 0.17500031, 0.26934912, 0.38169554, 0.50456648, 0.62825352, 0.74249459, 0.83846571, 0.91065807), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$condPowerValues, collapse = ", "), ")")) + expect_equal(plotData1$likelihoodValues, c(0.95261056, 0.95859015, 0.67101367, 0.32674624, 0.11068039, 0.026080239, 0.0042749722, 0.00048745649, 3.866511e-05, 2.1334549e-06), tolerance = 1e-07, label = paste0("c(", paste0(plotData1$likelihoodValues, collapse = ", "), ")")) + expect_equal(plotData1$main, "Conditional Power with Likelihood", label = paste0("c(", paste0(plotData1$main, collapse = ", "), ")")) + expect_equal(plotData1$xlab, "pi1", label = paste0("c(", paste0(plotData1$xlab, collapse = ", "), ")")) + expect_equal(plotData1$ylab, "Conditional power / Likelihood", label = paste0("c(", paste0(plotData1$ylab, collapse = ", "), ")")) + expect_equal(plotData1$sub, "Stage = 1, # of remaining subjects = 40, pi2 = 0.4, allocation ratio = 1", label = paste0("c(", paste0(plotData1$sub, collapse = ", "), ")")) + + # non-inferiority, reversed "directionUpper" + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} + # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} + # @refFS[Formula]{fs:testStatisticGroupSequential} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:EstimatesDiffFarringtonManning} + x3 <- getAnalysisResults(design13, dataExample9, + thetaH0 = 0.1, stage = 2, directionUpper = FALSE, + normalApproximation = TRUE + ) + + ## Comparison of the results of AnalysisResultsGroupSequential object 'x3' with expected results + expect_equal(x3$pi1, 0.62626263, tolerance = 1e-07, label = paste0("c(", paste0(x3$pi1, collapse = ", "), ")")) + expect_equal(x3$pi2, 0.5, tolerance = 1e-07, label = paste0("c(", paste0(x3$pi2, collapse = ", "), ")")) + expect_equal(x3$testActions, c("continue", "accept"), label = paste0("c(", paste0(x3$testActions, collapse = ", "), ")")) + expect_equal(x3$conditionalRejectionProbabilities, c(0.012395218, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x3$conditionalPower, c(NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPower, collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalLowerBounds, c(-0.26992436, -0.011398056), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalUpperBounds, c(0.42527258, 0.25916391), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x3$repeatedPValues, c(0.49999905, 0.49999905), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues, collapse = ", "), ")")) + expect_equal(x3$finalStage, 2, label = paste0("c(", paste0(x3$finalStage, collapse = ", "), ")")) + expect_equal(x3$finalPValues, c(NA_real_, 0.64703032), tolerance = 1e-07, label = paste0("c(", paste0(x3$finalPValues, collapse = ", "), ")")) + expect_equal(x3$finalConfidenceIntervalLowerBounds, c(NA_real_, -0.0098227441), tolerance = 1e-07, label = paste0("c(", paste0(x3$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x3$finalConfidenceIntervalUpperBounds, c(NA_real_, 0.26218829), tolerance = 1e-07, label = paste0("c(", paste0(x3$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x3$medianUnbiasedEstimates, c(NA_real_, 0.12618258), tolerance = 1e-07, label = paste0("c(", paste0(x3$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x3), NA))) + expect_output(print(x3)$show()) + invisible(capture.output(expect_error(summary(x3), NA))) + expect_output(summary(x3)$show()) + x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) + expect_equal(x3CodeBased$pi1, x3$pi1, tolerance = 1e-07) + expect_equal(x3CodeBased$pi2, x3$pi2, tolerance = 1e-07) + expect_equal(x3CodeBased$testActions, x3$testActions, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) + expect_equal(x3CodeBased$finalStage, x3$finalStage, tolerance = 1e-07) + expect_equal(x3CodeBased$finalPValues, x3$finalPValues, tolerance = 1e-07) + expect_equal(x3CodeBased$finalConfidenceIntervalLowerBounds, x3$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$finalConfidenceIntervalUpperBounds, x3$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$medianUnbiasedEstimates, x3$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x3), "character") + df <- as.data.frame(x3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getAnalysisResultsGroupSequential} + # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} + # @refFS[Formula]{fs:pValuesTwoRatesAlternativeSmaller} + # @refFS[Formula]{fs:testStatisticGroupSequential} + # @refFS[Formula]{fs:definitionRCIInverseNormal} + # @refFS[Formula]{fs:calculationRepeatedpValue} + # @refFS[Formula]{fs:EstimatesDiffFarringtonManning} + x4 <- getAnalysisResults(design13, dataExample9, + thetaH0 = 0.1, stage = 1, nPlanned = 40, + pi1 = 0.4, pi2 = 0.45, directionUpper = FALSE, normalApproximation = TRUE + ) + + ## Comparison of the results of AnalysisResultsGroupSequential object 'x4' with expected results + expect_equal(x4$testActions, c("continue", NA_character_), label = paste0("c(", paste0(x4$testActions, collapse = ", "), ")")) + expect_equal(x4$conditionalRejectionProbabilities, c(0.012395218, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalRejectionProbabilities, collapse = ", "), ")")) + expect_equal(x4$conditionalPower, c(NA_real_, 0.10084143), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalPower, collapse = ", "), ")")) + expect_equal(x4$repeatedConfidenceIntervalLowerBounds, c(-0.26992436, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x4$repeatedConfidenceIntervalUpperBounds, c(0.42527258, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x4$repeatedPValues, c(0.49999905, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedPValues, collapse = ", "), ")")) + expect_equal(x4$finalStage, NA_integer_, label = paste0("c(", paste0(x4$finalStage, collapse = ", "), ")")) + expect_equal(x4$finalPValues, c(NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalPValues, collapse = ", "), ")")) + expect_equal(x4$finalConfidenceIntervalLowerBounds, c(NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(x4$finalConfidenceIntervalUpperBounds, c(NA_real_, NA_real_), label = paste0("c(", paste0(x4$finalConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(x4$medianUnbiasedEstimates, c(NA_real_, NA_real_), label = paste0("c(", paste0(x4$medianUnbiasedEstimates, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x4), NA))) + expect_output(print(x4)$show()) + invisible(capture.output(expect_error(summary(x4), NA))) + expect_output(summary(x4)$show()) + x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) + expect_equal(x4CodeBased$testActions, x4$testActions, tolerance = 1e-07) + expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-07) + expect_equal(x4CodeBased$finalStage, x4$finalStage, tolerance = 1e-07) + expect_equal(x4CodeBased$finalPValues, x4$finalPValues, tolerance = 1e-07) + expect_equal(x4CodeBased$finalConfidenceIntervalLowerBounds, x4$finalConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$finalConfidenceIntervalUpperBounds, x4$finalConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$medianUnbiasedEstimates, x4$medianUnbiasedEstimates, tolerance = 1e-07) + expect_type(names(x4), "character") + df <- as.data.frame(x4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getAnalysisResults' with a dataset of rates and without defining a design", { + + .skipTestIfDisabled() + + data <- getDataset( + n1 = c(10), + n2 = c(15), + events1 = c(8), + events2 = c(6) + ) + + # @refFS[Formula]{fs:testStatisticTwoRatesApproximation} + # @refFS[Formula]{fs:pValuesTwoRatesAlternativeGreater} + analysisResults1 <- getAnalysisResults(data, alpha = 0.02) + + ## Comparison of the results of AnalysisResultsInverseNormal object 'analysisResults1' with expected results + expect_equal(analysisResults1$pi1, 0.8, tolerance = 1e-07, label = paste0("c(", paste0(analysisResults1$pi1, collapse = ", "), ")")) + expect_equal(analysisResults1$pi2, 0.4, tolerance = 1e-07, label = paste0("c(", paste0(analysisResults1$pi2, collapse = ", "), ")")) + expect_equal(analysisResults1$testActions, "accept", label = paste0("c(", paste0(analysisResults1$testActions, collapse = ", "), ")")) + expect_equal(analysisResults1$repeatedConfidenceIntervalLowerBounds, -0.016534109, tolerance = 1e-07, label = paste0("c(", paste0(analysisResults1$repeatedConfidenceIntervalLowerBounds, collapse = ", "), ")")) + expect_equal(analysisResults1$repeatedConfidenceIntervalUpperBounds, 0.68698828, tolerance = 1e-07, label = paste0("c(", paste0(analysisResults1$repeatedConfidenceIntervalUpperBounds, collapse = ", "), ")")) + expect_equal(analysisResults1$repeatedPValues, 0.024199112, tolerance = 1e-07, label = paste0("c(", paste0(analysisResults1$repeatedPValues, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(analysisResults1), NA))) + expect_output(print(analysisResults1)$show()) + invisible(capture.output(expect_error(summary(analysisResults1), NA))) + expect_output(summary(analysisResults1)$show()) + analysisResults1CodeBased <- eval(parse(text = getObjectRCode(analysisResults1, stringWrapParagraphWidth = NULL))) + expect_equal(analysisResults1CodeBased$pi1, analysisResults1$pi1, tolerance = 1e-07) + expect_equal(analysisResults1CodeBased$pi2, analysisResults1$pi2, tolerance = 1e-07) + expect_equal(analysisResults1CodeBased$testActions, analysisResults1$testActions, tolerance = 1e-07) + expect_equal(analysisResults1CodeBased$repeatedConfidenceIntervalLowerBounds, analysisResults1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(analysisResults1CodeBased$repeatedConfidenceIntervalUpperBounds, analysisResults1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(analysisResults1CodeBased$repeatedPValues, analysisResults1$repeatedPValues, tolerance = 1e-07) + expect_type(names(analysisResults1), "character") + df <- as.data.frame(analysisResults1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(analysisResults1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getAnalysisResults' produces the correct critical values for a boundary recalculation at the last stage", { + + .skipTestIfDisabled() + + data1 <- getDataset( + overallN = c(22, 33, 45), + overallEvents = c(11, 18, 28) + ) + data2 <- getDataset( + overallN = c(22, 33, 40), + overallEvents = c(11, 18, 23) + ) + data3 <- getDataset( + overallN = c(22, 33, 38), + overallEvents = c(11, 18, 21) + ) + design <- getDesignGroupSequential( + typeOfDesign = "asP" + ) + + # @refFS[Formula]{fs:getAnalysisResults:maxInformation} + # @refFS[Formula]{fs:getAnalysisResults:maxInformation:methods} + expect_warning(result1 <- getAnalysisResults(design, data1, + thetaH0 = 0.5, maxInformation = 40 + )) + result2 <- getAnalysisResults(design, data2, + thetaH0 = 0.5, maxInformation = 40 + ) + expect_warning(result3 <- getAnalysisResults(design, data3, + thetaH0 = 0.5, maxInformation = 40, informationEpsilon = 2 + )) + expect_equal(result1$.design$criticalValues[1:2], result2$.design$criticalValues[1:2], tolerance = 1e-07) + expect_equal(result1$.design$criticalValues[1:2], result3$.design$criticalValues[1:2], tolerance = 1e-07) + expect_equal(result2$.design$criticalValues[1:2], result3$.design$criticalValues[1:2], tolerance = 1e-07) +}) + diff --git a/tests/testthat/test-f_analysis_enrichment_rates.R b/tests/testthat/test-f_analysis_enrichment_rates.R index 489ba7d6..e55e90bf 100644 --- a/tests/testthat/test-f_analysis_enrichment_rates.R +++ b/tests/testthat/test-f_analysis_enrichment_rates.R @@ -1,668 +1,667 @@ -## | -## | *Unit tests* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | RPACT package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File name: test-f_analysis_enrichment_rates.R -## | Creation date: 08 November 2023, 08:54:54 -## | File version: $Revision$ -## | Last changed: $Date$ -## | Last changed by: $Author$ -## | - -test_plan_section("Testing Analysis Enrichment Rates Function") - - -test_that("'getAnalysisResults': enrichment rates, one sub-population, non-stratified input, select S1 at second IA, directionUpper = FALSE, gMax = 2", { - .skipTestIfDisabled() - - # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} - # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} - # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} - # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentRates} - # @refFS[Formula]{fs:computeRCIsEnrichment} - # @refFS[Formula]{fs:conditionalPowerEnrichment} - # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} - # @refFS[Formula]{fs:stratifiedTestEnrichmentRates} - # @refFS[Formula]{fs:testStatisticEnrichmentRates} - design1 <- getDesignInverseNormal(kMax = 3, alpha = 0.02, typeOfDesign = "P", informationRates = c(0.4, 0.7, 1)) - - S1 <- getDataset( - sampleSize1 = c(22, 31, 37), - sampleSize2 = c(28, 33, 39), - events1 = c(7, 16, 17), - events2 = c(18, 21, 19) - ) - - F <- getDataset( - sampleSize1 = c(46, 54, NA), - sampleSize2 = c(49, 62, NA), - events1 = c(16, 31, NA), - events2 = c(29, 35, NA) - ) - - dataInput1 <- getDataset(S1 = S1, F = F) - - ## Comparison of the results of DatasetRates object 'dataInput1' with expected results - expect_equal(dataInput1$overallSampleSizes, c(22, 46, 28, 49, 53, 100, 61, 111, 90, NA_real_, 100, NA_real_), label = paste0("c(", paste0(dataInput1$overallSampleSizes, collapse = ", "), ")")) - expect_equal(dataInput1$overallEvents, c(7, 16, 18, 29, 23, 47, 39, 64, 40, NA_real_, 58, NA_real_), label = paste0("c(", paste0(dataInput1$overallEvents, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dataInput1), NA))) - expect_output(print(dataInput1)$show()) - invisible(capture.output(expect_error(summary(dataInput1), NA))) - expect_output(summary(dataInput1)$show()) - dataInput1CodeBased <- eval(parse(text = getObjectRCode(dataInput1, stringWrapParagraphWidth = NULL))) - expect_equal(dataInput1CodeBased$overallSampleSizes, dataInput1$overallSampleSizes, tolerance = 1e-07) - expect_equal(dataInput1CodeBased$overallEvents, dataInput1$overallEvents, tolerance = 1e-07) - expect_type(names(dataInput1), "character") - df <- as.data.frame(dataInput1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dataInput1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x1 <- getAnalysisResults(design1, dataInput1, - stratifiedAnalysis = FALSE, - intersectionTest = "SpiessensDebois", - allocationRatioPlanned = 0.5, - directionUpper = FALSE, - normalApproximation = TRUE, - stage = 2, - nPlanned = c(80) - ) - - ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x1' with expected results - expect_equal(x1$piTreatments[1, ], 0.43396226, tolerance = 1e-07, label = paste0("c(", paste0(x1$piTreatments[1, ], collapse = ", "), ")")) - expect_equal(x1$piTreatments[2, ], 0.47, tolerance = 1e-07, label = paste0("c(", paste0(x1$piTreatments[2, ], collapse = ", "), ")")) - expect_equal(x1$conditionalRejectionProbabilities[1, ], c(0.17935289, 0.13861558, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(x1$conditionalRejectionProbabilities[2, ], c(0.17935289, 0.047432959, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(x1$conditionalPower[1, ], c(NA_real_, NA_real_, 0.74825773), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(x1$conditionalPower[2, ], c(NA_real_, NA_real_, 0.22069678), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.61149604, -0.44933531, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.47492191, -0.29772839, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalUpperBounds[1, ], c(0.040176497, 0.029772743, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalUpperBounds[2, ], c(0.018732449, 0.06513775, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(x1$repeatedPValues[1, ], c(0.031827909, 0.031827909, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(x1$repeatedPValues[2, ], c(0.031827909, 0.031827909, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(x1$piControls[1, ], 0.63934426, tolerance = 1e-07, label = paste0("c(", paste0(x1$piControls[1, ], collapse = ", "), ")")) - expect_equal(x1$piControls[2, ], 0.57657658, tolerance = 1e-07, label = paste0("c(", paste0(x1$piControls[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x1), NA))) - expect_output(print(x1)$show()) - invisible(capture.output(expect_error(summary(x1), NA))) - expect_output(summary(x1)$show()) - x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) - expect_equal(x1CodeBased$piTreatments, x1$piTreatments, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) - expect_equal(x1CodeBased$piControls, x1$piControls, tolerance = 1e-07) - expect_type(names(x1), "character") - df <- as.data.frame(x1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - .skipTestIfDisabled() - - x2 <- getAnalysisResults(design1, dataInput1, - stratifiedAnalysis = FALSE, - intersectionTest = "Bonferroni", - allocationRatioPlanned = 0.5, - directionUpper = FALSE, - normalApproximation = TRUE, - stage = 2, - nPlanned = c(80) - ) - - ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x2' with expected results - expect_equal(x2$piTreatments[1, ], 0.43396226, tolerance = 1e-07, label = paste0("c(", paste0(x2$piTreatments[1, ], collapse = ", "), ")")) - expect_equal(x2$piTreatments[2, ], 0.47, tolerance = 1e-07, label = paste0("c(", paste0(x2$piTreatments[2, ], collapse = ", "), ")")) - expect_equal(x2$conditionalRejectionProbabilities[1, ], c(0.16289564, 0.075460476, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(x2$conditionalRejectionProbabilities[2, ], c(0.16289564, 0.047432959, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(x2$conditionalPower[1, ], c(NA_real_, NA_real_, 0.62405214), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(x2$conditionalPower[2, ], c(NA_real_, NA_real_, 0.22069678), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.61554799, -0.46343398, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.47860086, -0.31516617, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalUpperBounds[1, ], c(0.046721667, 0.044120395, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalUpperBounds[2, ], c(0.02350445, 0.081574104, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(x2$repeatedPValues[1, ], c(0.036684009, 0.036684009, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(x2$repeatedPValues[2, ], c(0.036684009, 0.036684009, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(x2$piControls[1, ], 0.63934426, tolerance = 1e-07, label = paste0("c(", paste0(x2$piControls[1, ], collapse = ", "), ")")) - expect_equal(x2$piControls[2, ], 0.57657658, tolerance = 1e-07, label = paste0("c(", paste0(x2$piControls[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x2), NA))) - expect_output(print(x2)$show()) - invisible(capture.output(expect_error(summary(x2), NA))) - expect_output(summary(x2)$show()) - x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) - expect_equal(x2CodeBased$piTreatments, x2$piTreatments, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) - expect_equal(x2CodeBased$piControls, x2$piControls, tolerance = 1e-07) - expect_type(names(x2), "character") - df <- as.data.frame(x2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getAnalysisResults': enrichment rates, one sub-population, stratified input, select S1 at second IA, directionUpper = FALSE, gMax = 2", { - - .skipTestIfDisabled() - - # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} - # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} - # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} - # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentRates} - # @refFS[Formula]{fs:computeRCIsEnrichment} - # @refFS[Formula]{fs:conditionalPowerEnrichment} - # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} - # @refFS[Formula]{fs:stratifiedTestEnrichmentRates} - # @refFS[Formula]{fs:testStatisticEnrichmentRates} - design1 <- getDesignInverseNormal(kMax = 3, alpha = 0.05, typeOfDesign = "WT", deltaWT = 0.1, informationRates = c(0.4, 0.7, 1)) - - S1 <- getDataset( - sampleSize1 = c(22, 31, 37), - sampleSize2 = c(28, 33, 39), - events1 = c(7, 16, 10), - events2 = c(18, 21, 19) - ) - - R <- getDataset( - sampleSize1 = c(24, 23, NA), - sampleSize2 = c(21, 29, NA), - events1 = c(9, 15, NA), - events2 = c(11, 14, NA) - ) - - dataInput2 <- getDataset(S1 = S1, R = R) - - ## Comparison of the results of DatasetRates object 'dataInput2' with expected results - expect_equal(dataInput2$overallSampleSizes, c(22, 24, 28, 21, 53, 47, 61, 50, 90, NA_real_, 100, NA_real_), label = paste0("c(", paste0(dataInput2$overallSampleSizes, collapse = ", "), ")")) - expect_equal(dataInput2$overallEvents, c(7, 9, 18, 11, 23, 24, 39, 25, 33, NA_real_, 58, NA_real_), label = paste0("c(", paste0(dataInput2$overallEvents, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dataInput2), NA))) - expect_output(print(dataInput2)$show()) - invisible(capture.output(expect_error(summary(dataInput2), NA))) - expect_output(summary(dataInput2)$show()) - dataInput2CodeBased <- eval(parse(text = getObjectRCode(dataInput2, stringWrapParagraphWidth = NULL))) - expect_equal(dataInput2CodeBased$overallSampleSizes, dataInput2$overallSampleSizes, tolerance = 1e-07) - expect_equal(dataInput2CodeBased$overallEvents, dataInput2$overallEvents, tolerance = 1e-07) - expect_type(names(dataInput2), "character") - df <- as.data.frame(dataInput2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dataInput2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x3 <- getAnalysisResults(design1, dataInput2, - stratifiedAnalysis = FALSE, - intersectionTest = "Simes", - directionUpper = FALSE, - normalApproximation = FALSE - ) - - ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x3' with expected results - expect_equal(x3$piTreatments[1, ], 0.36666667, tolerance = 1e-07, label = paste0("c(", paste0(x3$piTreatments[1, ], collapse = ", "), ")")) - expect_equal(x3$piTreatments[2, ], NA_real_, label = paste0("c(", paste0(x3$piTreatments[2, ], collapse = ", "), ")")) - expect_equal(x3$conditionalRejectionProbabilities[1, ], c(0.34476337, 0.21123906, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(x3$conditionalRejectionProbabilities[2, ], c(0.34476337, 0.16889178, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(x3$conditionalPower[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(x3$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.62776669, -0.44175544, -0.38366304), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.4897991, -0.29886557, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalUpperBounds[1, ], c(0.066751342, 0.016446892, -0.050014598), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalUpperBounds[2, ], c(0.038157503, 0.063536395, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(x3$repeatedPValues[1, ], c(0.10653002, 0.10653002, 0.014413851), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(x3$repeatedPValues[2, ], c(0.10653002, 0.10653002, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(x3$piControls[1, ], 0.58, tolerance = 1e-07, label = paste0("c(", paste0(x3$piControls[1, ], collapse = ", "), ")")) - expect_equal(x3$piControls[2, ], NA_real_, label = paste0("c(", paste0(x3$piControls[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x3), NA))) - expect_output(print(x3)$show()) - invisible(capture.output(expect_error(summary(x3), NA))) - expect_output(summary(x3)$show()) - x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) - expect_equal(x3CodeBased$piTreatments, x3$piTreatments, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) - expect_equal(x3CodeBased$piControls, x3$piControls, tolerance = 1e-07) - expect_type(names(x3), "character") - df <- as.data.frame(x3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - x4 <- getAnalysisResults(design1, dataInput2, - stratifiedAnalysis = TRUE, - intersectionTest = "Simes", - directionUpper = FALSE, - normalApproximation = TRUE - ) - - ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x4' with expected results - expect_equal(x4$piTreatments[1, ], 0.36666667, tolerance = 1e-07, label = paste0("c(", paste0(x4$piTreatments[1, ], collapse = ", "), ")")) - expect_equal(x4$piTreatments[2, ], NA_real_, label = paste0("c(", paste0(x4$piTreatments[2, ], collapse = ", "), ")")) - expect_equal(x4$conditionalRejectionProbabilities[1, ], c(0.4519333, 0.45336181, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(x4$conditionalRejectionProbabilities[2, ], c(0.4519333, 0.2823056, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(x4$conditionalPower[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(x4$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(x4$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.62776669, -0.44175544, -0.38366304), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(x4$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.48811625, -0.29740945, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(x4$repeatedConfidenceIntervalUpperBounds[1, ], c(0.066751342, 0.016446892, -0.050014598), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(x4$repeatedConfidenceIntervalUpperBounds[2, ], c(0.041874626, 0.06452777, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(x4$repeatedPValues[1, ], c(0.07212343, 0.050354903, 0.0033350387), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(x4$repeatedPValues[2, ], c(0.07212343, 0.065501128, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(x4$piControls[1, ], 0.58, tolerance = 1e-07, label = paste0("c(", paste0(x4$piControls[1, ], collapse = ", "), ")")) - expect_equal(x4$piControls[2, ], NA_real_, label = paste0("c(", paste0(x4$piControls[2, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x4), NA))) - expect_output(print(x4)$show()) - invisible(capture.output(expect_error(summary(x4), NA))) - expect_output(summary(x4)$show()) - x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) - expect_equal(x4CodeBased$piTreatments, x4$piTreatments, tolerance = 1e-07) - expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-07) - expect_equal(x4CodeBased$piControls, x4$piControls, tolerance = 1e-07) - expect_type(names(x4), "character") - df <- as.data.frame(x4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getAnalysisResults': enrichment rates, more sub-populations, select S1 and S2 at first IA, select S1 at second, directionUpper = TRUE, gMax = 3", { - - .skipTestIfDisabled() - - # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} - # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} - # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} - # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentRates} - # @refFS[Formula]{fs:computeRCIsEnrichment} - # @refFS[Formula]{fs:conditionalPowerEnrichment} - # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} - # @refFS[Formula]{fs:stratifiedTestEnrichmentRates} - # @refFS[Formula]{fs:testStatisticEnrichmentRates} - S1 <- getDataset( - sampleSize1 = c(47, 33, 37), - sampleSize2 = c(48, 47, 39), - events1 = c(18, 13, 17), - events2 = c(12, 11, 9) - ) - - S2 <- getDataset( - sampleSize1 = c(49, NA, NA), - sampleSize2 = c(45, NA, NA), - events1 = c(12, NA, NA), - events2 = c(13, NA, NA) - ) - - S12 <- getDataset( - sampleSize1 = c(35, 42, NA), - sampleSize2 = c(36, 47, NA), - events1 = c(19, 10, NA), - events2 = c(13, 17, NA) - ) - - R <- getDataset( - sampleSize1 = c(43, NA, NA), - sampleSize2 = c(39, NA, NA), - events1 = c(17, NA, NA), - events2 = c(14, NA, NA) - ) - - dataInput3 <- getDataset(S1 = S1, S2 = S2, S12 = S12, R = R) - - ## Comparison of the results of DatasetRates object 'dataInput3' with expected results - expect_equal(dataInput3$overallSampleSizes, c(47, 49, 35, 43, 48, 45, 36, 39, 80, NA_real_, 77, NA_real_, 95, NA_real_, 83, NA_real_, 117, NA_real_, NA_real_, NA_real_, 134, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(dataInput3$overallSampleSizes, collapse = ", "), ")")) - expect_equal(dataInput3$overallEvents, c(18, 12, 19, 17, 12, 13, 13, 14, 31, NA_real_, 29, NA_real_, 23, NA_real_, 30, NA_real_, 48, NA_real_, NA_real_, NA_real_, 32, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(dataInput3$overallEvents, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dataInput3), NA))) - expect_output(print(dataInput3)$show()) - invisible(capture.output(expect_error(summary(dataInput3), NA))) - expect_output(summary(dataInput3)$show()) - dataInput3CodeBased <- eval(parse(text = getObjectRCode(dataInput3, stringWrapParagraphWidth = NULL))) - expect_equal(dataInput3CodeBased$overallSampleSizes, dataInput3$overallSampleSizes, tolerance = 1e-07) - expect_equal(dataInput3CodeBased$overallEvents, dataInput3$overallEvents, tolerance = 1e-07) - expect_type(names(dataInput3), "character") - df <- as.data.frame(dataInput3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dataInput3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - design1 <- getDesignInverseNormal(kMax = 3, alpha = 0.05, typeOfDesign = "WT", deltaWT = 0.1, informationRates = c(0.4, 0.7, 1)) - - x1 <- getAnalysisResults(design1, dataInput3, - directionUpper = TRUE, - stratifiedAnalysis = FALSE, - intersectionTest = "Sidak", - allocationRatioPlanned = 3, - normalApproximation = FALSE, - nPlanned = c(80), - piControls = c(0.2, NA, NA), - piTreatments = c(0.55, NA, NA), - stage = 2 - ) - - ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x1' with expected results - expect_equal(x1$conditionalRejectionProbabilities[1, ], c(0.15297113, 0.049132584, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(x1$conditionalRejectionProbabilities[2, ], c(0.034063149, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(x1$conditionalRejectionProbabilities[3, ], c(0.064895921, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(x1$conditionalPower[1, ], c(NA_real_, NA_real_, 0.89354539), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(x1$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(x1$conditionalPower[3, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.062823383, -0.036086154, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.16425035, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalLowerBounds[3, ], c(-0.078510197, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalUpperBounds[1, ], c(0.35743976, 0.21982839, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalUpperBounds[2, ], c(0.25557989, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(x1$repeatedConfidenceIntervalUpperBounds[3, ], c(0.21491638, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(x1$repeatedPValues[1, ], c(0.23298603, 0.23298603, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(x1$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(x1$repeatedPValues[3, ], c(0.389024, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x1), NA))) - expect_output(print(x1)$show()) - invisible(capture.output(expect_error(summary(x1), NA))) - expect_output(summary(x1)$show()) - x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) - expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) - expect_type(names(x1), "character") - df <- as.data.frame(x1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - design2 <- getDesignFisher(kMax = 3, method = "equalAlpha", alpha = 0.05, informationRates = c(0.4, 0.7, 1)) - - x2 <- getAnalysisResults(design2, dataInput3, - directionUpper = TRUE, - stratifiedAnalysis = FALSE, - intersectionTest = "Sidak", - normalApproximation = FALSE, - stage = 3 - ) - - ## Comparison of the results of AnalysisResultsEnrichmentFisher object 'x2' with expected results - expect_equal(x2$piTreatments[1, ], 0.41025641, tolerance = 1e-07, label = paste0("c(", paste0(x2$piTreatments[1, ], collapse = ", "), ")")) - expect_equal(x2$piTreatments[2, ], NA_real_, label = paste0("c(", paste0(x2$piTreatments[2, ], collapse = ", "), ")")) - expect_equal(x2$piTreatments[3, ], NA_real_, label = paste0("c(", paste0(x2$piTreatments[3, ], collapse = ", "), ")")) - expect_equal(x2$conditionalRejectionProbabilities[1, ], c(0.075105953, 0.018243594, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(x2$conditionalRejectionProbabilities[2, ], c(0.020009021, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(x2$conditionalRejectionProbabilities[3, ], c(0.031471245, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(x2$conditionalPower[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(x2$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(x2$conditionalPower[3, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.023654531, -0.034180226, 0.008300518), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.12625532, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalLowerBounds[3, ], c(-0.051634044, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalUpperBounds[1, ], c(0.32239366, 0.19556, 0.21299371), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalUpperBounds[2, ], c(0.21912956, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(x2$repeatedConfidenceIntervalUpperBounds[3, ], c(0.1890798, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(x2$repeatedPValues[1, ], c(0.14811777, 0.14811777, 0.07171335), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(x2$repeatedPValues[2, ], c(0.46979052, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(x2$repeatedPValues[3, ], c(0.32146776, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(x2$piControls[1, ], 0.23880597, tolerance = 1e-07, label = paste0("c(", paste0(x2$piControls[1, ], collapse = ", "), ")")) - expect_equal(x2$piControls[2, ], NA_real_, label = paste0("c(", paste0(x2$piControls[2, ], collapse = ", "), ")")) - expect_equal(x2$piControls[3, ], NA_real_, label = paste0("c(", paste0(x2$piControls[3, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x2), NA))) - expect_output(print(x2)$show()) - invisible(capture.output(expect_error(summary(x2), NA))) - expect_output(summary(x2)$show()) - x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) - expect_equal(x2CodeBased$piTreatments, x2$piTreatments, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) - expect_equal(x2CodeBased$piControls, x2$piControls, tolerance = 1e-07) - expect_type(names(x2), "character") - df <- as.data.frame(x2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getAnalysisResults': enrichment rates, more sub-populations, non-stratified input, select S1 and S2 at first IA, select S1 at second, directionUpper = FALSE, gMax = 4", { - - .skipTestIfDisabled() - - # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} - # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} - # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} - # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} - # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentRates} - # @refFS[Formula]{fs:computeRCIsEnrichment} - # @refFS[Formula]{fs:conditionalPowerEnrichment} - # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} - # @refFS[Formula]{fs:stratifiedTestEnrichmentRates} - # @refFS[Formula]{fs:testStatisticEnrichmentRates} - S1 <- getDataset( - sampleSize1 = c(84, 94, 25), - sampleSize2 = c(82, 75, 23), - events1 = c(21, 28, 13), - events2 = c(32, 23, 20) - ) - - S2 <- getDataset( - sampleSize1 = c(81, 95, NA), - sampleSize2 = c(84, 64, NA), - events1 = c(26, 29, NA), - events2 = c(31, 26, NA) - ) - - S3 <- getDataset( - sampleSize1 = c(71, NA, NA), - sampleSize2 = c(74, NA, NA), - events1 = c(16, NA, NA), - events2 = c(21, NA, NA) - ) - - F <- getDataset( - sampleSize1 = c(248, NA, NA), - sampleSize2 = c(254, NA, NA), - events1 = c(75, NA, NA), - events2 = c(98, NA, NA) - ) - - R <- getDataset( - sampleSize1 = c(12, NA, NA), - sampleSize2 = c(14, NA, NA), - events1 = c(12, NA, NA), - events2 = c(14, NA, NA) - ) - - dataInput4 <- getDataset(S1 = S1, S2 = S2, S3 = S3, F = F) - - ## Comparison of the results of DatasetRates object 'dataInput4' with expected results - expect_equal(dataInput4$overallSampleSizes, c(84, 81, 71, 248, 82, 84, 74, 254, 178, 176, NA_real_, NA_real_, 157, 148, NA_real_, NA_real_, 203, NA_real_, NA_real_, NA_real_, 180, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(dataInput4$overallSampleSizes, collapse = ", "), ")")) - expect_equal(dataInput4$overallEvents, c(21, 26, 16, 75, 32, 31, 21, 98, 49, 55, NA_real_, NA_real_, 55, 57, NA_real_, NA_real_, 62, NA_real_, NA_real_, NA_real_, 75, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(dataInput4$overallEvents, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dataInput4), NA))) - expect_output(print(dataInput4)$show()) - invisible(capture.output(expect_error(summary(dataInput4), NA))) - expect_output(summary(dataInput4)$show()) - dataInput4CodeBased <- eval(parse(text = getObjectRCode(dataInput4, stringWrapParagraphWidth = NULL))) - expect_equal(dataInput4CodeBased$overallSampleSizes, dataInput4$overallSampleSizes, tolerance = 1e-07) - expect_equal(dataInput4CodeBased$overallEvents, dataInput4$overallEvents, tolerance = 1e-07) - expect_type(names(dataInput4), "character") - df <- as.data.frame(dataInput4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dataInput4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - design1 <- getDesignInverseNormal(kMax = 3, alpha = 0.05, typeOfDesign = "asKD", gammaA = 2, informationRates = c(0.4, 0.7, 1)) - - x3 <- getAnalysisResults(design1, dataInput4, - directionUpper = FALSE, - stratifiedAnalysis = FALSE, - intersectionTest = "Sidak", - allocationRatioPlanned = 1, - stage = 3, - normalApproximation = TRUE - ) - - ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x3' with expected results - expect_equal(x3$piTreatments[1, ], 0.30541872, tolerance = 1e-07, label = paste0("c(", paste0(x3$piTreatments[1, ], collapse = ", "), ")")) - expect_equal(x3$piTreatments[2, ], NA_real_, label = paste0("c(", paste0(x3$piTreatments[2, ], collapse = ", "), ")")) - expect_equal(x3$piTreatments[3, ], NA_real_, label = paste0("c(", paste0(x3$piTreatments[3, ], collapse = ", "), ")")) - expect_equal(x3$piTreatments[4, ], NA_real_, label = paste0("c(", paste0(x3$piTreatments[4, ], collapse = ", "), ")")) - expect_equal(x3$conditionalRejectionProbabilities[1, ], c(0.13745997, 0.082835151, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) - expect_equal(x3$conditionalRejectionProbabilities[2, ], c(0.023915975, 0.064596491, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) - expect_equal(x3$conditionalRejectionProbabilities[3, ], c(0.023915975, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) - expect_equal(x3$conditionalRejectionProbabilities[4, ], c(0.13745997, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities[4, ], collapse = ", "), ")")) - expect_equal(x3$conditionalPower[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPower[1, ], collapse = ", "), ")")) - expect_equal(x3$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPower[2, ], collapse = ", "), ")")) - expect_equal(x3$conditionalPower[3, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPower[3, ], collapse = ", "), ")")) - expect_equal(x3$conditionalPower[4, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPower[4, ], collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.33926099, -0.22469062, -0.248011), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.255132, -0.21555052, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalLowerBounds[3, ], c(-0.26390722, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalLowerBounds[4, ], c(-0.20314825, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds[4, ], collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalUpperBounds[1, ], c(0.068268149, 0.059220127, -0.0081515662), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalUpperBounds[2, ], c(0.16378176, 0.07555087, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalUpperBounds[3, ], c(0.15232186, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) - expect_equal(x3$repeatedConfidenceIntervalUpperBounds[4, ], c(0.038730826, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds[4, ], collapse = ", "), ")")) - expect_equal(x3$repeatedPValues[1, ], c(0.5, 0.26483774, 0.01063254), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues[1, ], collapse = ", "), ")")) - expect_equal(x3$repeatedPValues[2, ], c(0.5, 0.30264322, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues[2, ], collapse = ", "), ")")) - expect_equal(x3$repeatedPValues[3, ], c(0.5, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues[3, ], collapse = ", "), ")")) - expect_equal(x3$repeatedPValues[4, ], c(0.5, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues[4, ], collapse = ", "), ")")) - expect_equal(x3$piControls[1, ], 0.41666667, tolerance = 1e-07, label = paste0("c(", paste0(x3$piControls[1, ], collapse = ", "), ")")) - expect_equal(x3$piControls[2, ], NA_real_, label = paste0("c(", paste0(x3$piControls[2, ], collapse = ", "), ")")) - expect_equal(x3$piControls[3, ], NA_real_, label = paste0("c(", paste0(x3$piControls[3, ], collapse = ", "), ")")) - expect_equal(x3$piControls[4, ], NA_real_, label = paste0("c(", paste0(x3$piControls[4, ], collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x3), NA))) - expect_output(print(x3)$show()) - invisible(capture.output(expect_error(summary(x3), NA))) - expect_output(summary(x3)$show()) - x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) - expect_equal(x3CodeBased$piTreatments, x3$piTreatments, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) - expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) - expect_equal(x3CodeBased$piControls, x3$piControls, tolerance = 1e-07) - expect_type(names(x3), "character") - df <- as.data.frame(x3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getAnalysisResults': enrichment rates, expected warning for empty subsets", { - - .skipTestIfDisabled() - - S1 <- getDataset( - sampleSize1 = c(84, 94, 25), - sampleSize2 = c(82, 75, 23), - events1 = c(21, 28, 13), - events2 = c(32, 23, 20) - ) - - S2 <- getDataset( - sampleSize1 = c(81, 95, NA), - sampleSize2 = c(84, 64, NA), - events1 = c(26, 29, NA), - events2 = c(31, 26, NA) - ) - - S3 <- getDataset( - sampleSize1 = c(71, NA, NA), - sampleSize2 = c(74, NA, NA), - events1 = c(16, NA, NA), - events2 = c(21, NA, NA) - ) - - R <- getDataset( - sampleSize1 = c(12, NA, NA), - sampleSize2 = c(14, NA, NA), - events1 = c(12, NA, NA), - events2 = c(14, NA, NA) - ) - - expect_warning(getDataset(S1 = S1, S2 = S2, S3 = S3, R = R), - "The 4 undefined subsets S12, S13, S23, S123 were defined as empty subsets", - fixed = TRUE - ) - -}) - +## | +## | *Unit tests* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | RPACT package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File name: test-f_analysis_enrichment_rates.R +## | Creation date: 08 November 2023, 08:54:54 +## | File version: $Revision$ +## | Last changed: $Date$ +## | Last changed by: $Author$ +## | + +test_plan_section("Testing Analysis Enrichment Rates Function") + + +test_that("'getAnalysisResults': enrichment rates, one sub-population, non-stratified input, select S1 at second IA, directionUpper = FALSE, gMax = 2", { + .skipTestIfDisabled() + + # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} + # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} + # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} + # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentRates} + # @refFS[Formula]{fs:computeRCIsEnrichment} + # @refFS[Formula]{fs:conditionalPowerEnrichment} + # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} + # @refFS[Formula]{fs:stratifiedTestEnrichmentRates} + # @refFS[Formula]{fs:testStatisticEnrichmentRates} + design1 <- getDesignInverseNormal(kMax = 3, alpha = 0.02, typeOfDesign = "P", informationRates = c(0.4, 0.7, 1)) + + S1 <- getDataset( + sampleSize1 = c(22, 31, 37), + sampleSize2 = c(28, 33, 39), + events1 = c(7, 16, 17), + events2 = c(18, 21, 19) + ) + + F <- getDataset( + sampleSize1 = c(46, 54, NA), + sampleSize2 = c(49, 62, NA), + events1 = c(16, 31, NA), + events2 = c(29, 35, NA) + ) + + dataInput1 <- getDataset(S1 = S1, F = F) + + ## Comparison of the results of DatasetRates object 'dataInput1' with expected results + expect_equal(dataInput1$overallSampleSizes, c(22, 46, 28, 49, 53, 100, 61, 111, 90, NA_real_, 100, NA_real_), label = paste0("c(", paste0(dataInput1$overallSampleSizes, collapse = ", "), ")")) + expect_equal(dataInput1$overallEvents, c(7, 16, 18, 29, 23, 47, 39, 64, 40, NA_real_, 58, NA_real_), label = paste0("c(", paste0(dataInput1$overallEvents, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dataInput1), NA))) + expect_output(print(dataInput1)$show()) + invisible(capture.output(expect_error(summary(dataInput1), NA))) + expect_output(summary(dataInput1)$show()) + dataInput1CodeBased <- eval(parse(text = getObjectRCode(dataInput1, stringWrapParagraphWidth = NULL))) + expect_equal(dataInput1CodeBased$overallSampleSizes, dataInput1$overallSampleSizes, tolerance = 1e-07) + expect_equal(dataInput1CodeBased$overallEvents, dataInput1$overallEvents, tolerance = 1e-07) + expect_type(names(dataInput1), "character") + df <- as.data.frame(dataInput1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dataInput1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x1 <- getAnalysisResults(design1, dataInput1, + stratifiedAnalysis = FALSE, + intersectionTest = "SpiessensDebois", + allocationRatioPlanned = 0.5, + directionUpper = FALSE, + normalApproximation = TRUE, + stage = 2, + nPlanned = c(80) + ) + + ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x1' with expected results + expect_equal(x1$piTreatments[1, ], 0.43396226, tolerance = 1e-07, label = paste0("c(", paste0(x1$piTreatments[1, ], collapse = ", "), ")")) + expect_equal(x1$piTreatments[2, ], 0.47, tolerance = 1e-07, label = paste0("c(", paste0(x1$piTreatments[2, ], collapse = ", "), ")")) + expect_equal(x1$conditionalRejectionProbabilities[1, ], c(0.17935289, 0.13861558, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(x1$conditionalRejectionProbabilities[2, ], c(0.17935289, 0.047432959, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(x1$conditionalPower[1, ], c(NA_real_, NA_real_, 0.74825773), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(x1$conditionalPower[2, ], c(NA_real_, NA_real_, 0.22069678), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.61149604, -0.44933531, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.47492191, -0.29772839, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalUpperBounds[1, ], c(0.040176497, 0.029772743, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalUpperBounds[2, ], c(0.018732449, 0.06513775, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(x1$repeatedPValues[1, ], c(0.031827909, 0.031827909, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(x1$repeatedPValues[2, ], c(0.031827909, 0.031827909, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(x1$piControls[1, ], 0.63934426, tolerance = 1e-07, label = paste0("c(", paste0(x1$piControls[1, ], collapse = ", "), ")")) + expect_equal(x1$piControls[2, ], 0.57657658, tolerance = 1e-07, label = paste0("c(", paste0(x1$piControls[2, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x1), NA))) + expect_output(print(x1)$show()) + invisible(capture.output(expect_error(summary(x1), NA))) + expect_output(summary(x1)$show()) + x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) + expect_equal(x1CodeBased$piTreatments, x1$piTreatments, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) + expect_equal(x1CodeBased$piControls, x1$piControls, tolerance = 1e-07) + expect_type(names(x1), "character") + df <- as.data.frame(x1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + .skipTestIfDisabled() + + x2 <- getAnalysisResults(design1, dataInput1, + stratifiedAnalysis = FALSE, + intersectionTest = "Bonferroni", + allocationRatioPlanned = 0.5, + directionUpper = FALSE, + normalApproximation = TRUE, + stage = 2, + nPlanned = c(80) + ) + + ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x2' with expected results + expect_equal(x2$piTreatments[1, ], 0.43396226, tolerance = 1e-07, label = paste0("c(", paste0(x2$piTreatments[1, ], collapse = ", "), ")")) + expect_equal(x2$piTreatments[2, ], 0.47, tolerance = 1e-07, label = paste0("c(", paste0(x2$piTreatments[2, ], collapse = ", "), ")")) + expect_equal(x2$conditionalRejectionProbabilities[1, ], c(0.16289564, 0.075460476, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(x2$conditionalRejectionProbabilities[2, ], c(0.16289564, 0.047432959, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(x2$conditionalPower[1, ], c(NA_real_, NA_real_, 0.62405214), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(x2$conditionalPower[2, ], c(NA_real_, NA_real_, 0.22069678), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.61554799, -0.46343398, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.47860086, -0.31516617, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalUpperBounds[1, ], c(0.046721667, 0.044120395, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalUpperBounds[2, ], c(0.02350445, 0.081574104, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(x2$repeatedPValues[1, ], c(0.036684009, 0.036684009, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(x2$repeatedPValues[2, ], c(0.036684009, 0.036684009, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(x2$piControls[1, ], 0.63934426, tolerance = 1e-07, label = paste0("c(", paste0(x2$piControls[1, ], collapse = ", "), ")")) + expect_equal(x2$piControls[2, ], 0.57657658, tolerance = 1e-07, label = paste0("c(", paste0(x2$piControls[2, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x2), NA))) + expect_output(print(x2)$show()) + invisible(capture.output(expect_error(summary(x2), NA))) + expect_output(summary(x2)$show()) + x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) + expect_equal(x2CodeBased$piTreatments, x2$piTreatments, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) + expect_equal(x2CodeBased$piControls, x2$piControls, tolerance = 1e-07) + expect_type(names(x2), "character") + df <- as.data.frame(x2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getAnalysisResults': enrichment rates, one sub-population, stratified input, select S1 at second IA, directionUpper = FALSE, gMax = 2", { + + .skipTestIfDisabled() + + # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} + # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} + # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} + # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentRates} + # @refFS[Formula]{fs:computeRCIsEnrichment} + # @refFS[Formula]{fs:conditionalPowerEnrichment} + # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} + # @refFS[Formula]{fs:stratifiedTestEnrichmentRates} + # @refFS[Formula]{fs:testStatisticEnrichmentRates} + design1 <- getDesignInverseNormal(kMax = 3, alpha = 0.05, typeOfDesign = "WT", deltaWT = 0.1, informationRates = c(0.4, 0.7, 1)) + + S1 <- getDataset( + sampleSize1 = c(22, 31, 37), + sampleSize2 = c(28, 33, 39), + events1 = c(7, 16, 10), + events2 = c(18, 21, 19) + ) + + R <- getDataset( + sampleSize1 = c(24, 23, NA), + sampleSize2 = c(21, 29, NA), + events1 = c(9, 15, NA), + events2 = c(11, 14, NA) + ) + + dataInput2 <- getDataset(S1 = S1, R = R) + + ## Comparison of the results of DatasetRates object 'dataInput2' with expected results + expect_equal(dataInput2$overallSampleSizes, c(22, 24, 28, 21, 53, 47, 61, 50, 90, NA_real_, 100, NA_real_), label = paste0("c(", paste0(dataInput2$overallSampleSizes, collapse = ", "), ")")) + expect_equal(dataInput2$overallEvents, c(7, 9, 18, 11, 23, 24, 39, 25, 33, NA_real_, 58, NA_real_), label = paste0("c(", paste0(dataInput2$overallEvents, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dataInput2), NA))) + expect_output(print(dataInput2)$show()) + invisible(capture.output(expect_error(summary(dataInput2), NA))) + expect_output(summary(dataInput2)$show()) + dataInput2CodeBased <- eval(parse(text = getObjectRCode(dataInput2, stringWrapParagraphWidth = NULL))) + expect_equal(dataInput2CodeBased$overallSampleSizes, dataInput2$overallSampleSizes, tolerance = 1e-07) + expect_equal(dataInput2CodeBased$overallEvents, dataInput2$overallEvents, tolerance = 1e-07) + expect_type(names(dataInput2), "character") + df <- as.data.frame(dataInput2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dataInput2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x3 <- getAnalysisResults(design1, dataInput2, + stratifiedAnalysis = FALSE, + intersectionTest = "Simes", + directionUpper = FALSE, + normalApproximation = FALSE + ) + + ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x3' with expected results + expect_equal(x3$piTreatments[1, ], 0.36666667, tolerance = 1e-07, label = paste0("c(", paste0(x3$piTreatments[1, ], collapse = ", "), ")")) + expect_equal(x3$piTreatments[2, ], NA_real_, label = paste0("c(", paste0(x3$piTreatments[2, ], collapse = ", "), ")")) + expect_equal(x3$conditionalRejectionProbabilities[1, ], c(0.34476337, 0.21123906, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(x3$conditionalRejectionProbabilities[2, ], c(0.34476337, 0.16889178, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(x3$conditionalPower[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(x3$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.62776669, -0.44175544, -0.38366304), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.4897991, -0.29886557, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalUpperBounds[1, ], c(0.066751342, 0.016446892, -0.050014598), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalUpperBounds[2, ], c(0.038157503, 0.063536395, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(x3$repeatedPValues[1, ], c(0.10653002, 0.10653002, 0.014413851), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(x3$repeatedPValues[2, ], c(0.10653002, 0.10653002, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(x3$piControls[1, ], 0.58, tolerance = 1e-07, label = paste0("c(", paste0(x3$piControls[1, ], collapse = ", "), ")")) + expect_equal(x3$piControls[2, ], NA_real_, label = paste0("c(", paste0(x3$piControls[2, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x3), NA))) + expect_output(print(x3)$show()) + invisible(capture.output(expect_error(summary(x3), NA))) + expect_output(summary(x3)$show()) + x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) + expect_equal(x3CodeBased$piTreatments, x3$piTreatments, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) + expect_equal(x3CodeBased$piControls, x3$piControls, tolerance = 1e-07) + expect_type(names(x3), "character") + df <- as.data.frame(x3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + x4 <- getAnalysisResults(design1, dataInput2, + stratifiedAnalysis = TRUE, + intersectionTest = "Simes", + directionUpper = FALSE, + normalApproximation = TRUE + ) + + ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x4' with expected results + expect_equal(x4$piTreatments[1, ], 0.36666667, tolerance = 1e-07, label = paste0("c(", paste0(x4$piTreatments[1, ], collapse = ", "), ")")) + expect_equal(x4$piTreatments[2, ], NA_real_, label = paste0("c(", paste0(x4$piTreatments[2, ], collapse = ", "), ")")) + expect_equal(x4$conditionalRejectionProbabilities[1, ], c(0.4519333, 0.45336181, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(x4$conditionalRejectionProbabilities[2, ], c(0.4519333, 0.2823056, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(x4$conditionalPower[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(x4$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x4$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(x4$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.62776669, -0.44175544, -0.38366304), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(x4$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.48811625, -0.29740945, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(x4$repeatedConfidenceIntervalUpperBounds[1, ], c(0.066751342, 0.016446892, -0.050014598), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(x4$repeatedConfidenceIntervalUpperBounds[2, ], c(0.041874626, 0.06452777, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(x4$repeatedPValues[1, ], c(0.07212343, 0.050354903, 0.0033350387), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(x4$repeatedPValues[2, ], c(0.07212343, 0.065501128, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x4$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(x4$piControls[1, ], 0.58, tolerance = 1e-07, label = paste0("c(", paste0(x4$piControls[1, ], collapse = ", "), ")")) + expect_equal(x4$piControls[2, ], NA_real_, label = paste0("c(", paste0(x4$piControls[2, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x4), NA))) + expect_output(print(x4)$show()) + invisible(capture.output(expect_error(summary(x4), NA))) + expect_output(summary(x4)$show()) + x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) + expect_equal(x4CodeBased$piTreatments, x4$piTreatments, tolerance = 1e-07) + expect_equal(x4CodeBased$conditionalRejectionProbabilities, x4$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x4CodeBased$conditionalPower, x4$conditionalPower, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedConfidenceIntervalLowerBounds, x4$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedConfidenceIntervalUpperBounds, x4$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x4CodeBased$repeatedPValues, x4$repeatedPValues, tolerance = 1e-07) + expect_equal(x4CodeBased$piControls, x4$piControls, tolerance = 1e-07) + expect_type(names(x4), "character") + df <- as.data.frame(x4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getAnalysisResults': enrichment rates, more sub-populations, select S1 and S2 at first IA, select S1 at second, directionUpper = TRUE, gMax = 3", { + + .skipTestIfDisabled() + + # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} + # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} + # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} + # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentRates} + # @refFS[Formula]{fs:computeRCIsEnrichment} + # @refFS[Formula]{fs:conditionalPowerEnrichment} + # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} + # @refFS[Formula]{fs:stratifiedTestEnrichmentRates} + # @refFS[Formula]{fs:testStatisticEnrichmentRates} + S1 <- getDataset( + sampleSize1 = c(47, 33, 37), + sampleSize2 = c(48, 47, 39), + events1 = c(18, 13, 17), + events2 = c(12, 11, 9) + ) + + S2 <- getDataset( + sampleSize1 = c(49, NA, NA), + sampleSize2 = c(45, NA, NA), + events1 = c(12, NA, NA), + events2 = c(13, NA, NA) + ) + + S12 <- getDataset( + sampleSize1 = c(35, 42, NA), + sampleSize2 = c(36, 47, NA), + events1 = c(19, 10, NA), + events2 = c(13, 17, NA) + ) + + R <- getDataset( + sampleSize1 = c(43, NA, NA), + sampleSize2 = c(39, NA, NA), + events1 = c(17, NA, NA), + events2 = c(14, NA, NA) + ) + + dataInput3 <- getDataset(S1 = S1, S2 = S2, S12 = S12, R = R) + + ## Comparison of the results of DatasetRates object 'dataInput3' with expected results + expect_equal(dataInput3$overallSampleSizes, c(47, 49, 35, 43, 48, 45, 36, 39, 80, NA_real_, 77, NA_real_, 95, NA_real_, 83, NA_real_, 117, NA_real_, NA_real_, NA_real_, 134, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(dataInput3$overallSampleSizes, collapse = ", "), ")")) + expect_equal(dataInput3$overallEvents, c(18, 12, 19, 17, 12, 13, 13, 14, 31, NA_real_, 29, NA_real_, 23, NA_real_, 30, NA_real_, 48, NA_real_, NA_real_, NA_real_, 32, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(dataInput3$overallEvents, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dataInput3), NA))) + expect_output(print(dataInput3)$show()) + invisible(capture.output(expect_error(summary(dataInput3), NA))) + expect_output(summary(dataInput3)$show()) + dataInput3CodeBased <- eval(parse(text = getObjectRCode(dataInput3, stringWrapParagraphWidth = NULL))) + expect_equal(dataInput3CodeBased$overallSampleSizes, dataInput3$overallSampleSizes, tolerance = 1e-07) + expect_equal(dataInput3CodeBased$overallEvents, dataInput3$overallEvents, tolerance = 1e-07) + expect_type(names(dataInput3), "character") + df <- as.data.frame(dataInput3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dataInput3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + design1 <- getDesignInverseNormal(kMax = 3, alpha = 0.05, typeOfDesign = "WT", deltaWT = 0.1, informationRates = c(0.4, 0.7, 1)) + + x1 <- getAnalysisResults(design1, dataInput3, + directionUpper = TRUE, + stratifiedAnalysis = FALSE, + intersectionTest = "Sidak", + allocationRatioPlanned = 3, + normalApproximation = FALSE, + nPlanned = c(80), + piControls = c(0.2, NA, NA), + piTreatments = c(0.55, NA, NA), + stage = 2 + ) + + ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x1' with expected results + expect_equal(x1$conditionalRejectionProbabilities[1, ], c(0.15297113, 0.049132584, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(x1$conditionalRejectionProbabilities[2, ], c(0.034063149, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(x1$conditionalRejectionProbabilities[3, ], c(0.064895921, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(x1$conditionalPower[1, ], c(NA_real_, NA_real_, 0.89354539), tolerance = 1e-07, label = paste0("c(", paste0(x1$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(x1$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(x1$conditionalPower[3, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x1$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.062823383, -0.036086154, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.16425035, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalLowerBounds[3, ], c(-0.078510197, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalUpperBounds[1, ], c(0.35743976, 0.21982839, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalUpperBounds[2, ], c(0.25557989, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(x1$repeatedConfidenceIntervalUpperBounds[3, ], c(0.21491638, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(x1$repeatedPValues[1, ], c(0.23298603, 0.23298603, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(x1$repeatedPValues[2, ], c(0.5, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(x1$repeatedPValues[3, ], c(0.389024, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x1$repeatedPValues[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x1), NA))) + expect_output(print(x1)$show()) + invisible(capture.output(expect_error(summary(x1), NA))) + expect_output(summary(x1)$show()) + x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) + expect_equal(x1CodeBased$conditionalRejectionProbabilities, x1$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x1CodeBased$conditionalPower, x1$conditionalPower, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalLowerBounds, x1$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedConfidenceIntervalUpperBounds, x1$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x1CodeBased$repeatedPValues, x1$repeatedPValues, tolerance = 1e-07) + expect_type(names(x1), "character") + df <- as.data.frame(x1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + design2 <- getDesignFisher(kMax = 3, method = "equalAlpha", alpha = 0.05, informationRates = c(0.4, 0.7, 1)) + + x2 <- getAnalysisResults(design2, dataInput3, + directionUpper = TRUE, + stratifiedAnalysis = FALSE, + intersectionTest = "Sidak", + normalApproximation = FALSE, + stage = 3 + ) + + ## Comparison of the results of AnalysisResultsEnrichmentFisher object 'x2' with expected results + expect_equal(x2$piTreatments[1, ], 0.41025641, tolerance = 1e-07, label = paste0("c(", paste0(x2$piTreatments[1, ], collapse = ", "), ")")) + expect_equal(x2$piTreatments[2, ], NA_real_, label = paste0("c(", paste0(x2$piTreatments[2, ], collapse = ", "), ")")) + expect_equal(x2$piTreatments[3, ], NA_real_, label = paste0("c(", paste0(x2$piTreatments[3, ], collapse = ", "), ")")) + expect_equal(x2$conditionalRejectionProbabilities[1, ], c(0.075105953, 0.018243594, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(x2$conditionalRejectionProbabilities[2, ], c(0.020009021, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(x2$conditionalRejectionProbabilities[3, ], c(0.031471245, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(x2$conditionalPower[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(x2$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(x2$conditionalPower[3, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x2$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.023654531, -0.034180226, 0.008300518), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.12625532, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalLowerBounds[3, ], c(-0.051634044, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalUpperBounds[1, ], c(0.32239366, 0.19556, 0.21299371), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalUpperBounds[2, ], c(0.21912956, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(x2$repeatedConfidenceIntervalUpperBounds[3, ], c(0.1890798, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(x2$repeatedPValues[1, ], c(0.14811777, 0.14811777, 0.07171335), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(x2$repeatedPValues[2, ], c(0.46979052, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(x2$repeatedPValues[3, ], c(0.32146776, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x2$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(x2$piControls[1, ], 0.23880597, tolerance = 1e-07, label = paste0("c(", paste0(x2$piControls[1, ], collapse = ", "), ")")) + expect_equal(x2$piControls[2, ], NA_real_, label = paste0("c(", paste0(x2$piControls[2, ], collapse = ", "), ")")) + expect_equal(x2$piControls[3, ], NA_real_, label = paste0("c(", paste0(x2$piControls[3, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x2), NA))) + expect_output(print(x2)$show()) + invisible(capture.output(expect_error(summary(x2), NA))) + expect_output(summary(x2)$show()) + x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) + expect_equal(x2CodeBased$piTreatments, x2$piTreatments, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalRejectionProbabilities, x2$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x2CodeBased$conditionalPower, x2$conditionalPower, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalLowerBounds, x2$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedConfidenceIntervalUpperBounds, x2$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$repeatedPValues, x2$repeatedPValues, tolerance = 1e-07) + expect_equal(x2CodeBased$piControls, x2$piControls, tolerance = 1e-07) + expect_type(names(x2), "character") + df <- as.data.frame(x2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getAnalysisResults': enrichment rates, more sub-populations, non-stratified input, select S1 and S2 at first IA, select S1 at second, directionUpper = FALSE, gMax = 4", { + + .skipTestIfDisabled() + + # @refFS[Formula]{fs:adjustedPValueBonferroniEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCIBonferroniSimesEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCISidakEnrichment} + # @refFS[Formula]{fs:adjustedPValueForRCISpiessensEnrichment} + # @refFS[Formula]{fs:adjustedPValueSidakEnrichment} + # @refFS[Formula]{fs:adjustedPValueSimesEnrichment} + # @refFS[Formula]{fs:adjustedPValueSpiessensDeboisEnrichmentRates} + # @refFS[Formula]{fs:computeRCIsEnrichment} + # @refFS[Formula]{fs:conditionalPowerEnrichment} + # @refFS[Formula]{fs:conditionalRejectionProbabilityEnrichment} + # @refFS[Formula]{fs:stratifiedTestEnrichmentRates} + # @refFS[Formula]{fs:testStatisticEnrichmentRates} + S1 <- getDataset( + sampleSize1 = c(84, 94, 25), + sampleSize2 = c(82, 75, 23), + events1 = c(21, 28, 13), + events2 = c(32, 23, 20) + ) + + S2 <- getDataset( + sampleSize1 = c(81, 95, NA), + sampleSize2 = c(84, 64, NA), + events1 = c(26, 29, NA), + events2 = c(31, 26, NA) + ) + + S3 <- getDataset( + sampleSize1 = c(71, NA, NA), + sampleSize2 = c(74, NA, NA), + events1 = c(16, NA, NA), + events2 = c(21, NA, NA) + ) + + F <- getDataset( + sampleSize1 = c(248, NA, NA), + sampleSize2 = c(254, NA, NA), + events1 = c(75, NA, NA), + events2 = c(98, NA, NA) + ) + + R <- getDataset( + sampleSize1 = c(12, NA, NA), + sampleSize2 = c(14, NA, NA), + events1 = c(12, NA, NA), + events2 = c(14, NA, NA) + ) + + dataInput4 <- getDataset(S1 = S1, S2 = S2, S3 = S3, F = F) + + ## Comparison of the results of DatasetRates object 'dataInput4' with expected results + expect_equal(dataInput4$overallSampleSizes, c(84, 81, 71, 248, 82, 84, 74, 254, 178, 176, NA_real_, NA_real_, 157, 148, NA_real_, NA_real_, 203, NA_real_, NA_real_, NA_real_, 180, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(dataInput4$overallSampleSizes, collapse = ", "), ")")) + expect_equal(dataInput4$overallEvents, c(21, 26, 16, 75, 32, 31, 21, 98, 49, 55, NA_real_, NA_real_, 55, 57, NA_real_, NA_real_, 62, NA_real_, NA_real_, NA_real_, 75, NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(dataInput4$overallEvents, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dataInput4), NA))) + expect_output(print(dataInput4)$show()) + invisible(capture.output(expect_error(summary(dataInput4), NA))) + expect_output(summary(dataInput4)$show()) + dataInput4CodeBased <- eval(parse(text = getObjectRCode(dataInput4, stringWrapParagraphWidth = NULL))) + expect_equal(dataInput4CodeBased$overallSampleSizes, dataInput4$overallSampleSizes, tolerance = 1e-07) + expect_equal(dataInput4CodeBased$overallEvents, dataInput4$overallEvents, tolerance = 1e-07) + expect_type(names(dataInput4), "character") + df <- as.data.frame(dataInput4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dataInput4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + design1 <- getDesignInverseNormal(kMax = 3, alpha = 0.05, typeOfDesign = "asKD", gammaA = 2, informationRates = c(0.4, 0.7, 1)) + + x3 <- getAnalysisResults(design1, dataInput4, + directionUpper = FALSE, + stratifiedAnalysis = FALSE, + intersectionTest = "Sidak", + allocationRatioPlanned = 1, + stage = 3, + normalApproximation = TRUE + ) + + ## Comparison of the results of AnalysisResultsEnrichmentInverseNormal object 'x3' with expected results + expect_equal(x3$piTreatments[1, ], 0.30541872, tolerance = 1e-07, label = paste0("c(", paste0(x3$piTreatments[1, ], collapse = ", "), ")")) + expect_equal(x3$piTreatments[2, ], NA_real_, label = paste0("c(", paste0(x3$piTreatments[2, ], collapse = ", "), ")")) + expect_equal(x3$piTreatments[3, ], NA_real_, label = paste0("c(", paste0(x3$piTreatments[3, ], collapse = ", "), ")")) + expect_equal(x3$piTreatments[4, ], NA_real_, label = paste0("c(", paste0(x3$piTreatments[4, ], collapse = ", "), ")")) + expect_equal(x3$conditionalRejectionProbabilities[1, ], c(0.13745997, 0.082835151, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities[1, ], collapse = ", "), ")")) + expect_equal(x3$conditionalRejectionProbabilities[2, ], c(0.023915975, 0.064596491, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities[2, ], collapse = ", "), ")")) + expect_equal(x3$conditionalRejectionProbabilities[3, ], c(0.023915975, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities[3, ], collapse = ", "), ")")) + expect_equal(x3$conditionalRejectionProbabilities[4, ], c(0.13745997, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$conditionalRejectionProbabilities[4, ], collapse = ", "), ")")) + expect_equal(x3$conditionalPower[1, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPower[1, ], collapse = ", "), ")")) + expect_equal(x3$conditionalPower[2, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPower[2, ], collapse = ", "), ")")) + expect_equal(x3$conditionalPower[3, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPower[3, ], collapse = ", "), ")")) + expect_equal(x3$conditionalPower[4, ], c(NA_real_, NA_real_, NA_real_), label = paste0("c(", paste0(x3$conditionalPower[4, ], collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalLowerBounds[1, ], c(-0.33926099, -0.22469062, -0.248011), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds[1, ], collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalLowerBounds[2, ], c(-0.255132, -0.21555052, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds[2, ], collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalLowerBounds[3, ], c(-0.26390722, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds[3, ], collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalLowerBounds[4, ], c(-0.20314825, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalLowerBounds[4, ], collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalUpperBounds[1, ], c(0.068268149, 0.059220127, -0.0081515662), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds[1, ], collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalUpperBounds[2, ], c(0.16378176, 0.07555087, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds[2, ], collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalUpperBounds[3, ], c(0.15232186, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds[3, ], collapse = ", "), ")")) + expect_equal(x3$repeatedConfidenceIntervalUpperBounds[4, ], c(0.038730826, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedConfidenceIntervalUpperBounds[4, ], collapse = ", "), ")")) + expect_equal(x3$repeatedPValues[1, ], c(0.5, 0.26483774, 0.01063254), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues[1, ], collapse = ", "), ")")) + expect_equal(x3$repeatedPValues[2, ], c(0.5, 0.30264322, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues[2, ], collapse = ", "), ")")) + expect_equal(x3$repeatedPValues[3, ], c(0.5, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues[3, ], collapse = ", "), ")")) + expect_equal(x3$repeatedPValues[4, ], c(0.5, NA_real_, NA_real_), tolerance = 1e-07, label = paste0("c(", paste0(x3$repeatedPValues[4, ], collapse = ", "), ")")) + expect_equal(x3$piControls[1, ], 0.41666667, tolerance = 1e-07, label = paste0("c(", paste0(x3$piControls[1, ], collapse = ", "), ")")) + expect_equal(x3$piControls[2, ], NA_real_, label = paste0("c(", paste0(x3$piControls[2, ], collapse = ", "), ")")) + expect_equal(x3$piControls[3, ], NA_real_, label = paste0("c(", paste0(x3$piControls[3, ], collapse = ", "), ")")) + expect_equal(x3$piControls[4, ], NA_real_, label = paste0("c(", paste0(x3$piControls[4, ], collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x3), NA))) + expect_output(print(x3)$show()) + invisible(capture.output(expect_error(summary(x3), NA))) + expect_output(summary(x3)$show()) + x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) + expect_equal(x3CodeBased$piTreatments, x3$piTreatments, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalRejectionProbabilities, x3$conditionalRejectionProbabilities, tolerance = 1e-07) + expect_equal(x3CodeBased$conditionalPower, x3$conditionalPower, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalLowerBounds, x3$repeatedConfidenceIntervalLowerBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedConfidenceIntervalUpperBounds, x3$repeatedConfidenceIntervalUpperBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$repeatedPValues, x3$repeatedPValues, tolerance = 1e-07) + expect_equal(x3CodeBased$piControls, x3$piControls, tolerance = 1e-07) + expect_type(names(x3), "character") + df <- as.data.frame(x3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getAnalysisResults': enrichment rates, expected warning for empty subsets", { + + .skipTestIfDisabled() + + S1 <- getDataset( + sampleSize1 = c(84, 94, 25), + sampleSize2 = c(82, 75, 23), + events1 = c(21, 28, 13), + events2 = c(32, 23, 20) + ) + + S2 <- getDataset( + sampleSize1 = c(81, 95, NA), + sampleSize2 = c(84, 64, NA), + events1 = c(26, 29, NA), + events2 = c(31, 26, NA) + ) + + S3 <- getDataset( + sampleSize1 = c(71, NA, NA), + sampleSize2 = c(74, NA, NA), + events1 = c(16, NA, NA), + events2 = c(21, NA, NA) + ) + + R <- getDataset( + sampleSize1 = c(12, NA, NA), + sampleSize2 = c(14, NA, NA), + events1 = c(12, NA, NA), + events2 = c(14, NA, NA) + ) + + expect_warning(getDataset(S1 = S1, S2 = S2, S3 = S3, R = R), + "The 4 undefined subsets S12, S13, S23, S123 were defined as empty subsets", + fixed = TRUE + ) +}) + diff --git a/tests/testthat/test-f_analysis_input_validation.R b/tests/testthat/test-f_analysis_input_validation.R index b8c28634..0e874f94 100644 --- a/tests/testthat/test-f_analysis_input_validation.R +++ b/tests/testthat/test-f_analysis_input_validation.R @@ -1,115 +1,114 @@ -## | -## | *Unit tests* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | RPACT package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File name: test-f_analysis_input_validation.R -## | Creation date: 08 November 2023, 08:56:03 -## | File version: $Revision: 7662 $ -## | Last changed: $Date: 2024-02-23 12:42:26 +0100 (Fr, 23 Feb 2024) $ -## | Last changed by: $Author: pahlke $ -## | - -test_plan_section("Testing the Correct Input Validation of All Analysis Functions") - - -test_that("Errors and warnings for calculation of analysis results with dataset of means", { - .skipTestIfDisabled() - - design1 <- getDesignInverseNormal( - kMax = 4, alpha = 0.02, futilityBounds = c(-0.5, 0, 0.5), - bindingFutility = FALSE, typeOfDesign = "asKD", gammaA = 1.2, informationRates = c(0.15, 0.4, 0.7, 1) - ) - - design3 <- getDesignConditionalDunnett(alpha = 0.02, informationAtInterim = 0.4, secondStageConditioning = TRUE) - - dataExample1 <- getDataset( - n = c(13, 25), - means = c(24.2, 22.2), - stDevs = c(24.4, 22.1) - ) - - dataExample2 <- getDataset( - n1 = c(13, 25), - n2 = c(15, 27), - means1 = c(24.2, 22.2), - means2 = c(18.8, 27.7), - stDevs1 = c(24.4, 22.1), - stDevs2 = c(21.2, 23.7) - ) - - dataExample4 <- getDataset( - n1 = c(13, 25), - n2 = c(15, NA), - n3 = c(14, 27), - n4 = c(12, 29), - means1 = c(24.2, 22.2), - means2 = c(18.8, NA), - means3 = c(26.7, 27.7), - means4 = c(9.2, 12.2), - stDevs1 = c(24.4, 22.1), - stDevs2 = c(21.2, NA), - stDevs3 = c(25.6, 23.2), - stDevs4 = c(21.5, 22.7) - ) - - expect_error(getAnalysisResults( - design = design1, dataInput = dataExample4, - intersectionTest = "", varianceOption = "notPooled", nPlanned = c(20, 20) - )) - expect_error(getAnalysisResults( - design = design1, dataInput = dataExample4, - intersectionTest = "Simes", varianceOption = "X", nPlanned = c(20, 20) - )) - expect_error(getAnalysisResults( - design = design1, dataInput = dataExample4, - intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = c(20, 20, 30) - )) - expect_error(getAnalysisResults( - design = design1, dataInput = dataExample4, - intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = 20 - )) - expect_error(getAnalysisResults( - design = design1, dataInput = dataExample4, - intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = c() - )) - expect_error(getAnalysisResults( - design = design1, dataInput = dataExample4, - intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = numeric(0) - )) - - expect_error(getAnalysisResults( - design = design3, dataInput = dataExample4, - intersectionTest = "Dunnett", varianceOption = "pairwisePooled" - ), - paste0( - "Illegal argument: variance option ('pairwisePooled') must be 'overallPooled' ", - "because conditional Dunnett test was specified as design" - ), - fixed = TRUE - ) - - expect_error(getAnalysisResults( - design = design1, dataInput = dataExample4, - intersectionTest = "Dunnett", varianceOption = "pairwisePooled", nPlanned = c(20, 20) - ), - "Dunnett t test can only be performed with overall variance estimation", - fixed = TRUE - ) - - expect_error(getConditionalPower(getStageResults(design1, dataInput = dataExample2), - nPlanned = c(20, 20), allocationRatioPlanned = -1 - )) - -}) - +## | +## | *Unit tests* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | RPACT package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File name: test-f_analysis_input_validation.R +## | Creation date: 08 November 2023, 08:56:03 +## | File version: $Revision: 7662 $ +## | Last changed: $Date: 2024-02-23 12:42:26 +0100 (Fr, 23 Feb 2024) $ +## | Last changed by: $Author: pahlke $ +## | + +test_plan_section("Testing the Correct Input Validation of All Analysis Functions") + + +test_that("Errors and warnings for calculation of analysis results with dataset of means", { + .skipTestIfDisabled() + + design1 <- getDesignInverseNormal( + kMax = 4, alpha = 0.02, futilityBounds = c(-0.5, 0, 0.5), + bindingFutility = FALSE, typeOfDesign = "asKD", gammaA = 1.2, informationRates = c(0.15, 0.4, 0.7, 1) + ) + + design3 <- getDesignConditionalDunnett(alpha = 0.02, informationAtInterim = 0.4, secondStageConditioning = TRUE) + + dataExample1 <- getDataset( + n = c(13, 25), + means = c(24.2, 22.2), + stDevs = c(24.4, 22.1) + ) + + dataExample2 <- getDataset( + n1 = c(13, 25), + n2 = c(15, 27), + means1 = c(24.2, 22.2), + means2 = c(18.8, 27.7), + stDevs1 = c(24.4, 22.1), + stDevs2 = c(21.2, 23.7) + ) + + dataExample4 <- getDataset( + n1 = c(13, 25), + n2 = c(15, NA), + n3 = c(14, 27), + n4 = c(12, 29), + means1 = c(24.2, 22.2), + means2 = c(18.8, NA), + means3 = c(26.7, 27.7), + means4 = c(9.2, 12.2), + stDevs1 = c(24.4, 22.1), + stDevs2 = c(21.2, NA), + stDevs3 = c(25.6, 23.2), + stDevs4 = c(21.5, 22.7) + ) + + expect_error(getAnalysisResults( + design = design1, dataInput = dataExample4, + intersectionTest = "", varianceOption = "notPooled", nPlanned = c(20, 20) + )) + expect_error(getAnalysisResults( + design = design1, dataInput = dataExample4, + intersectionTest = "Simes", varianceOption = "X", nPlanned = c(20, 20) + )) + expect_error(getAnalysisResults( + design = design1, dataInput = dataExample4, + intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = c(20, 20, 30) + )) + expect_error(getAnalysisResults( + design = design1, dataInput = dataExample4, + intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = 20 + )) + expect_error(getAnalysisResults( + design = design1, dataInput = dataExample4, + intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = c() + )) + expect_error(getAnalysisResults( + design = design1, dataInput = dataExample4, + intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = numeric(0) + )) + + expect_error(getAnalysisResults( + design = design3, dataInput = dataExample4, + intersectionTest = "Dunnett", varianceOption = "pairwisePooled" + ), + paste0( + "Illegal argument: variance option ('pairwisePooled') must be 'overallPooled' ", + "because conditional Dunnett test was specified as design" + ), + fixed = TRUE + ) + + expect_error(getAnalysisResults( + design = design1, dataInput = dataExample4, + intersectionTest = "Dunnett", varianceOption = "pairwisePooled", nPlanned = c(20, 20) + ), + "Dunnett t test can only be performed with overall variance estimation", + fixed = TRUE + ) + + expect_error(getConditionalPower(getStageResults(design1, dataInput = dataExample2), + nPlanned = c(20, 20), allocationRatioPlanned = -1 + )) +}) + diff --git a/tests/testthat/test-f_core_assertions.R b/tests/testthat/test-f_core_assertions.R index 07ec8287..2ae6a5e1 100644 --- a/tests/testthat/test-f_core_assertions.R +++ b/tests/testthat/test-f_core_assertions.R @@ -1,254 +1,253 @@ -## | -## | *Unit tests* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | RPACT package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File name: test-f_core_assertions.R -## | Creation date: 08 November 2023, 09:09:35 -## | File version: $Revision$ -## | Last changed: $Date$ -## | Last changed by: $Author$ -## | - -test_plan_section("Testing Assertion Functions") - - -test_that("Testing '.assertIsInClosedInterval'", { - invisible(capture.output(expect_error(.assertIsInClosedInterval(x = 0, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) - invisible(capture.output(expect_error(.assertIsInClosedInterval(x = 1, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) - invisible(capture.output(expect_error(.assertIsInClosedInterval(x = 0.0001, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) - invisible(capture.output(expect_error(.assertIsInClosedInterval(x = 0.9999, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) - invisible(capture.output(expect_error(.assertIsInClosedInterval(x = NA_real_, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) - invisible(capture.output(expect_error(.assertIsInClosedInterval(x = NA_real_, xName = "x", lower = 0, upper = 1, naAllowed = TRUE), NA))) - invisible(capture.output(expect_error(.assertIsInClosedInterval(x = c(1, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = TRUE), NA))) - invisible(capture.output(expect_error(.assertIsInClosedInterval(x = c(NA_real_, 0, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = TRUE), NA))) - - expect_error(.assertIsInClosedInterval(x = -0.0001, xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) - expect_error(.assertIsInClosedInterval(x = -0.0001, xName = "x", lower = 0, upper = NA_real_, naAllowed = FALSE)) - expect_error(.assertIsInClosedInterval(x = 1.0001, xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) - expect_error(.assertIsInClosedInterval(x = c(1, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) - expect_error(.assertIsInClosedInterval(x = c(-1, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = TRUE)) - expect_error(.assertIsInClosedInterval(x = c(NA_real_, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) - expect_error(.assertIsInClosedInterval(x = c(0, -1, 1, 2), xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) - -}) - -test_that("Testing '.assertIsInOpenInterval'", { - - invisible(capture.output(expect_error(.assertIsInOpenInterval(x = 0.0001, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) - invisible(capture.output(expect_error(.assertIsInOpenInterval(x = 0.9999, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) - invisible(capture.output(expect_error(.assertIsInOpenInterval(x = NA_real_, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) - invisible(capture.output(expect_error(.assertIsInOpenInterval(x = NA_real_, xName = "x", lower = 0, upper = 1, naAllowed = TRUE), NA))) - invisible(capture.output(expect_error(.assertIsInOpenInterval(x = c(0.9999, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = TRUE), NA))) - invisible(capture.output(expect_error(.assertIsInOpenInterval(x = c(NA_real_, 0.0001, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = TRUE), NA))) - - expect_error(.assertIsInOpenInterval(x = 0, xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) - expect_error(.assertIsInOpenInterval(x = 0, xName = "x", lower = 0, upper = NA_real_, naAllowed = FALSE)) - expect_error(.assertIsInOpenInterval(x = 1, xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) - expect_error(.assertIsInOpenInterval(x = c(1.0001, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) - expect_error(.assertIsInOpenInterval(x = c(-1, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = TRUE)) - expect_error(.assertIsInOpenInterval(x = c(NA_real_, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) - expect_error(.assertIsInOpenInterval(x = c(0, -1, 1, 2), xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) - -}) - -test_that("Testing '.assertDesignParameterExists'", { - - expect_error(.assertDesignParameterExists(), - "Missing argument: 'design' must be defined", - fixed = TRUE - ) - - expect_error(.assertDesignParameterExists(design = getAssertionTestDesign()), - "Missing argument: 'parameterName' must be defined", - fixed = TRUE - ) - - expect_error(.assertDesignParameterExists(design = getAssertionTestDesign(), parameterName = "kMax"), - "Missing argument: 'defaultValue' must be defined", - fixed = TRUE - ) - - expect_error(.assertDesignParameterExists( - design = getAssertionTestDesign(), - parameterName = "kMax", defaultValue = C_KMAX_DEFAULT - ), - "Missing argument: parameter 'kMax' must be specified in design", - fixed = TRUE - ) - - expect_error(.assertDesignParameterExists( - design = getAssertionTestDesign(kMax = NA_integer_), - parameterName = "kMax", defaultValue = C_KMAX_DEFAULT - ), - "Missing argument: parameter 'kMax' must be specified in design", - fixed = TRUE - ) - -}) - -test_that("Testing '.assertIsValidThetaRange'", { - - expect_error(.assertIsValidThetaRange(thetaRange = c()), - "Illegal argument: 'thetaRange' (NULL) must be a vector with two entries defining minimum and maximum or a sequence of numeric values with length > 2", - fixed = TRUE - ) - - expect_error(.assertIsValidThetaRange(thetaRange = c(1, -2)), - "Illegal argument: 'thetaRange' with length 2 must contain minimum < maximum (1 >= -2)", - fixed = TRUE - ) - - expect_equal(.assertIsValidThetaRange(thetaRange = c(1, 2, 3)), c(1, 2, 3)) - - expect_equal(.assertIsValidThetaRange(thetaRange = c(-1, 2)), seq(-1, 2, 3 / C_THETA_RANGE_SEQUENCE_LENGTH_DEFAULT)) - -}) - -test_that("Testing '.assertIsSingleNumber'", { - - expect_error(.assertIsSingleNumber(NA, "x"), - "Illegal argument: 'x' (NA) must be a valid numeric value", - fixed = TRUE - ) - - expect_error(.assertIsSingleNumber(NULL, "x"), - "Missing argument: 'x' must be a valid numeric value", - fixed = TRUE - ) - - expect_error(.assertIsSingleNumber(c(1, 2), "x"), - "Illegal argument: 'x' c(1, 2) must be a single numeric value", - fixed = TRUE - ) - - expect_error(.assertIsSingleNumber(numeric(0), "x"), - "Missing argument: 'x' must be a valid numeric value", - fixed = TRUE - ) - -}) - -test_that("Testing '.assertAssociatedArgumentsAreDefined'", { - - expect_error(.assertAssociatedArgumentsAreDefined(a = NA, b = 1), - "Missing argument: 'a' must be defined because 'b' is defined", - fixed = TRUE - ) - - expect_error(.assertAssociatedArgumentsAreDefined(a = NA, b = 1, c = NA), - "Missing argument: 'a', 'c' must be defined because 'b' is defined", - fixed = TRUE - ) - - expect_error(.assertAssociatedArgumentsAreDefined(a = NA, b = 1, c = 2), - "Missing argument: 'a' must be defined because 'b', 'c' are defined", - fixed = TRUE - ) - -}) - -test_that("Testing '.associatedArgumentsAreDefined'", { - - expect_equal(.associatedArgumentsAreDefined(nPlanned = NA_real_, thetaH1 = NA_real_), FALSE) - - expect_warning(expect_equal(.associatedArgumentsAreDefined(nPlanned = NA_real_, thetaH1 = 1), FALSE), - "Incomplete associated arguments: 'nPlanned' should be defined because 'thetaH1' is defined", - fixed = TRUE - ) - - expect_equal(.associatedArgumentsAreDefined(nPlanned = 1, thetaH1 = 1), TRUE) - -}) - -test_that("Testing '.isValidNPlanned'", { - - expect_equal(.isValidNPlanned(nPlanned = c(1, 2), kMax = 4, stage = 2), TRUE) - - expect_silent(.isValidNPlanned(nPlanned = NA_real_, kMax = 4, stage = 2)) - - expect_warning(.isValidNPlanned(nPlanned = c(1), kMax = 4, stage = 2), - "'nPlanned' (1) will be ignored: length must be equal to 2 (kMax - stage = 4 - 2)", - fixed = TRUE - ) - - expect_warning(.isValidNPlanned(nPlanned = c(1, 2, 3), kMax = 4, stage = 2), - "'nPlanned' (1, 2, 3) will be ignored: length must be equal to 2 (kMax - stage = 4 - 2)", - fixed = TRUE - ) - -}) - -test_that("Testing '.assertIsValidSummaryIntervalFormat'", { - - .assertIsValidSummaryIntervalFormat("[%s; %s]") - .assertIsValidSummaryIntervalFormat("%s - %s") - .assertIsValidSummaryIntervalFormat("(%s, %s)") - - expect_error(.assertIsValidSummaryIntervalFormat("[%s; %s; %s]")) - expect_error(.assertIsValidSummaryIntervalFormat("[%s]")) - expect_error(.assertIsValidSummaryIntervalFormat("")) - expect_error(.assertIsValidSummaryIntervalFormat(1)) - -}) - -test_that("Testing '.assertIsSingleInteger'", { - - expect_error(.assertIsSingleInteger(NA_integer_, "x", naAllowed = FALSE)) - expect_error(.assertIsSingleInteger(-1, "x", naAllowed = FALSE)) - expect_error(.assertIsSingleInteger(-1, "x", naAllowed = FALSE, validateType = FALSE), NA) - expect_error(.assertIsSingleInteger(NA_integer_, "x", naAllowed = TRUE), NA) - expect_error(.assertIsSingleInteger(-1, "x", naAllowed = TRUE)) - expect_error(.assertIsSingleInteger("1", "x", naAllowed = TRUE)) - expect_error(.assertIsSingleInteger(1, "x", naAllowed = TRUE, validateType = TRUE)) - expect_error(.assertIsSingleInteger(1, "x", naAllowed = TRUE, validateType = FALSE), NA) - -}) - -test_that("Testing '.assertIsSinglePositiveInteger'", { - - expect_error(.assertIsSinglePositiveInteger(NA_integer_, "x", naAllowed = FALSE)) - expect_error(.assertIsSinglePositiveInteger(-1, "x", naAllowed = FALSE)) - expect_error(.assertIsSinglePositiveInteger(NA_integer_, "x", naAllowed = TRUE), NA) - expect_error(.assertIsSinglePositiveInteger(NA_real_, "x", naAllowed = TRUE)) - expect_error(.assertIsSinglePositiveInteger(-1, "x", naAllowed = TRUE)) - expect_error(.assertIsSinglePositiveInteger("1", "x", naAllowed = TRUE)) - expect_error(.assertIsSinglePositiveInteger(1, "x", naAllowed = TRUE, validateType = TRUE)) - expect_error(.assertIsSinglePositiveInteger(1, "x", naAllowed = TRUE, validateType = FALSE), NA) - -}) - -test_that("Testing '.assertIsSingleLogical'", { - - expect_error(.assertIsSingleLogical("TRUE", "x", naAllowed = FALSE)) - expect_error(.assertIsSingleLogical("FALSE", "x", naAllowed = FALSE)) - expect_error(.assertIsSingleLogical(TRUE, "x", naAllowed = FALSE), NA) - expect_error(.assertIsSingleLogical(FALSE, "x", naAllowed = FALSE), NA) - expect_error(.assertIsSingleLogical(NA, "x", naAllowed = TRUE), NA) - expect_error(.assertIsSingleLogical(NA, "x", naAllowed = FALSE)) - -}) - -test_that("Testing '.assertIsValidMatrix'", { - - expect_error(.assertIsValidMatrix(c(), "x", naAllowed = FALSE)) - expect_error(.assertIsValidMatrix(NULL, "x", naAllowed = FALSE)) - expect_error(.assertIsValidMatrix(1:3, "x", naAllowed = FALSE)) - expect_error(.assertIsValidMatrix(1:3, "x", naAllowed = TRUE)) - expect_error(.assertIsValidMatrix("a", "x", naAllowed = FALSE)) - expect_error(.assertIsValidMatrix("a", "x", naAllowed = TRUE)) - expect_error(.assertIsValidMatrix(NA, "x", naAllowed = FALSE)) - expect_error(.assertIsValidMatrix(NA, "x", naAllowed = TRUE)) - -}) - +## | +## | *Unit tests* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | RPACT package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File name: test-f_core_assertions.R +## | Creation date: 08 November 2023, 09:09:35 +## | File version: $Revision$ +## | Last changed: $Date$ +## | Last changed by: $Author$ +## | + +test_plan_section("Testing Assertion Functions") + + +test_that("Testing '.assertIsInClosedInterval'", { + invisible(capture.output(expect_error(.assertIsInClosedInterval(x = 0, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) + invisible(capture.output(expect_error(.assertIsInClosedInterval(x = 1, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) + invisible(capture.output(expect_error(.assertIsInClosedInterval(x = 0.0001, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) + invisible(capture.output(expect_error(.assertIsInClosedInterval(x = 0.9999, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) + invisible(capture.output(expect_error(.assertIsInClosedInterval(x = NA_real_, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) + invisible(capture.output(expect_error(.assertIsInClosedInterval(x = NA_real_, xName = "x", lower = 0, upper = 1, naAllowed = TRUE), NA))) + invisible(capture.output(expect_error(.assertIsInClosedInterval(x = c(1, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = TRUE), NA))) + invisible(capture.output(expect_error(.assertIsInClosedInterval(x = c(NA_real_, 0, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = TRUE), NA))) + + expect_error(.assertIsInClosedInterval(x = -0.0001, xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) + expect_error(.assertIsInClosedInterval(x = -0.0001, xName = "x", lower = 0, upper = NA_real_, naAllowed = FALSE)) + expect_error(.assertIsInClosedInterval(x = 1.0001, xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) + expect_error(.assertIsInClosedInterval(x = c(1, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) + expect_error(.assertIsInClosedInterval(x = c(-1, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = TRUE)) + expect_error(.assertIsInClosedInterval(x = c(NA_real_, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) + expect_error(.assertIsInClosedInterval(x = c(0, -1, 1, 2), xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) + +}) + +test_that("Testing '.assertIsInOpenInterval'", { + + invisible(capture.output(expect_error(.assertIsInOpenInterval(x = 0.0001, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) + invisible(capture.output(expect_error(.assertIsInOpenInterval(x = 0.9999, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) + invisible(capture.output(expect_error(.assertIsInOpenInterval(x = NA_real_, xName = "x", lower = 0, upper = 1, naAllowed = FALSE), NA))) + invisible(capture.output(expect_error(.assertIsInOpenInterval(x = NA_real_, xName = "x", lower = 0, upper = 1, naAllowed = TRUE), NA))) + invisible(capture.output(expect_error(.assertIsInOpenInterval(x = c(0.9999, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = TRUE), NA))) + invisible(capture.output(expect_error(.assertIsInOpenInterval(x = c(NA_real_, 0.0001, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = TRUE), NA))) + + expect_error(.assertIsInOpenInterval(x = 0, xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) + expect_error(.assertIsInOpenInterval(x = 0, xName = "x", lower = 0, upper = NA_real_, naAllowed = FALSE)) + expect_error(.assertIsInOpenInterval(x = 1, xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) + expect_error(.assertIsInOpenInterval(x = c(1.0001, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) + expect_error(.assertIsInOpenInterval(x = c(-1, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = TRUE)) + expect_error(.assertIsInOpenInterval(x = c(NA_real_, NA_real_), xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) + expect_error(.assertIsInOpenInterval(x = c(0, -1, 1, 2), xName = "x", lower = 0, upper = 1, naAllowed = FALSE)) + +}) + +test_that("Testing '.assertDesignParameterExists'", { + + expect_error(.assertDesignParameterExists(), + "Missing argument: 'design' must be defined", + fixed = TRUE + ) + + expect_error(.assertDesignParameterExists(design = getAssertionTestDesign()), + "Missing argument: 'parameterName' must be defined", + fixed = TRUE + ) + + expect_error(.assertDesignParameterExists(design = getAssertionTestDesign(), parameterName = "kMax"), + "Missing argument: 'defaultValue' must be defined", + fixed = TRUE + ) + + expect_error(.assertDesignParameterExists( + design = getAssertionTestDesign(), + parameterName = "kMax", defaultValue = C_KMAX_DEFAULT + ), + "Missing argument: parameter 'kMax' must be specified in design", + fixed = TRUE + ) + + expect_error(.assertDesignParameterExists( + design = getAssertionTestDesign(kMax = NA_integer_), + parameterName = "kMax", defaultValue = C_KMAX_DEFAULT + ), + "Missing argument: parameter 'kMax' must be specified in design", + fixed = TRUE + ) + +}) + +test_that("Testing '.assertIsValidThetaRange'", { + + expect_error(.assertIsValidThetaRange(thetaRange = c()), + "Illegal argument: 'thetaRange' (NULL) must be a vector with two entries defining minimum and maximum or a sequence of numeric values with length > 2", + fixed = TRUE + ) + + expect_error(.assertIsValidThetaRange(thetaRange = c(1, -2)), + "Illegal argument: 'thetaRange' with length 2 must contain minimum < maximum (1 >= -2)", + fixed = TRUE + ) + + expect_equal(.assertIsValidThetaRange(thetaRange = c(1, 2, 3)), c(1, 2, 3)) + + expect_equal(.assertIsValidThetaRange(thetaRange = c(-1, 2)), seq(-1, 2, 3 / C_THETA_RANGE_SEQUENCE_LENGTH_DEFAULT)) + +}) + +test_that("Testing '.assertIsSingleNumber'", { + + expect_error(.assertIsSingleNumber(NA, "x"), + "Illegal argument: 'x' (NA) must be a valid numeric value", + fixed = TRUE + ) + + expect_error(.assertIsSingleNumber(NULL, "x"), + "Missing argument: 'x' must be a valid numeric value", + fixed = TRUE + ) + + expect_error(.assertIsSingleNumber(c(1, 2), "x"), + "Illegal argument: 'x' c(1, 2) must be a single numeric value", + fixed = TRUE + ) + + expect_error(.assertIsSingleNumber(numeric(0), "x"), + "Missing argument: 'x' must be a valid numeric value", + fixed = TRUE + ) + +}) + +test_that("Testing '.assertAssociatedArgumentsAreDefined'", { + + expect_error(.assertAssociatedArgumentsAreDefined(a = NA, b = 1), + "Missing argument: 'a' must be defined because 'b' is defined", + fixed = TRUE + ) + + expect_error(.assertAssociatedArgumentsAreDefined(a = NA, b = 1, c = NA), + "Missing argument: 'a', 'c' must be defined because 'b' is defined", + fixed = TRUE + ) + + expect_error(.assertAssociatedArgumentsAreDefined(a = NA, b = 1, c = 2), + "Missing argument: 'a' must be defined because 'b', 'c' are defined", + fixed = TRUE + ) + +}) + +test_that("Testing '.associatedArgumentsAreDefined'", { + + expect_equal(.associatedArgumentsAreDefined(nPlanned = NA_real_, thetaH1 = NA_real_), FALSE) + + expect_warning(expect_equal(.associatedArgumentsAreDefined(nPlanned = NA_real_, thetaH1 = 1), FALSE), + "Incomplete associated arguments: 'nPlanned' should be defined because 'thetaH1' is defined", + fixed = TRUE + ) + + expect_equal(.associatedArgumentsAreDefined(nPlanned = 1, thetaH1 = 1), TRUE) + +}) + +test_that("Testing '.isValidNPlanned'", { + + expect_equal(.isValidNPlanned(nPlanned = c(1, 2), kMax = 4, stage = 2), TRUE) + + expect_silent(.isValidNPlanned(nPlanned = NA_real_, kMax = 4, stage = 2)) + + expect_warning(.isValidNPlanned(nPlanned = c(1), kMax = 4, stage = 2), + "'nPlanned' (1) will be ignored: length must be equal to 2 (kMax - stage = 4 - 2)", + fixed = TRUE + ) + + expect_warning(.isValidNPlanned(nPlanned = c(1, 2, 3), kMax = 4, stage = 2), + "'nPlanned' (1, 2, 3) will be ignored: length must be equal to 2 (kMax - stage = 4 - 2)", + fixed = TRUE + ) + +}) + +test_that("Testing '.assertIsValidSummaryIntervalFormat'", { + + .assertIsValidSummaryIntervalFormat("[%s; %s]") + .assertIsValidSummaryIntervalFormat("%s - %s") + .assertIsValidSummaryIntervalFormat("(%s, %s)") + + expect_error(.assertIsValidSummaryIntervalFormat("[%s; %s; %s]")) + expect_error(.assertIsValidSummaryIntervalFormat("[%s]")) + expect_error(.assertIsValidSummaryIntervalFormat("")) + expect_error(.assertIsValidSummaryIntervalFormat(1)) + +}) + +test_that("Testing '.assertIsSingleInteger'", { + + expect_error(.assertIsSingleInteger(NA_integer_, "x", naAllowed = FALSE)) + expect_error(.assertIsSingleInteger(-1, "x", naAllowed = FALSE)) + expect_error(.assertIsSingleInteger(-1, "x", naAllowed = FALSE, validateType = FALSE), NA) + expect_error(.assertIsSingleInteger(NA_integer_, "x", naAllowed = TRUE), NA) + expect_error(.assertIsSingleInteger(-1, "x", naAllowed = TRUE)) + expect_error(.assertIsSingleInteger("1", "x", naAllowed = TRUE)) + expect_error(.assertIsSingleInteger(1, "x", naAllowed = TRUE, validateType = TRUE)) + expect_error(.assertIsSingleInteger(1, "x", naAllowed = TRUE, validateType = FALSE), NA) + +}) + +test_that("Testing '.assertIsSinglePositiveInteger'", { + + expect_error(.assertIsSinglePositiveInteger(NA_integer_, "x", naAllowed = FALSE)) + expect_error(.assertIsSinglePositiveInteger(-1, "x", naAllowed = FALSE)) + expect_error(.assertIsSinglePositiveInteger(NA_integer_, "x", naAllowed = TRUE), NA) + expect_error(.assertIsSinglePositiveInteger(NA_real_, "x", naAllowed = TRUE)) + expect_error(.assertIsSinglePositiveInteger(-1, "x", naAllowed = TRUE)) + expect_error(.assertIsSinglePositiveInteger("1", "x", naAllowed = TRUE)) + expect_error(.assertIsSinglePositiveInteger(1, "x", naAllowed = TRUE, validateType = TRUE)) + expect_error(.assertIsSinglePositiveInteger(1, "x", naAllowed = TRUE, validateType = FALSE), NA) + +}) + +test_that("Testing '.assertIsSingleLogical'", { + + expect_error(.assertIsSingleLogical("TRUE", "x", naAllowed = FALSE)) + expect_error(.assertIsSingleLogical("FALSE", "x", naAllowed = FALSE)) + expect_error(.assertIsSingleLogical(TRUE, "x", naAllowed = FALSE), NA) + expect_error(.assertIsSingleLogical(FALSE, "x", naAllowed = FALSE), NA) + expect_error(.assertIsSingleLogical(NA, "x", naAllowed = TRUE), NA) + expect_error(.assertIsSingleLogical(NA, "x", naAllowed = FALSE)) + +}) + +test_that("Testing '.assertIsValidMatrix'", { + + expect_error(.assertIsValidMatrix(c(), "x", naAllowed = FALSE)) + expect_error(.assertIsValidMatrix(NULL, "x", naAllowed = FALSE)) + expect_error(.assertIsValidMatrix(1:3, "x", naAllowed = FALSE)) + expect_error(.assertIsValidMatrix(1:3, "x", naAllowed = TRUE)) + expect_error(.assertIsValidMatrix("a", "x", naAllowed = FALSE)) + expect_error(.assertIsValidMatrix("a", "x", naAllowed = TRUE)) + expect_error(.assertIsValidMatrix(NA, "x", naAllowed = FALSE)) + expect_error(.assertIsValidMatrix(NA, "x", naAllowed = TRUE)) +}) + diff --git a/tests/testthat/test-f_core_output_formats.R b/tests/testthat/test-f_core_output_formats.R index 1af5767b..78431f5e 100644 --- a/tests/testthat/test-f_core_output_formats.R +++ b/tests/testthat/test-f_core_output_formats.R @@ -1,443 +1,442 @@ -## | -## | *Unit tests* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | RPACT package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File name: test-f_core_output_formats.R -## | Creation date: 08 November 2023, 09:09:35 -## | File version: $Revision: 7665 $ -## | Last changed: $Date: 2024-02-23 17:33:46 +0100 (Fr, 23 Feb 2024) $ -## | Last changed by: $Author: pahlke $ -## | - -test_plan_section("Testing the Output Format Functions") - - -test_that("'.formatPValues'", { - # @refFS[Sec.]{fs:sec:outputFormats} - # @refFS[Tab.]{fs:tab:outputFormats} - x <- .formatPValues(0.0000234) - - ## Comparison of the results of character object 'x' with expected results - expect_equal(x, "<0.0001", label = paste0("c(", paste0(x, collapse = ", "), ")")) - - x <- .formatPValues(c(0.0000234, 0.0000134, 0.1234)) - - ## Comparison of the results of character object 'x' with expected results - expect_equal(x, c("<0.0001", "<0.0001", "0.1234"), label = paste0("c(", paste0(x, collapse = ", "), ")")) - - x <- .formatPValues(c(0.0002345678, 0.0000134, 0.1234, 0.000000000001, .00000009999)) - - ## Comparison of the results of character object 'x' with expected results - expect_equal(x, c("0.0002346", "0.0000134", "0.1234000", "<0.000001", "<0.000001"), label = paste0("c(", paste0(x, collapse = ", "), ")")) - - x <- .formatPValues(c(0.00234, 0.000013, 0.1234, 0.000000000001, .00000009999)) - - ## Comparison of the results of character object 'x' with expected results - expect_equal(x, c("0.00234", "<0.0001", "0.12340", "<0.0001", "<0.0001"), label = paste0("c(", paste0(x, collapse = ", "), ")")) - - x <- .formatPValues(c(6.244e-05, 4.906e-02, 1.446e-02, NA_real_)) - - ## Comparison of the results of character object 'x' with expected results - expect_equal(x, c("<0.0001", "0.04906", "0.01446", "NA"), label = paste0("c(", paste0(x, collapse = ", "), ")")) - - x <- .formatPValues(c(6.24408201934656e-05, 7.55449751868031e-05, 1.23207030919836e-05, NA_real_)) - - ## Comparison of the results of character object 'x' with expected results - expect_equal(x, c("<0.0001", "<0.0001", "<0.0001", "NA"), label = paste0("c(", paste0(x, collapse = ", "), ")")) - -}) - -test_that("'.formatRepeatedPValues'", { - - # @refFS[Sec.]{fs:sec:outputFormats} - # @refFS[Tab.]{fs:tab:outputFormats} - x <- .formatRepeatedPValues(c(0.0000234, 0.0000134, 0.1234)) - - ## Comparison of the results of character object 'x' with expected results - expect_equal(x, c("<0.0001", "<0.0001", "0.1234"), label = paste0("c(", paste0(x, collapse = ", "), ")")) - - x <- .formatRepeatedPValues(c(0.0000234, 0.0000134, 0.5234)) - - ## Comparison of the results of character object 'x' with expected results - expect_equal(x, c("<0.0001", "<0.0001", ">0.5"), label = paste0("c(", paste0(x, collapse = ", "), ")")) - - x <- .formatRepeatedPValues(c(0.0000234, 0.0000134, 0.5234, NA_real_)) - - ## Comparison of the results of character object 'x' with expected results - expect_equal(x, c("<0.0001", "<0.0001", ">0.5", "NA"), label = paste0("c(", paste0(x, collapse = ", "), ")")) - -}) - -test_that("'.formatConditionalPower'", { - - # @refFS[Sec.]{fs:sec:outputFormats} - # @refFS[Tab.]{fs:tab:outputFormats} - x <- .formatConditionalPower(c(0.0000234, 0.0000134, 0.5234, NA_real_)) - - ## Comparison of the results of character object 'x' with expected results - expect_equal(x, c("0", "0", "0.5234", "NA"), label = paste0("c(", paste0(x, collapse = ", "), ")")) - - x <- .formatConditionalPower(c(0.234, 0.123456, 0.6, 0.000001)) - - ## Comparison of the results of character object 'x' with expected results - expect_equal(x, c("0.2340", "0.1235", "0.6000", "0"), label = paste0("c(", paste0(x, collapse = ", "), ")")) - -}) - -test_that("'.formatProbabilities'", { - - # @refFS[Sec.]{fs:sec:outputFormats} - # @refFS[Tab.]{fs:tab:outputFormats} - x <- .formatProbabilities(c(NA_real_, NA_real_, 0.4536623, 0.7713048)) - - ## Comparison of the results of character object 'x' with expected results - expect_equal(x, c("NA", "NA", "0.4537", "0.7713"), label = paste0("c(", paste0(x, collapse = ", "), ")")) - -}) - -test_that("'.getDecimalPlaces'", { - - # @refFS[Sec.]{fs:sec:outputFormats} - # @refFS[Tab.]{fs:tab:outputFormats} - x <- .getDecimalPlaces(NA) - - ## Comparison of the results of integer object 'x' with expected results - expect_equal(x, 0, label = paste0("c(", paste0(x, collapse = ", "), ")")) - - x <- .getDecimalPlaces(12.123) - - ## Comparison of the results of integer object 'x' with expected results - expect_equal(x, 3, label = paste0("c(", paste0(x, collapse = ", "), ")")) - - x <- .getDecimalPlaces(c(6.661338e-16, 8.000000e-01, NA_real_)) - - ## Comparison of the results of integer object 'x' with expected results - expect_equal(x, c(15, 1, 0), label = paste0("c(", paste0(x, collapse = ", "), ")")) - - x <- .getDecimalPlaces(c(6.661338e-16, 8.12300000e-02)) - - ## Comparison of the results of integer object 'x' with expected results - expect_equal(x, c(15, 5), label = paste0("c(", paste0(x, collapse = ", "), ")")) - -}) - -test_that(" Internal output format functions throw errors when arguments are missing or wrong", { - - expect_equal(.getFormattedValue(), "NA") - expect_error(.assertIsValitOutputFormatOptionValue()) - expect_error(.getOutputFormatOptions()) - expect_error(.getOptionBasedFormattedValue()) - expect_no_error(getOutputFormat()) - expect_no_error(.getOutputFormat()) - expect_error(.addFieldsToOutputFormatList()) - expect_error(.getOutputFormatParameterNames()) - expect_error(.getOutputFormatFunctionName()) - expect_error(.getOutputFormatKeyByFieldName()) - expect_error(.getOutputFormatKeyByFunctionName()) - -}) - -test_that(".assertIsValidOutputFormatOptionValue handles valid option value'", { - - # Valid option value - optionKey <- "exampleKey" - optionValue <- "roundFunction = ceiling" - - # Call the function being tested - result <- .assertIsValidOutputFormatOptionValue(optionKey, optionValue) - - # Expect no error or exception - expect_null(result) - -}) - -test_that(".assertIsValidOutputFormatOptionValue handles invalid empty option value'", { - - # Invalid empty option value - optionKey <- "exampleKey" - optionValue <- "" - - # Call the function being tested - result <- capture_output(.assertIsValidOutputFormatOptionValue(optionKey, optionValue)) - - # Expect an error message - expect_match(result, "") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.p.value'", { - - key <- "rpact.output.format.p.value" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatPValues") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.repeated.p.value'", { - - key <- "rpact.output.format.repeated.p.value" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatRepeatedPValues") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.probability'", { - - key <- "rpact.output.format.probability" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatProbabilities") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.futility.probability'", { - - key <- "rpact.output.format.futility.probability" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatFutilityProbabilities") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.sample.size'", { - - key <- "rpact.output.format.sample.size" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatSampleSizes") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.event'", { - - key <- "rpact.output.format.event" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatEvents") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.event.time'", { - - key <- "rpact.output.format.event.time" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatEventTime") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.conditional.power'", { - - key <- "rpact.output.format.conditional.power" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatConditionalPower") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.critical.value'", { - - key <- "rpact.output.format.critical.value" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatCriticalValues") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.critical.value.fisher'", { - - key <- "rpact.output.format.critical.value.fisher" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatCriticalValuesFisher") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.test.statistic.fisher'", { - - key <- "rpact.output.format.test.statistic.fisher" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatTestStatisticsFisher") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.test.statistic'", { - - key <- "rpact.output.format.test.statistic" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatTestStatistics") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.rate'", { - - key <- "rpact.output.format.rate" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatRates") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.rate1'", { - - key <- "rpact.output.format.rate1" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatRatesDynamic") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.accrual.intensity'", { - - key <- "rpact.output.format.accrual.intensity" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatAccrualIntensities") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.mean'", { - - key <- "rpact.output.format.mean" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatMeans") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.ratio'", { - - key <- "rpact.output.format.ratio" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatRatios") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.st.dev'", { - - key <- "rpact.output.format.st.dev" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatStDevs") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.duration'", { - - key <- "rpact.output.format.duration" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatDurations") - -}) - -test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.time'", { - - key <- "rpact.output.format.time" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect the correct function name - expect_equal(result, ".formatTime") - -}) - -test_that(".getOutputFormatFunctionName returns NULL for unknown key", { - - key <- "unknown.key" - - # Call the function being tested - result <- .getOutputFormatFunctionName(key) - - # Expect NULL as the result - expect_null(result) - -}) - -test_that(".getOptionBasedFormattedValue returns NULL for unknown option key", { - - optionKey <- "unknown.key" - value <- 0.123 - - # Call the function being tested - result <- .getOptionBasedFormattedValue(optionKey, value) - - # Expect NULL as the result - expect_null(result) - -}) - +## | +## | *Unit tests* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | RPACT package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File name: test-f_core_output_formats.R +## | Creation date: 08 November 2023, 09:09:35 +## | File version: $Revision: 7665 $ +## | Last changed: $Date: 2024-02-23 17:33:46 +0100 (Fr, 23 Feb 2024) $ +## | Last changed by: $Author: pahlke $ +## | + +test_plan_section("Testing the Output Format Functions") + + +test_that("'.formatPValues'", { + # @refFS[Sec.]{fs:sec:outputFormats} + # @refFS[Tab.]{fs:tab:outputFormats} + x <- .formatPValues(0.0000234) + + ## Comparison of the results of character object 'x' with expected results + expect_equal(x, "<0.0001", label = paste0("c(", paste0(x, collapse = ", "), ")")) + + x <- .formatPValues(c(0.0000234, 0.0000134, 0.1234)) + + ## Comparison of the results of character object 'x' with expected results + expect_equal(x, c("<0.0001", "<0.0001", "0.1234"), label = paste0("c(", paste0(x, collapse = ", "), ")")) + + x <- .formatPValues(c(0.0002345678, 0.0000134, 0.1234, 0.000000000001, .00000009999)) + + ## Comparison of the results of character object 'x' with expected results + expect_equal(x, c("0.0002346", "0.0000134", "0.1234000", "<0.000001", "<0.000001"), label = paste0("c(", paste0(x, collapse = ", "), ")")) + + x <- .formatPValues(c(0.00234, 0.000013, 0.1234, 0.000000000001, .00000009999)) + + ## Comparison of the results of character object 'x' with expected results + expect_equal(x, c("0.00234", "<0.0001", "0.12340", "<0.0001", "<0.0001"), label = paste0("c(", paste0(x, collapse = ", "), ")")) + + x <- .formatPValues(c(6.244e-05, 4.906e-02, 1.446e-02, NA_real_)) + + ## Comparison of the results of character object 'x' with expected results + expect_equal(x, c("<0.0001", "0.04906", "0.01446", "NA"), label = paste0("c(", paste0(x, collapse = ", "), ")")) + + x <- .formatPValues(c(6.24408201934656e-05, 7.55449751868031e-05, 1.23207030919836e-05, NA_real_)) + + ## Comparison of the results of character object 'x' with expected results + expect_equal(x, c("<0.0001", "<0.0001", "<0.0001", "NA"), label = paste0("c(", paste0(x, collapse = ", "), ")")) + +}) + +test_that("'.formatRepeatedPValues'", { + + # @refFS[Sec.]{fs:sec:outputFormats} + # @refFS[Tab.]{fs:tab:outputFormats} + x <- .formatRepeatedPValues(c(0.0000234, 0.0000134, 0.1234)) + + ## Comparison of the results of character object 'x' with expected results + expect_equal(x, c("<0.0001", "<0.0001", "0.1234"), label = paste0("c(", paste0(x, collapse = ", "), ")")) + + x <- .formatRepeatedPValues(c(0.0000234, 0.0000134, 0.5234)) + + ## Comparison of the results of character object 'x' with expected results + expect_equal(x, c("<0.0001", "<0.0001", ">0.5"), label = paste0("c(", paste0(x, collapse = ", "), ")")) + + x <- .formatRepeatedPValues(c(0.0000234, 0.0000134, 0.5234, NA_real_)) + + ## Comparison of the results of character object 'x' with expected results + expect_equal(x, c("<0.0001", "<0.0001", ">0.5", "NA"), label = paste0("c(", paste0(x, collapse = ", "), ")")) + +}) + +test_that("'.formatConditionalPower'", { + + # @refFS[Sec.]{fs:sec:outputFormats} + # @refFS[Tab.]{fs:tab:outputFormats} + x <- .formatConditionalPower(c(0.0000234, 0.0000134, 0.5234, NA_real_)) + + ## Comparison of the results of character object 'x' with expected results + expect_equal(x, c("0", "0", "0.5234", "NA"), label = paste0("c(", paste0(x, collapse = ", "), ")")) + + x <- .formatConditionalPower(c(0.234, 0.123456, 0.6, 0.000001)) + + ## Comparison of the results of character object 'x' with expected results + expect_equal(x, c("0.2340", "0.1235", "0.6000", "0"), label = paste0("c(", paste0(x, collapse = ", "), ")")) + +}) + +test_that("'.formatProbabilities'", { + + # @refFS[Sec.]{fs:sec:outputFormats} + # @refFS[Tab.]{fs:tab:outputFormats} + x <- .formatProbabilities(c(NA_real_, NA_real_, 0.4536623, 0.7713048)) + + ## Comparison of the results of character object 'x' with expected results + expect_equal(x, c("NA", "NA", "0.4537", "0.7713"), label = paste0("c(", paste0(x, collapse = ", "), ")")) + +}) + +test_that("'.getDecimalPlaces'", { + + # @refFS[Sec.]{fs:sec:outputFormats} + # @refFS[Tab.]{fs:tab:outputFormats} + x <- .getDecimalPlaces(NA) + + ## Comparison of the results of integer object 'x' with expected results + expect_equal(x, 0, label = paste0("c(", paste0(x, collapse = ", "), ")")) + + x <- .getDecimalPlaces(12.123) + + ## Comparison of the results of integer object 'x' with expected results + expect_equal(x, 3, label = paste0("c(", paste0(x, collapse = ", "), ")")) + + x <- .getDecimalPlaces(c(6.661338e-16, 8.000000e-01, NA_real_)) + + ## Comparison of the results of integer object 'x' with expected results + expect_equal(x, c(15, 1, 0), label = paste0("c(", paste0(x, collapse = ", "), ")")) + + x <- .getDecimalPlaces(c(6.661338e-16, 8.12300000e-02)) + + ## Comparison of the results of integer object 'x' with expected results + expect_equal(x, c(15, 5), label = paste0("c(", paste0(x, collapse = ", "), ")")) + +}) + +test_that(" Internal output format functions throw errors when arguments are missing or wrong", { + + expect_equal(.getFormattedValue(), "NA") + expect_error(.assertIsValitOutputFormatOptionValue()) + expect_error(.getOutputFormatOptions()) + expect_error(.getOptionBasedFormattedValue()) + expect_no_error(getOutputFormat()) + expect_no_error(.getOutputFormat()) + expect_error(.addFieldsToOutputFormatList()) + expect_error(.getOutputFormatParameterNames()) + expect_error(.getOutputFormatFunctionName()) + expect_error(.getOutputFormatKeyByFieldName()) + expect_error(.getOutputFormatKeyByFunctionName()) + +}) + +test_that(".assertIsValidOutputFormatOptionValue handles valid option value'", { + + # Valid option value + optionKey <- "exampleKey" + optionValue <- "roundFunction = ceiling" + + # Call the function being tested + result <- .assertIsValidOutputFormatOptionValue(optionKey, optionValue) + + # Expect no error or exception + expect_null(result) + +}) + +test_that(".assertIsValidOutputFormatOptionValue handles invalid empty option value'", { + + # Invalid empty option value + optionKey <- "exampleKey" + optionValue <- "" + + # Call the function being tested + result <- capture_output(.assertIsValidOutputFormatOptionValue(optionKey, optionValue)) + + # Expect an error message + expect_match(result, "") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.p.value'", { + + key <- "rpact.output.format.p.value" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatPValues") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.repeated.p.value'", { + + key <- "rpact.output.format.repeated.p.value" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatRepeatedPValues") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.probability'", { + + key <- "rpact.output.format.probability" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatProbabilities") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.futility.probability'", { + + key <- "rpact.output.format.futility.probability" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatFutilityProbabilities") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.sample.size'", { + + key <- "rpact.output.format.sample.size" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatSampleSizes") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.event'", { + + key <- "rpact.output.format.event" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatEvents") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.event.time'", { + + key <- "rpact.output.format.event.time" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatEventTime") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.conditional.power'", { + + key <- "rpact.output.format.conditional.power" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatConditionalPower") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.critical.value'", { + + key <- "rpact.output.format.critical.value" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatCriticalValues") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.critical.value.fisher'", { + + key <- "rpact.output.format.critical.value.fisher" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatCriticalValuesFisher") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.test.statistic.fisher'", { + + key <- "rpact.output.format.test.statistic.fisher" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatTestStatisticsFisher") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.test.statistic'", { + + key <- "rpact.output.format.test.statistic" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatTestStatistics") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.rate'", { + + key <- "rpact.output.format.rate" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatRates") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.rate1'", { + + key <- "rpact.output.format.rate1" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatRatesDynamic") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.accrual.intensity'", { + + key <- "rpact.output.format.accrual.intensity" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatAccrualIntensities") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.mean'", { + + key <- "rpact.output.format.mean" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatMeans") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.ratio'", { + + key <- "rpact.output.format.ratio" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatRatios") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.st.dev'", { + + key <- "rpact.output.format.st.dev" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatStDevs") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.duration'", { + + key <- "rpact.output.format.duration" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatDurations") + +}) + +test_that(".getOutputFormatFunctionName returns correct function name for key 'rpact.output.format.time'", { + + key <- "rpact.output.format.time" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect the correct function name + expect_equal(result, ".formatTime") + +}) + +test_that(".getOutputFormatFunctionName returns NULL for unknown key", { + + key <- "unknown.key" + + # Call the function being tested + result <- .getOutputFormatFunctionName(key) + + # Expect NULL as the result + expect_null(result) + +}) + +test_that(".getOptionBasedFormattedValue returns NULL for unknown option key", { + + optionKey <- "unknown.key" + value <- 0.123 + + # Call the function being tested + result <- .getOptionBasedFormattedValue(optionKey, value) + + # Expect NULL as the result + expect_null(result) +}) + diff --git a/tests/testthat/test-f_core_plot.R b/tests/testthat/test-f_core_plot.R index ab1ab70f..216e7702 100644 --- a/tests/testthat/test-f_core_plot.R +++ b/tests/testthat/test-f_core_plot.R @@ -1,116 +1,115 @@ -## | -## | *Unit tests* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | RPACT package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File name: test-f_core_plot.R -## | Creation date: 08 November 2023, 09:09:36 -## | File version: $Revision: 7662 $ -## | Last changed: $Date: 2024-02-23 12:42:26 +0100 (Fr, 23 Feb 2024) $ -## | Last changed by: $Author: pahlke $ -## | - -test_plan_section("Testing .reconstructSequenceCommand") - - -test_that("The output is as exptected", { - expect_equal(.reconstructSequenceCommand(seq(-1, 1, 0.02)), "seq(-1, 1, 0.02)") - expect_equal(.reconstructSequenceCommand(c()), NA_character_) - expect_equal(.reconstructSequenceCommand(c(1)), "1") - expect_equal(.reconstructSequenceCommand(c(1, 2)), "c(1, 2)") - expect_equal(.reconstructSequenceCommand(c(1, 2, 3)), "c(1, 2, 3)") - expect_equal(.reconstructSequenceCommand(c(1, 2, 3, 4)), "seq(1, 4, 1)") - expect_equal(.reconstructSequenceCommand(c(1, 2, 3, 5)), "c(1, 2, 3, 5)") - - expect_true(grepl(.getRexepSaveCharacter("x$.design"), "x$.design")) - expect_true(grepl(.getRexepSaveCharacter("x$.design"), "c(x$.design, xxx)")) - expect_false(grepl(.getRexepSaveCharacter("x$.design"), "c(x$design, xxx)")) - -}) - -test_that("Internal core plot functions throw errors when arguments are missing or wrong", { - - expect_equal(.addNumberToPlotCaption(caption = "hello", type = "character"), "hello") - - expect_error(.getPlotCaption()) - - expect_error(.getPlotTypeNumber()) - expect_error(.getPlotTypeNumber(type = "test")) - - expect_error(.createPlotResultObject()) - expect_error(.createPlotResultObject(list(x = 1), grid = -1)) - expect_error(.createPlotResultObject(list(x = 1), grid = 101)) - expect_error(.createPlotResultObject(list(x = 1), grid = 101)) - - expect_error(.printPlotShowSourceSeparator()) - - expect_error(plotTypes()) - - expect_error(.isValidVariedParameterVectorForPlotting()) - - expect_error(.removeInvalidPlotTypes()) - - expect_error(getAvailablePlotTypes()) - - expect_error(.getVariedParameterHint()) - - expect_error(.createValidParameterName()) - expect_equal(.createValidParameterName(NULL, "hello"), "hello") - expect_equal(.createValidParameterName("HI", "hello"), "HI$hello") - - expect_null(.showPlotSourceInformation()) - - expect_error(.testPlotCommand()) - - expect_error(.getParameterSetAsDataFrame()) - - expect_error(.getCategories()) - - expect_error(.getAxisLabel()) - expect_equal(.getAxisLabel("heho", NULL), "%heho%") - - expect_error(.allGroupValuesEqual()) - - expect_error(.plotParameterSet()) - - expect_error(.naAndNaNOmit()) - expect_null(.naAndNaNOmit(NULL)) - - expect_error(.getScalingFactors()) - - expect_error(.plotDataFrame()) - - expect_error(.getPointBorder()) - - expect_error(.getLegendPosition()) - - expect_error(.addQnormAlphaLine()) - - expect_equal(.getLambdaStepFunctionByTime(3, NA, 5), 5) - - expect_error(.getLambdaStepFunction()) - - expect_error(getLambdaStepFunction()) - - expect_type(.getRelativeFigureOutputPath(), "character") - - expect_error(saveLastPlot()) - - expect_error(.getGridPlotSettings()) - - expect_error(.getGridLegendPosition()) - - expect_error(.formatSubTitleValue()) - -}) - +## | +## | *Unit tests* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | RPACT package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File name: test-f_core_plot.R +## | Creation date: 08 November 2023, 09:09:36 +## | File version: $Revision: 7662 $ +## | Last changed: $Date: 2024-02-23 12:42:26 +0100 (Fr, 23 Feb 2024) $ +## | Last changed by: $Author: pahlke $ +## | + +test_plan_section("Testing .reconstructSequenceCommand") + + +test_that("The output is as exptected", { + expect_equal(.reconstructSequenceCommand(seq(-1, 1, 0.02)), "seq(-1, 1, 0.02)") + expect_equal(.reconstructSequenceCommand(c()), NA_character_) + expect_equal(.reconstructSequenceCommand(c(1)), "1") + expect_equal(.reconstructSequenceCommand(c(1, 2)), "c(1, 2)") + expect_equal(.reconstructSequenceCommand(c(1, 2, 3)), "c(1, 2, 3)") + expect_equal(.reconstructSequenceCommand(c(1, 2, 3, 4)), "seq(1, 4, 1)") + expect_equal(.reconstructSequenceCommand(c(1, 2, 3, 5)), "c(1, 2, 3, 5)") + + expect_true(grepl(.getRexepSaveCharacter("x$.design"), "x$.design")) + expect_true(grepl(.getRexepSaveCharacter("x$.design"), "c(x$.design, xxx)")) + expect_false(grepl(.getRexepSaveCharacter("x$.design"), "c(x$design, xxx)")) + +}) + +test_that("Internal core plot functions throw errors when arguments are missing or wrong", { + + expect_equal(.addNumberToPlotCaption(caption = "hello", type = "character"), "hello") + + expect_error(.getPlotCaption()) + + expect_error(.getPlotTypeNumber()) + expect_error(.getPlotTypeNumber(type = "test")) + + expect_error(.createPlotResultObject()) + expect_error(.createPlotResultObject(list(x = 1), grid = -1)) + expect_error(.createPlotResultObject(list(x = 1), grid = 101)) + expect_error(.createPlotResultObject(list(x = 1), grid = 101)) + + expect_error(.printPlotShowSourceSeparator()) + + expect_error(plotTypes()) + + expect_error(.isValidVariedParameterVectorForPlotting()) + + expect_error(.removeInvalidPlotTypes()) + + expect_error(getAvailablePlotTypes()) + + expect_error(.getVariedParameterHint()) + + expect_error(.createValidParameterName()) + expect_equal(.createValidParameterName(NULL, "hello"), "hello") + expect_equal(.createValidParameterName("HI", "hello"), "HI$hello") + + expect_null(.showPlotSourceInformation()) + + expect_error(.testPlotCommand()) + + expect_error(.getParameterSetAsDataFrame()) + + expect_error(.getCategories()) + + expect_error(.getAxisLabel()) + expect_equal(.getAxisLabel("heho", NULL), "%heho%") + + expect_error(.allGroupValuesEqual()) + + expect_error(.plotParameterSet()) + + expect_error(.naAndNaNOmit()) + expect_null(.naAndNaNOmit(NULL)) + + expect_error(.getScalingFactors()) + + expect_error(.plotDataFrame()) + + expect_error(.getPointBorder()) + + expect_error(.getLegendPosition()) + + expect_error(.addQnormAlphaLine()) + + expect_equal(.getLambdaStepFunctionByTime(3, NA, 5), 5) + + expect_error(.getLambdaStepFunction()) + + expect_error(getLambdaStepFunction()) + + expect_type(.getRelativeFigureOutputPath(), "character") + + expect_error(saveLastPlot()) + + expect_error(.getGridPlotSettings()) + + expect_error(.getGridLegendPosition()) + + expect_error(.formatSubTitleValue()) +}) + diff --git a/tests/testthat/test-f_design_fisher_combination_test.R b/tests/testthat/test-f_design_fisher_combination_test.R index 06180f7a..0725855c 100644 --- a/tests/testthat/test-f_design_fisher_combination_test.R +++ b/tests/testthat/test-f_design_fisher_combination_test.R @@ -1,565 +1,564 @@ -## | -## | *Unit tests* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | RPACT package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File name: test-f_design_fisher_combination_test.R -## | Creation date: 08 November 2023, 09:09:43 -## | File version: $Revision$ -## | Last changed: $Date$ -## | Last changed by: $Author$ -## | - -test_plan_section("Testing the Fisher Design Functionality") - - -test_that("'getDesignFisher' with default parameters: parameters and results are as expected", { - # @refFS[Tab.]{fs:tab:output:getDesignFisher} - # @refFS[Formula]{fs:FisherCombinationEqualAlpha} - designFisher0 <- getDesignFisher() - - ## Comparison of the results of TrialDesignFisher object 'designFisher0' with expected results - expect_equal(designFisher0$alphaSpent, c(0.012308547, 0.01962413, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher0$alphaSpent, collapse = ", "), ")")) - expect_equal(designFisher0$criticalValues, c(0.012308547, 0.0016635923, 0.00029106687), tolerance = 1e-07, label = paste0("c(", paste0(designFisher0$criticalValues, collapse = ", "), ")")) - expect_equal(designFisher0$stageLevels, c(0.012308547, 0.012308547, 0.012308547), tolerance = 1e-07, label = paste0("c(", paste0(designFisher0$stageLevels, collapse = ", "), ")")) - expect_equal(designFisher0$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher0$nonStochasticCurtailment, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(designFisher0), NA))) - expect_output(print(designFisher0)$show()) - invisible(capture.output(expect_error(summary(designFisher0), NA))) - expect_output(summary(designFisher0)$show()) - designFisher0CodeBased <- eval(parse(text = getObjectRCode(designFisher0, stringWrapParagraphWidth = NULL))) - expect_equal(designFisher0CodeBased$alphaSpent, designFisher0$alphaSpent, tolerance = 1e-07) - expect_equal(designFisher0CodeBased$criticalValues, designFisher0$criticalValues, tolerance = 1e-07) - expect_equal(designFisher0CodeBased$stageLevels, designFisher0$stageLevels, tolerance = 1e-07) - expect_equal(designFisher0CodeBased$nonStochasticCurtailment, designFisher0$nonStochasticCurtailment, tolerance = 1e-07) - expect_type(names(designFisher0), "character") - df <- as.data.frame(designFisher0) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(designFisher0) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignFisher' with default parameters and simulated alpha: parameters and results are as expected", { - - .skipTestIfDisabled() - .skipTestIfNotX64() - - # @refFS[Tab.]{fs:tab:output:getDesignFisher} - # @refFS[Formula]{fs:FisherCombinationEqualAlpha} - designFisher <- getDesignFisher(iterations = 10000, seed = 1234567) - - ## Comparison of the results of TrialDesignFisher object 'designFisher' with expected results - expect_equal(designFisher$alphaSpent, c(0.012308547, 0.01962413, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher$alphaSpent, collapse = ", "), ")")) - expect_equal(designFisher$criticalValues, c(0.012308547, 0.0016635923, 0.00029106687), tolerance = 1e-07, label = paste0("c(", paste0(designFisher$criticalValues, collapse = ", "), ")")) - expect_equal(designFisher$stageLevels, c(0.012308547, 0.012308547, 0.012308547), tolerance = 1e-07, label = paste0("c(", paste0(designFisher$stageLevels, collapse = ", "), ")")) - expect_equal(designFisher$simAlpha, 0.0243, tolerance = 1e-07, label = paste0("c(", paste0(designFisher$simAlpha, collapse = ", "), ")")) - expect_equal(designFisher$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher$nonStochasticCurtailment, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(designFisher), NA))) - expect_output(print(designFisher)$show()) - invisible(capture.output(expect_error(summary(designFisher), NA))) - expect_output(summary(designFisher)$show()) - designFisherCodeBased <- eval(parse(text = getObjectRCode(designFisher, stringWrapParagraphWidth = NULL))) - expect_equal(designFisherCodeBased$alphaSpent, designFisher$alphaSpent, tolerance = 1e-07) - expect_equal(designFisherCodeBased$criticalValues, designFisher$criticalValues, tolerance = 1e-07) - expect_equal(designFisherCodeBased$stageLevels, designFisher$stageLevels, tolerance = 1e-07) - expect_equal(designFisherCodeBased$simAlpha, designFisher$simAlpha, tolerance = 1e-07) - expect_equal(designFisherCodeBased$nonStochasticCurtailment, designFisher$nonStochasticCurtailment, tolerance = 1e-07) - expect_type(names(designFisher), "character") - df <- as.data.frame(designFisher) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(designFisher) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignFisher' with kMax = 2,3,..,6: parameters and results are as expected for different arguments", { - - .skipTestIfDisabled() - - # @refFS[Tab.]{fs:tab:output:getDesignFisher} - # @refFS[Formula]{fs:FisherCombinationFullAlpha} - designFisher1 <- getDesignFisher(kMax = 2, alpha = 0.05, alpha0Vec = 0.5, method = "fullAlpha") - - ## Comparison of the results of TrialDesignFisher object 'designFisher1' with expected results - expect_equal(designFisher1$alphaSpent, c(0.023314852, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(designFisher1$alphaSpent, collapse = ", "), ")")) - expect_equal(designFisher1$criticalValues, c(0.023314852, 0.0087049407), tolerance = 1e-07, label = paste0("c(", paste0(designFisher1$criticalValues, collapse = ", "), ")")) - expect_equal(designFisher1$stageLevels, c(0.023314852, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(designFisher1$stageLevels, collapse = ", "), ")")) - expect_equal(designFisher1$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher1$nonStochasticCurtailment, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(designFisher1), NA))) - expect_output(print(designFisher1)$show()) - invisible(capture.output(expect_error(summary(designFisher1), NA))) - expect_output(summary(designFisher1)$show()) - designFisher1CodeBased <- eval(parse(text = getObjectRCode(designFisher1, stringWrapParagraphWidth = NULL))) - expect_equal(designFisher1CodeBased$alphaSpent, designFisher1$alphaSpent, tolerance = 1e-07) - expect_equal(designFisher1CodeBased$criticalValues, designFisher1$criticalValues, tolerance = 1e-07) - expect_equal(designFisher1CodeBased$stageLevels, designFisher1$stageLevels, tolerance = 1e-07) - expect_equal(designFisher1CodeBased$nonStochasticCurtailment, designFisher1$nonStochasticCurtailment, tolerance = 1e-07) - expect_type(names(designFisher1), "character") - df <- as.data.frame(designFisher1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(designFisher1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignFisher} - # @refFS[Formula]{fs:FisherCombinationEqualAlpha} - designFisher2 <- getDesignFisher(kMax = 3, alpha0Vec = c(0.7, 0.5), informationRates = c(0.1, 0.3, 1), method = "equalAlpha") - - ## Comparison of the results of TrialDesignFisher object 'designFisher2' with expected results - expect_equal(designFisher2$alphaSpent, c(0.011823636, 0.019807903, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher2$alphaSpent, collapse = ", "), ")")) - expect_equal(designFisher2$criticalValues, c(0.011823636, 0.00036698794, 3.0631293e-07), tolerance = 1e-07, label = paste0("c(", paste0(designFisher2$criticalValues, collapse = ", "), ")")) - expect_equal(designFisher2$stageLevels, c(0.011823636, 0.011823636, 0.011823636), tolerance = 1e-07, label = paste0("c(", paste0(designFisher2$stageLevels, collapse = ", "), ")")) - expect_equal(designFisher2$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher2$nonStochasticCurtailment, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(designFisher2), NA))) - expect_output(print(designFisher2)$show()) - invisible(capture.output(expect_error(summary(designFisher2), NA))) - expect_output(summary(designFisher2)$show()) - designFisher2CodeBased <- eval(parse(text = getObjectRCode(designFisher2, stringWrapParagraphWidth = NULL))) - expect_equal(designFisher2CodeBased$alphaSpent, designFisher2$alphaSpent, tolerance = 1e-07) - expect_equal(designFisher2CodeBased$criticalValues, designFisher2$criticalValues, tolerance = 1e-07) - expect_equal(designFisher2CodeBased$stageLevels, designFisher2$stageLevels, tolerance = 1e-07) - expect_equal(designFisher2CodeBased$nonStochasticCurtailment, designFisher2$nonStochasticCurtailment, tolerance = 1e-07) - expect_type(names(designFisher2), "character") - df <- as.data.frame(designFisher2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(designFisher2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignFisher} - # @refFS[Formula]{fs:FisherCombinationEqualAlpha} - designFisher3 <- getDesignFisher(kMax = 4, alpha0Vec = c(0.7, 0.5, 0.3), informationRates = c(0.1, 0.3, 0.6, 1), bindingFutility = FALSE, method = "equalAlpha") - - ## Comparison of the results of TrialDesignFisher object 'designFisher3' with expected results - expect_equal(designFisher3$alphaSpent, c(0.0082575405, 0.014885188, 0.020347598, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher3$alphaSpent, collapse = ", "), ")")) - expect_equal(designFisher3$criticalValues, c(0.0082575405, 0.00021760942, 4.7163541e-06, 8.3369321e-08), tolerance = 1e-07, label = paste0("c(", paste0(designFisher3$criticalValues, collapse = ", "), ")")) - expect_equal(designFisher3$stageLevels, c(0.0082575405, 0.0082575405, 0.0082575405, 0.0082575405), tolerance = 1e-07, label = paste0("c(", paste0(designFisher3$stageLevels, collapse = ", "), ")")) - expect_equal(designFisher3$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher3$nonStochasticCurtailment, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(designFisher3), NA))) - expect_output(print(designFisher3)$show()) - invisible(capture.output(expect_error(summary(designFisher3), NA))) - expect_output(summary(designFisher3)$show()) - designFisher3CodeBased <- eval(parse(text = getObjectRCode(designFisher3, stringWrapParagraphWidth = NULL))) - expect_equal(designFisher3CodeBased$alphaSpent, designFisher3$alphaSpent, tolerance = 1e-07) - expect_equal(designFisher3CodeBased$criticalValues, designFisher3$criticalValues, tolerance = 1e-07) - expect_equal(designFisher3CodeBased$stageLevels, designFisher3$stageLevels, tolerance = 1e-07) - expect_equal(designFisher3CodeBased$nonStochasticCurtailment, designFisher3$nonStochasticCurtailment, tolerance = 1e-07) - expect_type(names(designFisher3), "character") - df <- as.data.frame(designFisher3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(designFisher3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignFisher} - # @refFS[Formula]{fs:FisherCombinationEqualAlpha} - designFisher4 <- getDesignFisher(kMax = 5, alpha0Vec = c(0.7, 0.5, 0.3, 0.3), informationRates = c(0.1, 0.3, 0.5, 0.6, 1), method = "equalAlpha") - - ## Comparison of the results of TrialDesignFisher object 'designFisher4' with expected results - expect_equal(designFisher4$alphaSpent, c(0.011157609, 0.018733282, 0.022750003, 0.024162936, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher4$alphaSpent, collapse = ", "), ")")) - expect_equal(designFisher4$criticalValues, c(0.011157609, 0.00033722277, 2.3068413e-05, 5.4825339e-06, 9.8015456e-08), tolerance = 1e-07, label = paste0("c(", paste0(designFisher4$criticalValues, collapse = ", "), ")")) - expect_equal(designFisher4$stageLevels, c(0.011157609, 0.011157609, 0.011157609, 0.011157609, 0.011157609), tolerance = 1e-07, label = paste0("c(", paste0(designFisher4$stageLevels, collapse = ", "), ")")) - expect_equal(designFisher4$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher4$nonStochasticCurtailment, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(designFisher4), NA))) - expect_output(print(designFisher4)$show()) - invisible(capture.output(expect_error(summary(designFisher4), NA))) - expect_output(summary(designFisher4)$show()) - designFisher4CodeBased <- eval(parse(text = getObjectRCode(designFisher4, stringWrapParagraphWidth = NULL))) - expect_equal(designFisher4CodeBased$alphaSpent, designFisher4$alphaSpent, tolerance = 1e-07) - expect_equal(designFisher4CodeBased$criticalValues, designFisher4$criticalValues, tolerance = 1e-07) - expect_equal(designFisher4CodeBased$stageLevels, designFisher4$stageLevels, tolerance = 1e-07) - expect_equal(designFisher4CodeBased$nonStochasticCurtailment, designFisher4$nonStochasticCurtailment, tolerance = 1e-07) - expect_type(names(designFisher4), "character") - df <- as.data.frame(designFisher4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(designFisher4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignFisher} - # @refFS[Formula]{fs:FisherCombinationEqualAlpha} - designFisher5 <- getDesignFisher(kMax = 5, alpha = 0.2, alpha0Vec = c(0.7, 0.5, 0.3, 0.2), method = "equalAlpha") - - ## Comparison of the results of TrialDesignFisher object 'designFisher5' with expected results - expect_equal(designFisher5$alphaSpent, c(0.12649082, 0.17362071, 0.19349017, 0.19931765, 0.2), tolerance = 1e-07, label = paste0("c(", paste0(designFisher5$alphaSpent, collapse = ", "), ")")) - expect_equal(designFisher5$criticalValues, c(0.12649082, 0.027546669, 0.0068856935, 0.0018391192, 0.00051168366), tolerance = 1e-07, label = paste0("c(", paste0(designFisher5$criticalValues, collapse = ", "), ")")) - expect_equal(designFisher5$stageLevels, c(0.12649082, 0.12649082, 0.12649082, 0.12649082, 0.12649082), tolerance = 1e-07, label = paste0("c(", paste0(designFisher5$stageLevels, collapse = ", "), ")")) - expect_equal(designFisher5$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher5$nonStochasticCurtailment, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(designFisher5), NA))) - expect_output(print(designFisher5)$show()) - invisible(capture.output(expect_error(summary(designFisher5), NA))) - expect_output(summary(designFisher5)$show()) - designFisher5CodeBased <- eval(parse(text = getObjectRCode(designFisher5, stringWrapParagraphWidth = NULL))) - expect_equal(designFisher5CodeBased$alphaSpent, designFisher5$alphaSpent, tolerance = 1e-07) - expect_equal(designFisher5CodeBased$criticalValues, designFisher5$criticalValues, tolerance = 1e-07) - expect_equal(designFisher5CodeBased$stageLevels, designFisher5$stageLevels, tolerance = 1e-07) - expect_equal(designFisher5CodeBased$nonStochasticCurtailment, designFisher5$nonStochasticCurtailment, tolerance = 1e-07) - expect_type(names(designFisher5), "character") - df <- as.data.frame(designFisher5) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(designFisher5) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignFisher} - # @refFS[Formula]{fs:FisherCombinationFullAlpha} - designFisher6 <- getDesignFisher(kMax = 4, informationRates = c(0.1, 0.3, 0.7, 1), method = "fullAlpha") - - ## Comparison of the results of TrialDesignFisher object 'designFisher6' with expected results - expect_equal(designFisher6$alphaSpent, c(1.0550077e-06, 0.00020026524, 0.0065266359, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher6$alphaSpent, collapse = ", "), ")")) - expect_equal(designFisher6$criticalValues, c(1.0550077e-06, 1.0550077e-06, 1.0550077e-06, 1.0550077e-06), tolerance = 1e-07, label = paste0("c(", paste0(designFisher6$criticalValues, collapse = ", "), ")")) - expect_equal(designFisher6$stageLevels, c(1.0550077e-06, 0.00020026524, 0.0065266359, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher6$stageLevels, collapse = ", "), ")")) - expect_equal(designFisher6$nonStochasticCurtailment, TRUE, label = paste0("c(", paste0(designFisher6$nonStochasticCurtailment, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(designFisher6), NA))) - expect_output(print(designFisher6)$show()) - invisible(capture.output(expect_error(summary(designFisher6), NA))) - expect_output(summary(designFisher6)$show()) - designFisher6CodeBased <- eval(parse(text = getObjectRCode(designFisher6, stringWrapParagraphWidth = NULL))) - expect_equal(designFisher6CodeBased$alphaSpent, designFisher6$alphaSpent, tolerance = 1e-07) - expect_equal(designFisher6CodeBased$criticalValues, designFisher6$criticalValues, tolerance = 1e-07) - expect_equal(designFisher6CodeBased$stageLevels, designFisher6$stageLevels, tolerance = 1e-07) - expect_equal(designFisher6CodeBased$nonStochasticCurtailment, designFisher6$nonStochasticCurtailment, tolerance = 1e-07) - expect_type(names(designFisher6), "character") - df <- as.data.frame(designFisher6) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(designFisher6) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignFisher} - # @refFS[Formula]{fs:FisherCombinationFullAlpha} - designFisher7 <- getDesignFisher(kMax = 3, alpha0Vec = c(0.7, 0.6), informationRates = c(0.1, 0.7, 1), method = "fullAlpha") - - ## Comparison of the results of TrialDesignFisher object 'designFisher7' with expected results - expect_equal(designFisher7$alphaSpent, c(2.1580149e-06, 0.0066525356, 0.01947245), tolerance = 1e-07, label = paste0("c(", paste0(designFisher7$alphaSpent, collapse = ", "), ")")) - expect_equal(designFisher7$criticalValues, c(2.1580149e-06, 2.1580149e-06, 2.1580149e-06), tolerance = 1e-07, label = paste0("c(", paste0(designFisher7$criticalValues, collapse = ", "), ")")) - expect_equal(designFisher7$stageLevels, c(2.1580149e-06, 0.008216166, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher7$stageLevels, collapse = ", "), ")")) - expect_equal(designFisher7$nonStochasticCurtailment, TRUE, label = paste0("c(", paste0(designFisher7$nonStochasticCurtailment, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(designFisher7), NA))) - expect_output(print(designFisher7)$show()) - invisible(capture.output(expect_error(summary(designFisher7), NA))) - expect_output(summary(designFisher7)$show()) - designFisher7CodeBased <- eval(parse(text = getObjectRCode(designFisher7, stringWrapParagraphWidth = NULL))) - expect_equal(designFisher7CodeBased$alphaSpent, designFisher7$alphaSpent, tolerance = 1e-07) - expect_equal(designFisher7CodeBased$criticalValues, designFisher7$criticalValues, tolerance = 1e-07) - expect_equal(designFisher7CodeBased$stageLevels, designFisher7$stageLevels, tolerance = 1e-07) - expect_equal(designFisher7CodeBased$nonStochasticCurtailment, designFisher7$nonStochasticCurtailment, tolerance = 1e-07) - expect_type(names(designFisher7), "character") - df <- as.data.frame(designFisher7) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(designFisher7) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignFisher} - # @refFS[Formula]{fs:FisherCombinationNoTreatmentStageInteraction} - designFisher8 <- getDesignFisher(kMax = 4, alpha0Vec = c(0.7, 0.6, 0.5), method = "noInteraction") - - ## Comparison of the results of TrialDesignFisher object 'designFisher8' with expected results - expect_equal(designFisher8$alphaSpent, c(0.0098603693, 0.012073314, 0.018133935, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher8$alphaSpent, collapse = ", "), ")")) - expect_equal(designFisher8$criticalValues, c(0.0098603693, 0.00051915905, 0.00031149543, 0.00015574772), tolerance = 1e-07, label = paste0("c(", paste0(designFisher8$criticalValues, collapse = ", "), ")")) - expect_equal(designFisher8$stageLevels, c(0.0098603693, 0.0044457148, 0.012979977, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher8$stageLevels, collapse = ", "), ")")) - expect_equal(designFisher8$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher8$nonStochasticCurtailment, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(designFisher8), NA))) - expect_output(print(designFisher8)$show()) - invisible(capture.output(expect_error(summary(designFisher8), NA))) - expect_output(summary(designFisher8)$show()) - designFisher8CodeBased <- eval(parse(text = getObjectRCode(designFisher8, stringWrapParagraphWidth = NULL))) - expect_equal(designFisher8CodeBased$alphaSpent, designFisher8$alphaSpent, tolerance = 1e-07) - expect_equal(designFisher8CodeBased$criticalValues, designFisher8$criticalValues, tolerance = 1e-07) - expect_equal(designFisher8CodeBased$stageLevels, designFisher8$stageLevels, tolerance = 1e-07) - expect_equal(designFisher8CodeBased$nonStochasticCurtailment, designFisher8$nonStochasticCurtailment, tolerance = 1e-07) - expect_type(names(designFisher8), "character") - df <- as.data.frame(designFisher8) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(designFisher8) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignFisher} - # @refFS[Formula]{fs:FisherCombinationNoTreatmentStageInteraction} - designFisher9 <- getDesignFisher(kMax = 6, alpha = 0.1, alpha0Vec = c(0.7, 0.6, 0.5, 0.4, 0.3), method = "noInteraction") - - ## Comparison of the results of TrialDesignFisher object 'designFisher9' with expected results - expect_equal(designFisher9$alphaSpent, c(0.058031958, 0.064517887, 0.079453273, 0.092924559, 0.098794775, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(designFisher9$alphaSpent, collapse = ", "), ")")) - expect_equal(designFisher9$criticalValues, c(0.058031958, 0.0026047006, 0.0015628203, 0.00078141017, 0.00031256407, 9.3769221e-05), tolerance = 1e-07, label = paste0("c(", paste0(designFisher9$criticalValues, collapse = ", "), ")")) - expect_equal(designFisher9$stageLevels, c(0.058031958, 0.018103809, 0.044282865, 0.074062827, 0.095655516, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(designFisher9$stageLevels, collapse = ", "), ")")) - expect_equal(designFisher9$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher9$nonStochasticCurtailment, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(designFisher9), NA))) - expect_output(print(designFisher9)$show()) - invisible(capture.output(expect_error(summary(designFisher9), NA))) - expect_output(summary(designFisher9)$show()) - designFisher9CodeBased <- eval(parse(text = getObjectRCode(designFisher9, stringWrapParagraphWidth = NULL))) - expect_equal(designFisher9CodeBased$alphaSpent, designFisher9$alphaSpent, tolerance = 1e-07) - expect_equal(designFisher9CodeBased$criticalValues, designFisher9$criticalValues, tolerance = 1e-07) - expect_equal(designFisher9CodeBased$stageLevels, designFisher9$stageLevels, tolerance = 1e-07) - expect_equal(designFisher9CodeBased$nonStochasticCurtailment, designFisher9$nonStochasticCurtailment, tolerance = 1e-07) - expect_type(names(designFisher9), "character") - df <- as.data.frame(designFisher9) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(designFisher9) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignFisher} - # @refFS[Formula]{fs:FisherCombinationNoTreatmentStageInteraction} - designFisher10 <- getDesignFisher( - kMax = 6, alpha = 0.1, alpha0Vec = c(0.7, 0.6, 0.5, 0.4, 0.3), method = "noInteraction", - informationRates = c(0.1, 0.15, 0.3, 0.4, 0.9, 1) - ) - - ## Comparison of the results of TrialDesignFisher object 'designFisher10' with expected results - expect_equal(designFisher10$alphaSpent, c(0.082381502, 0.082401579, 0.084330144, 0.086806556, 0.10023391, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(designFisher10$alphaSpent, collapse = ", "), ")")) - expect_equal(designFisher10$criticalValues, c(0.082381502, 0.00017925198, 0.00011812048, 5.906024e-05, 3.9204058e-05, 1.1761218e-05), tolerance = 1e-07, label = paste0("c(", paste0(designFisher10$criticalValues, collapse = ", "), ")")) - expect_equal(designFisher10$stageLevels, c(0.082381502, 0.0005998602, 0.0062212598, 0.012409923, 0.09943647, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(designFisher10$stageLevels, collapse = ", "), ")")) - expect_equal(designFisher10$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher10$nonStochasticCurtailment, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(designFisher10), NA))) - expect_output(print(designFisher10)$show()) - invisible(capture.output(expect_error(summary(designFisher10), NA))) - expect_output(summary(designFisher10)$show()) - designFisher10CodeBased <- eval(parse(text = getObjectRCode(designFisher10, stringWrapParagraphWidth = NULL))) - expect_equal(designFisher10CodeBased$alphaSpent, designFisher10$alphaSpent, tolerance = 1e-07) - expect_equal(designFisher10CodeBased$criticalValues, designFisher10$criticalValues, tolerance = 1e-07) - expect_equal(designFisher10CodeBased$stageLevels, designFisher10$stageLevels, tolerance = 1e-07) - expect_equal(designFisher10CodeBased$nonStochasticCurtailment, designFisher10$nonStochasticCurtailment, tolerance = 1e-07) - expect_type(names(designFisher10), "character") - df <- as.data.frame(designFisher10) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(designFisher10) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignFisher} - # @refFS[Formula]{fs:FisherCombinationUserDefinedAlphaSpending} - designFisher11 <- getDesignFisher(kMax = 4, alpha0Vec = c(0.7, 0.6, 0.5), method = "userDefinedAlpha", userAlphaSpending = c(0.01, 0.015, 0.02, 0.025)) - - ## Comparison of the results of TrialDesignFisher object 'designFisher11' with expected results - expect_equal(designFisher11$alphaSpent, c(0.01, 0.015, 0.02, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher11$alphaSpent, collapse = ", "), ")")) - expect_equal(designFisher11$criticalValues, c(0.01, 0.0011768873, 0.00031357454, 0.00011586425), tolerance = 1e-07, label = paste0("c(", paste0(designFisher11$criticalValues, collapse = ", "), ")")) - expect_equal(designFisher11$stageLevels, c(0.01, 0.0091148534, 0.013047692, 0.020300118), tolerance = 1e-07, label = paste0("c(", paste0(designFisher11$stageLevels, collapse = ", "), ")")) - expect_equal(designFisher11$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher11$nonStochasticCurtailment, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(designFisher11), NA))) - expect_output(print(designFisher11)$show()) - invisible(capture.output(expect_error(summary(designFisher11), NA))) - expect_output(summary(designFisher11)$show()) - designFisher11CodeBased <- eval(parse(text = getObjectRCode(designFisher11, stringWrapParagraphWidth = NULL))) - expect_equal(designFisher11CodeBased$alphaSpent, designFisher11$alphaSpent, tolerance = 1e-07) - expect_equal(designFisher11CodeBased$criticalValues, designFisher11$criticalValues, tolerance = 1e-07) - expect_equal(designFisher11CodeBased$stageLevels, designFisher11$stageLevels, tolerance = 1e-07) - expect_equal(designFisher11CodeBased$nonStochasticCurtailment, designFisher11$nonStochasticCurtailment, tolerance = 1e-07) - expect_type(names(designFisher11), "character") - df <- as.data.frame(designFisher11) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(designFisher11) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignFisher} - # @refFS[Formula]{fs:FisherCombinationUserDefinedAlphaSpending} - designFisher12 <- getDesignFisher( - kMax = 4, alpha0Vec = c(0.7, 0.6, 0.5), informationRates = c(0.1, 0.3, 0.7, 1), - method = "userDefinedAlpha", userAlphaSpending = c(0.01, 0.015, 0.02, 0.025) - ) - - ## Comparison of the results of TrialDesignFisher object 'designFisher12' with expected results - expect_equal(designFisher12$alphaSpent, c(0.01, 0.015, 0.02, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher12$alphaSpent, collapse = ", "), ")")) - expect_equal(designFisher12$criticalValues, c(0.01, 0.00018389153, 2.6484943e-06, 5.2344628e-07), tolerance = 1e-07, label = paste0("c(", paste0(designFisher12$criticalValues, collapse = ", "), ")")) - expect_equal(designFisher12$stageLevels, c(0.01, 0.0073532156, 0.0101804, 0.018500415), tolerance = 1e-07, label = paste0("c(", paste0(designFisher12$stageLevels, collapse = ", "), ")")) - expect_equal(designFisher12$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher12$nonStochasticCurtailment, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(designFisher12), NA))) - expect_output(print(designFisher12)$show()) - invisible(capture.output(expect_error(summary(designFisher12), NA))) - expect_output(summary(designFisher12)$show()) - designFisher12CodeBased <- eval(parse(text = getObjectRCode(designFisher12, stringWrapParagraphWidth = NULL))) - expect_equal(designFisher12CodeBased$alphaSpent, designFisher12$alphaSpent, tolerance = 1e-07) - expect_equal(designFisher12CodeBased$criticalValues, designFisher12$criticalValues, tolerance = 1e-07) - expect_equal(designFisher12CodeBased$stageLevels, designFisher12$stageLevels, tolerance = 1e-07) - expect_equal(designFisher12CodeBased$nonStochasticCurtailment, designFisher12$nonStochasticCurtailment, tolerance = 1e-07) - expect_type(names(designFisher12), "character") - df <- as.data.frame(designFisher12) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(designFisher12) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignFisher': illegal arguments throw exceptions as expected", { - - expect_error(getDesignFisher( - method = C_FISHER_METHOD_USER_DEFINED_ALPHA, - userAlphaSpending = c(0.01, 0.02, 0.023, 0.023, 0.025), kMax = 4 - ), - paste0( - "Conflicting arguments: length of 'userAlphaSpending' (5) ", - "must be equal to 'kMax' (4)" - ), - fixed = TRUE - ) - - expect_error(getDesignFisher( - method = C_FISHER_METHOD_USER_DEFINED_ALPHA, - userAlphaSpending = c(0.01, 0.02, 0.025), informationRates = c(0.5, 1) - ), - paste0( - "Conflicting arguments: length of 'userAlphaSpending' (3) ", - "must be equal to length of 'informationRates' (2)" - ), - fixed = TRUE - ) - - expect_error(getDesignFisher( - method = C_FISHER_METHOD_USER_DEFINED_ALPHA, - userAlphaSpending = c(0.01, 0.02, 0.025), informationRates = c(0.4, 1) - ), - paste0( - "Conflicting arguments: length of 'userAlphaSpending' (3) ", - "must be equal to length of 'informationRates' (2)" - ), - fixed = TRUE - ) - - expect_error(getDesignFisher( - method = C_FISHER_METHOD_USER_DEFINED_ALPHA, - userAlphaSpending = c(0.01, 0.02, 0.023, 0.023, 0.021) - ), - paste0( - "'userAlphaSpending' = c(0.01, 0.02, 0.023, 0.023, 0.021) must be a vector that ", - "satisfies the following condition: 0 <= alpha_1 <= .. <= alpha_5 <= alpha = 0.021" - ), - fixed = TRUE - ) - - expect_error(getDesignFisher( - method = C_FISHER_METHOD_USER_DEFINED_ALPHA, - userAlphaSpending = c(0.01, 0.02, 0.023), alpha = 0.02 - ), - paste0( - "'userAlphaSpending' = c(0.01, 0.02, 0.023) must be a vector that ", - "satisfies the following condition: 0 <= alpha_1 <= .. <= alpha_3 <= alpha = 0.02" - ), - fixed = TRUE - ) - - expect_equal(getDesignFisher( - method = C_FISHER_METHOD_USER_DEFINED_ALPHA, - userAlphaSpending = c(0.01, 0.02, 0.023) - )$alpha, 0.023) - - expect_error(getDesignFisher(method = C_FISHER_METHOD_USER_DEFINED_ALPHA), - "Missing argument: parameter 'userAlphaSpending' must be specified in design", - fixed = TRUE - ) - - expect_error(getDesignFisher(kMax = Inf), - paste0( - "Argument out of bounds: 'kMax' (Inf) is out of bounds [1; ", - C_KMAX_UPPER_BOUND_FISHER, "]" - ), - fixed = TRUE - ) - - expect_error(getDesignFisher(kMax = -Inf), - paste0( - "Argument out of bounds: 'kMax' (-Inf) is out of bounds [1; ", - C_KMAX_UPPER_BOUND_FISHER, "]" - ), - fixed = TRUE - ) - - expect_error(getDesignFisher(kMax = -Inf), "Argument out of bounds: 'kMax' (-Inf) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = -10), "Argument out of bounds: 'kMax' (-10) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = -9), "Argument out of bounds: 'kMax' (-9) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = -8), "Argument out of bounds: 'kMax' (-8) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = -7), "Argument out of bounds: 'kMax' (-7) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = -6), "Argument out of bounds: 'kMax' (-6) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = -5), "Argument out of bounds: 'kMax' (-5) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = -4), "Argument out of bounds: 'kMax' (-4) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = -3), "Argument out of bounds: 'kMax' (-3) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = -2), "Argument out of bounds: 'kMax' (-2) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = -1), "Argument out of bounds: 'kMax' (-1) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = 0), "Argument out of bounds: 'kMax' (0) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = 7), "Argument out of bounds: 'kMax' (7) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = 8), "Argument out of bounds: 'kMax' (8) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = 9), "Argument out of bounds: 'kMax' (9) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = 10), "Argument out of bounds: 'kMax' (10) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = 11), "Argument out of bounds: 'kMax' (11) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = 12), "Argument out of bounds: 'kMax' (12) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = 13), "Argument out of bounds: 'kMax' (13) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = 14), "Argument out of bounds: 'kMax' (14) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = 15), "Argument out of bounds: 'kMax' (15) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = 16), "Argument out of bounds: 'kMax' (16) is out of bounds [1; 6]", fixed = TRUE) - expect_error(getDesignFisher(kMax = Inf), "Argument out of bounds: 'kMax' (Inf) is out of bounds [1; 6]", fixed = TRUE) - - expect_error(getDesignFisher(kMax = 2, informationRates = c(0.01, 0.02, 0.04, 0.05)), "Conflicting arguments: length of 'informationRates' (4) must be equal to 'kMax' (2)", fixed = TRUE) - expect_error(getDesignFisher(kMax = 3, informationRates = c(0.01, 0.02, 0.04, 0.05)), "Conflicting arguments: length of 'informationRates' (4) must be equal to 'kMax' (3)", fixed = TRUE) - expect_error(getDesignFisher(kMax = 5, informationRates = c(0.01, 0.02, 0.04, 0.05)), "Conflicting arguments: length of 'informationRates' (4) must be equal to 'kMax' (5)", fixed = TRUE) - expect_error(getDesignFisher(kMax = 6, informationRates = c(0.01, 0.02, 0.04, 0.05)), "Conflicting arguments: length of 'informationRates' (4) must be equal to 'kMax' (6)", fixed = TRUE) - - expect_error(getDesignFisher(alpha0Vec = c(0, 1)), - "Argument out of bounds: 'alpha0Vec' (0, 1) is out of bounds (0; 1]", - fixed = TRUE - ) - - expect_error(getDesignFisher(alpha0Vec = c(0.1, 1.01)), - "Argument out of bounds: 'alpha0Vec' (0.1, 1.01) is out of bounds (0; 1]", - fixed = TRUE - ) - -}) - +## | +## | *Unit tests* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | RPACT package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File name: test-f_design_fisher_combination_test.R +## | Creation date: 08 November 2023, 09:09:43 +## | File version: $Revision$ +## | Last changed: $Date$ +## | Last changed by: $Author$ +## | + +test_plan_section("Testing the Fisher Design Functionality") + + +test_that("'getDesignFisher' with default parameters: parameters and results are as expected", { + # @refFS[Tab.]{fs:tab:output:getDesignFisher} + # @refFS[Formula]{fs:FisherCombinationEqualAlpha} + designFisher0 <- getDesignFisher() + + ## Comparison of the results of TrialDesignFisher object 'designFisher0' with expected results + expect_equal(designFisher0$alphaSpent, c(0.012308547, 0.01962413, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher0$alphaSpent, collapse = ", "), ")")) + expect_equal(designFisher0$criticalValues, c(0.012308547, 0.0016635923, 0.00029106687), tolerance = 1e-07, label = paste0("c(", paste0(designFisher0$criticalValues, collapse = ", "), ")")) + expect_equal(designFisher0$stageLevels, c(0.012308547, 0.012308547, 0.012308547), tolerance = 1e-07, label = paste0("c(", paste0(designFisher0$stageLevels, collapse = ", "), ")")) + expect_equal(designFisher0$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher0$nonStochasticCurtailment, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(designFisher0), NA))) + expect_output(print(designFisher0)$show()) + invisible(capture.output(expect_error(summary(designFisher0), NA))) + expect_output(summary(designFisher0)$show()) + designFisher0CodeBased <- eval(parse(text = getObjectRCode(designFisher0, stringWrapParagraphWidth = NULL))) + expect_equal(designFisher0CodeBased$alphaSpent, designFisher0$alphaSpent, tolerance = 1e-07) + expect_equal(designFisher0CodeBased$criticalValues, designFisher0$criticalValues, tolerance = 1e-07) + expect_equal(designFisher0CodeBased$stageLevels, designFisher0$stageLevels, tolerance = 1e-07) + expect_equal(designFisher0CodeBased$nonStochasticCurtailment, designFisher0$nonStochasticCurtailment, tolerance = 1e-07) + expect_type(names(designFisher0), "character") + df <- as.data.frame(designFisher0) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(designFisher0) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignFisher' with default parameters and simulated alpha: parameters and results are as expected", { + + .skipTestIfDisabled() + .skipTestIfNotX64() + + # @refFS[Tab.]{fs:tab:output:getDesignFisher} + # @refFS[Formula]{fs:FisherCombinationEqualAlpha} + designFisher <- getDesignFisher(iterations = 10000, seed = 1234567) + + ## Comparison of the results of TrialDesignFisher object 'designFisher' with expected results + expect_equal(designFisher$alphaSpent, c(0.012308547, 0.01962413, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher$alphaSpent, collapse = ", "), ")")) + expect_equal(designFisher$criticalValues, c(0.012308547, 0.0016635923, 0.00029106687), tolerance = 1e-07, label = paste0("c(", paste0(designFisher$criticalValues, collapse = ", "), ")")) + expect_equal(designFisher$stageLevels, c(0.012308547, 0.012308547, 0.012308547), tolerance = 1e-07, label = paste0("c(", paste0(designFisher$stageLevels, collapse = ", "), ")")) + expect_equal(designFisher$simAlpha, 0.0243, tolerance = 1e-07, label = paste0("c(", paste0(designFisher$simAlpha, collapse = ", "), ")")) + expect_equal(designFisher$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher$nonStochasticCurtailment, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(designFisher), NA))) + expect_output(print(designFisher)$show()) + invisible(capture.output(expect_error(summary(designFisher), NA))) + expect_output(summary(designFisher)$show()) + designFisherCodeBased <- eval(parse(text = getObjectRCode(designFisher, stringWrapParagraphWidth = NULL))) + expect_equal(designFisherCodeBased$alphaSpent, designFisher$alphaSpent, tolerance = 1e-07) + expect_equal(designFisherCodeBased$criticalValues, designFisher$criticalValues, tolerance = 1e-07) + expect_equal(designFisherCodeBased$stageLevels, designFisher$stageLevels, tolerance = 1e-07) + expect_equal(designFisherCodeBased$simAlpha, designFisher$simAlpha, tolerance = 1e-07) + expect_equal(designFisherCodeBased$nonStochasticCurtailment, designFisher$nonStochasticCurtailment, tolerance = 1e-07) + expect_type(names(designFisher), "character") + df <- as.data.frame(designFisher) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(designFisher) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignFisher' with kMax = 2,3,..,6: parameters and results are as expected for different arguments", { + + .skipTestIfDisabled() + + # @refFS[Tab.]{fs:tab:output:getDesignFisher} + # @refFS[Formula]{fs:FisherCombinationFullAlpha} + designFisher1 <- getDesignFisher(kMax = 2, alpha = 0.05, alpha0Vec = 0.5, method = "fullAlpha") + + ## Comparison of the results of TrialDesignFisher object 'designFisher1' with expected results + expect_equal(designFisher1$alphaSpent, c(0.023314852, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(designFisher1$alphaSpent, collapse = ", "), ")")) + expect_equal(designFisher1$criticalValues, c(0.023314852, 0.0087049407), tolerance = 1e-07, label = paste0("c(", paste0(designFisher1$criticalValues, collapse = ", "), ")")) + expect_equal(designFisher1$stageLevels, c(0.023314852, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(designFisher1$stageLevels, collapse = ", "), ")")) + expect_equal(designFisher1$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher1$nonStochasticCurtailment, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(designFisher1), NA))) + expect_output(print(designFisher1)$show()) + invisible(capture.output(expect_error(summary(designFisher1), NA))) + expect_output(summary(designFisher1)$show()) + designFisher1CodeBased <- eval(parse(text = getObjectRCode(designFisher1, stringWrapParagraphWidth = NULL))) + expect_equal(designFisher1CodeBased$alphaSpent, designFisher1$alphaSpent, tolerance = 1e-07) + expect_equal(designFisher1CodeBased$criticalValues, designFisher1$criticalValues, tolerance = 1e-07) + expect_equal(designFisher1CodeBased$stageLevels, designFisher1$stageLevels, tolerance = 1e-07) + expect_equal(designFisher1CodeBased$nonStochasticCurtailment, designFisher1$nonStochasticCurtailment, tolerance = 1e-07) + expect_type(names(designFisher1), "character") + df <- as.data.frame(designFisher1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(designFisher1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignFisher} + # @refFS[Formula]{fs:FisherCombinationEqualAlpha} + designFisher2 <- getDesignFisher(kMax = 3, alpha0Vec = c(0.7, 0.5), informationRates = c(0.1, 0.3, 1), method = "equalAlpha") + + ## Comparison of the results of TrialDesignFisher object 'designFisher2' with expected results + expect_equal(designFisher2$alphaSpent, c(0.011823636, 0.019807903, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher2$alphaSpent, collapse = ", "), ")")) + expect_equal(designFisher2$criticalValues, c(0.011823636, 0.00036698794, 3.0631293e-07), tolerance = 1e-07, label = paste0("c(", paste0(designFisher2$criticalValues, collapse = ", "), ")")) + expect_equal(designFisher2$stageLevels, c(0.011823636, 0.011823636, 0.011823636), tolerance = 1e-07, label = paste0("c(", paste0(designFisher2$stageLevels, collapse = ", "), ")")) + expect_equal(designFisher2$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher2$nonStochasticCurtailment, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(designFisher2), NA))) + expect_output(print(designFisher2)$show()) + invisible(capture.output(expect_error(summary(designFisher2), NA))) + expect_output(summary(designFisher2)$show()) + designFisher2CodeBased <- eval(parse(text = getObjectRCode(designFisher2, stringWrapParagraphWidth = NULL))) + expect_equal(designFisher2CodeBased$alphaSpent, designFisher2$alphaSpent, tolerance = 1e-07) + expect_equal(designFisher2CodeBased$criticalValues, designFisher2$criticalValues, tolerance = 1e-07) + expect_equal(designFisher2CodeBased$stageLevels, designFisher2$stageLevels, tolerance = 1e-07) + expect_equal(designFisher2CodeBased$nonStochasticCurtailment, designFisher2$nonStochasticCurtailment, tolerance = 1e-07) + expect_type(names(designFisher2), "character") + df <- as.data.frame(designFisher2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(designFisher2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignFisher} + # @refFS[Formula]{fs:FisherCombinationEqualAlpha} + designFisher3 <- getDesignFisher(kMax = 4, alpha0Vec = c(0.7, 0.5, 0.3), informationRates = c(0.1, 0.3, 0.6, 1), bindingFutility = FALSE, method = "equalAlpha") + + ## Comparison of the results of TrialDesignFisher object 'designFisher3' with expected results + expect_equal(designFisher3$alphaSpent, c(0.0082575405, 0.014885188, 0.020347598, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher3$alphaSpent, collapse = ", "), ")")) + expect_equal(designFisher3$criticalValues, c(0.0082575405, 0.00021760942, 4.7163541e-06, 8.3369321e-08), tolerance = 1e-07, label = paste0("c(", paste0(designFisher3$criticalValues, collapse = ", "), ")")) + expect_equal(designFisher3$stageLevels, c(0.0082575405, 0.0082575405, 0.0082575405, 0.0082575405), tolerance = 1e-07, label = paste0("c(", paste0(designFisher3$stageLevels, collapse = ", "), ")")) + expect_equal(designFisher3$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher3$nonStochasticCurtailment, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(designFisher3), NA))) + expect_output(print(designFisher3)$show()) + invisible(capture.output(expect_error(summary(designFisher3), NA))) + expect_output(summary(designFisher3)$show()) + designFisher3CodeBased <- eval(parse(text = getObjectRCode(designFisher3, stringWrapParagraphWidth = NULL))) + expect_equal(designFisher3CodeBased$alphaSpent, designFisher3$alphaSpent, tolerance = 1e-07) + expect_equal(designFisher3CodeBased$criticalValues, designFisher3$criticalValues, tolerance = 1e-07) + expect_equal(designFisher3CodeBased$stageLevels, designFisher3$stageLevels, tolerance = 1e-07) + expect_equal(designFisher3CodeBased$nonStochasticCurtailment, designFisher3$nonStochasticCurtailment, tolerance = 1e-07) + expect_type(names(designFisher3), "character") + df <- as.data.frame(designFisher3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(designFisher3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignFisher} + # @refFS[Formula]{fs:FisherCombinationEqualAlpha} + designFisher4 <- getDesignFisher(kMax = 5, alpha0Vec = c(0.7, 0.5, 0.3, 0.3), informationRates = c(0.1, 0.3, 0.5, 0.6, 1), method = "equalAlpha") + + ## Comparison of the results of TrialDesignFisher object 'designFisher4' with expected results + expect_equal(designFisher4$alphaSpent, c(0.011157609, 0.018733282, 0.022750003, 0.024162936, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher4$alphaSpent, collapse = ", "), ")")) + expect_equal(designFisher4$criticalValues, c(0.011157609, 0.00033722277, 2.3068413e-05, 5.4825339e-06, 9.8015456e-08), tolerance = 1e-07, label = paste0("c(", paste0(designFisher4$criticalValues, collapse = ", "), ")")) + expect_equal(designFisher4$stageLevels, c(0.011157609, 0.011157609, 0.011157609, 0.011157609, 0.011157609), tolerance = 1e-07, label = paste0("c(", paste0(designFisher4$stageLevels, collapse = ", "), ")")) + expect_equal(designFisher4$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher4$nonStochasticCurtailment, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(designFisher4), NA))) + expect_output(print(designFisher4)$show()) + invisible(capture.output(expect_error(summary(designFisher4), NA))) + expect_output(summary(designFisher4)$show()) + designFisher4CodeBased <- eval(parse(text = getObjectRCode(designFisher4, stringWrapParagraphWidth = NULL))) + expect_equal(designFisher4CodeBased$alphaSpent, designFisher4$alphaSpent, tolerance = 1e-07) + expect_equal(designFisher4CodeBased$criticalValues, designFisher4$criticalValues, tolerance = 1e-07) + expect_equal(designFisher4CodeBased$stageLevels, designFisher4$stageLevels, tolerance = 1e-07) + expect_equal(designFisher4CodeBased$nonStochasticCurtailment, designFisher4$nonStochasticCurtailment, tolerance = 1e-07) + expect_type(names(designFisher4), "character") + df <- as.data.frame(designFisher4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(designFisher4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignFisher} + # @refFS[Formula]{fs:FisherCombinationEqualAlpha} + designFisher5 <- getDesignFisher(kMax = 5, alpha = 0.2, alpha0Vec = c(0.7, 0.5, 0.3, 0.2), method = "equalAlpha") + + ## Comparison of the results of TrialDesignFisher object 'designFisher5' with expected results + expect_equal(designFisher5$alphaSpent, c(0.12649082, 0.17362071, 0.19349017, 0.19931765, 0.2), tolerance = 1e-07, label = paste0("c(", paste0(designFisher5$alphaSpent, collapse = ", "), ")")) + expect_equal(designFisher5$criticalValues, c(0.12649082, 0.027546669, 0.0068856935, 0.0018391192, 0.00051168366), tolerance = 1e-07, label = paste0("c(", paste0(designFisher5$criticalValues, collapse = ", "), ")")) + expect_equal(designFisher5$stageLevels, c(0.12649082, 0.12649082, 0.12649082, 0.12649082, 0.12649082), tolerance = 1e-07, label = paste0("c(", paste0(designFisher5$stageLevels, collapse = ", "), ")")) + expect_equal(designFisher5$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher5$nonStochasticCurtailment, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(designFisher5), NA))) + expect_output(print(designFisher5)$show()) + invisible(capture.output(expect_error(summary(designFisher5), NA))) + expect_output(summary(designFisher5)$show()) + designFisher5CodeBased <- eval(parse(text = getObjectRCode(designFisher5, stringWrapParagraphWidth = NULL))) + expect_equal(designFisher5CodeBased$alphaSpent, designFisher5$alphaSpent, tolerance = 1e-07) + expect_equal(designFisher5CodeBased$criticalValues, designFisher5$criticalValues, tolerance = 1e-07) + expect_equal(designFisher5CodeBased$stageLevels, designFisher5$stageLevels, tolerance = 1e-07) + expect_equal(designFisher5CodeBased$nonStochasticCurtailment, designFisher5$nonStochasticCurtailment, tolerance = 1e-07) + expect_type(names(designFisher5), "character") + df <- as.data.frame(designFisher5) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(designFisher5) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignFisher} + # @refFS[Formula]{fs:FisherCombinationFullAlpha} + designFisher6 <- getDesignFisher(kMax = 4, informationRates = c(0.1, 0.3, 0.7, 1), method = "fullAlpha") + + ## Comparison of the results of TrialDesignFisher object 'designFisher6' with expected results + expect_equal(designFisher6$alphaSpent, c(1.0550077e-06, 0.00020026524, 0.0065266359, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher6$alphaSpent, collapse = ", "), ")")) + expect_equal(designFisher6$criticalValues, c(1.0550077e-06, 1.0550077e-06, 1.0550077e-06, 1.0550077e-06), tolerance = 1e-07, label = paste0("c(", paste0(designFisher6$criticalValues, collapse = ", "), ")")) + expect_equal(designFisher6$stageLevels, c(1.0550077e-06, 0.00020026524, 0.0065266359, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher6$stageLevels, collapse = ", "), ")")) + expect_equal(designFisher6$nonStochasticCurtailment, TRUE, label = paste0("c(", paste0(designFisher6$nonStochasticCurtailment, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(designFisher6), NA))) + expect_output(print(designFisher6)$show()) + invisible(capture.output(expect_error(summary(designFisher6), NA))) + expect_output(summary(designFisher6)$show()) + designFisher6CodeBased <- eval(parse(text = getObjectRCode(designFisher6, stringWrapParagraphWidth = NULL))) + expect_equal(designFisher6CodeBased$alphaSpent, designFisher6$alphaSpent, tolerance = 1e-07) + expect_equal(designFisher6CodeBased$criticalValues, designFisher6$criticalValues, tolerance = 1e-07) + expect_equal(designFisher6CodeBased$stageLevels, designFisher6$stageLevels, tolerance = 1e-07) + expect_equal(designFisher6CodeBased$nonStochasticCurtailment, designFisher6$nonStochasticCurtailment, tolerance = 1e-07) + expect_type(names(designFisher6), "character") + df <- as.data.frame(designFisher6) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(designFisher6) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignFisher} + # @refFS[Formula]{fs:FisherCombinationFullAlpha} + designFisher7 <- getDesignFisher(kMax = 3, alpha0Vec = c(0.7, 0.6), informationRates = c(0.1, 0.7, 1), method = "fullAlpha") + + ## Comparison of the results of TrialDesignFisher object 'designFisher7' with expected results + expect_equal(designFisher7$alphaSpent, c(2.1580149e-06, 0.0066525356, 0.01947245), tolerance = 1e-07, label = paste0("c(", paste0(designFisher7$alphaSpent, collapse = ", "), ")")) + expect_equal(designFisher7$criticalValues, c(2.1580149e-06, 2.1580149e-06, 2.1580149e-06), tolerance = 1e-07, label = paste0("c(", paste0(designFisher7$criticalValues, collapse = ", "), ")")) + expect_equal(designFisher7$stageLevels, c(2.1580149e-06, 0.008216166, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher7$stageLevels, collapse = ", "), ")")) + expect_equal(designFisher7$nonStochasticCurtailment, TRUE, label = paste0("c(", paste0(designFisher7$nonStochasticCurtailment, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(designFisher7), NA))) + expect_output(print(designFisher7)$show()) + invisible(capture.output(expect_error(summary(designFisher7), NA))) + expect_output(summary(designFisher7)$show()) + designFisher7CodeBased <- eval(parse(text = getObjectRCode(designFisher7, stringWrapParagraphWidth = NULL))) + expect_equal(designFisher7CodeBased$alphaSpent, designFisher7$alphaSpent, tolerance = 1e-07) + expect_equal(designFisher7CodeBased$criticalValues, designFisher7$criticalValues, tolerance = 1e-07) + expect_equal(designFisher7CodeBased$stageLevels, designFisher7$stageLevels, tolerance = 1e-07) + expect_equal(designFisher7CodeBased$nonStochasticCurtailment, designFisher7$nonStochasticCurtailment, tolerance = 1e-07) + expect_type(names(designFisher7), "character") + df <- as.data.frame(designFisher7) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(designFisher7) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignFisher} + # @refFS[Formula]{fs:FisherCombinationNoTreatmentStageInteraction} + designFisher8 <- getDesignFisher(kMax = 4, alpha0Vec = c(0.7, 0.6, 0.5), method = "noInteraction") + + ## Comparison of the results of TrialDesignFisher object 'designFisher8' with expected results + expect_equal(designFisher8$alphaSpent, c(0.0098603693, 0.012073314, 0.018133935, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher8$alphaSpent, collapse = ", "), ")")) + expect_equal(designFisher8$criticalValues, c(0.0098603693, 0.00051915905, 0.00031149543, 0.00015574772), tolerance = 1e-07, label = paste0("c(", paste0(designFisher8$criticalValues, collapse = ", "), ")")) + expect_equal(designFisher8$stageLevels, c(0.0098603693, 0.0044457148, 0.012979977, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher8$stageLevels, collapse = ", "), ")")) + expect_equal(designFisher8$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher8$nonStochasticCurtailment, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(designFisher8), NA))) + expect_output(print(designFisher8)$show()) + invisible(capture.output(expect_error(summary(designFisher8), NA))) + expect_output(summary(designFisher8)$show()) + designFisher8CodeBased <- eval(parse(text = getObjectRCode(designFisher8, stringWrapParagraphWidth = NULL))) + expect_equal(designFisher8CodeBased$alphaSpent, designFisher8$alphaSpent, tolerance = 1e-07) + expect_equal(designFisher8CodeBased$criticalValues, designFisher8$criticalValues, tolerance = 1e-07) + expect_equal(designFisher8CodeBased$stageLevels, designFisher8$stageLevels, tolerance = 1e-07) + expect_equal(designFisher8CodeBased$nonStochasticCurtailment, designFisher8$nonStochasticCurtailment, tolerance = 1e-07) + expect_type(names(designFisher8), "character") + df <- as.data.frame(designFisher8) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(designFisher8) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignFisher} + # @refFS[Formula]{fs:FisherCombinationNoTreatmentStageInteraction} + designFisher9 <- getDesignFisher(kMax = 6, alpha = 0.1, alpha0Vec = c(0.7, 0.6, 0.5, 0.4, 0.3), method = "noInteraction") + + ## Comparison of the results of TrialDesignFisher object 'designFisher9' with expected results + expect_equal(designFisher9$alphaSpent, c(0.058031958, 0.064517887, 0.079453273, 0.092924559, 0.098794775, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(designFisher9$alphaSpent, collapse = ", "), ")")) + expect_equal(designFisher9$criticalValues, c(0.058031958, 0.0026047006, 0.0015628203, 0.00078141017, 0.00031256407, 9.3769221e-05), tolerance = 1e-07, label = paste0("c(", paste0(designFisher9$criticalValues, collapse = ", "), ")")) + expect_equal(designFisher9$stageLevels, c(0.058031958, 0.018103809, 0.044282865, 0.074062827, 0.095655516, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(designFisher9$stageLevels, collapse = ", "), ")")) + expect_equal(designFisher9$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher9$nonStochasticCurtailment, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(designFisher9), NA))) + expect_output(print(designFisher9)$show()) + invisible(capture.output(expect_error(summary(designFisher9), NA))) + expect_output(summary(designFisher9)$show()) + designFisher9CodeBased <- eval(parse(text = getObjectRCode(designFisher9, stringWrapParagraphWidth = NULL))) + expect_equal(designFisher9CodeBased$alphaSpent, designFisher9$alphaSpent, tolerance = 1e-07) + expect_equal(designFisher9CodeBased$criticalValues, designFisher9$criticalValues, tolerance = 1e-07) + expect_equal(designFisher9CodeBased$stageLevels, designFisher9$stageLevels, tolerance = 1e-07) + expect_equal(designFisher9CodeBased$nonStochasticCurtailment, designFisher9$nonStochasticCurtailment, tolerance = 1e-07) + expect_type(names(designFisher9), "character") + df <- as.data.frame(designFisher9) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(designFisher9) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignFisher} + # @refFS[Formula]{fs:FisherCombinationNoTreatmentStageInteraction} + designFisher10 <- getDesignFisher( + kMax = 6, alpha = 0.1, alpha0Vec = c(0.7, 0.6, 0.5, 0.4, 0.3), method = "noInteraction", + informationRates = c(0.1, 0.15, 0.3, 0.4, 0.9, 1) + ) + + ## Comparison of the results of TrialDesignFisher object 'designFisher10' with expected results + expect_equal(designFisher10$alphaSpent, c(0.082381502, 0.082401579, 0.084330144, 0.086806556, 0.10023391, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(designFisher10$alphaSpent, collapse = ", "), ")")) + expect_equal(designFisher10$criticalValues, c(0.082381502, 0.00017925198, 0.00011812048, 5.906024e-05, 3.9204058e-05, 1.1761218e-05), tolerance = 1e-07, label = paste0("c(", paste0(designFisher10$criticalValues, collapse = ", "), ")")) + expect_equal(designFisher10$stageLevels, c(0.082381502, 0.0005998602, 0.0062212598, 0.012409923, 0.09943647, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(designFisher10$stageLevels, collapse = ", "), ")")) + expect_equal(designFisher10$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher10$nonStochasticCurtailment, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(designFisher10), NA))) + expect_output(print(designFisher10)$show()) + invisible(capture.output(expect_error(summary(designFisher10), NA))) + expect_output(summary(designFisher10)$show()) + designFisher10CodeBased <- eval(parse(text = getObjectRCode(designFisher10, stringWrapParagraphWidth = NULL))) + expect_equal(designFisher10CodeBased$alphaSpent, designFisher10$alphaSpent, tolerance = 1e-07) + expect_equal(designFisher10CodeBased$criticalValues, designFisher10$criticalValues, tolerance = 1e-07) + expect_equal(designFisher10CodeBased$stageLevels, designFisher10$stageLevels, tolerance = 1e-07) + expect_equal(designFisher10CodeBased$nonStochasticCurtailment, designFisher10$nonStochasticCurtailment, tolerance = 1e-07) + expect_type(names(designFisher10), "character") + df <- as.data.frame(designFisher10) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(designFisher10) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignFisher} + # @refFS[Formula]{fs:FisherCombinationUserDefinedAlphaSpending} + designFisher11 <- getDesignFisher(kMax = 4, alpha0Vec = c(0.7, 0.6, 0.5), method = "userDefinedAlpha", userAlphaSpending = c(0.01, 0.015, 0.02, 0.025)) + + ## Comparison of the results of TrialDesignFisher object 'designFisher11' with expected results + expect_equal(designFisher11$alphaSpent, c(0.01, 0.015, 0.02, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher11$alphaSpent, collapse = ", "), ")")) + expect_equal(designFisher11$criticalValues, c(0.01, 0.0011768873, 0.00031357454, 0.00011586425), tolerance = 1e-07, label = paste0("c(", paste0(designFisher11$criticalValues, collapse = ", "), ")")) + expect_equal(designFisher11$stageLevels, c(0.01, 0.0091148534, 0.013047692, 0.020300118), tolerance = 1e-07, label = paste0("c(", paste0(designFisher11$stageLevels, collapse = ", "), ")")) + expect_equal(designFisher11$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher11$nonStochasticCurtailment, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(designFisher11), NA))) + expect_output(print(designFisher11)$show()) + invisible(capture.output(expect_error(summary(designFisher11), NA))) + expect_output(summary(designFisher11)$show()) + designFisher11CodeBased <- eval(parse(text = getObjectRCode(designFisher11, stringWrapParagraphWidth = NULL))) + expect_equal(designFisher11CodeBased$alphaSpent, designFisher11$alphaSpent, tolerance = 1e-07) + expect_equal(designFisher11CodeBased$criticalValues, designFisher11$criticalValues, tolerance = 1e-07) + expect_equal(designFisher11CodeBased$stageLevels, designFisher11$stageLevels, tolerance = 1e-07) + expect_equal(designFisher11CodeBased$nonStochasticCurtailment, designFisher11$nonStochasticCurtailment, tolerance = 1e-07) + expect_type(names(designFisher11), "character") + df <- as.data.frame(designFisher11) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(designFisher11) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignFisher} + # @refFS[Formula]{fs:FisherCombinationUserDefinedAlphaSpending} + designFisher12 <- getDesignFisher( + kMax = 4, alpha0Vec = c(0.7, 0.6, 0.5), informationRates = c(0.1, 0.3, 0.7, 1), + method = "userDefinedAlpha", userAlphaSpending = c(0.01, 0.015, 0.02, 0.025) + ) + + ## Comparison of the results of TrialDesignFisher object 'designFisher12' with expected results + expect_equal(designFisher12$alphaSpent, c(0.01, 0.015, 0.02, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(designFisher12$alphaSpent, collapse = ", "), ")")) + expect_equal(designFisher12$criticalValues, c(0.01, 0.00018389153, 2.6484943e-06, 5.2344628e-07), tolerance = 1e-07, label = paste0("c(", paste0(designFisher12$criticalValues, collapse = ", "), ")")) + expect_equal(designFisher12$stageLevels, c(0.01, 0.0073532156, 0.0101804, 0.018500415), tolerance = 1e-07, label = paste0("c(", paste0(designFisher12$stageLevels, collapse = ", "), ")")) + expect_equal(designFisher12$nonStochasticCurtailment, FALSE, label = paste0("c(", paste0(designFisher12$nonStochasticCurtailment, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(designFisher12), NA))) + expect_output(print(designFisher12)$show()) + invisible(capture.output(expect_error(summary(designFisher12), NA))) + expect_output(summary(designFisher12)$show()) + designFisher12CodeBased <- eval(parse(text = getObjectRCode(designFisher12, stringWrapParagraphWidth = NULL))) + expect_equal(designFisher12CodeBased$alphaSpent, designFisher12$alphaSpent, tolerance = 1e-07) + expect_equal(designFisher12CodeBased$criticalValues, designFisher12$criticalValues, tolerance = 1e-07) + expect_equal(designFisher12CodeBased$stageLevels, designFisher12$stageLevels, tolerance = 1e-07) + expect_equal(designFisher12CodeBased$nonStochasticCurtailment, designFisher12$nonStochasticCurtailment, tolerance = 1e-07) + expect_type(names(designFisher12), "character") + df <- as.data.frame(designFisher12) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(designFisher12) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignFisher': illegal arguments throw exceptions as expected", { + + expect_error(getDesignFisher( + method = C_FISHER_METHOD_USER_DEFINED_ALPHA, + userAlphaSpending = c(0.01, 0.02, 0.023, 0.023, 0.025), kMax = 4 + ), + paste0( + "Conflicting arguments: length of 'userAlphaSpending' (5) ", + "must be equal to 'kMax' (4)" + ), + fixed = TRUE + ) + + expect_error(getDesignFisher( + method = C_FISHER_METHOD_USER_DEFINED_ALPHA, + userAlphaSpending = c(0.01, 0.02, 0.025), informationRates = c(0.5, 1) + ), + paste0( + "Conflicting arguments: length of 'userAlphaSpending' (3) ", + "must be equal to length of 'informationRates' (2)" + ), + fixed = TRUE + ) + + expect_error(getDesignFisher( + method = C_FISHER_METHOD_USER_DEFINED_ALPHA, + userAlphaSpending = c(0.01, 0.02, 0.025), informationRates = c(0.4, 1) + ), + paste0( + "Conflicting arguments: length of 'userAlphaSpending' (3) ", + "must be equal to length of 'informationRates' (2)" + ), + fixed = TRUE + ) + + expect_error(getDesignFisher( + method = C_FISHER_METHOD_USER_DEFINED_ALPHA, + userAlphaSpending = c(0.01, 0.02, 0.023, 0.023, 0.021) + ), + paste0( + "'userAlphaSpending' = c(0.01, 0.02, 0.023, 0.023, 0.021) must be a vector that ", + "satisfies the following condition: 0 <= alpha_1 <= .. <= alpha_5 <= alpha = 0.021" + ), + fixed = TRUE + ) + + expect_error(getDesignFisher( + method = C_FISHER_METHOD_USER_DEFINED_ALPHA, + userAlphaSpending = c(0.01, 0.02, 0.023), alpha = 0.02 + ), + paste0( + "'userAlphaSpending' = c(0.01, 0.02, 0.023) must be a vector that ", + "satisfies the following condition: 0 <= alpha_1 <= .. <= alpha_3 <= alpha = 0.02" + ), + fixed = TRUE + ) + + expect_equal(getDesignFisher( + method = C_FISHER_METHOD_USER_DEFINED_ALPHA, + userAlphaSpending = c(0.01, 0.02, 0.023) + )$alpha, 0.023) + + expect_error(getDesignFisher(method = C_FISHER_METHOD_USER_DEFINED_ALPHA), + "Missing argument: parameter 'userAlphaSpending' must be specified in design", + fixed = TRUE + ) + + expect_error(getDesignFisher(kMax = Inf), + paste0( + "Argument out of bounds: 'kMax' (Inf) is out of bounds [1; ", + C_KMAX_UPPER_BOUND_FISHER, "]" + ), + fixed = TRUE + ) + + expect_error(getDesignFisher(kMax = -Inf), + paste0( + "Argument out of bounds: 'kMax' (-Inf) is out of bounds [1; ", + C_KMAX_UPPER_BOUND_FISHER, "]" + ), + fixed = TRUE + ) + + expect_error(getDesignFisher(kMax = -Inf), "Argument out of bounds: 'kMax' (-Inf) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = -10), "Argument out of bounds: 'kMax' (-10) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = -9), "Argument out of bounds: 'kMax' (-9) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = -8), "Argument out of bounds: 'kMax' (-8) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = -7), "Argument out of bounds: 'kMax' (-7) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = -6), "Argument out of bounds: 'kMax' (-6) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = -5), "Argument out of bounds: 'kMax' (-5) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = -4), "Argument out of bounds: 'kMax' (-4) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = -3), "Argument out of bounds: 'kMax' (-3) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = -2), "Argument out of bounds: 'kMax' (-2) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = -1), "Argument out of bounds: 'kMax' (-1) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = 0), "Argument out of bounds: 'kMax' (0) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = 7), "Argument out of bounds: 'kMax' (7) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = 8), "Argument out of bounds: 'kMax' (8) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = 9), "Argument out of bounds: 'kMax' (9) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = 10), "Argument out of bounds: 'kMax' (10) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = 11), "Argument out of bounds: 'kMax' (11) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = 12), "Argument out of bounds: 'kMax' (12) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = 13), "Argument out of bounds: 'kMax' (13) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = 14), "Argument out of bounds: 'kMax' (14) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = 15), "Argument out of bounds: 'kMax' (15) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = 16), "Argument out of bounds: 'kMax' (16) is out of bounds [1; 6]", fixed = TRUE) + expect_error(getDesignFisher(kMax = Inf), "Argument out of bounds: 'kMax' (Inf) is out of bounds [1; 6]", fixed = TRUE) + + expect_error(getDesignFisher(kMax = 2, informationRates = c(0.01, 0.02, 0.04, 0.05)), "Conflicting arguments: length of 'informationRates' (4) must be equal to 'kMax' (2)", fixed = TRUE) + expect_error(getDesignFisher(kMax = 3, informationRates = c(0.01, 0.02, 0.04, 0.05)), "Conflicting arguments: length of 'informationRates' (4) must be equal to 'kMax' (3)", fixed = TRUE) + expect_error(getDesignFisher(kMax = 5, informationRates = c(0.01, 0.02, 0.04, 0.05)), "Conflicting arguments: length of 'informationRates' (4) must be equal to 'kMax' (5)", fixed = TRUE) + expect_error(getDesignFisher(kMax = 6, informationRates = c(0.01, 0.02, 0.04, 0.05)), "Conflicting arguments: length of 'informationRates' (4) must be equal to 'kMax' (6)", fixed = TRUE) + + expect_error(getDesignFisher(alpha0Vec = c(0, 1)), + "Argument out of bounds: 'alpha0Vec' (0, 1) is out of bounds (0; 1]", + fixed = TRUE + ) + + expect_error(getDesignFisher(alpha0Vec = c(0.1, 1.01)), + "Argument out of bounds: 'alpha0Vec' (0.1, 1.01) is out of bounds (0; 1]", + fixed = TRUE + ) +}) + diff --git a/tests/testthat/test-f_design_group_sequential.R b/tests/testthat/test-f_design_group_sequential.R index f2e07c88..f9af03ad 100644 --- a/tests/testthat/test-f_design_group_sequential.R +++ b/tests/testthat/test-f_design_group_sequential.R @@ -1,2109 +1,2108 @@ -## | -## | *Unit tests* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | RPACT package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File name: test-f_design_group_sequential.R -## | Creation date: 08 November 2023, 09:09:43 -## | File version: $Revision$ -## | Last changed: $Date$ -## | Last changed by: $Author$ -## | - -test_plan_section("Testing the Group Sequential and Inverse Normal Design Functionality") - - -test_that("'getGroupSequentialProbabilities' with one and two continuation regions for weighted test statistic", { - # @refFS[Formula]{fs:testStatisticGroupSequentialWeightedAverage} - xa <- getGroupSequentialProbabilities(matrix(c(rep(-qnorm(0.95), 4), rep(qnorm(0.95), 4)), nrow = 2, byrow = TRUE), (1:4) / 4) - - ## Comparison of the results of matrixarray object 'xa' with expected results - expect_equal(xa[1, ], c(0.05, 0.030074925, 0.020961248, 0.01595848), tolerance = 1e-07, label = paste0("c(", paste0(xa[1, ], collapse = ", "), ")")) - expect_equal(xa[2, ], c(0.95, 0.86992507, 0.8188889, 0.78196917), tolerance = 1e-07, label = paste0("c(", paste0(xa[2, ], collapse = ", "), ")")) - expect_equal(xa[3, ], c(1, 0.9, 0.83985015, 0.79792765), tolerance = 1e-07, label = paste0("c(", paste0(xa[3, ], collapse = ", "), ")")) - - xb <- getGroupSequentialProbabilities(matrix(c(rep(-qnorm(0.95), 4), rep(-1, 4), rep(1, 4), rep(qnorm(0.95), 4)), nrow = 4, byrow = TRUE), (1:4) / 4) - - ## Comparison of the results of matrixarray object 'xb' with expected results - expect_equal(xb[1, ], c(0.05, 0.016446517, 0.005264288, 0.0019569508), tolerance = 1e-07, label = paste0("c(", paste0(xb[1, ], collapse = ", "), ")")) - expect_equal(xb[2, ], c(0.15865525, 0.048950554, 0.017478997, 0.0072417024), tolerance = 1e-07, label = paste0("c(", paste0(xb[2, ], collapse = ", "), ")")) - expect_equal(xb[3, ], c(0.84134475, 0.16835995, 0.047529077, 0.017187717), tolerance = 1e-07, label = paste0("c(", paste0(xb[3, ], collapse = ", "), ")")) - expect_equal(xb[4, ], c(0.95, 0.20086399, 0.059743786, 0.022472468), tolerance = 1e-07, label = paste0("c(", paste0(xb[4, ], collapse = ", "), ")")) - expect_equal(xb[5, ], c(1, 0.21731051, 0.065008074, 0.024429419), tolerance = 1e-07, label = paste0("c(", paste0(xb[5, ], collapse = ", "), ")")) - -}) - -test_that("'getDesignInverseNormal' with default parameters: parameters and results are as expected", { - - # @refFS[Tab.]{fs:tab:output:getDesignInverseNormal} - # @refFS[Formula]{fs:criticalValuesOBrienFleming} - x0 <- getDesignInverseNormal() - - ## Comparison of the results of TrialDesignInverseNormal object 'x0' with expected results - expect_equal(x0$alphaSpent, c(0.00025917372, 0.0071600594, 0.02499999), tolerance = 1e-07, label = paste0("c(", paste0(x0$alphaSpent, collapse = ", "), ")")) - expect_equal(x0$criticalValues, c(3.4710914, 2.4544323, 2.0040356), tolerance = 1e-07, label = paste0("c(", paste0(x0$criticalValues, collapse = ", "), ")")) - expect_equal(x0$stageLevels, c(0.00025917372, 0.0070553616, 0.022533125), tolerance = 1e-07, label = paste0("c(", paste0(x0$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x0), NA))) - expect_output(print(x0)$show()) - invisible(capture.output(expect_error(summary(x0), NA))) - expect_output(summary(x0)$show()) - x0CodeBased <- eval(parse(text = getObjectRCode(x0, stringWrapParagraphWidth = NULL))) - expect_equal(x0CodeBased$alphaSpent, x0$alphaSpent, tolerance = 1e-07) - expect_equal(x0CodeBased$criticalValues, x0$criticalValues, tolerance = 1e-07) - expect_equal(x0CodeBased$stageLevels, x0$stageLevels, tolerance = 1e-07) - expect_type(names(x0), "character") - df <- as.data.frame(x0) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x0) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignInverseNormal' with type of design = 'asHSD', 'bsHSD', 'asKD', and 'bsKD'", { - - .skipTestIfDisabled() - - # @refFS[Tab.]{fs:tab:output:getDesignInverseNormal} - # @refFS[Formula]{fs:alphaSpendingConcept} - # @refFS[Formula]{fs:alphaSpendingHwangShiDeCani} - x1 <- getDesignInverseNormal( - kMax = 3, informationRates = c(0.2, 0.4, 1), - alpha = 0.03, sided = 1, beta = 0.14, typeOfDesign = "asHSD", gammaA = 0 - ) - - ## Comparison of the results of TrialDesignInverseNormal object 'x1' with expected results - expect_equal(x1$alphaSpent, c(0.006, 0.012, 0.03), tolerance = 1e-07, label = paste0("c(", paste0(x1$alphaSpent, collapse = ", "), ")")) - expect_equal(x1$criticalValues, c(2.5121443, 2.4228747, 2.0280392), tolerance = 1e-07, label = paste0("c(", paste0(x1$criticalValues, collapse = ", "), ")")) - expect_equal(x1$stageLevels, c(0.006, 0.0076991188, 0.021278125), tolerance = 1e-07, label = paste0("c(", paste0(x1$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x1), NA))) - expect_output(print(x1)$show()) - invisible(capture.output(expect_error(summary(x1), NA))) - expect_output(summary(x1)$show()) - x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) - expect_equal(x1CodeBased$alphaSpent, x1$alphaSpent, tolerance = 1e-07) - expect_equal(x1CodeBased$criticalValues, x1$criticalValues, tolerance = 1e-07) - expect_equal(x1CodeBased$stageLevels, x1$stageLevels, tolerance = 1e-07) - expect_type(names(x1), "character") - df <- as.data.frame(x1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignCharacteristics} - # @refFS[Formula]{fs:inflationFactor} - # @refFS[Formula]{fs:expectedReduction} - y1 <- getDesignCharacteristics(x1) - - ## Comparison of the results of TrialDesignCharacteristics object 'y1' with expected results - expect_equal(y1$nFixed, 8.7681899, tolerance = 1e-07, label = paste0("c(", paste0(y1$nFixed, collapse = ", "), ")")) - expect_equal(y1$shift, 9.4594101, tolerance = 1e-07, label = paste0("c(", paste0(y1$shift, collapse = ", "), ")")) - expect_equal(y1$inflationFactor, 1.0788327, tolerance = 1e-07, label = paste0("c(", paste0(y1$inflationFactor, collapse = ", "), ")")) - expect_equal(y1$information, c(1.891882, 3.7837641, 9.4594101), tolerance = 1e-07, label = paste0("c(", paste0(y1$information, collapse = ", "), ")")) - expect_equal(y1$power, c(0.12783451, 0.34055165, 0.86), tolerance = 1e-07, label = paste0("c(", paste0(y1$power, collapse = ", "), ")")) - expect_equal(y1$rejectionProbabilities, c(0.12783451, 0.21271713, 0.51944835), tolerance = 1e-07, label = paste0("c(", paste0(y1$rejectionProbabilities, collapse = ", "), ")")) - expect_equal(y1$futilityProbabilities, c(0, 0), label = paste0("c(", paste0(y1$futilityProbabilities, collapse = ", "), ")")) - expect_equal(y1$averageSampleNumber1, 0.83081135, tolerance = 1e-07, label = paste0("c(", paste0(y1$averageSampleNumber1, collapse = ", "), ")")) - expect_equal(y1$averageSampleNumber01, 1.0142116, tolerance = 1e-07, label = paste0("c(", paste0(y1$averageSampleNumber01, collapse = ", "), ")")) - expect_equal(y1$averageSampleNumber0, 1.0697705, tolerance = 1e-07, label = paste0("c(", paste0(y1$averageSampleNumber0, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(y1), NA))) - expect_output(print(y1)$show()) - invisible(capture.output(expect_error(summary(y1), NA))) - expect_output(summary(y1)$show()) - y1CodeBased <- eval(parse(text = getObjectRCode(y1, stringWrapParagraphWidth = NULL))) - expect_equal(y1CodeBased$nFixed, y1$nFixed, tolerance = 1e-07) - expect_equal(y1CodeBased$shift, y1$shift, tolerance = 1e-07) - expect_equal(y1CodeBased$inflationFactor, y1$inflationFactor, tolerance = 1e-07) - expect_equal(y1CodeBased$information, y1$information, tolerance = 1e-07) - expect_equal(y1CodeBased$power, y1$power, tolerance = 1e-07) - expect_equal(y1CodeBased$rejectionProbabilities, y1$rejectionProbabilities, tolerance = 1e-07) - expect_equal(y1CodeBased$futilityProbabilities, y1$futilityProbabilities, tolerance = 1e-07) - expect_equal(y1CodeBased$averageSampleNumber1, y1$averageSampleNumber1, tolerance = 1e-07) - expect_equal(y1CodeBased$averageSampleNumber01, y1$averageSampleNumber01, tolerance = 1e-07) - expect_equal(y1CodeBased$averageSampleNumber0, y1$averageSampleNumber0, tolerance = 1e-07) - expect_type(names(y1), "character") - df <- as.data.frame(y1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(y1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignInverseNormal} - # @refFS[Formula]{fs:alphaSpendingConcept} - # @refFS[Formula]{fs:alphaSpendingHwangShiDeCani} - # @refFS[Formula]{fs:betaSpendingApproach} - # @refFS[Formula]{fs:betaSpendingHwangShiDeCani} - x2 <- getDesignInverseNormal( - kMax = 3, informationRates = c(0.2, 0.4, 1), - alpha = 0.07, sided = 1, beta = 0.14, typeOfDesign = "asHSD", gammaA = -1, - typeBetaSpending = "bsHSD", gammaB = -2 - ) - - ## Comparison of the results of TrialDesignInverseNormal object 'x2' with expected results - expect_equal(x2$power, c(0.12038953, 0.32895265, 0.86), tolerance = 1e-07, label = paste0("c(", paste0(x2$power, collapse = ", "), ")")) - expect_equal(x2$futilityBounds, c(-1.1063623, -0.35992439), tolerance = 1e-07, label = paste0("c(", paste0(x2$futilityBounds, collapse = ", "), ")")) - expect_equal(x2$alphaSpent, c(0.0090195874, 0.020036136, 0.07), tolerance = 1e-07, label = paste0("c(", paste0(x2$alphaSpent, collapse = ", "), ")")) - expect_equal(x2$betaSpent, c(0.010777094, 0.026854629, 0.14), tolerance = 1e-07, label = paste0("c(", paste0(x2$betaSpent, collapse = ", "), ")")) - expect_equal(x2$criticalValues, c(2.364813, 2.1928805, 1.5660474), tolerance = 1e-07, label = paste0("c(", paste0(x2$criticalValues, collapse = ", "), ")")) - expect_equal(x2$stageLevels, c(0.0090195874, 0.014157994, 0.058668761), tolerance = 1e-07, label = paste0("c(", paste0(x2$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x2), NA))) - expect_output(print(x2)$show()) - invisible(capture.output(expect_error(summary(x2), NA))) - expect_output(summary(x2)$show()) - x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) - expect_equal(x2CodeBased$power, x2$power, tolerance = 1e-07) - expect_equal(x2CodeBased$futilityBounds, x2$futilityBounds, tolerance = 1e-07) - expect_equal(x2CodeBased$alphaSpent, x2$alphaSpent, tolerance = 1e-07) - expect_equal(x2CodeBased$betaSpent, x2$betaSpent, tolerance = 1e-07) - expect_equal(x2CodeBased$criticalValues, x2$criticalValues, tolerance = 1e-07) - expect_equal(x2CodeBased$stageLevels, x2$stageLevels, tolerance = 1e-07) - expect_type(names(x2), "character") - df <- as.data.frame(x2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignCharacteristics} - # @refFS[Formula]{fs:inflationFactor} - # @refFS[Formula]{fs:expectedReduction} - y2 <- getDesignCharacteristics(x2) - - ## Comparison of the results of TrialDesignCharacteristics object 'y2' with expected results - expect_equal(y2$nFixed, 6.5337002, tolerance = 1e-07, label = paste0("c(", paste0(y2$nFixed, collapse = ", "), ")")) - expect_equal(y2$shift, 7.1015942, tolerance = 1e-07, label = paste0("c(", paste0(y2$shift, collapse = ", "), ")")) - expect_equal(y2$inflationFactor, 1.0869177, tolerance = 1e-07, label = paste0("c(", paste0(y2$inflationFactor, collapse = ", "), ")")) - expect_equal(y2$information, c(1.4203188, 2.8406377, 7.1015942), tolerance = 1e-07, label = paste0("c(", paste0(y2$information, collapse = ", "), ")")) - expect_equal(y2$power, c(0.12038953, 0.32895265, 0.86), tolerance = 1e-07, label = paste0("c(", paste0(y2$power, collapse = ", "), ")")) - expect_equal(y2$rejectionProbabilities, c(0.12038953, 0.20856311, 0.53104735), tolerance = 1e-07, label = paste0("c(", paste0(y2$rejectionProbabilities, collapse = ", "), ")")) - expect_equal(y2$futilityProbabilities, c(0.010777094, 0.016077535), tolerance = 1e-07, label = paste0("c(", paste0(y2$futilityProbabilities, collapse = ", "), ")")) - expect_equal(y2$averageSampleNumber1, 0.82636428, tolerance = 1e-07, label = paste0("c(", paste0(y2$averageSampleNumber1, collapse = ", "), ")")) - expect_equal(y2$averageSampleNumber01, 0.916142, tolerance = 1e-07, label = paste0("c(", paste0(y2$averageSampleNumber01, collapse = ", "), ")")) - expect_equal(y2$averageSampleNumber0, 0.79471657, tolerance = 1e-07, label = paste0("c(", paste0(y2$averageSampleNumber0, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(y2), NA))) - expect_output(print(y2)$show()) - invisible(capture.output(expect_error(summary(y2), NA))) - expect_output(summary(y2)$show()) - y2CodeBased <- eval(parse(text = getObjectRCode(y2, stringWrapParagraphWidth = NULL))) - expect_equal(y2CodeBased$nFixed, y2$nFixed, tolerance = 1e-07) - expect_equal(y2CodeBased$shift, y2$shift, tolerance = 1e-07) - expect_equal(y2CodeBased$inflationFactor, y2$inflationFactor, tolerance = 1e-07) - expect_equal(y2CodeBased$information, y2$information, tolerance = 1e-07) - expect_equal(y2CodeBased$power, y2$power, tolerance = 1e-07) - expect_equal(y2CodeBased$rejectionProbabilities, y2$rejectionProbabilities, tolerance = 1e-07) - expect_equal(y2CodeBased$futilityProbabilities, y2$futilityProbabilities, tolerance = 1e-07) - expect_equal(y2CodeBased$averageSampleNumber1, y2$averageSampleNumber1, tolerance = 1e-07) - expect_equal(y2CodeBased$averageSampleNumber01, y2$averageSampleNumber01, tolerance = 1e-07) - expect_equal(y2CodeBased$averageSampleNumber0, y2$averageSampleNumber0, tolerance = 1e-07) - expect_type(names(y2), "character") - df <- as.data.frame(y2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(y2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignInverseNormal} - # @refFS[Formula]{fs:alphaSpendingConcept} - # @refFS[Formula]{fs:alphaSpendingKimDeMets} - # @refFS[Formula]{fs:betaSpendingApproach} - # @refFS[Formula]{fs:betaSpendingKimDeMets} - x3 <- getDesignInverseNormal( - kMax = 3, informationRates = c(0.3, 0.7, 1), - alpha = 0.03, sided = 1, beta = 0.34, typeOfDesign = "asKD", gammaA = 2.2, - typeBetaSpending = "bsKD", gammaB = 3.2 - ) - - ## Comparison of the results of TrialDesignInverseNormal object 'x3' with expected results - expect_equal(x3$power, c(0.058336437, 0.398246, 0.66), tolerance = 1e-07, label = paste0("c(", paste0(x3$power, collapse = ", "), ")")) - expect_equal(x3$futilityBounds, c(-1.1558435, 0.72836893), tolerance = 1e-07, label = paste0("c(", paste0(x3$futilityBounds, collapse = ", "), ")")) - expect_equal(x3$alphaSpent, c(0.0021222083, 0.013687904, 0.03), tolerance = 1e-07, label = paste0("c(", paste0(x3$alphaSpent, collapse = ", "), ")")) - expect_equal(x3$betaSpent, c(0.0072155083, 0.1085907, 0.34), tolerance = 1e-07, label = paste0("c(", paste0(x3$betaSpent, collapse = ", "), ")")) - expect_equal(x3$criticalValues, c(2.8594012, 2.2435708, 1.9735737), tolerance = 1e-07, label = paste0("c(", paste0(x3$criticalValues, collapse = ", "), ")")) - expect_equal(x3$stageLevels, c(0.0021222083, 0.012430014, 0.02421512), tolerance = 1e-07, label = paste0("c(", paste0(x3$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x3), NA))) - expect_output(print(x3)$show()) - invisible(capture.output(expect_error(summary(x3), NA))) - expect_output(summary(x3)$show()) - x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) - expect_equal(x3CodeBased$power, x3$power, tolerance = 1e-07) - expect_equal(x3CodeBased$futilityBounds, x3$futilityBounds, tolerance = 1e-07) - expect_equal(x3CodeBased$alphaSpent, x3$alphaSpent, tolerance = 1e-07) - expect_equal(x3CodeBased$betaSpent, x3$betaSpent, tolerance = 1e-07) - expect_equal(x3CodeBased$criticalValues, x3$criticalValues, tolerance = 1e-07) - expect_equal(x3CodeBased$stageLevels, x3$stageLevels, tolerance = 1e-07) - expect_type(names(x3), "character") - df <- as.data.frame(x3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignCharacteristics} - # @refFS[Formula]{fs:inflationFactor} - # @refFS[Formula]{fs:expectedReduction} - y3 <- getDesignCharacteristics(x3) - - ## Comparison of the results of TrialDesignCharacteristics object 'y3' with expected results - expect_equal(y3$nFixed, 5.2590265, tolerance = 1e-07, label = paste0("c(", paste0(y3$nFixed, collapse = ", "), ")")) - expect_equal(y3$shift, 5.551371, tolerance = 1e-07, label = paste0("c(", paste0(y3$shift, collapse = ", "), ")")) - expect_equal(y3$inflationFactor, 1.0555891, tolerance = 1e-07, label = paste0("c(", paste0(y3$inflationFactor, collapse = ", "), ")")) - expect_equal(y3$information, c(1.6654113, 3.8859597, 5.551371), tolerance = 1e-07, label = paste0("c(", paste0(y3$information, collapse = ", "), ")")) - expect_equal(y3$power, c(0.058336437, 0.398246, 0.66), tolerance = 1e-07, label = paste0("c(", paste0(y3$power, collapse = ", "), ")")) - expect_equal(y3$rejectionProbabilities, c(0.058336437, 0.33990957, 0.261754), tolerance = 1e-07, label = paste0("c(", paste0(y3$rejectionProbabilities, collapse = ", "), ")")) - expect_equal(y3$futilityProbabilities, c(0.0072155083, 0.1013752), tolerance = 1e-07, label = paste0("c(", paste0(y3$futilityProbabilities, collapse = ", "), ")")) - expect_equal(y3$averageSampleNumber1, 0.86740735, tolerance = 1e-07, label = paste0("c(", paste0(y3$averageSampleNumber1, collapse = ", "), ")")) - expect_equal(y3$averageSampleNumber01, 0.87361707, tolerance = 1e-07, label = paste0("c(", paste0(y3$averageSampleNumber01, collapse = ", "), ")")) - expect_equal(y3$averageSampleNumber0, 0.75480974, tolerance = 1e-07, label = paste0("c(", paste0(y3$averageSampleNumber0, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(y3), NA))) - expect_output(print(y3)$show()) - invisible(capture.output(expect_error(summary(y3), NA))) - expect_output(summary(y3)$show()) - y3CodeBased <- eval(parse(text = getObjectRCode(y3, stringWrapParagraphWidth = NULL))) - expect_equal(y3CodeBased$nFixed, y3$nFixed, tolerance = 1e-07) - expect_equal(y3CodeBased$shift, y3$shift, tolerance = 1e-07) - expect_equal(y3CodeBased$inflationFactor, y3$inflationFactor, tolerance = 1e-07) - expect_equal(y3CodeBased$information, y3$information, tolerance = 1e-07) - expect_equal(y3CodeBased$power, y3$power, tolerance = 1e-07) - expect_equal(y3CodeBased$rejectionProbabilities, y3$rejectionProbabilities, tolerance = 1e-07) - expect_equal(y3CodeBased$futilityProbabilities, y3$futilityProbabilities, tolerance = 1e-07) - expect_equal(y3CodeBased$averageSampleNumber1, y3$averageSampleNumber1, tolerance = 1e-07) - expect_equal(y3CodeBased$averageSampleNumber01, y3$averageSampleNumber01, tolerance = 1e-07) - expect_equal(y3CodeBased$averageSampleNumber0, y3$averageSampleNumber0, tolerance = 1e-07) - expect_type(names(y3), "character") - df <- as.data.frame(y3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(y3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignInverseNormal' with binding futility bounds", { - - # @refFS[Tab.]{fs:tab:output:getDesignInverseNormal} - # @refFS[Formula]{fs:criticalValuesWithFutility} - # @refFS[Formula]{fs:criticalValuesWangTiatis} - x4 <- getDesignInverseNormal( - kMax = 4, alpha = 0.035, futilityBounds = rep(0.5244, 3), - bindingFutility = TRUE, typeOfDesign = "WT", deltaWT = 0.4 - ) - - ## Comparison of the results of TrialDesignInverseNormal object 'x4' with expected results - expect_equal(x4$alphaSpent, c(0.0099446089, 0.020756912, 0.029001537, 0.03499999), tolerance = 1e-07, label = paste0("c(", paste0(x4$alphaSpent, collapse = ", "), ")")) - expect_equal(x4$criticalValues, c(2.3284312, 2.1725031, 2.0861776, 2.0270171), tolerance = 1e-07, label = paste0("c(", paste0(x4$criticalValues, collapse = ", "), ")")) - expect_equal(x4$stageLevels, c(0.0099446089, 0.014908866, 0.018481267, 0.021330332), tolerance = 1e-07, label = paste0("c(", paste0(x4$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x4), NA))) - expect_output(print(x4)$show()) - invisible(capture.output(expect_error(summary(x4), NA))) - expect_output(summary(x4)$show()) - x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) - expect_equal(x4CodeBased$alphaSpent, x4$alphaSpent, tolerance = 1e-07) - expect_equal(x4CodeBased$criticalValues, x4$criticalValues, tolerance = 1e-07) - expect_equal(x4CodeBased$stageLevels, x4$stageLevels, tolerance = 1e-07) - expect_type(names(x4), "character") - df <- as.data.frame(x4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignGroupSequential' with type of design = 'asUser'", { - - .skipTestIfDisabled() - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:alphaSpendingConcept} - x5 <- getDesignGroupSequential( - typeOfDesign = "asUser", - userAlphaSpending = c(0.01, 0.02, 0.03, 0.05) - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x5' with expected results - expect_equal(x5$alphaSpent, c(0.01, 0.02, 0.03, 0.04999999), tolerance = 1e-07, label = paste0("c(", paste0(x5$alphaSpent, collapse = ", "), ")")) - expect_equal(x5$criticalValues, c(2.3263479, 2.2192994, 2.1201347, 1.8189562), tolerance = 1e-07, label = paste0("c(", paste0(x5$criticalValues, collapse = ", "), ")")) - expect_equal(x5$stageLevels, c(0.01, 0.01323318, 0.016997342, 0.034459057), tolerance = 1e-07, label = paste0("c(", paste0(x5$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x5), NA))) - expect_output(print(x5)$show()) - invisible(capture.output(expect_error(summary(x5), NA))) - expect_output(summary(x5)$show()) - x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) - expect_equal(x5CodeBased$alphaSpent, x5$alphaSpent, tolerance = 1e-07) - expect_equal(x5CodeBased$criticalValues, x5$criticalValues, tolerance = 1e-07) - expect_equal(x5CodeBased$stageLevels, x5$stageLevels, tolerance = 1e-07) - expect_type(names(x5), "character") - df <- as.data.frame(x5) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x5) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignGroupSequential' with type of design = 'asP' and 'bsUser' and non-binding futility bounds", { - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:alphaSpendingConcept} - # @refFS[Formula]{fs:alphaSpendingPocock} - # @refFS[Formula]{fs:betaSpendingApproach} - x6a <- getDesignGroupSequential( - kMax = 3, alpha = 0.13, - typeOfDesign = "asP", typeBetaSpending = "bsUser", - informationRates = c(0.35, 0.7, 1), - bindingFutility = FALSE, - userBetaSpending = c(0.01, 0.05, 0.3) - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x6a' with expected results - expect_equal(x6a$power, c(0.31774348, 0.5598179, 0.7), tolerance = 1e-07, label = paste0("c(", paste0(x6a$power, collapse = ", "), ")")) - expect_equal(x6a$futilityBounds, c(-1.2557044, -0.16828659), tolerance = 1e-07, label = paste0("c(", paste0(x6a$futilityBounds, collapse = ", "), ")")) - expect_equal(x6a$alphaSpent, c(0.061214062, 0.10266465, 0.13), tolerance = 1e-07, label = paste0("c(", paste0(x6a$alphaSpent, collapse = ", "), ")")) - expect_equal(x6a$betaSpent, c(0.01, 0.05, 0.3), tolerance = 1e-07, label = paste0("c(", paste0(x6a$betaSpent, collapse = ", "), ")")) - expect_equal(x6a$criticalValues, c(1.5446617, 1.4828682, 1.4620058), tolerance = 1e-07, label = paste0("c(", paste0(x6a$criticalValues, collapse = ", "), ")")) - expect_equal(x6a$stageLevels, c(0.061214062, 0.069054712, 0.071869812), tolerance = 1e-07, label = paste0("c(", paste0(x6a$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x6a), NA))) - expect_output(print(x6a)$show()) - invisible(capture.output(expect_error(summary(x6a), NA))) - expect_output(summary(x6a)$show()) - x6aCodeBased <- eval(parse(text = getObjectRCode(x6a, stringWrapParagraphWidth = NULL))) - expect_equal(x6aCodeBased$power, x6a$power, tolerance = 1e-07) - expect_equal(x6aCodeBased$futilityBounds, x6a$futilityBounds, tolerance = 1e-07) - expect_equal(x6aCodeBased$alphaSpent, x6a$alphaSpent, tolerance = 1e-07) - expect_equal(x6aCodeBased$betaSpent, x6a$betaSpent, tolerance = 1e-07) - expect_equal(x6aCodeBased$criticalValues, x6a$criticalValues, tolerance = 1e-07) - expect_equal(x6aCodeBased$stageLevels, x6a$stageLevels, tolerance = 1e-07) - expect_type(names(x6a), "character") - df <- as.data.frame(x6a) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x6a) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignGroupSequential' with type of design = 'asP' and information rate < 1 at maximum stage", { - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:alphaSpendingConcept} - # @refFS[Formula]{fs:alphaSpendingPocock} - x6b <- getDesignGroupSequential(informationRates = c(0.4, 0.7), typeOfDesign = "asP") - - ## Comparison of the results of TrialDesignGroupSequential object 'x6b' with expected results - expect_equal(x6b$alphaSpent, c(0.013078429, 0.0197432), tolerance = 1e-07, label = paste0("c(", paste0(x6b$alphaSpent, collapse = ", "), ")")) - expect_equal(x6b$criticalValues, c(2.223875, 2.3050796), tolerance = 1e-07, label = paste0("c(", paste0(x6b$criticalValues, collapse = ", "), ")")) - expect_equal(x6b$stageLevels, c(0.013078429, 0.010581057), tolerance = 1e-07, label = paste0("c(", paste0(x6b$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x6b), NA))) - expect_output(print(x6b)$show()) - invisible(capture.output(expect_error(summary(x6b), NA))) - expect_output(summary(x6b)$show()) - x6bCodeBased <- eval(parse(text = getObjectRCode(x6b, stringWrapParagraphWidth = NULL))) - expect_equal(x6bCodeBased$alphaSpent, x6b$alphaSpent, tolerance = 1e-07) - expect_equal(x6bCodeBased$criticalValues, x6b$criticalValues, tolerance = 1e-07) - expect_equal(x6bCodeBased$stageLevels, x6b$stageLevels, tolerance = 1e-07) - expect_type(names(x6b), "character") - df <- as.data.frame(x6b) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x6b) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignGroupSequential' with type of design = 'asOF' and 'bsKD' and non-binding futility bounds (kMax = 3)", { - - .skipTestIfDisabled() - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:alphaSpendingConcept} - # @refFS[Formula]{fs:alphaSpendingOBrienFleming} - # @refFS[Formula]{fs:betaSpendingApproach} - # @refFS[Formula]{fs:betaSpendingKimDeMets} - x7a <- getDesignGroupSequential( - kMax = 3, alpha = 0.13, beta = 0.41, - typeOfDesign = "asOF", typeBetaSpending = "bsKD", - informationRates = c(0.4, 0.75, 1), - gammaB = 2.5, bindingFutility = FALSE - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x7a' with expected results - expect_equal(x7a$power, c(0.10903632, 0.42541278, 0.59), tolerance = 1e-07, label = paste0("c(", paste0(x7a$power, collapse = ", "), ")")) - expect_equal(x7a$futilityBounds, c(-0.83725762, 0.35992547), tolerance = 1e-07, label = paste0("c(", paste0(x7a$futilityBounds, collapse = ", "), ")")) - expect_equal(x7a$alphaSpent, c(0.016665509, 0.080406163, 0.12999999), tolerance = 1e-07, label = paste0("c(", paste0(x7a$alphaSpent, collapse = ", "), ")")) - expect_equal(x7a$betaSpent, c(0.041489083, 0.19972711, 0.41), tolerance = 1e-07, label = paste0("c(", paste0(x7a$betaSpent, collapse = ", "), ")")) - expect_equal(x7a$criticalValues, c(2.1280732, 1.4368565, 1.2468994), tolerance = 1e-07, label = paste0("c(", paste0(x7a$criticalValues, collapse = ", "), ")")) - expect_equal(x7a$stageLevels, c(0.016665509, 0.075379384, 0.1062172), tolerance = 1e-07, label = paste0("c(", paste0(x7a$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x7a), NA))) - expect_output(print(x7a)$show()) - invisible(capture.output(expect_error(summary(x7a), NA))) - expect_output(summary(x7a)$show()) - x7aCodeBased <- eval(parse(text = getObjectRCode(x7a, stringWrapParagraphWidth = NULL))) - expect_equal(x7aCodeBased$power, x7a$power, tolerance = 1e-07) - expect_equal(x7aCodeBased$futilityBounds, x7a$futilityBounds, tolerance = 1e-07) - expect_equal(x7aCodeBased$alphaSpent, x7a$alphaSpent, tolerance = 1e-07) - expect_equal(x7aCodeBased$betaSpent, x7a$betaSpent, tolerance = 1e-07) - expect_equal(x7aCodeBased$criticalValues, x7a$criticalValues, tolerance = 1e-07) - expect_equal(x7aCodeBased$stageLevels, x7a$stageLevels, tolerance = 1e-07) - expect_type(names(x7a), "character") - df <- as.data.frame(x7a) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x7a) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignGroupSequential' with type of design = 'asOF' and 'bsKD' and non-binding futility bounds (kMax = 4)", { - - .skipTestIfDisabled() - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:alphaSpendingConcept} - # @refFS[Formula]{fs:alphaSpendingOBrienFleming} - # @refFS[Formula]{fs:betaSpendingApproach} - # @refFS[Formula]{fs:betaSpendingKimDeMets} - x7a <- getDesignGroupSequential( - kMax = 4, alpha = 0.13, beta = 0.41, - typeOfDesign = "asOF", typeBetaSpending = "bsKD", - informationRates = c(0.4, 0.75, 0.85, 1), - gammaB = 2.5, bindingFutility = FALSE - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x7a' with expected results - expect_equal(x7a$power, c(0.1110095, 0.43099683, 0.50326205, 0.59), tolerance = 1e-07, label = paste0("c(", paste0(x7a$power, collapse = ", "), ")")) - expect_equal(x7a$futilityBounds, c(-0.82676531, 0.3743303, 0.65077266), tolerance = 1e-07, label = paste0("c(", paste0(x7a$futilityBounds, collapse = ", "), ")")) - expect_equal(x7a$alphaSpent, c(0.016665509, 0.080406163, 0.10053322, 0.13), tolerance = 1e-07, label = paste0("c(", paste0(x7a$alphaSpent, collapse = ", "), ")")) - expect_equal(x7a$betaSpent, c(0.041489083, 0.19972711, 0.27310596, 0.41), tolerance = 1e-07, label = paste0("c(", paste0(x7a$betaSpent, collapse = ", "), ")")) - expect_equal(x7a$criticalValues, c(2.1280732, 1.4368565, 1.422873, 1.2970881), tolerance = 1e-07, label = paste0("c(", paste0(x7a$criticalValues, collapse = ", "), ")")) - expect_equal(x7a$stageLevels, c(0.016665509, 0.075379384, 0.077386492, 0.097300444), tolerance = 1e-07, label = paste0("c(", paste0(x7a$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x7a), NA))) - expect_output(print(x7a)$show()) - invisible(capture.output(expect_error(summary(x7a), NA))) - expect_output(summary(x7a)$show()) - x7aCodeBased <- eval(parse(text = getObjectRCode(x7a, stringWrapParagraphWidth = NULL))) - expect_equal(x7aCodeBased$power, x7a$power, tolerance = 1e-07) - expect_equal(x7aCodeBased$futilityBounds, x7a$futilityBounds, tolerance = 1e-07) - expect_equal(x7aCodeBased$alphaSpent, x7a$alphaSpent, tolerance = 1e-07) - expect_equal(x7aCodeBased$betaSpent, x7a$betaSpent, tolerance = 1e-07) - expect_equal(x7aCodeBased$criticalValues, x7a$criticalValues, tolerance = 1e-07) - expect_equal(x7aCodeBased$stageLevels, x7a$stageLevels, tolerance = 1e-07) - expect_type(names(x7a), "character") - df <- as.data.frame(x7a) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x7a) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignGroupSequential' with type of design = 'asP' and 'bsUser' and binding futility bounds", { - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:alphaSpendingConcept} - # @refFS[Formula]{fs:alphaSpendingPocock} - # @refFS[Formula]{fs:betaSpendingApproach} - x6b <- getDesignGroupSequential( - kMax = 3, alpha = 0.13, - typeOfDesign = "asP", typeBetaSpending = "bsUser", - informationRates = c(0.35, 0.7, 1), - bindingFutility = TRUE, - userBetaSpending = c(0.01, 0.05, 0.3) - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x6b' with expected results - expect_equal(x6b$power, c(0.31728597, 0.55917233, 0.7), tolerance = 1e-07, label = paste0("c(", paste0(x6b$power, collapse = ", "), ")")) - expect_equal(x6b$futilityBounds, c(-1.2569879, -0.17011271), tolerance = 1e-07, label = paste0("c(", paste0(x6b$futilityBounds, collapse = ", "), ")")) - expect_equal(x6b$alphaSpent, c(0.061214062, 0.10266465, 0.13), tolerance = 1e-07, label = paste0("c(", paste0(x6b$alphaSpent, collapse = ", "), ")")) - expect_equal(x6b$betaSpent, c(0.01, 0.05, 0.3), tolerance = 1e-07, label = paste0("c(", paste0(x6b$betaSpent, collapse = ", "), ")")) - expect_equal(x6b$criticalValues, c(1.5446617, 1.4827312, 1.4588737), tolerance = 1e-07, label = paste0("c(", paste0(x6b$criticalValues, collapse = ", "), ")")) - expect_equal(x6b$stageLevels, c(0.061214062, 0.069072925, 0.072299935), tolerance = 1e-07, label = paste0("c(", paste0(x6b$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x6b), NA))) - expect_output(print(x6b)$show()) - invisible(capture.output(expect_error(summary(x6b), NA))) - expect_output(summary(x6b)$show()) - x6bCodeBased <- eval(parse(text = getObjectRCode(x6b, stringWrapParagraphWidth = NULL))) - expect_equal(x6bCodeBased$power, x6b$power, tolerance = 1e-07) - expect_equal(x6bCodeBased$futilityBounds, x6b$futilityBounds, tolerance = 1e-07) - expect_equal(x6bCodeBased$alphaSpent, x6b$alphaSpent, tolerance = 1e-07) - expect_equal(x6bCodeBased$betaSpent, x6b$betaSpent, tolerance = 1e-07) - expect_equal(x6bCodeBased$criticalValues, x6b$criticalValues, tolerance = 1e-07) - expect_equal(x6bCodeBased$stageLevels, x6b$stageLevels, tolerance = 1e-07) - expect_type(names(x6b), "character") - df <- as.data.frame(x6b) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x6b) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignGroupSequential' with type of design = 'asOF' and 'bsKD' and binding futility bounds (kMax = 3)", { - - .skipTestIfDisabled() - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:alphaSpendingConcept} - # @refFS[Formula]{fs:alphaSpendingOBrienFleming} - # @refFS[Formula]{fs:betaSpendingApproach} - # @refFS[Formula]{fs:betaSpendingKimDeMets} - x7b <- getDesignGroupSequential( - kMax = 3, alpha = 0.13, beta = 0.41, - typeOfDesign = "asOF", typeBetaSpending = "bsKD", - informationRates = c(0.4, 0.75, 1), - gammaB = 2.5, bindingFutility = TRUE - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x7b' with expected results - expect_equal(x7b$power, c(0.1067887, 0.41918821, 0.59), tolerance = 1e-07, label = paste0("c(", paste0(x7b$power, collapse = ", "), ")")) - expect_equal(x7b$futilityBounds, c(-0.84937686, 0.34328914), tolerance = 1e-07, label = paste0("c(", paste0(x7b$futilityBounds, collapse = ", "), ")")) - expect_equal(x7b$alphaSpent, c(0.016665509, 0.080406163, 0.12999999), tolerance = 1e-07, label = paste0("c(", paste0(x7b$alphaSpent, collapse = ", "), ")")) - expect_equal(x7b$betaSpent, c(0.041489083, 0.19972711, 0.41), tolerance = 1e-07, label = paste0("c(", paste0(x7b$betaSpent, collapse = ", "), ")")) - expect_equal(x7b$criticalValues, c(2.1280732, 1.4362896, 1.2218662), tolerance = 1e-07, label = paste0("c(", paste0(x7b$criticalValues, collapse = ", "), ")")) - expect_equal(x7b$stageLevels, c(0.016665509, 0.075459972, 0.11087911), tolerance = 1e-07, label = paste0("c(", paste0(x7b$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x7b), NA))) - expect_output(print(x7b)$show()) - invisible(capture.output(expect_error(summary(x7b), NA))) - expect_output(summary(x7b)$show()) - x7bCodeBased <- eval(parse(text = getObjectRCode(x7b, stringWrapParagraphWidth = NULL))) - expect_equal(x7bCodeBased$power, x7b$power, tolerance = 1e-07) - expect_equal(x7bCodeBased$futilityBounds, x7b$futilityBounds, tolerance = 1e-07) - expect_equal(x7bCodeBased$alphaSpent, x7b$alphaSpent, tolerance = 1e-07) - expect_equal(x7bCodeBased$betaSpent, x7b$betaSpent, tolerance = 1e-07) - expect_equal(x7bCodeBased$criticalValues, x7b$criticalValues, tolerance = 1e-07) - expect_equal(x7bCodeBased$stageLevels, x7b$stageLevels, tolerance = 1e-07) - expect_type(names(x7b), "character") - df <- as.data.frame(x7b) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x7b) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignGroupSequential' with type of design = 'asOF' and 'bsKD' and binding futility bounds (kMax = 4)", { - - .skipTestIfDisabled() - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:alphaSpendingConcept} - # @refFS[Formula]{fs:alphaSpendingOBrienFleming} - # @refFS[Formula]{fs:betaSpendingApproach} - # @refFS[Formula]{fs:betaSpendingKimDeMets} - x7b <- getDesignGroupSequential( - kMax = 4, alpha = 0.13, beta = 0.41, - typeOfDesign = "asOF", typeBetaSpending = "bsKD", - informationRates = c(0.4, 0.75, 0.85, 1), - gammaB = 2.5, bindingFutility = TRUE - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x7b' with expected results - expect_equal(x7b$power, c(0.10806422, 0.422855, 0.4950578, 0.59), tolerance = 1e-07, label = paste0("c(", paste0(x7b$power, collapse = ", "), ")")) - expect_equal(x7b$futilityBounds, c(-0.84247693, 0.35276055, 0.62744509), tolerance = 1e-07, label = paste0("c(", paste0(x7b$futilityBounds, collapse = ", "), ")")) - expect_equal(x7b$alphaSpent, c(0.016665509, 0.080406163, 0.10053322, 0.13), tolerance = 1e-07, label = paste0("c(", paste0(x7b$alphaSpent, collapse = ", "), ")")) - expect_equal(x7b$betaSpent, c(0.041489083, 0.19972711, 0.27310596, 0.41), tolerance = 1e-07, label = paste0("c(", paste0(x7b$betaSpent, collapse = ", "), ")")) - expect_equal(x7b$criticalValues, c(2.1280732, 1.4362706, 1.4203748, 1.2576258), tolerance = 1e-07, label = paste0("c(", paste0(x7b$criticalValues, collapse = ", "), ")")) - expect_equal(x7b$stageLevels, c(0.016665509, 0.075462674, 0.077749297, 0.10426357), tolerance = 1e-07, label = paste0("c(", paste0(x7b$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x7b), NA))) - expect_output(print(x7b)$show()) - invisible(capture.output(expect_error(summary(x7b), NA))) - expect_output(summary(x7b)$show()) - x7bCodeBased <- eval(parse(text = getObjectRCode(x7b, stringWrapParagraphWidth = NULL))) - expect_equal(x7bCodeBased$power, x7b$power, tolerance = 1e-07) - expect_equal(x7bCodeBased$futilityBounds, x7b$futilityBounds, tolerance = 1e-07) - expect_equal(x7bCodeBased$alphaSpent, x7b$alphaSpent, tolerance = 1e-07) - expect_equal(x7bCodeBased$betaSpent, x7b$betaSpent, tolerance = 1e-07) - expect_equal(x7bCodeBased$criticalValues, x7b$criticalValues, tolerance = 1e-07) - expect_equal(x7bCodeBased$stageLevels, x7b$stageLevels, tolerance = 1e-07) - expect_type(names(x7b), "character") - df <- as.data.frame(x7b) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x7b) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignGroupSequential' with type of design = 'asOF' and 'bsKD' and binding futility bounds, two-sided (kMax = 3)", { - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:alphaSpendingConcept} - # @refFS[Formula]{fs:alphaSpendingOBrienFleming} - # @refFS[Formula]{fs:betaSpendingApproach} - # @refFS[Formula]{fs:betaSpendingKimDeMets} - # @refFS[Formula]{fs:betaSpendingApproachTwoSided} - # @refFS[Formula]{fs:betaSpendingAdjustment} - suppressWarnings(x7c <- getDesignGroupSequential( - kMax = 3, alpha = 0.09, beta = 0.11, sided = 2, - typeOfDesign = "asOF", typeBetaSpending = "bsKD", - informationRates = c(0.2, 0.55, 1), - gammaB = 2.5, bindingFutility = TRUE - )) - - ## Comparison of the results of TrialDesignGroupSequential object 'x7c' with expected results - expect_equal(x7c$power, c(0.0013105743, 0.39377047, 0.889997), tolerance = 1e-07, label = paste0("c(", paste0(x7c$power, collapse = ", "), ")")) - expect_equal(x7c$futilityBounds, c(NA_real_, 0.30419861), tolerance = 1e-07, label = paste0("c(", paste0(x7c$futilityBounds, collapse = ", "), ")")) - expect_equal(x7c$alphaSpent, c(1.475171e-05, 0.013740227, 0.09), tolerance = 1e-07, label = paste0("c(", paste0(x7c$alphaSpent, collapse = ", "), ")")) - expect_equal(x7c$betaSpent, c(0, 0.023123303, 0.11), tolerance = 1e-07, label = paste0("c(", paste0(x7c$betaSpent, collapse = ", "), ")")) - expect_equal(x7c$criticalValues, c(4.3323635, 2.4641251, 1.7013171), tolerance = 1e-07, label = paste0("c(", paste0(x7c$criticalValues, collapse = ", "), ")")) - expect_equal(x7c$stageLevels, c(7.375855e-06, 0.006867409, 0.044441733), tolerance = 1e-07, label = paste0("c(", paste0(x7c$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x7c), NA))) - expect_output(print(x7c)$show()) - invisible(capture.output(expect_error(summary(x7c), NA))) - expect_output(summary(x7c)$show()) - suppressWarnings(x7cCodeBased <- eval(parse(text = getObjectRCode(x7c, stringWrapParagraphWidth = NULL)))) - expect_equal(x7cCodeBased$power, x7c$power, tolerance = 1e-07) - expect_equal(x7cCodeBased$futilityBounds, x7c$futilityBounds, tolerance = 1e-07) - expect_equal(x7cCodeBased$alphaSpent, x7c$alphaSpent, tolerance = 1e-07) - expect_equal(x7cCodeBased$betaSpent, x7c$betaSpent, tolerance = 1e-07) - expect_equal(x7cCodeBased$criticalValues, x7c$criticalValues, tolerance = 1e-07) - expect_equal(x7cCodeBased$stageLevels, x7c$stageLevels, tolerance = 1e-07) - expect_type(names(x7c), "character") - df <- as.data.frame(x7c) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x7c) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - suppressWarnings(x7d <- getDesignGroupSequential( - kMax = 3, alpha = 0.05, beta = 0.2, sided = 2, - typeOfDesign = "asOF", typeBetaSpending = "bsKD", - informationRates = c(0.4, 0.65, 1), - gammaB = 1.5, bindingFutility = TRUE - )) - - ## Comparison of the results of TrialDesignGroupSequential object 'x7d' with expected results - expect_equal(x7d$power, c(0.063122463, 0.41229849, 0.79999885), tolerance = 1e-07, label = paste0("c(", paste0(x7d$power, collapse = ", "), ")")) - expect_equal(x7d$futilityBounds, c(0.32391511, 0.91946811), tolerance = 1e-07, label = paste0("c(", paste0(x7d$futilityBounds, collapse = ", "), ")")) - expect_equal(x7d$alphaSpent, c(0.00078830351, 0.010867832, 0.04999999), tolerance = 1e-07, label = paste0("c(", paste0(x7d$alphaSpent, collapse = ", "), ")")) - expect_equal(x7d$betaSpent, c(0.050596443, 0.10480935, 0.2), tolerance = 1e-07, label = paste0("c(", paste0(x7d$betaSpent, collapse = ", "), ")")) - expect_equal(x7d$criticalValues, c(3.3568694, 2.5549656, 1.9350784), tolerance = 1e-07, label = paste0("c(", paste0(x7d$criticalValues, collapse = ", "), ")")) - expect_equal(x7d$stageLevels, c(0.00039415176, 0.0053099152, 0.026490337), tolerance = 1e-07, label = paste0("c(", paste0(x7d$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x7d), NA))) - expect_output(print(x7d)$show()) - invisible(capture.output(expect_error(summary(x7d), NA))) - expect_output(summary(x7d)$show()) - suppressWarnings(x7dCodeBased <- eval(parse(text = getObjectRCode(x7d, stringWrapParagraphWidth = NULL)))) - expect_equal(x7dCodeBased$power, x7d$power, tolerance = 1e-07) - expect_equal(x7dCodeBased$futilityBounds, x7d$futilityBounds, tolerance = 1e-07) - expect_equal(x7dCodeBased$alphaSpent, x7d$alphaSpent, tolerance = 1e-07) - expect_equal(x7dCodeBased$betaSpent, x7d$betaSpent, tolerance = 1e-07) - expect_equal(x7dCodeBased$criticalValues, x7d$criticalValues, tolerance = 1e-07) - expect_equal(x7dCodeBased$stageLevels, x7d$stageLevels, tolerance = 1e-07) - expect_type(names(x7d), "character") - df <- as.data.frame(x7d) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x7d) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignGroupSequential' with type of design = 'asOF' and 'bsKD' and non-binding futility bounds, no betaAdjustment, two-sided (kMax = 3)", { - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:alphaSpendingConcept} - # @refFS[Formula]{fs:alphaSpendingOBrienFleming} - # @refFS[Formula]{fs:betaSpendingApproach} - # @refFS[Formula]{fs:betaSpendingKimDeMets} - # @refFS[Formula]{fs:betaSpendingApproachTwoSided} - # @refFS[Formula]{fs:betaSpendingAdjustment} - suppressWarnings(x7e <- getDesignGroupSequential( - kMax = 3, alpha = 0.09, beta = 0.11, sided = 2, - typeOfDesign = "asOF", typeBetaSpending = "bsKD", - informationRates = c(0.4, 0.65, 1), - betaAdjustment = FALSE, - gammaB = 2.5, bindingFutility = FALSE - )) - - ## Comparison of the results of TrialDesignGroupSequential object 'x7e' with expected results - expect_equal(x7e$power, c(0.14268064, 0.57037981, 0.88999701), tolerance = 1e-07, label = paste0("c(", paste0(x7e$power, collapse = ", "), ")")) - expect_equal(x7e$futilityBounds, c(NA_real_, 0.64692592), tolerance = 1e-07, label = paste0("c(", paste0(x7e$futilityBounds, collapse = ", "), ")")) - expect_equal(x7e$alphaSpent, c(0.0030525896, 0.025803646, 0.09), tolerance = 1e-07, label = paste0("c(", paste0(x7e$alphaSpent, collapse = ", "), ")")) - expect_equal(x7e$betaSpent, c(0, 0.037469343, 0.11), tolerance = 1e-07, label = paste0("c(", paste0(x7e$betaSpent, collapse = ", "), ")")) - expect_equal(x7e$criticalValues, c(2.9623919, 2.2442359, 1.7391729), tolerance = 1e-07, label = paste0("c(", paste0(x7e$criticalValues, collapse = ", "), ")")) - expect_equal(x7e$stageLevels, c(0.0015262948, 0.012408614, 0.041002179), tolerance = 1e-07, label = paste0("c(", paste0(x7e$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x7e), NA))) - expect_output(print(x7e)$show()) - invisible(capture.output(expect_error(summary(x7e), NA))) - expect_output(summary(x7e)$show()) - suppressWarnings(x7eCodeBased <- eval(parse(text = getObjectRCode(x7e, stringWrapParagraphWidth = NULL)))) - expect_equal(x7eCodeBased$power, x7e$power, tolerance = 1e-07) - expect_equal(x7eCodeBased$futilityBounds, x7e$futilityBounds, tolerance = 1e-07) - expect_equal(x7eCodeBased$alphaSpent, x7e$alphaSpent, tolerance = 1e-07) - expect_equal(x7eCodeBased$betaSpent, x7e$betaSpent, tolerance = 1e-07) - expect_equal(x7eCodeBased$criticalValues, x7e$criticalValues, tolerance = 1e-07) - expect_equal(x7eCodeBased$stageLevels, x7e$stageLevels, tolerance = 1e-07) - expect_type(names(x7e), "character") - df <- as.data.frame(x7e) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x7e) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignGroupSequential' with type of design = 'asOF' and 'bsOF', binding futility bounds and delayed response (kMax = 3)", { - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:alphaSpendingConcept} - # @refFS[Formula]{fs:alphaSpendingOBrienFleming} - # @refFS[Formula]{fs:betaSpendingApproach} - # @refFS[Formula]{fs:betaSpendingOBrienFleming} - # @refFS[Formula]{fs:delayedResponseCondition1} - # @refFS[Formula]{fs:delayedResponseCondition2} - # @refFS[Formula]{fs:delayedResponsePower} - suppressWarnings(dl1 <- getDesignGroupSequential( - kMax = 3, alpha = 0.05, beta = 0.1, sided = 1, - typeOfDesign = "asOF", typeBetaSpending = "bsOF", - informationRates = c(0.4, 0.65, 1), - bindingFutility = TRUE, - delayedInformation = c(0.1, 0.2) - )) - - ## Comparison of the results of TrialDesignGroupSequential object 'dl1' with expected results - expect_equal(dl1$power, c(0.15998522, 0.59313184, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl1$power, collapse = ", "), ")")) - expect_equal(dl1$futilityBounds, c(-0.46043472, 0.64445014), tolerance = 1e-07, label = paste0("c(", paste0(dl1$futilityBounds, collapse = ", "), ")")) - expect_equal(dl1$alphaSpent, c(0.001941913, 0.015055713, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(dl1$alphaSpent, collapse = ", "), ")")) - expect_equal(dl1$betaSpent, c(0.00930224, 0.041331422, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(dl1$betaSpent, collapse = ", "), ")")) - expect_equal(dl1$criticalValues, c(2.8874465, 2.1853011, 1.6575593), tolerance = 1e-07, label = paste0("c(", paste0(dl1$criticalValues, collapse = ", "), ")")) - expect_equal(dl1$stageLevels, c(0.001941913, 0.014433388, 0.048703222), tolerance = 1e-07, label = paste0("c(", paste0(dl1$stageLevels, collapse = ", "), ")")) - expect_equal(dl1$decisionCriticalValues, c(1.3388855, 1.5378695, 1.6575593), tolerance = 1e-07, label = paste0("c(", paste0(dl1$decisionCriticalValues, collapse = ", "), ")")) - expect_equal(dl1$reversalProbabilities, c(1.7563249e-06, 0.0014674026), tolerance = 1e-07, label = paste0("c(", paste0(dl1$reversalProbabilities, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dl1), NA))) - expect_output(print(dl1)$show()) - invisible(capture.output(expect_error(summary(dl1), NA))) - expect_output(summary(dl1)$show()) - suppressWarnings(dl1CodeBased <- eval(parse(text = getObjectRCode(dl1, stringWrapParagraphWidth = NULL)))) - expect_equal(dl1CodeBased$power, dl1$power, tolerance = 1e-07) - expect_equal(dl1CodeBased$futilityBounds, dl1$futilityBounds, tolerance = 1e-07) - expect_equal(dl1CodeBased$alphaSpent, dl1$alphaSpent, tolerance = 1e-07) - expect_equal(dl1CodeBased$betaSpent, dl1$betaSpent, tolerance = 1e-07) - expect_equal(dl1CodeBased$criticalValues, dl1$criticalValues, tolerance = 1e-07) - expect_equal(dl1CodeBased$stageLevels, dl1$stageLevels, tolerance = 1e-07) - expect_equal(dl1CodeBased$decisionCriticalValues, dl1$decisionCriticalValues, tolerance = 1e-07) - expect_equal(dl1CodeBased$reversalProbabilities, dl1$reversalProbabilities, tolerance = 1e-07) - expect_type(names(dl1), "character") - df <- as.data.frame(dl1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dl1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - dl2 <- getDesignCharacteristics(dl1) - - ## Comparison of the results of TrialDesignCharacteristics object 'dl2' with expected results - expect_equal(dl2$nFixed, 8.5638474, tolerance = 1e-07, label = paste0("c(", paste0(dl2$nFixed, collapse = ", "), ")")) - expect_equal(dl2$shift, 8.8633082, tolerance = 1e-07, label = paste0("c(", paste0(dl2$shift, collapse = ", "), ")")) - expect_equal(dl2$inflationFactor, 1.034968, tolerance = 1e-07, label = paste0("c(", paste0(dl2$inflationFactor, collapse = ", "), ")")) - expect_equal(dl2$information, c(3.5453233, 5.7611503, 8.8633082), tolerance = 1e-07, label = paste0("c(", paste0(dl2$information, collapse = ", "), ")")) - expect_equal(dl2$power, c(0.15755984, 0.59089729, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl2$power, collapse = ", "), ")")) - expect_equal(dl2$rejectionProbabilities, c(0.15755984, 0.43333745, 0.30910271), tolerance = 1e-07, label = paste0("c(", paste0(dl2$rejectionProbabilities, collapse = ", "), ")")) - expect_equal(dl2$futilityProbabilities, c(0.0095560402, 0.032904105), tolerance = 1e-07, label = paste0("c(", paste0(dl2$futilityProbabilities, collapse = ", "), ")")) - expect_equal(dl2$averageSampleNumber1, 0.87652961, tolerance = 1e-07, label = paste0("c(", paste0(dl2$averageSampleNumber1, collapse = ", "), ")")) - expect_equal(dl2$averageSampleNumber01, 0.92477729, tolerance = 1e-07, label = paste0("c(", paste0(dl2$averageSampleNumber01, collapse = ", "), ")")) - expect_equal(dl2$averageSampleNumber0, 0.79932679, tolerance = 1e-07, label = paste0("c(", paste0(dl2$averageSampleNumber0, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dl2), NA))) - expect_output(print(dl2)$show()) - invisible(capture.output(expect_error(summary(dl2), NA))) - expect_output(summary(dl2)$show()) - suppressWarnings(dl2CodeBased <- eval(parse(text = getObjectRCode(dl2, stringWrapParagraphWidth = NULL)))) - expect_equal(dl2CodeBased$nFixed, dl2$nFixed, tolerance = 1e-07) - expect_equal(dl2CodeBased$shift, dl2$shift, tolerance = 1e-07) - expect_equal(dl2CodeBased$inflationFactor, dl2$inflationFactor, tolerance = 1e-07) - expect_equal(dl2CodeBased$information, dl2$information, tolerance = 1e-07) - expect_equal(dl2CodeBased$power, dl2$power, tolerance = 1e-07) - expect_equal(dl2CodeBased$rejectionProbabilities, dl2$rejectionProbabilities, tolerance = 1e-07) - expect_equal(dl2CodeBased$futilityProbabilities, dl2$futilityProbabilities, tolerance = 1e-07) - expect_equal(dl2CodeBased$averageSampleNumber1, dl2$averageSampleNumber1, tolerance = 1e-07) - expect_equal(dl2CodeBased$averageSampleNumber01, dl2$averageSampleNumber01, tolerance = 1e-07) - expect_equal(dl2CodeBased$averageSampleNumber0, dl2$averageSampleNumber0, tolerance = 1e-07) - expect_type(names(dl2), "character") - df <- as.data.frame(dl2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dl2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - suppressWarnings(dl3 <- getDesignGroupSequential( - kMax = 3, alpha = 0.05, beta = 0.1, sided = 1, - typeOfDesign = "asOF", typeBetaSpending = "bsOF", - informationRates = c(0.4, 0.65, 1), - bindingFutility = TRUE, - delayedInformation = c(0, 0.2) - )) - - ## Comparison of the results of TrialDesignGroupSequential object 'dl3' with expected results - expect_equal(dl3$power, c(0.15998522, 0.59313184, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl3$power, collapse = ", "), ")")) - expect_equal(dl3$futilityBounds, c(-0.46043472, 0.64445014), tolerance = 1e-07, label = paste0("c(", paste0(dl3$futilityBounds, collapse = ", "), ")")) - expect_equal(dl3$alphaSpent, c(0.001941913, 0.015055713, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(dl3$alphaSpent, collapse = ", "), ")")) - expect_equal(dl3$betaSpent, c(0.00930224, 0.041331422, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(dl3$betaSpent, collapse = ", "), ")")) - expect_equal(dl3$criticalValues, c(2.8874465, 2.1853011, 1.6575593), tolerance = 1e-07, label = paste0("c(", paste0(dl3$criticalValues, collapse = ", "), ")")) - expect_equal(dl3$stageLevels, c(0.001941913, 0.014433388, 0.048703222), tolerance = 1e-07, label = paste0("c(", paste0(dl3$stageLevels, collapse = ", "), ")")) - expect_equal(dl3$decisionCriticalValues, c(NA_real_, 1.5378695, 1.6575593), tolerance = 1e-07, label = paste0("c(", paste0(dl3$decisionCriticalValues, collapse = ", "), ")")) - expect_equal(dl3$reversalProbabilities, c(NA_real_, 0.0014674026), tolerance = 1e-07, label = paste0("c(", paste0(dl3$reversalProbabilities, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dl3), NA))) - expect_output(print(dl3)$show()) - invisible(capture.output(expect_error(summary(dl3), NA))) - expect_output(summary(dl3)$show()) - suppressWarnings(dl3CodeBased <- eval(parse(text = getObjectRCode(dl3, stringWrapParagraphWidth = NULL)))) - expect_equal(dl3CodeBased$power, dl3$power, tolerance = 1e-07) - expect_equal(dl3CodeBased$futilityBounds, dl3$futilityBounds, tolerance = 1e-07) - expect_equal(dl3CodeBased$alphaSpent, dl3$alphaSpent, tolerance = 1e-07) - expect_equal(dl3CodeBased$betaSpent, dl3$betaSpent, tolerance = 1e-07) - expect_equal(dl3CodeBased$criticalValues, dl3$criticalValues, tolerance = 1e-07) - expect_equal(dl3CodeBased$stageLevels, dl3$stageLevels, tolerance = 1e-07) - expect_equal(dl3CodeBased$decisionCriticalValues, dl3$decisionCriticalValues, tolerance = 1e-07) - expect_equal(dl3CodeBased$reversalProbabilities, dl3$reversalProbabilities, tolerance = 1e-07) - expect_type(names(dl3), "character") - df <- as.data.frame(dl3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dl3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - dl4 <- getDesignCharacteristics(dl3) - - ## Comparison of the results of TrialDesignCharacteristics object 'dl4' with expected results - expect_equal(dl4$nFixed, 8.5638474, tolerance = 1e-07, label = paste0("c(", paste0(dl4$nFixed, collapse = ", "), ")")) - expect_equal(dl4$shift, 8.8633608, tolerance = 1e-07, label = paste0("c(", paste0(dl4$shift, collapse = ", "), ")")) - expect_equal(dl4$inflationFactor, 1.0349742, tolerance = 1e-07, label = paste0("c(", paste0(dl4$inflationFactor, collapse = ", "), ")")) - expect_equal(dl4$information, c(3.5453443, 5.7611845, 8.8633608), tolerance = 1e-07, label = paste0("c(", paste0(dl4$information, collapse = ", "), ")")) - expect_equal(dl4$power, c(0.15755967, 0.59089852, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl4$power, collapse = ", "), ")")) - expect_equal(dl4$rejectionProbabilities, c(0.15755967, 0.43333886, 0.30910148), tolerance = 1e-07, label = paste0("c(", paste0(dl4$rejectionProbabilities, collapse = ", "), ")")) - expect_equal(dl4$futilityProbabilities, c(0.0095558971, 0.032903612), tolerance = 1e-07, label = paste0("c(", paste0(dl4$futilityProbabilities, collapse = ", "), ")")) - expect_equal(dl4$averageSampleNumber1, 0.85923802, tolerance = 1e-07, label = paste0("c(", paste0(dl4$averageSampleNumber1, collapse = ", "), ")")) - expect_equal(dl4$averageSampleNumber01, 0.91378094, tolerance = 1e-07, label = paste0("c(", paste0(dl4$averageSampleNumber01, collapse = ", "), ")")) - expect_equal(dl4$averageSampleNumber0, 0.76574207, tolerance = 1e-07, label = paste0("c(", paste0(dl4$averageSampleNumber0, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dl4), NA))) - expect_output(print(dl4)$show()) - invisible(capture.output(expect_error(summary(dl4), NA))) - expect_output(summary(dl4)$show()) - suppressWarnings(dl4CodeBased <- eval(parse(text = getObjectRCode(dl4, stringWrapParagraphWidth = NULL)))) - expect_equal(dl4CodeBased$nFixed, dl4$nFixed, tolerance = 1e-07) - expect_equal(dl4CodeBased$shift, dl4$shift, tolerance = 1e-07) - expect_equal(dl4CodeBased$inflationFactor, dl4$inflationFactor, tolerance = 1e-07) - expect_equal(dl4CodeBased$information, dl4$information, tolerance = 1e-07) - expect_equal(dl4CodeBased$power, dl4$power, tolerance = 1e-07) - expect_equal(dl4CodeBased$rejectionProbabilities, dl4$rejectionProbabilities, tolerance = 1e-07) - expect_equal(dl4CodeBased$futilityProbabilities, dl4$futilityProbabilities, tolerance = 1e-07) - expect_equal(dl4CodeBased$averageSampleNumber1, dl4$averageSampleNumber1, tolerance = 1e-07) - expect_equal(dl4CodeBased$averageSampleNumber01, dl4$averageSampleNumber01, tolerance = 1e-07) - expect_equal(dl4CodeBased$averageSampleNumber0, dl4$averageSampleNumber0, tolerance = 1e-07) - expect_type(names(dl4), "character") - df <- as.data.frame(dl4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dl4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - suppressWarnings(dl5 <- getDesignGroupSequential( - kMax = 3, alpha = 0.05, beta = 0.1, sided = 1, - typeOfDesign = "asOF", typeBetaSpending = "bsOF", - informationRates = c(0.4, 0.65, 1), - bindingFutility = TRUE, - delayedInformation = 0.3 - )) - - ## Comparison of the results of TrialDesignGroupSequential object 'dl5' with expected results - expect_equal(dl5$power, c(0.15998522, 0.59313184, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl5$power, collapse = ", "), ")")) - expect_equal(dl5$futilityBounds, c(-0.46043472, 0.64445014), tolerance = 1e-07, label = paste0("c(", paste0(dl5$futilityBounds, collapse = ", "), ")")) - expect_equal(dl5$alphaSpent, c(0.001941913, 0.015055713, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(dl5$alphaSpent, collapse = ", "), ")")) - expect_equal(dl5$betaSpent, c(0.00930224, 0.041331422, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(dl5$betaSpent, collapse = ", "), ")")) - expect_equal(dl5$criticalValues, c(2.8874465, 2.1853011, 1.6575593), tolerance = 1e-07, label = paste0("c(", paste0(dl5$criticalValues, collapse = ", "), ")")) - expect_equal(dl5$stageLevels, c(0.001941913, 0.014433388, 0.048703222), tolerance = 1e-07, label = paste0("c(", paste0(dl5$stageLevels, collapse = ", "), ")")) - expect_equal(dl5$decisionCriticalValues, c(1.505831, 1.5735979, 1.6575593), tolerance = 1e-07, label = paste0("c(", paste0(dl5$decisionCriticalValues, collapse = ", "), ")")) - expect_equal(dl5$reversalProbabilities, c(0.00018341474, 0.0027022502), tolerance = 1e-07, label = paste0("c(", paste0(dl5$reversalProbabilities, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dl5), NA))) - expect_output(print(dl5)$show()) - invisible(capture.output(expect_error(summary(dl5), NA))) - expect_output(summary(dl5)$show()) - suppressWarnings(dl5CodeBased <- eval(parse(text = getObjectRCode(dl5, stringWrapParagraphWidth = NULL)))) - expect_equal(dl5CodeBased$power, dl5$power, tolerance = 1e-07) - expect_equal(dl5CodeBased$futilityBounds, dl5$futilityBounds, tolerance = 1e-07) - expect_equal(dl5CodeBased$alphaSpent, dl5$alphaSpent, tolerance = 1e-07) - expect_equal(dl5CodeBased$betaSpent, dl5$betaSpent, tolerance = 1e-07) - expect_equal(dl5CodeBased$criticalValues, dl5$criticalValues, tolerance = 1e-07) - expect_equal(dl5CodeBased$stageLevels, dl5$stageLevels, tolerance = 1e-07) - expect_equal(dl5CodeBased$decisionCriticalValues, dl5$decisionCriticalValues, tolerance = 1e-07) - expect_equal(dl5CodeBased$reversalProbabilities, dl5$reversalProbabilities, tolerance = 1e-07) - expect_type(names(dl5), "character") - df <- as.data.frame(dl5) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dl5) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - dl6 <- getDesignCharacteristics(dl5) - - ## Comparison of the results of TrialDesignCharacteristics object 'dl6' with expected results - expect_equal(dl6$nFixed, 8.5638474, tolerance = 1e-07, label = paste0("c(", paste0(dl6$nFixed, collapse = ", "), ")")) - expect_equal(dl6$shift, 8.7180222, tolerance = 1e-07, label = paste0("c(", paste0(dl6$shift, collapse = ", "), ")")) - expect_equal(dl6$inflationFactor, 1.018003, tolerance = 1e-07, label = paste0("c(", paste0(dl6$inflationFactor, collapse = ", "), ")")) - expect_equal(dl6$information, c(3.4872089, 5.6667144, 8.7180222), tolerance = 1e-07, label = paste0("c(", paste0(dl6$information, collapse = ", "), ")")) - expect_equal(dl6$power, c(0.15429254, 0.58752252, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl6$power, collapse = ", "), ")")) - expect_equal(dl6$rejectionProbabilities, c(0.15429254, 0.43322998, 0.31247748), tolerance = 1e-07, label = paste0("c(", paste0(dl6$rejectionProbabilities, collapse = ", "), ")")) - expect_equal(dl6$futilityProbabilities, c(0.0099602552, 0.03429374), tolerance = 1e-07, label = paste0("c(", paste0(dl6$futilityProbabilities, collapse = ", "), ")")) - expect_equal(dl6$averageSampleNumber1, 0.94451255, tolerance = 1e-07, label = paste0("c(", paste0(dl6$averageSampleNumber1, collapse = ", "), ")")) - expect_equal(dl6$averageSampleNumber01, 0.96721799, tolerance = 1e-07, label = paste0("c(", paste0(dl6$averageSampleNumber01, collapse = ", "), ")")) - expect_equal(dl6$averageSampleNumber0, 0.89669187, tolerance = 1e-07, label = paste0("c(", paste0(dl6$averageSampleNumber0, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dl6), NA))) - expect_output(print(dl6)$show()) - invisible(capture.output(expect_error(summary(dl6), NA))) - expect_output(summary(dl6)$show()) - suppressWarnings(dl6CodeBased <- eval(parse(text = getObjectRCode(dl6, stringWrapParagraphWidth = NULL)))) - expect_equal(dl6CodeBased$nFixed, dl6$nFixed, tolerance = 1e-07) - expect_equal(dl6CodeBased$shift, dl6$shift, tolerance = 1e-07) - expect_equal(dl6CodeBased$inflationFactor, dl6$inflationFactor, tolerance = 1e-07) - expect_equal(dl6CodeBased$information, dl6$information, tolerance = 1e-07) - expect_equal(dl6CodeBased$power, dl6$power, tolerance = 1e-07) - expect_equal(dl6CodeBased$rejectionProbabilities, dl6$rejectionProbabilities, tolerance = 1e-07) - expect_equal(dl6CodeBased$futilityProbabilities, dl6$futilityProbabilities, tolerance = 1e-07) - expect_equal(dl6CodeBased$averageSampleNumber1, dl6$averageSampleNumber1, tolerance = 1e-07) - expect_equal(dl6CodeBased$averageSampleNumber01, dl6$averageSampleNumber01, tolerance = 1e-07) - expect_equal(dl6CodeBased$averageSampleNumber0, dl6$averageSampleNumber0, tolerance = 1e-07) - expect_type(names(dl6), "character") - df <- as.data.frame(dl6) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dl6) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignGroupSequential' with type of design = 'asP' and 'bsP', non-binding futility bounds and delayed response (kMax = 3)", { - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:alphaSpendingConcept} - # @refFS[Formula]{fs:alphaSpendingOBrienFleming} - # @refFS[Formula]{fs:betaSpendingApproach} - # @refFS[Formula]{fs:betaSpendingOBrienFleming} - # @refFS[Formula]{fs:delayedResponseCondition1} - # @refFS[Formula]{fs:delayedResponseCondition2} - # @refFS[Formula]{fs:delayedResponsePower} - suppressWarnings(dl1 <- getDesignGroupSequential( - kMax = 3, alpha = 0.05, beta = 0.1, sided = 1, - typeOfDesign = "asP", typeBetaSpending = "bsP", - informationRates = c(0.4, 0.65, 1), - bindingFutility = FALSE, - delayedInformation = c(0.1, 0.2) - )) - - ## Comparison of the results of TrialDesignGroupSequential object 'dl1' with expected results - expect_equal(dl1$power, c(0.58983431, 0.79279807, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl1$power, collapse = ", "), ")")) - expect_equal(dl1$futilityBounds, c(0.5448398, 1.0899149), tolerance = 1e-07, label = paste0("c(", paste0(dl1$futilityBounds, collapse = ", "), ")")) - expect_equal(dl1$alphaSpent, c(0.026156858, 0.037497241, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(dl1$alphaSpent, collapse = ", "), ")")) - expect_equal(dl1$betaSpent, c(0.052313716, 0.074994481, 0.099999999), tolerance = 1e-07, label = paste0("c(", paste0(dl1$betaSpent, collapse = ", "), ")")) - expect_equal(dl1$criticalValues, c(1.9405431, 2.0327662, 1.9734104), tolerance = 1e-07, label = paste0("c(", paste0(dl1$criticalValues, collapse = ", "), ")")) - expect_equal(dl1$stageLevels, c(0.026156858, 0.021038075, 0.02422441), tolerance = 1e-07, label = paste0("c(", paste0(dl1$stageLevels, collapse = ", "), ")")) - expect_equal(dl1$decisionCriticalValues, c(1.3362296, 1.657468, 1.9734104), tolerance = 1e-07, label = paste0("c(", paste0(dl1$decisionCriticalValues, collapse = ", "), ")")) - expect_equal(dl1$reversalProbabilities, c(0.0020439695, 0.0026967589), tolerance = 1e-07, label = paste0("c(", paste0(dl1$reversalProbabilities, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dl1), NA))) - expect_output(print(dl1)$show()) - invisible(capture.output(expect_error(summary(dl1), NA))) - expect_output(summary(dl1)$show()) - suppressWarnings(dl1CodeBased <- eval(parse(text = getObjectRCode(dl1, stringWrapParagraphWidth = NULL)))) - expect_equal(dl1CodeBased$power, dl1$power, tolerance = 1e-07) - expect_equal(dl1CodeBased$futilityBounds, dl1$futilityBounds, tolerance = 1e-07) - expect_equal(dl1CodeBased$alphaSpent, dl1$alphaSpent, tolerance = 1e-07) - expect_equal(dl1CodeBased$betaSpent, dl1$betaSpent, tolerance = 1e-07) - expect_equal(dl1CodeBased$criticalValues, dl1$criticalValues, tolerance = 1e-07) - expect_equal(dl1CodeBased$stageLevels, dl1$stageLevels, tolerance = 1e-07) - expect_equal(dl1CodeBased$decisionCriticalValues, dl1$decisionCriticalValues, tolerance = 1e-07) - expect_equal(dl1CodeBased$reversalProbabilities, dl1$reversalProbabilities, tolerance = 1e-07) - expect_type(names(dl1), "character") - df <- as.data.frame(dl1) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dl1) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - dl2 <- getDesignCharacteristics(dl1) - - ## Comparison of the results of TrialDesignCharacteristics object 'dl2' with expected results - expect_equal(dl2$nFixed, 8.5638474, tolerance = 1e-07, label = paste0("c(", paste0(dl2$nFixed, collapse = ", "), ")")) - expect_equal(dl2$shift, 11.345796, tolerance = 1e-07, label = paste0("c(", paste0(dl2$shift, collapse = ", "), ")")) - expect_equal(dl2$inflationFactor, 1.324848, tolerance = 1e-07, label = paste0("c(", paste0(dl2$inflationFactor, collapse = ", "), ")")) - expect_equal(dl2$information, c(4.5383183, 7.3747672, 11.345796), tolerance = 1e-07, label = paste0("c(", paste0(dl2$information, collapse = ", "), ")")) - expect_equal(dl2$power, c(0.57788702, 0.78847934, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl2$power, collapse = ", "), ")")) - expect_equal(dl2$rejectionProbabilities, c(0.57788702, 0.21059232, 0.11152066), tolerance = 1e-07, label = paste0("c(", paste0(dl2$rejectionProbabilities, collapse = ", "), ")")) - expect_equal(dl2$futilityProbabilities, c(0.056427171, 0.024888086), tolerance = 1e-07, label = paste0("c(", paste0(dl2$futilityProbabilities, collapse = ", "), ")")) - expect_equal(dl2$averageSampleNumber1, 0.86088771, tolerance = 1e-07, label = paste0("c(", paste0(dl2$averageSampleNumber1, collapse = ", "), ")")) - expect_equal(dl2$averageSampleNumber01, 0.9483049, tolerance = 1e-07, label = paste0("c(", paste0(dl2$averageSampleNumber01, collapse = ", "), ")")) - expect_equal(dl2$averageSampleNumber0, 0.80259202, tolerance = 1e-07, label = paste0("c(", paste0(dl2$averageSampleNumber0, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dl2), NA))) - expect_output(print(dl2)$show()) - invisible(capture.output(expect_error(summary(dl2), NA))) - expect_output(summary(dl2)$show()) - suppressWarnings(dl2CodeBased <- eval(parse(text = getObjectRCode(dl2, stringWrapParagraphWidth = NULL)))) - expect_equal(dl2CodeBased$nFixed, dl2$nFixed, tolerance = 1e-07) - expect_equal(dl2CodeBased$shift, dl2$shift, tolerance = 1e-07) - expect_equal(dl2CodeBased$inflationFactor, dl2$inflationFactor, tolerance = 1e-07) - expect_equal(dl2CodeBased$information, dl2$information, tolerance = 1e-07) - expect_equal(dl2CodeBased$power, dl2$power, tolerance = 1e-07) - expect_equal(dl2CodeBased$rejectionProbabilities, dl2$rejectionProbabilities, tolerance = 1e-07) - expect_equal(dl2CodeBased$futilityProbabilities, dl2$futilityProbabilities, tolerance = 1e-07) - expect_equal(dl2CodeBased$averageSampleNumber1, dl2$averageSampleNumber1, tolerance = 1e-07) - expect_equal(dl2CodeBased$averageSampleNumber01, dl2$averageSampleNumber01, tolerance = 1e-07) - expect_equal(dl2CodeBased$averageSampleNumber0, dl2$averageSampleNumber0, tolerance = 1e-07) - expect_type(names(dl2), "character") - df <- as.data.frame(dl2) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dl2) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - suppressWarnings(dl3 <- getDesignGroupSequential( - kMax = 3, alpha = 0.05, beta = 0.1, sided = 1, - typeOfDesign = "asP", typeBetaSpending = "bsP", - informationRates = c(0.4, 0.65, 1), - bindingFutility = FALSE, - delayedInformation = c(0, 0.2) - )) - - ## Comparison of the results of TrialDesignGroupSequential object 'dl3' with expected results - expect_equal(dl3$power, c(0.58983431, 0.79279807, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl3$power, collapse = ", "), ")")) - expect_equal(dl3$futilityBounds, c(0.5448398, 1.0899149), tolerance = 1e-07, label = paste0("c(", paste0(dl3$futilityBounds, collapse = ", "), ")")) - expect_equal(dl3$alphaSpent, c(0.026156858, 0.037497241, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(dl3$alphaSpent, collapse = ", "), ")")) - expect_equal(dl3$betaSpent, c(0.052313716, 0.074994481, 0.099999999), tolerance = 1e-07, label = paste0("c(", paste0(dl3$betaSpent, collapse = ", "), ")")) - expect_equal(dl3$criticalValues, c(1.9405431, 2.0327662, 1.9734104), tolerance = 1e-07, label = paste0("c(", paste0(dl3$criticalValues, collapse = ", "), ")")) - expect_equal(dl3$stageLevels, c(0.026156858, 0.021038075, 0.02422441), tolerance = 1e-07, label = paste0("c(", paste0(dl3$stageLevels, collapse = ", "), ")")) - expect_equal(dl3$decisionCriticalValues, c(NA_real_, 1.657468, 1.9734104), tolerance = 1e-07, label = paste0("c(", paste0(dl3$decisionCriticalValues, collapse = ", "), ")")) - expect_equal(dl3$reversalProbabilities, c(NA_real_, 0.0026967589), tolerance = 1e-07, label = paste0("c(", paste0(dl3$reversalProbabilities, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dl3), NA))) - expect_output(print(dl3)$show()) - invisible(capture.output(expect_error(summary(dl3), NA))) - expect_output(summary(dl3)$show()) - suppressWarnings(dl3CodeBased <- eval(parse(text = getObjectRCode(dl3, stringWrapParagraphWidth = NULL)))) - expect_equal(dl3CodeBased$power, dl3$power, tolerance = 1e-07) - expect_equal(dl3CodeBased$futilityBounds, dl3$futilityBounds, tolerance = 1e-07) - expect_equal(dl3CodeBased$alphaSpent, dl3$alphaSpent, tolerance = 1e-07) - expect_equal(dl3CodeBased$betaSpent, dl3$betaSpent, tolerance = 1e-07) - expect_equal(dl3CodeBased$criticalValues, dl3$criticalValues, tolerance = 1e-07) - expect_equal(dl3CodeBased$stageLevels, dl3$stageLevels, tolerance = 1e-07) - expect_equal(dl3CodeBased$decisionCriticalValues, dl3$decisionCriticalValues, tolerance = 1e-07) - expect_equal(dl3CodeBased$reversalProbabilities, dl3$reversalProbabilities, tolerance = 1e-07) - expect_type(names(dl3), "character") - df <- as.data.frame(dl3) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dl3) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - dl4 <- getDesignCharacteristics(dl3) - - ## Comparison of the results of TrialDesignCharacteristics object 'dl4' with expected results - expect_equal(dl4$nFixed, 8.5638474, tolerance = 1e-07, label = paste0("c(", paste0(dl4$nFixed, collapse = ", "), ")")) - expect_equal(dl4$shift, 11.462579, tolerance = 1e-07, label = paste0("c(", paste0(dl4$shift, collapse = ", "), ")")) - expect_equal(dl4$inflationFactor, 1.3384848, tolerance = 1e-07, label = paste0("c(", paste0(dl4$inflationFactor, collapse = ", "), ")")) - expect_equal(dl4$information, c(4.5850317, 7.4506765, 11.462579), tolerance = 1e-07, label = paste0("c(", paste0(dl4$information, collapse = ", "), ")")) - expect_equal(dl4$power, c(0.57954342, 0.78973163, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl4$power, collapse = ", "), ")")) - expect_equal(dl4$rejectionProbabilities, c(0.57954342, 0.21018821, 0.11026837), tolerance = 1e-07, label = paste0("c(", paste0(dl4$rejectionProbabilities, collapse = ", "), ")")) - expect_equal(dl4$futilityProbabilities, c(0.055196532, 0.024225352), tolerance = 1e-07, label = paste0("c(", paste0(dl4$futilityProbabilities, collapse = ", "), ")")) - expect_equal(dl4$averageSampleNumber1, 0.7829433, tolerance = 1e-07, label = paste0("c(", paste0(dl4$averageSampleNumber1, collapse = ", "), ")")) - expect_equal(dl4$averageSampleNumber01, 0.89251343, tolerance = 1e-07, label = paste0("c(", paste0(dl4$averageSampleNumber01, collapse = ", "), ")")) - expect_equal(dl4$averageSampleNumber0, 0.71271214, tolerance = 1e-07, label = paste0("c(", paste0(dl4$averageSampleNumber0, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dl4), NA))) - expect_output(print(dl4)$show()) - invisible(capture.output(expect_error(summary(dl4), NA))) - expect_output(summary(dl4)$show()) - suppressWarnings(dl4CodeBased <- eval(parse(text = getObjectRCode(dl4, stringWrapParagraphWidth = NULL)))) - expect_equal(dl4CodeBased$nFixed, dl4$nFixed, tolerance = 1e-07) - expect_equal(dl4CodeBased$shift, dl4$shift, tolerance = 1e-07) - expect_equal(dl4CodeBased$inflationFactor, dl4$inflationFactor, tolerance = 1e-07) - expect_equal(dl4CodeBased$information, dl4$information, tolerance = 1e-07) - expect_equal(dl4CodeBased$power, dl4$power, tolerance = 1e-07) - expect_equal(dl4CodeBased$rejectionProbabilities, dl4$rejectionProbabilities, tolerance = 1e-07) - expect_equal(dl4CodeBased$futilityProbabilities, dl4$futilityProbabilities, tolerance = 1e-07) - expect_equal(dl4CodeBased$averageSampleNumber1, dl4$averageSampleNumber1, tolerance = 1e-07) - expect_equal(dl4CodeBased$averageSampleNumber01, dl4$averageSampleNumber01, tolerance = 1e-07) - expect_equal(dl4CodeBased$averageSampleNumber0, dl4$averageSampleNumber0, tolerance = 1e-07) - expect_type(names(dl4), "character") - df <- as.data.frame(dl4) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dl4) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - expect_warning( - dl5 <- getDesignGroupSequential( - kMax = 3, alpha = 0.05, beta = 0.1, sided = 1, - typeOfDesign = "asP", typeBetaSpending = "bsP", - informationRates = c(0.4, 0.65, 1), - bindingFutility = FALSE, - delayedInformation = 0 - ) - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'dl5' with expected results - expect_equal(dl5$power, c(0.58983431, 0.79279807, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl5$power, collapse = ", "), ")")) - expect_equal(dl5$futilityBounds, c(0.5448398, 1.0899149), tolerance = 1e-07, label = paste0("c(", paste0(dl5$futilityBounds, collapse = ", "), ")")) - expect_equal(dl5$alphaSpent, c(0.026156858, 0.037497241, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(dl5$alphaSpent, collapse = ", "), ")")) - expect_equal(dl5$betaSpent, c(0.052313716, 0.074994481, 0.099999999), tolerance = 1e-07, label = paste0("c(", paste0(dl5$betaSpent, collapse = ", "), ")")) - expect_equal(dl5$criticalValues, c(1.9405431, 2.0327662, 1.9734104), tolerance = 1e-07, label = paste0("c(", paste0(dl5$criticalValues, collapse = ", "), ")")) - expect_equal(dl5$stageLevels, c(0.026156858, 0.021038075, 0.02422441), tolerance = 1e-07, label = paste0("c(", paste0(dl5$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dl5), NA))) - expect_output(print(dl5)$show()) - invisible(capture.output(expect_error(summary(dl5), NA))) - expect_output(summary(dl5)$show()) - suppressWarnings(dl5CodeBased <- eval(parse(text = getObjectRCode(dl5, stringWrapParagraphWidth = NULL)))) - expect_equal(dl5CodeBased$power, dl5$power, tolerance = 1e-07) - expect_equal(dl5CodeBased$futilityBounds, dl5$futilityBounds, tolerance = 1e-07) - expect_equal(dl5CodeBased$alphaSpent, dl5$alphaSpent, tolerance = 1e-07) - expect_equal(dl5CodeBased$betaSpent, dl5$betaSpent, tolerance = 1e-07) - expect_equal(dl5CodeBased$criticalValues, dl5$criticalValues, tolerance = 1e-07) - expect_equal(dl5CodeBased$stageLevels, dl5$stageLevels, tolerance = 1e-07) - expect_type(names(dl5), "character") - df <- as.data.frame(dl5) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dl5) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - dl6 <- getDesignCharacteristics(dl5) - - ## Comparison of the results of TrialDesignCharacteristics object 'dl6' with expected results - expect_equal(dl6$nFixed, 8.5638474, tolerance = 1e-07, label = paste0("c(", paste0(dl6$nFixed, collapse = ", "), ")")) - expect_equal(dl6$shift, 11.746896, tolerance = 1e-07, label = paste0("c(", paste0(dl6$shift, collapse = ", "), ")")) - expect_equal(dl6$inflationFactor, 1.3716844, tolerance = 1e-07, label = paste0("c(", paste0(dl6$inflationFactor, collapse = ", "), ")")) - expect_equal(dl6$information, c(4.6987583, 7.6354822, 11.746896), tolerance = 1e-07, label = paste0("c(", paste0(dl6$information, collapse = ", "), ")")) - expect_equal(dl6$power, c(0.58983431, 0.79279807, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl6$power, collapse = ", "), ")")) - expect_equal(dl6$rejectionProbabilities, c(0.58983431, 0.20296375, 0.10720193), tolerance = 1e-07, label = paste0("c(", paste0(dl6$rejectionProbabilities, collapse = ", "), ")")) - expect_equal(dl6$futilityProbabilities, c(0.052313716, 0.022680765), tolerance = 1e-07, label = paste0("c(", paste0(dl6$futilityProbabilities, collapse = ", "), ")")) - expect_equal(dl6$averageSampleNumber1, 0.73486016, tolerance = 1e-07, label = paste0("c(", paste0(dl6$averageSampleNumber1, collapse = ", "), ")")) - expect_equal(dl6$averageSampleNumber01, 0.8455149, tolerance = 1e-07, label = paste0("c(", paste0(dl6$averageSampleNumber01, collapse = ", "), ")")) - expect_equal(dl6$averageSampleNumber0, 0.67993383, tolerance = 1e-07, label = paste0("c(", paste0(dl6$averageSampleNumber0, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(dl6), NA))) - expect_output(print(dl6)$show()) - invisible(capture.output(expect_error(summary(dl6), NA))) - expect_output(summary(dl6)$show()) - suppressWarnings(dl6CodeBased <- eval(parse(text = getObjectRCode(dl6, stringWrapParagraphWidth = NULL)))) - expect_equal(dl6CodeBased$nFixed, dl6$nFixed, tolerance = 1e-07) - expect_equal(dl6CodeBased$shift, dl6$shift, tolerance = 1e-07) - expect_equal(dl6CodeBased$inflationFactor, dl6$inflationFactor, tolerance = 1e-07) - expect_equal(dl6CodeBased$information, dl6$information, tolerance = 1e-07) - expect_equal(dl6CodeBased$power, dl6$power, tolerance = 1e-07) - expect_equal(dl6CodeBased$rejectionProbabilities, dl6$rejectionProbabilities, tolerance = 1e-07) - expect_equal(dl6CodeBased$futilityProbabilities, dl6$futilityProbabilities, tolerance = 1e-07) - expect_equal(dl6CodeBased$averageSampleNumber1, dl6$averageSampleNumber1, tolerance = 1e-07) - expect_equal(dl6CodeBased$averageSampleNumber01, dl6$averageSampleNumber01, tolerance = 1e-07) - expect_equal(dl6CodeBased$averageSampleNumber0, dl6$averageSampleNumber0, tolerance = 1e-07) - expect_type(names(dl6), "character") - df <- as.data.frame(dl6) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(dl6) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignGroupSequential' with binding futility bounds", { - - .skipTestIfDisabled() - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:criticalValuesWithFutility} - # @refFS[Formula]{fs:criticalValuesWangTiatis} - x8a <- getDesignGroupSequential( - kMax = 4, alpha = 0.025, futilityBounds = rep(0.5244, 3), - bindingFutility = TRUE, typeOfDesign = "WT", deltaWT = 0.4 - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x8a' with expected results - expect_equal(x8a$alphaSpent, c(0.0062828133, 0.013876673, 0.02015684, 0.02499999), tolerance = 1e-07, label = paste0("c(", paste0(x8a$alphaSpent, collapse = ", "), ")")) - expect_equal(x8a$criticalValues, c(2.4958485, 2.328709, 2.2361766, 2.1727623), tolerance = 1e-07, label = paste0("c(", paste0(x8a$criticalValues, collapse = ", "), ")")) - expect_equal(x8a$stageLevels, c(0.0062828133, 0.0099372444, 0.012670104, 0.014899106), tolerance = 1e-07, label = paste0("c(", paste0(x8a$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x8a), NA))) - expect_output(print(x8a)$show()) - invisible(capture.output(expect_error(summary(x8a), NA))) - expect_output(summary(x8a)$show()) - x8aCodeBased <- eval(parse(text = getObjectRCode(x8a, stringWrapParagraphWidth = NULL))) - expect_equal(x8aCodeBased$alphaSpent, x8a$alphaSpent, tolerance = 1e-07) - expect_equal(x8aCodeBased$criticalValues, x8a$criticalValues, tolerance = 1e-07) - expect_equal(x8aCodeBased$stageLevels, x8a$stageLevels, tolerance = 1e-07) - expect_type(names(x8a), "character") - df <- as.data.frame(x8a) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x8a) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:criticalValuesWangTiatis} - x8b <- getDesignGroupSequential( - kMax = 3, alpha = 0.025, sided = 2, informationRates = c(0.3, 0.8, 1), - typeOfDesign = "WT", deltaWT = 0.24 - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x8b' with expected results - expect_equal(x8b$alphaSpent, c(0.0013603353, 0.013978861, 0.02499999), tolerance = 1e-07, label = paste0("c(", paste0(x8b$alphaSpent, collapse = ", "), ")")) - expect_equal(x8b$criticalValues, c(3.2029374, 2.4819703, 2.3420706), tolerance = 1e-07, label = paste0("c(", paste0(x8b$criticalValues, collapse = ", "), ")")) - expect_equal(x8b$stageLevels, c(0.00068016766, 0.0065329078, 0.0095885436), tolerance = 1e-07, label = paste0("c(", paste0(x8b$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x8b), NA))) - expect_output(print(x8b)$show()) - invisible(capture.output(expect_error(summary(x8b), NA))) - expect_output(summary(x8b)$show()) - x8bCodeBased <- eval(parse(text = getObjectRCode(x8b, stringWrapParagraphWidth = NULL))) - expect_equal(x8bCodeBased$alphaSpent, x8b$alphaSpent, tolerance = 1e-07) - expect_equal(x8bCodeBased$criticalValues, x8b$criticalValues, tolerance = 1e-07) - expect_equal(x8bCodeBased$stageLevels, x8b$stageLevels, tolerance = 1e-07) - expect_type(names(x8b), "character") - df <- as.data.frame(x8b) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x8b) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:criticalValuesWangTiatis} - x8c <- getDesignGroupSequential( - kMax = 3, alpha = 0.025, sided = 1, informationRates = c(0.3, 0.8, 1), - typeOfDesign = "WToptimum", beta = 0.23 - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x8c' with expected results - expect_equal(x8c$power, c(0.17785982, 0.63184407, 0.77), tolerance = 1e-07, label = paste0("c(", paste0(x8c$power, collapse = ", "), ")")) - expect_equal(x8c$deltaWT, 0.393, tolerance = 1e-07, label = paste0("c(", paste0(x8c$deltaWT, collapse = ", "), ")")) - expect_equal(x8c$alphaSpent, c(0.0067542296, 0.01805085, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(x8c$alphaSpent, collapse = ", "), ")")) - expect_equal(x8c$criticalValues, c(2.4700754, 2.2239834, 2.1715117), tolerance = 1e-07, label = paste0("c(", paste0(x8c$criticalValues, collapse = ", "), ")")) - expect_equal(x8c$stageLevels, c(0.0067542296, 0.013074779, 0.014946256), tolerance = 1e-07, label = paste0("c(", paste0(x8c$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x8c), NA))) - expect_output(print(x8c)$show()) - invisible(capture.output(expect_error(summary(x8c), NA))) - expect_output(summary(x8c)$show()) - x8cCodeBased <- eval(parse(text = getObjectRCode(x8c, stringWrapParagraphWidth = NULL))) - expect_equal(x8cCodeBased$power, x8c$power, tolerance = 1e-07) - expect_equal(x8cCodeBased$deltaWT, x8c$deltaWT, tolerance = 1e-07) - expect_equal(x8cCodeBased$alphaSpent, x8c$alphaSpent, tolerance = 1e-07) - expect_equal(x8cCodeBased$criticalValues, x8c$criticalValues, tolerance = 1e-07) - expect_equal(x8cCodeBased$stageLevels, x8c$stageLevels, tolerance = 1e-07) - expect_type(names(x8c), "character") - df <- as.data.frame(x8c) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x8c) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:criticalValuesWangTiatis} - x8d <- getDesignGroupSequential( - kMax = 4, alpha = 0.025, sided = 2, informationRates = c(0.3, 0.6, 0.8, 1), - typeOfDesign = "WToptimum", beta = 0.1, optimizationCriterion = "ASNH1" - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x8d' with expected results - expect_equal(x8d$power, c(0.27905065, 0.63899817, 0.80432197, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(x8d$power, collapse = ", "), ")")) - expect_equal(x8d$deltaWT, 0.479, tolerance = 1e-07, label = paste0("c(", paste0(x8d$deltaWT, collapse = ", "), ")")) - expect_equal(x8d$alphaSpent, c(0.0082066211, 0.015417447, 0.020576899, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(x8d$alphaSpent, collapse = ", "), ")")) - expect_equal(x8d$criticalValues, c(2.6434487, 2.6052491, 2.5895574, 2.577451), tolerance = 1e-07, label = paste0("c(", paste0(x8d$criticalValues, collapse = ", "), ")")) - expect_equal(x8d$stageLevels, c(0.0041033106, 0.0045903747, 0.0048049705, 0.0049765989), tolerance = 1e-07, label = paste0("c(", paste0(x8d$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x8d), NA))) - expect_output(print(x8d)$show()) - invisible(capture.output(expect_error(summary(x8d), NA))) - expect_output(summary(x8d)$show()) - x8dCodeBased <- eval(parse(text = getObjectRCode(x8d, stringWrapParagraphWidth = NULL))) - expect_equal(x8dCodeBased$power, x8d$power, tolerance = 1e-07) - expect_equal(x8dCodeBased$deltaWT, x8d$deltaWT, tolerance = 1e-07) - expect_equal(x8dCodeBased$alphaSpent, x8d$alphaSpent, tolerance = 1e-07) - expect_equal(x8dCodeBased$criticalValues, x8d$criticalValues, tolerance = 1e-07) - expect_equal(x8dCodeBased$stageLevels, x8d$stageLevels, tolerance = 1e-07) - expect_type(names(x8d), "character") - df <- as.data.frame(x8d) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x8d) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:criticalValuesWangTiatis} - x8e <- getDesignGroupSequential( - kMax = 4, alpha = 0.025, sided = 2, informationRates = c(0.3, 0.6, 0.8, 1), - typeOfDesign = "WToptimum", beta = 0.1, optimizationCriterion = "ASNsum" - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x8e' with expected results - expect_equal(x8e$power, c(0.068425642, 0.50677837, 0.76253381, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(x8e$power, collapse = ", "), ")")) - expect_equal(x8e$deltaWT, 0.181, tolerance = 1e-07, label = paste0("c(", paste0(x8e$deltaWT, collapse = ", "), ")")) - expect_equal(x8e$alphaSpent, c(0.00055484217, 0.0059655413, 0.01417086, 0.02499999), tolerance = 1e-07, label = paste0("c(", paste0(x8e$alphaSpent, collapse = ", "), ")")) - expect_equal(x8e$criticalValues, c(3.4527796, 2.7678356, 2.5251363, 2.3516384), tolerance = 1e-07, label = paste0("c(", paste0(x8e$criticalValues, collapse = ", "), ")")) - expect_equal(x8e$stageLevels, c(0.00027742108, 0.0028214959, 0.0057826708, 0.0093454685), tolerance = 1e-07, label = paste0("c(", paste0(x8e$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x8e), NA))) - expect_output(print(x8e)$show()) - invisible(capture.output(expect_error(summary(x8e), NA))) - expect_output(summary(x8e)$show()) - x8eCodeBased <- eval(parse(text = getObjectRCode(x8e, stringWrapParagraphWidth = NULL))) - expect_equal(x8eCodeBased$power, x8e$power, tolerance = 1e-07) - expect_equal(x8eCodeBased$deltaWT, x8e$deltaWT, tolerance = 1e-07) - expect_equal(x8eCodeBased$alphaSpent, x8e$alphaSpent, tolerance = 1e-07) - expect_equal(x8eCodeBased$criticalValues, x8e$criticalValues, tolerance = 1e-07) - expect_equal(x8eCodeBased$stageLevels, x8e$stageLevels, tolerance = 1e-07) - expect_type(names(x8e), "character") - df <- as.data.frame(x8e) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x8e) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignGroupSequential' with Haybittle Peto boundaries", { - - .skipTestIfDisabled() - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:criticalValuesHaybittlePeto} - x9 <- getDesignGroupSequential(kMax = 4, alpha = 0.025, typeOfDesign = "HP") - - ## Comparison of the results of TrialDesignGroupSequential object 'x9' with expected results - expect_equal(x9$alphaSpent, c(0.001349898, 0.0024617416, 0.0033695882, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(x9$alphaSpent, collapse = ", "), ")")) - expect_equal(x9$criticalValues, c(3, 3, 3, 1.9827514), tolerance = 1e-07, label = paste0("c(", paste0(x9$criticalValues, collapse = ", "), ")")) - expect_equal(x9$stageLevels, c(0.001349898, 0.001349898, 0.001349898, 0.023697604), tolerance = 1e-07, label = paste0("c(", paste0(x9$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x9), NA))) - expect_output(print(x9)$show()) - invisible(capture.output(expect_error(summary(x9), NA))) - expect_output(summary(x9)$show()) - x9CodeBased <- eval(parse(text = getObjectRCode(x9, stringWrapParagraphWidth = NULL))) - expect_equal(x9CodeBased$alphaSpent, x9$alphaSpent, tolerance = 1e-07) - expect_equal(x9CodeBased$criticalValues, x9$criticalValues, tolerance = 1e-07) - expect_equal(x9CodeBased$stageLevels, x9$stageLevels, tolerance = 1e-07) - expect_type(names(x9), "character") - df <- as.data.frame(x9) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x9) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignGroupSequential' with Pampallona Tsiatis boundaries, binding and non-binding futility bounds", { - - .skipTestIfDisabled() - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:criticalValuesPampallonaTiatis} - x10 <- getDesignGroupSequential( - kMax = 3, alpha = 0.035, beta = 0.1, - informationRates = c(0.3, 0.8, 1), typeOfDesign = "PT", sided = 1, - bindingFutility = TRUE, deltaPT1 = 0.2, deltaPT0 = 0.3 - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x10' with expected results - expect_equal(x10$power, c(0.19834666, 0.83001122, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(x10$power, collapse = ", "), ")")) - expect_equal(x10$futilityBounds, c(-0.042079545, 1.4407359), tolerance = 1e-07, label = paste0("c(", paste0(x10$futilityBounds, collapse = ", "), ")")) - expect_equal(x10$alphaSpent, c(0.0038332428, 0.024917169, 0.035), tolerance = 1e-07, label = paste0("c(", paste0(x10$alphaSpent, collapse = ", "), ")")) - expect_equal(x10$betaSpent, c(0.031375368, 0.080734151, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(x10$betaSpent, collapse = ", "), ")")) - expect_equal(x10$criticalValues, c(2.6664156, 1.9867225, 1.8580792), tolerance = 1e-07, label = paste0("c(", paste0(x10$criticalValues, collapse = ", "), ")")) - expect_equal(x10$stageLevels, c(0.0038332428, 0.023476576, 0.031578886), tolerance = 1e-07, label = paste0("c(", paste0(x10$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x10), NA))) - expect_output(print(x10)$show()) - invisible(capture.output(expect_error(summary(x10), NA))) - expect_output(summary(x10)$show()) - x10CodeBased <- eval(parse(text = getObjectRCode(x10, stringWrapParagraphWidth = NULL))) - expect_equal(x10CodeBased$power, x10$power, tolerance = 1e-07) - expect_equal(x10CodeBased$futilityBounds, x10$futilityBounds, tolerance = 1e-07) - expect_equal(x10CodeBased$alphaSpent, x10$alphaSpent, tolerance = 1e-07) - expect_equal(x10CodeBased$betaSpent, x10$betaSpent, tolerance = 1e-07) - expect_equal(x10CodeBased$criticalValues, x10$criticalValues, tolerance = 1e-07) - expect_equal(x10CodeBased$stageLevels, x10$stageLevels, tolerance = 1e-07) - expect_type(names(x10), "character") - df <- as.data.frame(x10) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x10) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:criticalValuesPampallonaTiatis} - x11 <- getDesignGroupSequential( - kMax = 3, alpha = 0.035, beta = 0.05, - informationRates = c(0.3, 0.8, 1), typeOfDesign = "PT", sided = 2, - bindingFutility = TRUE, deltaPT1 = 0.2, deltaPT0 = 0.3 - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x11' with expected results - expect_equal(x11$power, c(0.16615376, 0.88013007, 0.94999991), tolerance = 1e-07, label = paste0("c(", paste0(x11$power, collapse = ", "), ")")) - expect_equal(x11$futilityBounds, c(NA_real_, 1.671433), tolerance = 1e-07, label = paste0("c(", paste0(x11$futilityBounds, collapse = ", "), ")")) - expect_equal(x11$alphaSpent, c(0.0019236202, 0.022017713, 0.035), tolerance = 1e-07, label = paste0("c(", paste0(x11$alphaSpent, collapse = ", "), ")")) - expect_equal(x11$betaSpent, c(0, 0.035025978, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(x11$betaSpent, collapse = ", "), ")")) - expect_equal(x11$criticalValues, c(3.1017782, 2.3111074, 2.1614596), tolerance = 1e-07, label = paste0("c(", paste0(x11$criticalValues, collapse = ", "), ")")) - expect_equal(x11$stageLevels, c(0.00096181012, 0.010413463, 0.015329928), tolerance = 1e-07, label = paste0("c(", paste0(x11$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x11), NA))) - expect_output(print(x11)$show()) - invisible(capture.output(expect_error(summary(x11), NA))) - expect_output(summary(x11)$show()) - x11CodeBased <- eval(parse(text = getObjectRCode(x11, stringWrapParagraphWidth = NULL))) - expect_equal(x11CodeBased$power, x11$power, tolerance = 1e-07) - expect_equal(x11CodeBased$futilityBounds, x11$futilityBounds, tolerance = 1e-07) - expect_equal(x11CodeBased$alphaSpent, x11$alphaSpent, tolerance = 1e-07) - expect_equal(x11CodeBased$betaSpent, x11$betaSpent, tolerance = 1e-07) - expect_equal(x11CodeBased$criticalValues, x11$criticalValues, tolerance = 1e-07) - expect_equal(x11CodeBased$stageLevels, x11$stageLevels, tolerance = 1e-07) - expect_type(names(x11), "character") - df <- as.data.frame(x11) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x11) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:criticalValuesPampallonaTiatis} - x12 <- getDesignGroupSequential( - kMax = 3, alpha = 0.035, beta = 0.05, - informationRates = c(0.3, 0.8, 1), typeOfDesign = "PT", sided = 2, - bindingFutility = FALSE, deltaPT1 = 0.2, deltaPT0 = 0.3 - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x12' with expected results - expect_equal(x12$power, c(0.15712278, 0.87874666, 0.94999994), tolerance = 1e-07, label = paste0("c(", paste0(x12$power, collapse = ", "), ")")) - expect_equal(x12$futilityBounds, c(NA_real_, 1.7090472), tolerance = 1e-07, label = paste0("c(", paste0(x12$futilityBounds, collapse = ", "), ")")) - expect_equal(x12$alphaSpent, c(0.0015647742, 0.019435851, 0.035), tolerance = 1e-07, label = paste0("c(", paste0(x12$alphaSpent, collapse = ", "), ")")) - expect_equal(x12$betaSpent, c(0, 0.034947415, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(x12$betaSpent, collapse = ", "), ")")) - expect_equal(x12$criticalValues, c(3.1623945, 2.356272, 2.2036998), tolerance = 1e-07, label = paste0("c(", paste0(x12$criticalValues, collapse = ", "), ")")) - expect_equal(x12$stageLevels, c(0.00078238709, 0.0092296971, 0.013772733), tolerance = 1e-07, label = paste0("c(", paste0(x12$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x12), NA))) - expect_output(print(x12)$show()) - invisible(capture.output(expect_error(summary(x12), NA))) - expect_output(summary(x12)$show()) - x12CodeBased <- eval(parse(text = getObjectRCode(x12, stringWrapParagraphWidth = NULL))) - expect_equal(x12CodeBased$power, x12$power, tolerance = 1e-07) - expect_equal(x12CodeBased$futilityBounds, x12$futilityBounds, tolerance = 1e-07) - expect_equal(x12CodeBased$alphaSpent, x12$alphaSpent, tolerance = 1e-07) - expect_equal(x12CodeBased$betaSpent, x12$betaSpent, tolerance = 1e-07) - expect_equal(x12CodeBased$criticalValues, x12$criticalValues, tolerance = 1e-07) - expect_equal(x12CodeBased$stageLevels, x12$stageLevels, tolerance = 1e-07) - expect_type(names(x12), "character") - df <- as.data.frame(x12) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x12) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:criticalValuesPampallonaTiatis} - x13 <- getDesignGroupSequential( - kMax = 4, alpha = 0.035, beta = 0.05, - informationRates = c(0.2, 0.4, 0.8, 1), typeOfDesign = "PT", sided = 1, - bindingFutility = FALSE, deltaPT1 = 0.1, deltaPT0 = 0.45 - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x13' with expected results - expect_equal(x13$power, c(0.029518378, 0.38853658, 0.90760886, 0.95), tolerance = 1e-07, label = paste0("c(", paste0(x13$power, collapse = ", "), ")")) - expect_equal(x13$futilityBounds, c(-0.41499566, 0.38106631, 1.4738957), tolerance = 1e-07, label = paste0("c(", paste0(x13$futilityBounds, collapse = ", "), ")")) - expect_equal(x13$alphaSpent, c(0.00014050218, 0.0030266381, 0.0199021, 0.035), tolerance = 1e-07, label = paste0("c(", paste0(x13$alphaSpent, collapse = ", "), ")")) - expect_equal(x13$betaSpent, c(0.015413989, 0.028721092, 0.043215976, 0.049999999), tolerance = 1e-07, label = paste0("c(", paste0(x13$betaSpent, collapse = ", "), ")")) - expect_equal(x13$criticalValues, c(3.6322099, 2.7527004, 2.0861568, 1.9080201), tolerance = 1e-07, label = paste0("c(", paste0(x13$criticalValues, collapse = ", "), ")")) - expect_equal(x13$stageLevels, c(0.00014050218, 0.002955298, 0.018482211, 0.02819431), tolerance = 1e-07, label = paste0("c(", paste0(x13$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x13), NA))) - expect_output(print(x13)$show()) - invisible(capture.output(expect_error(summary(x13), NA))) - expect_output(summary(x13)$show()) - x13CodeBased <- eval(parse(text = getObjectRCode(x13, stringWrapParagraphWidth = NULL))) - expect_equal(x13CodeBased$power, x13$power, tolerance = 1e-07) - expect_equal(x13CodeBased$futilityBounds, x13$futilityBounds, tolerance = 1e-07) - expect_equal(x13CodeBased$alphaSpent, x13$alphaSpent, tolerance = 1e-07) - expect_equal(x13CodeBased$betaSpent, x13$betaSpent, tolerance = 1e-07) - expect_equal(x13CodeBased$criticalValues, x13$criticalValues, tolerance = 1e-07) - expect_equal(x13CodeBased$stageLevels, x13$stageLevels, tolerance = 1e-07) - expect_type(names(x13), "character") - df <- as.data.frame(x13) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x13) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - - # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} - # @refFS[Formula]{fs:criticalValuesPampallonaTiatis} - x14 <- getDesignGroupSequential( - kMax = 6, alpha = 0.25, beta = 0.01, - typeOfDesign = "PT", sided = 2, - bindingFutility = TRUE, deltaPT1 = 0.02, deltaPT0 = 0.49, twoSidedPower = TRUE - ) - - ## Comparison of the results of TrialDesignGroupSequential object 'x14' with expected results - expect_equal(x14$power, c(0.076493626, 0.52863814, 0.83456395, 0.94950066, 0.98346861, 0.99), tolerance = 1e-07, label = paste0("c(", paste0(x14$power, collapse = ", "), ")")) - expect_equal(x14$futilityBounds, c(NA_real_, NA_real_, 0.12661836, 0.55308248, 0.92800873), tolerance = 1e-07, label = paste0("c(", paste0(x14$futilityBounds, collapse = ", "), ")")) - expect_equal(x14$alphaSpent, c(0.0027626806, 0.03301126, 0.088857236, 0.15440485, 0.2156594, 0.25), tolerance = 1e-07, label = paste0("c(", paste0(x14$alphaSpent, collapse = ", "), ")")) - expect_equal(x14$betaSpent, c(0, 0, 0.0026196848, 0.0066701046, 0.0089493411, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(x14$betaSpent, collapse = ", "), ")")) - expect_equal(x14$criticalValues, c(2.9929798, 2.1458995, 1.7663859, 1.5385619, 1.3822869, 1.2664591), tolerance = 1e-07, label = paste0("c(", paste0(x14$criticalValues, collapse = ", "), ")")) - expect_equal(x14$stageLevels, c(0.0013813403, 0.015940498, 0.038665568, 0.061955638, 0.08344182, 0.10267438), tolerance = 1e-07, label = paste0("c(", paste0(x14$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x14), NA))) - expect_output(print(x14)$show()) - invisible(capture.output(expect_error(summary(x14), NA))) - expect_output(summary(x14)$show()) - x14CodeBased <- eval(parse(text = getObjectRCode(x14, stringWrapParagraphWidth = NULL))) - expect_equal(x14CodeBased$power, x14$power, tolerance = 1e-07) - expect_equal(x14CodeBased$futilityBounds, x14$futilityBounds, tolerance = 1e-07) - expect_equal(x14CodeBased$alphaSpent, x14$alphaSpent, tolerance = 1e-07) - expect_equal(x14CodeBased$betaSpent, x14$betaSpent, tolerance = 1e-07) - expect_equal(x14CodeBased$criticalValues, x14$criticalValues, tolerance = 1e-07) - expect_equal(x14CodeBased$stageLevels, x14$stageLevels, tolerance = 1e-07) - expect_type(names(x14), "character") - df <- as.data.frame(x14) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x14) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - -}) - -test_that("'getDesignGroupSequential' with type of design = 'noEarlyEfficacy'", { - - .skipTestIfDisabled() - - # @refFS[Tab.]{fs:tab:output:getDesignInverseNormal} - # @refFS[Formula]{fs:alphaSpendingConcept} - x15 <- getDesignGroupSequential( - typeOfDesign = "noEarlyEfficacy", - futilityBounds = c(0, 0.5) - ) - - - ## Comparison of the results of TrialDesignGroupSequential object 'x15' with expected results - expect_equal(x15$alphaSpent, c(6.6613381e-16, -1.3145041e-13, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(x15$alphaSpent, collapse = ", "), ")")) - expect_equal(x15$criticalValues, c(Inf, Inf, 1.959964), tolerance = 1e-07, label = paste0("c(", paste0(x15$criticalValues, collapse = ", "), ")")) - expect_equal(x15$stageLevels, c(0, 0, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(x15$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x15), NA))) - expect_output(print(x15)$show()) - invisible(capture.output(expect_error(summary(x15), NA))) - expect_output(summary(x15)$show()) - x15CodeBased <- eval(parse(text = getObjectRCode(x15, stringWrapParagraphWidth = NULL))) - expect_equal(x15CodeBased$alphaSpent, x15$alphaSpent, tolerance = 1e-07) - expect_equal(x15CodeBased$criticalValues, x15$criticalValues, tolerance = 1e-07) - expect_equal(x15CodeBased$stageLevels, x15$stageLevels, tolerance = 1e-07) - expect_type(names(x15), "character") - df <- as.data.frame(x15) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x15) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } - x16 <- getDesignGroupSequential( - typeOfDesign = "noEarlyEfficacy", - futilityBounds = c(0, 0.5, 1), - bindingFutility = TRUE - ) - - - ## Comparison of the results of TrialDesignGroupSequential object 'x16' with expected results - expect_equal(x16$alphaSpent, c(6.6613381e-16, 1.110223e-15, 4.8067383e-11, 0.02499999), tolerance = 1e-07, label = paste0("c(", paste0(x16$alphaSpent, collapse = ", "), ")")) - expect_equal(x16$criticalValues, c(Inf, Inf, Inf, 1.8848634), tolerance = 1e-07, label = paste0("c(", paste0(x16$criticalValues, collapse = ", "), ")")) - expect_equal(x16$stageLevels, c(0, 0, 0, 0.029724142), tolerance = 1e-07, label = paste0("c(", paste0(x16$stageLevels, collapse = ", "), ")")) - if (isTRUE(.isCompleteUnitTestSetEnabled())) { - invisible(capture.output(expect_error(print(x16), NA))) - expect_output(print(x16)$show()) - invisible(capture.output(expect_error(summary(x16), NA))) - expect_output(summary(x16)$show()) - x16CodeBased <- eval(parse(text = getObjectRCode(x16, stringWrapParagraphWidth = NULL))) - expect_equal(x16CodeBased$alphaSpent, x16$alphaSpent, tolerance = 1e-07) - expect_equal(x16CodeBased$criticalValues, x16$criticalValues, tolerance = 1e-07) - expect_equal(x16CodeBased$stageLevels, x16$stageLevels, tolerance = 1e-07) - expect_type(names(x16), "character") - df <- as.data.frame(x16) - expect_s3_class(df, "data.frame") - expect_true(nrow(df) > 0 && ncol(df) > 0) - mtx <- as.matrix(x16) - expect_true(is.matrix(mtx)) - expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) - } -}) - -test_that("'getDesignInverseNormal': illegal arguments throw exceptions as expected", { - - expect_error(getDesignInverseNormal( - typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, - userAlphaSpending = c(0.01, 0.02, 0.023, 0.023, 0.025), kMax = 4 - ), - paste0( - "Conflicting arguments: length of 'userAlphaSpending' (5) ", - "must be equal to 'kMax' (4)" - ), - fixed = TRUE - ) - - expect_error(getDesignInverseNormal( - typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, - userAlphaSpending = c(0.01, 0.02, 0.023, 0.023, 0.021) - ), - paste0( - "'userAlphaSpending' = c(0.01, 0.02, 0.023, 0.023, 0.021) must be a vector that ", - "satisfies the following condition: 0 <= alpha_1 <= .. <= alpha_5 <= alpha = 0.021" - ), - fixed = TRUE - ) - - expect_error(getDesignInverseNormal( - typeOfDesign = "asUser", - userAlphaSpending = c(0.01, 0.02, 0.023), alpha = 0.02 - ), - paste0( - "'userAlphaSpending' = c(0.01, 0.02, 0.023) must be a vector that ", - "satisfies the following condition: 0 <= alpha_1 <= .. <= alpha_3 <= alpha = 0.02" - ), - fixed = TRUE - ) - - expect_error(getDesignInverseNormal(typeOfDesign = C_TYPE_OF_DESIGN_WT, deltaWT = NA_real_), - "Missing argument: parameter 'deltaWT' must be specified in design", - fixed = TRUE - ) - - expect_error(getDesignInverseNormal( - typeOfDesign = C_TYPE_OF_DESIGN_WT_OPTIMUM, - optimizationCriterion = "x" - ), - "Illegal argument: optimization criterion must be one of the following: 'ASNH1', 'ASNIFH1', 'ASNsum'", - fixed = TRUE - ) - - expect_error(getDesignInverseNormal(typeOfDesign = C_TYPE_OF_DESIGN_AS_KD, gammaA = NA_real_), - "Missing argument: parameter 'gammaA' must be specified in design", - fixed = TRUE - ) - - expect_error(getDesignInverseNormal(typeOfDesign = C_TYPE_OF_DESIGN_AS_HSD, gammaA = NA_real_), - "Missing argument: parameter 'gammaA' must be specified in design", - fixed = TRUE - ) - - expect_error(getDesignInverseNormal(typeOfDesign = C_TYPE_OF_DESIGN_AS_USER), - "Missing argument: parameter 'userAlphaSpending' must be specified in design", - fixed = TRUE - ) - - expect_error(getDesignInverseNormal( - typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, - userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = "x" - ), - "Illegal argument: type of beta spending must be one of the following: 'none', 'bsP', 'bsOF', 'bsKD', 'bsHSD', 'bsUser'", - fixed = TRUE - ) - - expect_error(getDesignInverseNormal( - typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, - userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER - ), - "Missing argument: parameter 'userBetaSpending' must be specified in design", - fixed = TRUE - ) - - expect_error(getDesignInverseNormal( - typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, - userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER, - userBetaSpending = c(0.1, 0.2) - ), - paste0( - "Conflicting arguments: length of 'userBetaSpending' (2) must ", - "be equal to length of 'informationRates' (3)" - ), - fixed = TRUE - ) - - expect_error(getDesignInverseNormal( - typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, - userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER, - userBetaSpending = c(0.2, 0.1, 0.05) - ), - paste0( - "'userBetaSpending' = c(0.2, 0.1, 0.05) must be a vector that satisfies the ", - "following condition: 0 <= beta_1 <= .. <= beta_3 <= beta = 0.05" - ), - fixed = TRUE - ) - - expect_error(getDesignInverseNormal( - typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, - userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER, - userBetaSpending = c(0.1, 0.2, 0.3), beta = 0.2 - ), - paste0( - "'userBetaSpending' = c(0.1, 0.2, 0.3) must be a vector that satisfies the ", - "following condition: 0 <= beta_1 <= .. <= beta_3 <= beta = 0.2" - ), - fixed = TRUE - ) - - expect_error(getDesignInverseNormal(kMax = Inf), - paste0( - "Argument out of bounds: 'kMax' (Inf) is out of bounds [1; ", - C_KMAX_UPPER_BOUND, "]" - ), - fixed = TRUE - ) - - expect_error(getDesignInverseNormal(kMax = -Inf), - paste0( - "Argument out of bounds: 'kMax' (-Inf) is out of bounds [1; ", - C_KMAX_UPPER_BOUND, "]" - ), - fixed = TRUE - ) - - expect_error(getDesignInverseNormal(kMax = -Inf), "Argument out of bounds: 'kMax' (-Inf) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = -10), "Argument out of bounds: 'kMax' (-10) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = -9), "Argument out of bounds: 'kMax' (-9) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = -8), "Argument out of bounds: 'kMax' (-8) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = -7), "Argument out of bounds: 'kMax' (-7) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = -6), "Argument out of bounds: 'kMax' (-6) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = -5), "Argument out of bounds: 'kMax' (-5) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = -4), "Argument out of bounds: 'kMax' (-4) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = -3), "Argument out of bounds: 'kMax' (-3) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = -2), "Argument out of bounds: 'kMax' (-2) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = -1), "Argument out of bounds: 'kMax' (-1) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 0), "Argument out of bounds: 'kMax' (0) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 21), "Argument out of bounds: 'kMax' (21) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 22), "Argument out of bounds: 'kMax' (22) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 23), "Argument out of bounds: 'kMax' (23) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 24), "Argument out of bounds: 'kMax' (24) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 25), "Argument out of bounds: 'kMax' (25) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 26), "Argument out of bounds: 'kMax' (26) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 27), "Argument out of bounds: 'kMax' (27) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 28), "Argument out of bounds: 'kMax' (28) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 29), "Argument out of bounds: 'kMax' (29) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 30), "Argument out of bounds: 'kMax' (30) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = Inf), "Argument out of bounds: 'kMax' (Inf) is out of bounds [1; 20]", fixed = TRUE) - - expect_error(getDesignInverseNormal(kMax = 2, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (2) - 1", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 3, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (3) - 1", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 4, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (4) - 1", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 6, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (6) - 1", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 7, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (7) - 1", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 8, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (8) - 1", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 9, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (9) - 1", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 10, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (10) - 1", fixed = TRUE) - - expect_warning(expect_error(getDesignInverseNormal(kMax = 11, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (11) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 12, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (12) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 13, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (13) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 14, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (14) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 15, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (15) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 16, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (16) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 17, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (17) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 18, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (18) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 19, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (19) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 20, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (20) - 1", fixed = TRUE)) - - expect_error(getDesignInverseNormal(futilityBounds = c(-7, 5)), - "Illegal argument: 'futilityBounds' (-7, 5) too extreme for this situation", - fixed = TRUE - ) - - expect_error(getDesignInverseNormal(futilityBounds = c(1, 7)), - "Argument out of bounds: 'futilityBounds' (1, 7) is out of bounds [-Inf; 6]", - fixed = TRUE - ) - -}) - -test_that("'getDesignGroupSequential': illegal arguments throw exceptions as expected", { - - expect_error(getDesignGroupSequential( - typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, - userAlphaSpending = c(0.01, 0.02, 0.023, 0.023, 0.025), kMax = 4 - ), - paste0( - "Conflicting arguments: length of 'userAlphaSpending' (5) ", - "must be equal to 'kMax' (4)" - ), - fixed = TRUE - ) - - expect_error(getDesignGroupSequential( - typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, - userAlphaSpending = c(0.01, 0.02, 0.023, 0.023, 0.021) - ), - paste0( - "'userAlphaSpending' = c(0.01, 0.02, 0.023, 0.023, 0.021) must be a vector that ", - "satisfies the following condition: 0 <= alpha_1 <= .. <= alpha_5 <= alpha = 0.021" - ), - fixed = TRUE - ) - - expect_error(getDesignGroupSequential( - typeOfDesign = "asUser", - userAlphaSpending = c(0.01, 0.02, 0.023), alpha = 0.02 - ), - paste0( - "'userAlphaSpending' = c(0.01, 0.02, 0.023) must be a vector that ", - "satisfies the following condition: 0 <= alpha_1 <= .. <= alpha_3 <= alpha = 0.02" - ), - fixed = TRUE - ) - - expect_equal(getDesignGroupSequential( - typeOfDesign = "asUser", - userAlphaSpending = c(0.01, 0.02, 0.023) - )$alpha, 0.023) - - expect_error(getDesignGroupSequential(typeOfDesign = C_TYPE_OF_DESIGN_WT, deltaWT = NA_real_), - "Missing argument: parameter 'deltaWT' must be specified in design", - fixed = TRUE - ) - - expect_error(getDesignGroupSequential( - typeOfDesign = C_TYPE_OF_DESIGN_WT_OPTIMUM, - optimizationCriterion = "x" - ), - "Illegal argument: optimization criterion must be one of the following: 'ASNH1', 'ASNIFH1', 'ASNsum'", - fixed = TRUE - ) - - expect_error(getDesignGroupSequential(typeOfDesign = C_TYPE_OF_DESIGN_AS_KD, gammaA = NA_real_), - "Missing argument: parameter 'gammaA' must be specified in design", - fixed = TRUE - ) - - expect_error(getDesignGroupSequential(typeOfDesign = C_TYPE_OF_DESIGN_AS_HSD, gammaA = NA_real_), - "Missing argument: parameter 'gammaA' must be specified in design", - fixed = TRUE - ) - - expect_error(getDesignGroupSequential(typeOfDesign = C_TYPE_OF_DESIGN_AS_USER), - "Missing argument: parameter 'userAlphaSpending' must be specified in design", - fixed = TRUE - ) - - expect_error(getDesignGroupSequential( - typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, - userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = "x" - ), - paste0( - "Illegal argument: type of beta spending must be one of the following: ", - "'none', 'bsP', 'bsOF', 'bsKD', 'bsHSD', 'bsUser'" - ), - fixed = TRUE - ) - - expect_error(getDesignGroupSequential( - typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, - userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER - ), - "Missing argument: parameter 'userBetaSpending' must be specified in design", - fixed = TRUE - ) - - expect_error(getDesignGroupSequential( - typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, - userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER, - userBetaSpending = c(0.1, 0.2) - ), - paste0( - "Conflicting arguments: length of 'userBetaSpending' (2) must ", - "be equal to length of 'informationRates' (3)" - ), - fixed = TRUE - ) - - expect_error(getDesignGroupSequential( - typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, - userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER, - userBetaSpending = c(0.2, 0.1, 0.05) - ), - paste0( - "'userBetaSpending' = c(0.2, 0.1, 0.05) must be a vector that satisfies the ", - "following condition: 0 <= beta_1 <= .. <= beta_3 <= beta = 0.05" - ), - fixed = TRUE - ) - - expect_error(getDesignGroupSequential( - typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, - userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER, - userBetaSpending = c(0.1, 0.2, 0.3), beta = 0.2 - ), - paste0( - "'userBetaSpending' = c(0.1, 0.2, 0.3) must be a vector that satisfies the ", - "following condition: 0 <= beta_1 <= .. <= beta_3 <= beta = 0.2" - ), - fixed = TRUE - ) - - expect_error(getDesignGroupSequential(kMax = Inf), - paste0( - "Argument out of bounds: 'kMax' (Inf) is out of bounds [1; ", - C_KMAX_UPPER_BOUND, "]" - ), - fixed = TRUE - ) - - expect_error(getDesignGroupSequential(kMax = -Inf), - paste0( - "Argument out of bounds: 'kMax' (-Inf) is out of bounds [1; ", - C_KMAX_UPPER_BOUND, "]" - ), - fixed = TRUE - ) - - expect_error(getDesignInverseNormal(kMax = -5), "Argument out of bounds: 'kMax' (-5) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 0), "Argument out of bounds: 'kMax' (0) is out of bounds [1; 20]", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 21), "Argument out of bounds: 'kMax' (21) is out of bounds [1; 20]", fixed = TRUE) - - expect_error(getDesignInverseNormal(kMax = 2, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (2) - 1", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 3, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (3) - 1", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 4, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (4) - 1", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 6, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (6) - 1", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 7, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (7) - 1", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 8, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (8) - 1", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 9, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (9) - 1", fixed = TRUE) - expect_error(getDesignInverseNormal(kMax = 10, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (10) - 1", fixed = TRUE) - - expect_warning(expect_error(getDesignInverseNormal(kMax = 11, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (11) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 12, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (12) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 13, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (13) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 14, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (14) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 15, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (15) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 16, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (16) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 17, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (17) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 18, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (18) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 19, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (19) - 1", fixed = TRUE)) - expect_warning(expect_error(getDesignInverseNormal(kMax = 20, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (20) - 1", fixed = TRUE)) - - expect_error(getDesignGroupSequential(futilityBounds = c(-7, 5)), - "Illegal argument: 'futilityBounds' (-7, 5) too extreme for this situation", - fixed = TRUE - ) - - expect_error(getDesignGroupSequential(futilityBounds = c(1, 7)), - "Argument out of bounds: 'futilityBounds' (1, 7) is out of bounds [-Inf; 6]", - fixed = TRUE - ) - -}) - +## | +## | *Unit tests* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | RPACT package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File name: test-f_design_group_sequential.R +## | Creation date: 08 November 2023, 09:09:43 +## | File version: $Revision$ +## | Last changed: $Date$ +## | Last changed by: $Author$ +## | + +test_plan_section("Testing the Group Sequential and Inverse Normal Design Functionality") + + +test_that("'getGroupSequentialProbabilities' with one and two continuation regions for weighted test statistic", { + # @refFS[Formula]{fs:testStatisticGroupSequentialWeightedAverage} + xa <- getGroupSequentialProbabilities(matrix(c(rep(-qnorm(0.95), 4), rep(qnorm(0.95), 4)), nrow = 2, byrow = TRUE), (1:4) / 4) + + ## Comparison of the results of matrixarray object 'xa' with expected results + expect_equal(xa[1, ], c(0.05, 0.030074925, 0.020961248, 0.01595848), tolerance = 1e-07, label = paste0("c(", paste0(xa[1, ], collapse = ", "), ")")) + expect_equal(xa[2, ], c(0.95, 0.86992507, 0.8188889, 0.78196917), tolerance = 1e-07, label = paste0("c(", paste0(xa[2, ], collapse = ", "), ")")) + expect_equal(xa[3, ], c(1, 0.9, 0.83985015, 0.79792765), tolerance = 1e-07, label = paste0("c(", paste0(xa[3, ], collapse = ", "), ")")) + + xb <- getGroupSequentialProbabilities(matrix(c(rep(-qnorm(0.95), 4), rep(-1, 4), rep(1, 4), rep(qnorm(0.95), 4)), nrow = 4, byrow = TRUE), (1:4) / 4) + + ## Comparison of the results of matrixarray object 'xb' with expected results + expect_equal(xb[1, ], c(0.05, 0.016446517, 0.005264288, 0.0019569508), tolerance = 1e-07, label = paste0("c(", paste0(xb[1, ], collapse = ", "), ")")) + expect_equal(xb[2, ], c(0.15865525, 0.048950554, 0.017478997, 0.0072417024), tolerance = 1e-07, label = paste0("c(", paste0(xb[2, ], collapse = ", "), ")")) + expect_equal(xb[3, ], c(0.84134475, 0.16835995, 0.047529077, 0.017187717), tolerance = 1e-07, label = paste0("c(", paste0(xb[3, ], collapse = ", "), ")")) + expect_equal(xb[4, ], c(0.95, 0.20086399, 0.059743786, 0.022472468), tolerance = 1e-07, label = paste0("c(", paste0(xb[4, ], collapse = ", "), ")")) + expect_equal(xb[5, ], c(1, 0.21731051, 0.065008074, 0.024429419), tolerance = 1e-07, label = paste0("c(", paste0(xb[5, ], collapse = ", "), ")")) + +}) + +test_that("'getDesignInverseNormal' with default parameters: parameters and results are as expected", { + + # @refFS[Tab.]{fs:tab:output:getDesignInverseNormal} + # @refFS[Formula]{fs:criticalValuesOBrienFleming} + x0 <- getDesignInverseNormal() + + ## Comparison of the results of TrialDesignInverseNormal object 'x0' with expected results + expect_equal(x0$alphaSpent, c(0.00025917372, 0.0071600594, 0.02499999), tolerance = 1e-07, label = paste0("c(", paste0(x0$alphaSpent, collapse = ", "), ")")) + expect_equal(x0$criticalValues, c(3.4710914, 2.4544323, 2.0040356), tolerance = 1e-07, label = paste0("c(", paste0(x0$criticalValues, collapse = ", "), ")")) + expect_equal(x0$stageLevels, c(0.00025917372, 0.0070553616, 0.022533125), tolerance = 1e-07, label = paste0("c(", paste0(x0$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x0), NA))) + expect_output(print(x0)$show()) + invisible(capture.output(expect_error(summary(x0), NA))) + expect_output(summary(x0)$show()) + x0CodeBased <- eval(parse(text = getObjectRCode(x0, stringWrapParagraphWidth = NULL))) + expect_equal(x0CodeBased$alphaSpent, x0$alphaSpent, tolerance = 1e-07) + expect_equal(x0CodeBased$criticalValues, x0$criticalValues, tolerance = 1e-07) + expect_equal(x0CodeBased$stageLevels, x0$stageLevels, tolerance = 1e-07) + expect_type(names(x0), "character") + df <- as.data.frame(x0) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x0) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignInverseNormal' with type of design = 'asHSD', 'bsHSD', 'asKD', and 'bsKD'", { + + .skipTestIfDisabled() + + # @refFS[Tab.]{fs:tab:output:getDesignInverseNormal} + # @refFS[Formula]{fs:alphaSpendingConcept} + # @refFS[Formula]{fs:alphaSpendingHwangShiDeCani} + x1 <- getDesignInverseNormal( + kMax = 3, informationRates = c(0.2, 0.4, 1), + alpha = 0.03, sided = 1, beta = 0.14, typeOfDesign = "asHSD", gammaA = 0 + ) + + ## Comparison of the results of TrialDesignInverseNormal object 'x1' with expected results + expect_equal(x1$alphaSpent, c(0.006, 0.012, 0.03), tolerance = 1e-07, label = paste0("c(", paste0(x1$alphaSpent, collapse = ", "), ")")) + expect_equal(x1$criticalValues, c(2.5121443, 2.4228747, 2.0280392), tolerance = 1e-07, label = paste0("c(", paste0(x1$criticalValues, collapse = ", "), ")")) + expect_equal(x1$stageLevels, c(0.006, 0.0076991188, 0.021278125), tolerance = 1e-07, label = paste0("c(", paste0(x1$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x1), NA))) + expect_output(print(x1)$show()) + invisible(capture.output(expect_error(summary(x1), NA))) + expect_output(summary(x1)$show()) + x1CodeBased <- eval(parse(text = getObjectRCode(x1, stringWrapParagraphWidth = NULL))) + expect_equal(x1CodeBased$alphaSpent, x1$alphaSpent, tolerance = 1e-07) + expect_equal(x1CodeBased$criticalValues, x1$criticalValues, tolerance = 1e-07) + expect_equal(x1CodeBased$stageLevels, x1$stageLevels, tolerance = 1e-07) + expect_type(names(x1), "character") + df <- as.data.frame(x1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignCharacteristics} + # @refFS[Formula]{fs:inflationFactor} + # @refFS[Formula]{fs:expectedReduction} + y1 <- getDesignCharacteristics(x1) + + ## Comparison of the results of TrialDesignCharacteristics object 'y1' with expected results + expect_equal(y1$nFixed, 8.7681899, tolerance = 1e-07, label = paste0("c(", paste0(y1$nFixed, collapse = ", "), ")")) + expect_equal(y1$shift, 9.4594101, tolerance = 1e-07, label = paste0("c(", paste0(y1$shift, collapse = ", "), ")")) + expect_equal(y1$inflationFactor, 1.0788327, tolerance = 1e-07, label = paste0("c(", paste0(y1$inflationFactor, collapse = ", "), ")")) + expect_equal(y1$information, c(1.891882, 3.7837641, 9.4594101), tolerance = 1e-07, label = paste0("c(", paste0(y1$information, collapse = ", "), ")")) + expect_equal(y1$power, c(0.12783451, 0.34055165, 0.86), tolerance = 1e-07, label = paste0("c(", paste0(y1$power, collapse = ", "), ")")) + expect_equal(y1$rejectionProbabilities, c(0.12783451, 0.21271713, 0.51944835), tolerance = 1e-07, label = paste0("c(", paste0(y1$rejectionProbabilities, collapse = ", "), ")")) + expect_equal(y1$futilityProbabilities, c(0, 0), label = paste0("c(", paste0(y1$futilityProbabilities, collapse = ", "), ")")) + expect_equal(y1$averageSampleNumber1, 0.83081135, tolerance = 1e-07, label = paste0("c(", paste0(y1$averageSampleNumber1, collapse = ", "), ")")) + expect_equal(y1$averageSampleNumber01, 1.0142116, tolerance = 1e-07, label = paste0("c(", paste0(y1$averageSampleNumber01, collapse = ", "), ")")) + expect_equal(y1$averageSampleNumber0, 1.0697705, tolerance = 1e-07, label = paste0("c(", paste0(y1$averageSampleNumber0, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(y1), NA))) + expect_output(print(y1)$show()) + invisible(capture.output(expect_error(summary(y1), NA))) + expect_output(summary(y1)$show()) + y1CodeBased <- eval(parse(text = getObjectRCode(y1, stringWrapParagraphWidth = NULL))) + expect_equal(y1CodeBased$nFixed, y1$nFixed, tolerance = 1e-07) + expect_equal(y1CodeBased$shift, y1$shift, tolerance = 1e-07) + expect_equal(y1CodeBased$inflationFactor, y1$inflationFactor, tolerance = 1e-07) + expect_equal(y1CodeBased$information, y1$information, tolerance = 1e-07) + expect_equal(y1CodeBased$power, y1$power, tolerance = 1e-07) + expect_equal(y1CodeBased$rejectionProbabilities, y1$rejectionProbabilities, tolerance = 1e-07) + expect_equal(y1CodeBased$futilityProbabilities, y1$futilityProbabilities, tolerance = 1e-07) + expect_equal(y1CodeBased$averageSampleNumber1, y1$averageSampleNumber1, tolerance = 1e-07) + expect_equal(y1CodeBased$averageSampleNumber01, y1$averageSampleNumber01, tolerance = 1e-07) + expect_equal(y1CodeBased$averageSampleNumber0, y1$averageSampleNumber0, tolerance = 1e-07) + expect_type(names(y1), "character") + df <- as.data.frame(y1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(y1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignInverseNormal} + # @refFS[Formula]{fs:alphaSpendingConcept} + # @refFS[Formula]{fs:alphaSpendingHwangShiDeCani} + # @refFS[Formula]{fs:betaSpendingApproach} + # @refFS[Formula]{fs:betaSpendingHwangShiDeCani} + x2 <- getDesignInverseNormal( + kMax = 3, informationRates = c(0.2, 0.4, 1), + alpha = 0.07, sided = 1, beta = 0.14, typeOfDesign = "asHSD", gammaA = -1, + typeBetaSpending = "bsHSD", gammaB = -2 + ) + + ## Comparison of the results of TrialDesignInverseNormal object 'x2' with expected results + expect_equal(x2$power, c(0.12038953, 0.32895265, 0.86), tolerance = 1e-07, label = paste0("c(", paste0(x2$power, collapse = ", "), ")")) + expect_equal(x2$futilityBounds, c(-1.1063623, -0.35992439), tolerance = 1e-07, label = paste0("c(", paste0(x2$futilityBounds, collapse = ", "), ")")) + expect_equal(x2$alphaSpent, c(0.0090195874, 0.020036136, 0.07), tolerance = 1e-07, label = paste0("c(", paste0(x2$alphaSpent, collapse = ", "), ")")) + expect_equal(x2$betaSpent, c(0.010777094, 0.026854629, 0.14), tolerance = 1e-07, label = paste0("c(", paste0(x2$betaSpent, collapse = ", "), ")")) + expect_equal(x2$criticalValues, c(2.364813, 2.1928805, 1.5660474), tolerance = 1e-07, label = paste0("c(", paste0(x2$criticalValues, collapse = ", "), ")")) + expect_equal(x2$stageLevels, c(0.0090195874, 0.014157994, 0.058668761), tolerance = 1e-07, label = paste0("c(", paste0(x2$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x2), NA))) + expect_output(print(x2)$show()) + invisible(capture.output(expect_error(summary(x2), NA))) + expect_output(summary(x2)$show()) + x2CodeBased <- eval(parse(text = getObjectRCode(x2, stringWrapParagraphWidth = NULL))) + expect_equal(x2CodeBased$power, x2$power, tolerance = 1e-07) + expect_equal(x2CodeBased$futilityBounds, x2$futilityBounds, tolerance = 1e-07) + expect_equal(x2CodeBased$alphaSpent, x2$alphaSpent, tolerance = 1e-07) + expect_equal(x2CodeBased$betaSpent, x2$betaSpent, tolerance = 1e-07) + expect_equal(x2CodeBased$criticalValues, x2$criticalValues, tolerance = 1e-07) + expect_equal(x2CodeBased$stageLevels, x2$stageLevels, tolerance = 1e-07) + expect_type(names(x2), "character") + df <- as.data.frame(x2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignCharacteristics} + # @refFS[Formula]{fs:inflationFactor} + # @refFS[Formula]{fs:expectedReduction} + y2 <- getDesignCharacteristics(x2) + + ## Comparison of the results of TrialDesignCharacteristics object 'y2' with expected results + expect_equal(y2$nFixed, 6.5337002, tolerance = 1e-07, label = paste0("c(", paste0(y2$nFixed, collapse = ", "), ")")) + expect_equal(y2$shift, 7.1015942, tolerance = 1e-07, label = paste0("c(", paste0(y2$shift, collapse = ", "), ")")) + expect_equal(y2$inflationFactor, 1.0869177, tolerance = 1e-07, label = paste0("c(", paste0(y2$inflationFactor, collapse = ", "), ")")) + expect_equal(y2$information, c(1.4203188, 2.8406377, 7.1015942), tolerance = 1e-07, label = paste0("c(", paste0(y2$information, collapse = ", "), ")")) + expect_equal(y2$power, c(0.12038953, 0.32895265, 0.86), tolerance = 1e-07, label = paste0("c(", paste0(y2$power, collapse = ", "), ")")) + expect_equal(y2$rejectionProbabilities, c(0.12038953, 0.20856311, 0.53104735), tolerance = 1e-07, label = paste0("c(", paste0(y2$rejectionProbabilities, collapse = ", "), ")")) + expect_equal(y2$futilityProbabilities, c(0.010777094, 0.016077535), tolerance = 1e-07, label = paste0("c(", paste0(y2$futilityProbabilities, collapse = ", "), ")")) + expect_equal(y2$averageSampleNumber1, 0.82636428, tolerance = 1e-07, label = paste0("c(", paste0(y2$averageSampleNumber1, collapse = ", "), ")")) + expect_equal(y2$averageSampleNumber01, 0.916142, tolerance = 1e-07, label = paste0("c(", paste0(y2$averageSampleNumber01, collapse = ", "), ")")) + expect_equal(y2$averageSampleNumber0, 0.79471657, tolerance = 1e-07, label = paste0("c(", paste0(y2$averageSampleNumber0, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(y2), NA))) + expect_output(print(y2)$show()) + invisible(capture.output(expect_error(summary(y2), NA))) + expect_output(summary(y2)$show()) + y2CodeBased <- eval(parse(text = getObjectRCode(y2, stringWrapParagraphWidth = NULL))) + expect_equal(y2CodeBased$nFixed, y2$nFixed, tolerance = 1e-07) + expect_equal(y2CodeBased$shift, y2$shift, tolerance = 1e-07) + expect_equal(y2CodeBased$inflationFactor, y2$inflationFactor, tolerance = 1e-07) + expect_equal(y2CodeBased$information, y2$information, tolerance = 1e-07) + expect_equal(y2CodeBased$power, y2$power, tolerance = 1e-07) + expect_equal(y2CodeBased$rejectionProbabilities, y2$rejectionProbabilities, tolerance = 1e-07) + expect_equal(y2CodeBased$futilityProbabilities, y2$futilityProbabilities, tolerance = 1e-07) + expect_equal(y2CodeBased$averageSampleNumber1, y2$averageSampleNumber1, tolerance = 1e-07) + expect_equal(y2CodeBased$averageSampleNumber01, y2$averageSampleNumber01, tolerance = 1e-07) + expect_equal(y2CodeBased$averageSampleNumber0, y2$averageSampleNumber0, tolerance = 1e-07) + expect_type(names(y2), "character") + df <- as.data.frame(y2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(y2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignInverseNormal} + # @refFS[Formula]{fs:alphaSpendingConcept} + # @refFS[Formula]{fs:alphaSpendingKimDeMets} + # @refFS[Formula]{fs:betaSpendingApproach} + # @refFS[Formula]{fs:betaSpendingKimDeMets} + x3 <- getDesignInverseNormal( + kMax = 3, informationRates = c(0.3, 0.7, 1), + alpha = 0.03, sided = 1, beta = 0.34, typeOfDesign = "asKD", gammaA = 2.2, + typeBetaSpending = "bsKD", gammaB = 3.2 + ) + + ## Comparison of the results of TrialDesignInverseNormal object 'x3' with expected results + expect_equal(x3$power, c(0.058336437, 0.398246, 0.66), tolerance = 1e-07, label = paste0("c(", paste0(x3$power, collapse = ", "), ")")) + expect_equal(x3$futilityBounds, c(-1.1558435, 0.72836893), tolerance = 1e-07, label = paste0("c(", paste0(x3$futilityBounds, collapse = ", "), ")")) + expect_equal(x3$alphaSpent, c(0.0021222083, 0.013687904, 0.03), tolerance = 1e-07, label = paste0("c(", paste0(x3$alphaSpent, collapse = ", "), ")")) + expect_equal(x3$betaSpent, c(0.0072155083, 0.1085907, 0.34), tolerance = 1e-07, label = paste0("c(", paste0(x3$betaSpent, collapse = ", "), ")")) + expect_equal(x3$criticalValues, c(2.8594012, 2.2435708, 1.9735737), tolerance = 1e-07, label = paste0("c(", paste0(x3$criticalValues, collapse = ", "), ")")) + expect_equal(x3$stageLevels, c(0.0021222083, 0.012430014, 0.02421512), tolerance = 1e-07, label = paste0("c(", paste0(x3$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x3), NA))) + expect_output(print(x3)$show()) + invisible(capture.output(expect_error(summary(x3), NA))) + expect_output(summary(x3)$show()) + x3CodeBased <- eval(parse(text = getObjectRCode(x3, stringWrapParagraphWidth = NULL))) + expect_equal(x3CodeBased$power, x3$power, tolerance = 1e-07) + expect_equal(x3CodeBased$futilityBounds, x3$futilityBounds, tolerance = 1e-07) + expect_equal(x3CodeBased$alphaSpent, x3$alphaSpent, tolerance = 1e-07) + expect_equal(x3CodeBased$betaSpent, x3$betaSpent, tolerance = 1e-07) + expect_equal(x3CodeBased$criticalValues, x3$criticalValues, tolerance = 1e-07) + expect_equal(x3CodeBased$stageLevels, x3$stageLevels, tolerance = 1e-07) + expect_type(names(x3), "character") + df <- as.data.frame(x3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignCharacteristics} + # @refFS[Formula]{fs:inflationFactor} + # @refFS[Formula]{fs:expectedReduction} + y3 <- getDesignCharacteristics(x3) + + ## Comparison of the results of TrialDesignCharacteristics object 'y3' with expected results + expect_equal(y3$nFixed, 5.2590265, tolerance = 1e-07, label = paste0("c(", paste0(y3$nFixed, collapse = ", "), ")")) + expect_equal(y3$shift, 5.551371, tolerance = 1e-07, label = paste0("c(", paste0(y3$shift, collapse = ", "), ")")) + expect_equal(y3$inflationFactor, 1.0555891, tolerance = 1e-07, label = paste0("c(", paste0(y3$inflationFactor, collapse = ", "), ")")) + expect_equal(y3$information, c(1.6654113, 3.8859597, 5.551371), tolerance = 1e-07, label = paste0("c(", paste0(y3$information, collapse = ", "), ")")) + expect_equal(y3$power, c(0.058336437, 0.398246, 0.66), tolerance = 1e-07, label = paste0("c(", paste0(y3$power, collapse = ", "), ")")) + expect_equal(y3$rejectionProbabilities, c(0.058336437, 0.33990957, 0.261754), tolerance = 1e-07, label = paste0("c(", paste0(y3$rejectionProbabilities, collapse = ", "), ")")) + expect_equal(y3$futilityProbabilities, c(0.0072155083, 0.1013752), tolerance = 1e-07, label = paste0("c(", paste0(y3$futilityProbabilities, collapse = ", "), ")")) + expect_equal(y3$averageSampleNumber1, 0.86740735, tolerance = 1e-07, label = paste0("c(", paste0(y3$averageSampleNumber1, collapse = ", "), ")")) + expect_equal(y3$averageSampleNumber01, 0.87361707, tolerance = 1e-07, label = paste0("c(", paste0(y3$averageSampleNumber01, collapse = ", "), ")")) + expect_equal(y3$averageSampleNumber0, 0.75480974, tolerance = 1e-07, label = paste0("c(", paste0(y3$averageSampleNumber0, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(y3), NA))) + expect_output(print(y3)$show()) + invisible(capture.output(expect_error(summary(y3), NA))) + expect_output(summary(y3)$show()) + y3CodeBased <- eval(parse(text = getObjectRCode(y3, stringWrapParagraphWidth = NULL))) + expect_equal(y3CodeBased$nFixed, y3$nFixed, tolerance = 1e-07) + expect_equal(y3CodeBased$shift, y3$shift, tolerance = 1e-07) + expect_equal(y3CodeBased$inflationFactor, y3$inflationFactor, tolerance = 1e-07) + expect_equal(y3CodeBased$information, y3$information, tolerance = 1e-07) + expect_equal(y3CodeBased$power, y3$power, tolerance = 1e-07) + expect_equal(y3CodeBased$rejectionProbabilities, y3$rejectionProbabilities, tolerance = 1e-07) + expect_equal(y3CodeBased$futilityProbabilities, y3$futilityProbabilities, tolerance = 1e-07) + expect_equal(y3CodeBased$averageSampleNumber1, y3$averageSampleNumber1, tolerance = 1e-07) + expect_equal(y3CodeBased$averageSampleNumber01, y3$averageSampleNumber01, tolerance = 1e-07) + expect_equal(y3CodeBased$averageSampleNumber0, y3$averageSampleNumber0, tolerance = 1e-07) + expect_type(names(y3), "character") + df <- as.data.frame(y3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(y3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignInverseNormal' with binding futility bounds", { + + # @refFS[Tab.]{fs:tab:output:getDesignInverseNormal} + # @refFS[Formula]{fs:criticalValuesWithFutility} + # @refFS[Formula]{fs:criticalValuesWangTiatis} + x4 <- getDesignInverseNormal( + kMax = 4, alpha = 0.035, futilityBounds = rep(0.5244, 3), + bindingFutility = TRUE, typeOfDesign = "WT", deltaWT = 0.4 + ) + + ## Comparison of the results of TrialDesignInverseNormal object 'x4' with expected results + expect_equal(x4$alphaSpent, c(0.0099446089, 0.020756912, 0.029001537, 0.03499999), tolerance = 1e-07, label = paste0("c(", paste0(x4$alphaSpent, collapse = ", "), ")")) + expect_equal(x4$criticalValues, c(2.3284312, 2.1725031, 2.0861776, 2.0270171), tolerance = 1e-07, label = paste0("c(", paste0(x4$criticalValues, collapse = ", "), ")")) + expect_equal(x4$stageLevels, c(0.0099446089, 0.014908866, 0.018481267, 0.021330332), tolerance = 1e-07, label = paste0("c(", paste0(x4$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x4), NA))) + expect_output(print(x4)$show()) + invisible(capture.output(expect_error(summary(x4), NA))) + expect_output(summary(x4)$show()) + x4CodeBased <- eval(parse(text = getObjectRCode(x4, stringWrapParagraphWidth = NULL))) + expect_equal(x4CodeBased$alphaSpent, x4$alphaSpent, tolerance = 1e-07) + expect_equal(x4CodeBased$criticalValues, x4$criticalValues, tolerance = 1e-07) + expect_equal(x4CodeBased$stageLevels, x4$stageLevels, tolerance = 1e-07) + expect_type(names(x4), "character") + df <- as.data.frame(x4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignGroupSequential' with type of design = 'asUser'", { + + .skipTestIfDisabled() + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:alphaSpendingConcept} + x5 <- getDesignGroupSequential( + typeOfDesign = "asUser", + userAlphaSpending = c(0.01, 0.02, 0.03, 0.05) + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x5' with expected results + expect_equal(x5$alphaSpent, c(0.01, 0.02, 0.03, 0.04999999), tolerance = 1e-07, label = paste0("c(", paste0(x5$alphaSpent, collapse = ", "), ")")) + expect_equal(x5$criticalValues, c(2.3263479, 2.2192994, 2.1201347, 1.8189562), tolerance = 1e-07, label = paste0("c(", paste0(x5$criticalValues, collapse = ", "), ")")) + expect_equal(x5$stageLevels, c(0.01, 0.01323318, 0.016997342, 0.034459057), tolerance = 1e-07, label = paste0("c(", paste0(x5$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x5), NA))) + expect_output(print(x5)$show()) + invisible(capture.output(expect_error(summary(x5), NA))) + expect_output(summary(x5)$show()) + x5CodeBased <- eval(parse(text = getObjectRCode(x5, stringWrapParagraphWidth = NULL))) + expect_equal(x5CodeBased$alphaSpent, x5$alphaSpent, tolerance = 1e-07) + expect_equal(x5CodeBased$criticalValues, x5$criticalValues, tolerance = 1e-07) + expect_equal(x5CodeBased$stageLevels, x5$stageLevels, tolerance = 1e-07) + expect_type(names(x5), "character") + df <- as.data.frame(x5) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x5) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignGroupSequential' with type of design = 'asP' and 'bsUser' and non-binding futility bounds", { + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:alphaSpendingConcept} + # @refFS[Formula]{fs:alphaSpendingPocock} + # @refFS[Formula]{fs:betaSpendingApproach} + x6a <- getDesignGroupSequential( + kMax = 3, alpha = 0.13, + typeOfDesign = "asP", typeBetaSpending = "bsUser", + informationRates = c(0.35, 0.7, 1), + bindingFutility = FALSE, + userBetaSpending = c(0.01, 0.05, 0.3) + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x6a' with expected results + expect_equal(x6a$power, c(0.31774348, 0.5598179, 0.7), tolerance = 1e-07, label = paste0("c(", paste0(x6a$power, collapse = ", "), ")")) + expect_equal(x6a$futilityBounds, c(-1.2557044, -0.16828659), tolerance = 1e-07, label = paste0("c(", paste0(x6a$futilityBounds, collapse = ", "), ")")) + expect_equal(x6a$alphaSpent, c(0.061214062, 0.10266465, 0.13), tolerance = 1e-07, label = paste0("c(", paste0(x6a$alphaSpent, collapse = ", "), ")")) + expect_equal(x6a$betaSpent, c(0.01, 0.05, 0.3), tolerance = 1e-07, label = paste0("c(", paste0(x6a$betaSpent, collapse = ", "), ")")) + expect_equal(x6a$criticalValues, c(1.5446617, 1.4828682, 1.4620058), tolerance = 1e-07, label = paste0("c(", paste0(x6a$criticalValues, collapse = ", "), ")")) + expect_equal(x6a$stageLevels, c(0.061214062, 0.069054712, 0.071869812), tolerance = 1e-07, label = paste0("c(", paste0(x6a$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x6a), NA))) + expect_output(print(x6a)$show()) + invisible(capture.output(expect_error(summary(x6a), NA))) + expect_output(summary(x6a)$show()) + x6aCodeBased <- eval(parse(text = getObjectRCode(x6a, stringWrapParagraphWidth = NULL))) + expect_equal(x6aCodeBased$power, x6a$power, tolerance = 1e-07) + expect_equal(x6aCodeBased$futilityBounds, x6a$futilityBounds, tolerance = 1e-07) + expect_equal(x6aCodeBased$alphaSpent, x6a$alphaSpent, tolerance = 1e-07) + expect_equal(x6aCodeBased$betaSpent, x6a$betaSpent, tolerance = 1e-07) + expect_equal(x6aCodeBased$criticalValues, x6a$criticalValues, tolerance = 1e-07) + expect_equal(x6aCodeBased$stageLevels, x6a$stageLevels, tolerance = 1e-07) + expect_type(names(x6a), "character") + df <- as.data.frame(x6a) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x6a) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignGroupSequential' with type of design = 'asP' and information rate < 1 at maximum stage", { + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:alphaSpendingConcept} + # @refFS[Formula]{fs:alphaSpendingPocock} + x6b <- getDesignGroupSequential(informationRates = c(0.4, 0.7), typeOfDesign = "asP") + + ## Comparison of the results of TrialDesignGroupSequential object 'x6b' with expected results + expect_equal(x6b$alphaSpent, c(0.013078429, 0.0197432), tolerance = 1e-07, label = paste0("c(", paste0(x6b$alphaSpent, collapse = ", "), ")")) + expect_equal(x6b$criticalValues, c(2.223875, 2.3050796), tolerance = 1e-07, label = paste0("c(", paste0(x6b$criticalValues, collapse = ", "), ")")) + expect_equal(x6b$stageLevels, c(0.013078429, 0.010581057), tolerance = 1e-07, label = paste0("c(", paste0(x6b$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x6b), NA))) + expect_output(print(x6b)$show()) + invisible(capture.output(expect_error(summary(x6b), NA))) + expect_output(summary(x6b)$show()) + x6bCodeBased <- eval(parse(text = getObjectRCode(x6b, stringWrapParagraphWidth = NULL))) + expect_equal(x6bCodeBased$alphaSpent, x6b$alphaSpent, tolerance = 1e-07) + expect_equal(x6bCodeBased$criticalValues, x6b$criticalValues, tolerance = 1e-07) + expect_equal(x6bCodeBased$stageLevels, x6b$stageLevels, tolerance = 1e-07) + expect_type(names(x6b), "character") + df <- as.data.frame(x6b) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x6b) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignGroupSequential' with type of design = 'asOF' and 'bsKD' and non-binding futility bounds (kMax = 3)", { + + .skipTestIfDisabled() + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:alphaSpendingConcept} + # @refFS[Formula]{fs:alphaSpendingOBrienFleming} + # @refFS[Formula]{fs:betaSpendingApproach} + # @refFS[Formula]{fs:betaSpendingKimDeMets} + x7a <- getDesignGroupSequential( + kMax = 3, alpha = 0.13, beta = 0.41, + typeOfDesign = "asOF", typeBetaSpending = "bsKD", + informationRates = c(0.4, 0.75, 1), + gammaB = 2.5, bindingFutility = FALSE + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x7a' with expected results + expect_equal(x7a$power, c(0.10903632, 0.42541278, 0.59), tolerance = 1e-07, label = paste0("c(", paste0(x7a$power, collapse = ", "), ")")) + expect_equal(x7a$futilityBounds, c(-0.83725762, 0.35992547), tolerance = 1e-07, label = paste0("c(", paste0(x7a$futilityBounds, collapse = ", "), ")")) + expect_equal(x7a$alphaSpent, c(0.016665509, 0.080406163, 0.12999999), tolerance = 1e-07, label = paste0("c(", paste0(x7a$alphaSpent, collapse = ", "), ")")) + expect_equal(x7a$betaSpent, c(0.041489083, 0.19972711, 0.41), tolerance = 1e-07, label = paste0("c(", paste0(x7a$betaSpent, collapse = ", "), ")")) + expect_equal(x7a$criticalValues, c(2.1280732, 1.4368565, 1.2468994), tolerance = 1e-07, label = paste0("c(", paste0(x7a$criticalValues, collapse = ", "), ")")) + expect_equal(x7a$stageLevels, c(0.016665509, 0.075379384, 0.1062172), tolerance = 1e-07, label = paste0("c(", paste0(x7a$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x7a), NA))) + expect_output(print(x7a)$show()) + invisible(capture.output(expect_error(summary(x7a), NA))) + expect_output(summary(x7a)$show()) + x7aCodeBased <- eval(parse(text = getObjectRCode(x7a, stringWrapParagraphWidth = NULL))) + expect_equal(x7aCodeBased$power, x7a$power, tolerance = 1e-07) + expect_equal(x7aCodeBased$futilityBounds, x7a$futilityBounds, tolerance = 1e-07) + expect_equal(x7aCodeBased$alphaSpent, x7a$alphaSpent, tolerance = 1e-07) + expect_equal(x7aCodeBased$betaSpent, x7a$betaSpent, tolerance = 1e-07) + expect_equal(x7aCodeBased$criticalValues, x7a$criticalValues, tolerance = 1e-07) + expect_equal(x7aCodeBased$stageLevels, x7a$stageLevels, tolerance = 1e-07) + expect_type(names(x7a), "character") + df <- as.data.frame(x7a) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x7a) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignGroupSequential' with type of design = 'asOF' and 'bsKD' and non-binding futility bounds (kMax = 4)", { + + .skipTestIfDisabled() + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:alphaSpendingConcept} + # @refFS[Formula]{fs:alphaSpendingOBrienFleming} + # @refFS[Formula]{fs:betaSpendingApproach} + # @refFS[Formula]{fs:betaSpendingKimDeMets} + x7a <- getDesignGroupSequential( + kMax = 4, alpha = 0.13, beta = 0.41, + typeOfDesign = "asOF", typeBetaSpending = "bsKD", + informationRates = c(0.4, 0.75, 0.85, 1), + gammaB = 2.5, bindingFutility = FALSE + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x7a' with expected results + expect_equal(x7a$power, c(0.1110095, 0.43099683, 0.50326205, 0.59), tolerance = 1e-07, label = paste0("c(", paste0(x7a$power, collapse = ", "), ")")) + expect_equal(x7a$futilityBounds, c(-0.82676531, 0.3743303, 0.65077266), tolerance = 1e-07, label = paste0("c(", paste0(x7a$futilityBounds, collapse = ", "), ")")) + expect_equal(x7a$alphaSpent, c(0.016665509, 0.080406163, 0.10053322, 0.13), tolerance = 1e-07, label = paste0("c(", paste0(x7a$alphaSpent, collapse = ", "), ")")) + expect_equal(x7a$betaSpent, c(0.041489083, 0.19972711, 0.27310596, 0.41), tolerance = 1e-07, label = paste0("c(", paste0(x7a$betaSpent, collapse = ", "), ")")) + expect_equal(x7a$criticalValues, c(2.1280732, 1.4368565, 1.422873, 1.2970881), tolerance = 1e-07, label = paste0("c(", paste0(x7a$criticalValues, collapse = ", "), ")")) + expect_equal(x7a$stageLevels, c(0.016665509, 0.075379384, 0.077386492, 0.097300444), tolerance = 1e-07, label = paste0("c(", paste0(x7a$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x7a), NA))) + expect_output(print(x7a)$show()) + invisible(capture.output(expect_error(summary(x7a), NA))) + expect_output(summary(x7a)$show()) + x7aCodeBased <- eval(parse(text = getObjectRCode(x7a, stringWrapParagraphWidth = NULL))) + expect_equal(x7aCodeBased$power, x7a$power, tolerance = 1e-07) + expect_equal(x7aCodeBased$futilityBounds, x7a$futilityBounds, tolerance = 1e-07) + expect_equal(x7aCodeBased$alphaSpent, x7a$alphaSpent, tolerance = 1e-07) + expect_equal(x7aCodeBased$betaSpent, x7a$betaSpent, tolerance = 1e-07) + expect_equal(x7aCodeBased$criticalValues, x7a$criticalValues, tolerance = 1e-07) + expect_equal(x7aCodeBased$stageLevels, x7a$stageLevels, tolerance = 1e-07) + expect_type(names(x7a), "character") + df <- as.data.frame(x7a) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x7a) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignGroupSequential' with type of design = 'asP' and 'bsUser' and binding futility bounds", { + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:alphaSpendingConcept} + # @refFS[Formula]{fs:alphaSpendingPocock} + # @refFS[Formula]{fs:betaSpendingApproach} + x6b <- getDesignGroupSequential( + kMax = 3, alpha = 0.13, + typeOfDesign = "asP", typeBetaSpending = "bsUser", + informationRates = c(0.35, 0.7, 1), + bindingFutility = TRUE, + userBetaSpending = c(0.01, 0.05, 0.3) + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x6b' with expected results + expect_equal(x6b$power, c(0.31728597, 0.55917233, 0.7), tolerance = 1e-07, label = paste0("c(", paste0(x6b$power, collapse = ", "), ")")) + expect_equal(x6b$futilityBounds, c(-1.2569879, -0.17011271), tolerance = 1e-07, label = paste0("c(", paste0(x6b$futilityBounds, collapse = ", "), ")")) + expect_equal(x6b$alphaSpent, c(0.061214062, 0.10266465, 0.13), tolerance = 1e-07, label = paste0("c(", paste0(x6b$alphaSpent, collapse = ", "), ")")) + expect_equal(x6b$betaSpent, c(0.01, 0.05, 0.3), tolerance = 1e-07, label = paste0("c(", paste0(x6b$betaSpent, collapse = ", "), ")")) + expect_equal(x6b$criticalValues, c(1.5446617, 1.4827312, 1.4588737), tolerance = 1e-07, label = paste0("c(", paste0(x6b$criticalValues, collapse = ", "), ")")) + expect_equal(x6b$stageLevels, c(0.061214062, 0.069072925, 0.072299935), tolerance = 1e-07, label = paste0("c(", paste0(x6b$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x6b), NA))) + expect_output(print(x6b)$show()) + invisible(capture.output(expect_error(summary(x6b), NA))) + expect_output(summary(x6b)$show()) + x6bCodeBased <- eval(parse(text = getObjectRCode(x6b, stringWrapParagraphWidth = NULL))) + expect_equal(x6bCodeBased$power, x6b$power, tolerance = 1e-07) + expect_equal(x6bCodeBased$futilityBounds, x6b$futilityBounds, tolerance = 1e-07) + expect_equal(x6bCodeBased$alphaSpent, x6b$alphaSpent, tolerance = 1e-07) + expect_equal(x6bCodeBased$betaSpent, x6b$betaSpent, tolerance = 1e-07) + expect_equal(x6bCodeBased$criticalValues, x6b$criticalValues, tolerance = 1e-07) + expect_equal(x6bCodeBased$stageLevels, x6b$stageLevels, tolerance = 1e-07) + expect_type(names(x6b), "character") + df <- as.data.frame(x6b) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x6b) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignGroupSequential' with type of design = 'asOF' and 'bsKD' and binding futility bounds (kMax = 3)", { + + .skipTestIfDisabled() + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:alphaSpendingConcept} + # @refFS[Formula]{fs:alphaSpendingOBrienFleming} + # @refFS[Formula]{fs:betaSpendingApproach} + # @refFS[Formula]{fs:betaSpendingKimDeMets} + x7b <- getDesignGroupSequential( + kMax = 3, alpha = 0.13, beta = 0.41, + typeOfDesign = "asOF", typeBetaSpending = "bsKD", + informationRates = c(0.4, 0.75, 1), + gammaB = 2.5, bindingFutility = TRUE + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x7b' with expected results + expect_equal(x7b$power, c(0.1067887, 0.41918821, 0.59), tolerance = 1e-07, label = paste0("c(", paste0(x7b$power, collapse = ", "), ")")) + expect_equal(x7b$futilityBounds, c(-0.84937686, 0.34328914), tolerance = 1e-07, label = paste0("c(", paste0(x7b$futilityBounds, collapse = ", "), ")")) + expect_equal(x7b$alphaSpent, c(0.016665509, 0.080406163, 0.12999999), tolerance = 1e-07, label = paste0("c(", paste0(x7b$alphaSpent, collapse = ", "), ")")) + expect_equal(x7b$betaSpent, c(0.041489083, 0.19972711, 0.41), tolerance = 1e-07, label = paste0("c(", paste0(x7b$betaSpent, collapse = ", "), ")")) + expect_equal(x7b$criticalValues, c(2.1280732, 1.4362896, 1.2218662), tolerance = 1e-07, label = paste0("c(", paste0(x7b$criticalValues, collapse = ", "), ")")) + expect_equal(x7b$stageLevels, c(0.016665509, 0.075459972, 0.11087911), tolerance = 1e-07, label = paste0("c(", paste0(x7b$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x7b), NA))) + expect_output(print(x7b)$show()) + invisible(capture.output(expect_error(summary(x7b), NA))) + expect_output(summary(x7b)$show()) + x7bCodeBased <- eval(parse(text = getObjectRCode(x7b, stringWrapParagraphWidth = NULL))) + expect_equal(x7bCodeBased$power, x7b$power, tolerance = 1e-07) + expect_equal(x7bCodeBased$futilityBounds, x7b$futilityBounds, tolerance = 1e-07) + expect_equal(x7bCodeBased$alphaSpent, x7b$alphaSpent, tolerance = 1e-07) + expect_equal(x7bCodeBased$betaSpent, x7b$betaSpent, tolerance = 1e-07) + expect_equal(x7bCodeBased$criticalValues, x7b$criticalValues, tolerance = 1e-07) + expect_equal(x7bCodeBased$stageLevels, x7b$stageLevels, tolerance = 1e-07) + expect_type(names(x7b), "character") + df <- as.data.frame(x7b) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x7b) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignGroupSequential' with type of design = 'asOF' and 'bsKD' and binding futility bounds (kMax = 4)", { + + .skipTestIfDisabled() + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:alphaSpendingConcept} + # @refFS[Formula]{fs:alphaSpendingOBrienFleming} + # @refFS[Formula]{fs:betaSpendingApproach} + # @refFS[Formula]{fs:betaSpendingKimDeMets} + x7b <- getDesignGroupSequential( + kMax = 4, alpha = 0.13, beta = 0.41, + typeOfDesign = "asOF", typeBetaSpending = "bsKD", + informationRates = c(0.4, 0.75, 0.85, 1), + gammaB = 2.5, bindingFutility = TRUE + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x7b' with expected results + expect_equal(x7b$power, c(0.10806422, 0.422855, 0.4950578, 0.59), tolerance = 1e-07, label = paste0("c(", paste0(x7b$power, collapse = ", "), ")")) + expect_equal(x7b$futilityBounds, c(-0.84247693, 0.35276055, 0.62744509), tolerance = 1e-07, label = paste0("c(", paste0(x7b$futilityBounds, collapse = ", "), ")")) + expect_equal(x7b$alphaSpent, c(0.016665509, 0.080406163, 0.10053322, 0.13), tolerance = 1e-07, label = paste0("c(", paste0(x7b$alphaSpent, collapse = ", "), ")")) + expect_equal(x7b$betaSpent, c(0.041489083, 0.19972711, 0.27310596, 0.41), tolerance = 1e-07, label = paste0("c(", paste0(x7b$betaSpent, collapse = ", "), ")")) + expect_equal(x7b$criticalValues, c(2.1280732, 1.4362706, 1.4203748, 1.2576258), tolerance = 1e-07, label = paste0("c(", paste0(x7b$criticalValues, collapse = ", "), ")")) + expect_equal(x7b$stageLevels, c(0.016665509, 0.075462674, 0.077749297, 0.10426357), tolerance = 1e-07, label = paste0("c(", paste0(x7b$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x7b), NA))) + expect_output(print(x7b)$show()) + invisible(capture.output(expect_error(summary(x7b), NA))) + expect_output(summary(x7b)$show()) + x7bCodeBased <- eval(parse(text = getObjectRCode(x7b, stringWrapParagraphWidth = NULL))) + expect_equal(x7bCodeBased$power, x7b$power, tolerance = 1e-07) + expect_equal(x7bCodeBased$futilityBounds, x7b$futilityBounds, tolerance = 1e-07) + expect_equal(x7bCodeBased$alphaSpent, x7b$alphaSpent, tolerance = 1e-07) + expect_equal(x7bCodeBased$betaSpent, x7b$betaSpent, tolerance = 1e-07) + expect_equal(x7bCodeBased$criticalValues, x7b$criticalValues, tolerance = 1e-07) + expect_equal(x7bCodeBased$stageLevels, x7b$stageLevels, tolerance = 1e-07) + expect_type(names(x7b), "character") + df <- as.data.frame(x7b) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x7b) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignGroupSequential' with type of design = 'asOF' and 'bsKD' and binding futility bounds, two-sided (kMax = 3)", { + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:alphaSpendingConcept} + # @refFS[Formula]{fs:alphaSpendingOBrienFleming} + # @refFS[Formula]{fs:betaSpendingApproach} + # @refFS[Formula]{fs:betaSpendingKimDeMets} + # @refFS[Formula]{fs:betaSpendingApproachTwoSided} + # @refFS[Formula]{fs:betaSpendingAdjustment} + suppressWarnings(x7c <- getDesignGroupSequential( + kMax = 3, alpha = 0.09, beta = 0.11, sided = 2, + typeOfDesign = "asOF", typeBetaSpending = "bsKD", + informationRates = c(0.2, 0.55, 1), + gammaB = 2.5, bindingFutility = TRUE + )) + + ## Comparison of the results of TrialDesignGroupSequential object 'x7c' with expected results + expect_equal(x7c$power, c(0.0013105743, 0.39377047, 0.889997), tolerance = 1e-07, label = paste0("c(", paste0(x7c$power, collapse = ", "), ")")) + expect_equal(x7c$futilityBounds, c(NA_real_, 0.30419861), tolerance = 1e-07, label = paste0("c(", paste0(x7c$futilityBounds, collapse = ", "), ")")) + expect_equal(x7c$alphaSpent, c(1.475171e-05, 0.013740227, 0.09), tolerance = 1e-07, label = paste0("c(", paste0(x7c$alphaSpent, collapse = ", "), ")")) + expect_equal(x7c$betaSpent, c(0, 0.023123303, 0.11), tolerance = 1e-07, label = paste0("c(", paste0(x7c$betaSpent, collapse = ", "), ")")) + expect_equal(x7c$criticalValues, c(4.3323635, 2.4641251, 1.7013171), tolerance = 1e-07, label = paste0("c(", paste0(x7c$criticalValues, collapse = ", "), ")")) + expect_equal(x7c$stageLevels, c(7.375855e-06, 0.006867409, 0.044441733), tolerance = 1e-07, label = paste0("c(", paste0(x7c$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x7c), NA))) + expect_output(print(x7c)$show()) + invisible(capture.output(expect_error(summary(x7c), NA))) + expect_output(summary(x7c)$show()) + suppressWarnings(x7cCodeBased <- eval(parse(text = getObjectRCode(x7c, stringWrapParagraphWidth = NULL)))) + expect_equal(x7cCodeBased$power, x7c$power, tolerance = 1e-07) + expect_equal(x7cCodeBased$futilityBounds, x7c$futilityBounds, tolerance = 1e-07) + expect_equal(x7cCodeBased$alphaSpent, x7c$alphaSpent, tolerance = 1e-07) + expect_equal(x7cCodeBased$betaSpent, x7c$betaSpent, tolerance = 1e-07) + expect_equal(x7cCodeBased$criticalValues, x7c$criticalValues, tolerance = 1e-07) + expect_equal(x7cCodeBased$stageLevels, x7c$stageLevels, tolerance = 1e-07) + expect_type(names(x7c), "character") + df <- as.data.frame(x7c) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x7c) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + suppressWarnings(x7d <- getDesignGroupSequential( + kMax = 3, alpha = 0.05, beta = 0.2, sided = 2, + typeOfDesign = "asOF", typeBetaSpending = "bsKD", + informationRates = c(0.4, 0.65, 1), + gammaB = 1.5, bindingFutility = TRUE + )) + + ## Comparison of the results of TrialDesignGroupSequential object 'x7d' with expected results + expect_equal(x7d$power, c(0.063122463, 0.41229849, 0.79999885), tolerance = 1e-07, label = paste0("c(", paste0(x7d$power, collapse = ", "), ")")) + expect_equal(x7d$futilityBounds, c(0.32391511, 0.91946811), tolerance = 1e-07, label = paste0("c(", paste0(x7d$futilityBounds, collapse = ", "), ")")) + expect_equal(x7d$alphaSpent, c(0.00078830351, 0.010867832, 0.04999999), tolerance = 1e-07, label = paste0("c(", paste0(x7d$alphaSpent, collapse = ", "), ")")) + expect_equal(x7d$betaSpent, c(0.050596443, 0.10480935, 0.2), tolerance = 1e-07, label = paste0("c(", paste0(x7d$betaSpent, collapse = ", "), ")")) + expect_equal(x7d$criticalValues, c(3.3568694, 2.5549656, 1.9350784), tolerance = 1e-07, label = paste0("c(", paste0(x7d$criticalValues, collapse = ", "), ")")) + expect_equal(x7d$stageLevels, c(0.00039415176, 0.0053099152, 0.026490337), tolerance = 1e-07, label = paste0("c(", paste0(x7d$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x7d), NA))) + expect_output(print(x7d)$show()) + invisible(capture.output(expect_error(summary(x7d), NA))) + expect_output(summary(x7d)$show()) + suppressWarnings(x7dCodeBased <- eval(parse(text = getObjectRCode(x7d, stringWrapParagraphWidth = NULL)))) + expect_equal(x7dCodeBased$power, x7d$power, tolerance = 1e-07) + expect_equal(x7dCodeBased$futilityBounds, x7d$futilityBounds, tolerance = 1e-07) + expect_equal(x7dCodeBased$alphaSpent, x7d$alphaSpent, tolerance = 1e-07) + expect_equal(x7dCodeBased$betaSpent, x7d$betaSpent, tolerance = 1e-07) + expect_equal(x7dCodeBased$criticalValues, x7d$criticalValues, tolerance = 1e-07) + expect_equal(x7dCodeBased$stageLevels, x7d$stageLevels, tolerance = 1e-07) + expect_type(names(x7d), "character") + df <- as.data.frame(x7d) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x7d) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignGroupSequential' with type of design = 'asOF' and 'bsKD' and non-binding futility bounds, no betaAdjustment, two-sided (kMax = 3)", { + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:alphaSpendingConcept} + # @refFS[Formula]{fs:alphaSpendingOBrienFleming} + # @refFS[Formula]{fs:betaSpendingApproach} + # @refFS[Formula]{fs:betaSpendingKimDeMets} + # @refFS[Formula]{fs:betaSpendingApproachTwoSided} + # @refFS[Formula]{fs:betaSpendingAdjustment} + suppressWarnings(x7e <- getDesignGroupSequential( + kMax = 3, alpha = 0.09, beta = 0.11, sided = 2, + typeOfDesign = "asOF", typeBetaSpending = "bsKD", + informationRates = c(0.4, 0.65, 1), + betaAdjustment = FALSE, + gammaB = 2.5, bindingFutility = FALSE + )) + + ## Comparison of the results of TrialDesignGroupSequential object 'x7e' with expected results + expect_equal(x7e$power, c(0.14268064, 0.57037981, 0.88999701), tolerance = 1e-07, label = paste0("c(", paste0(x7e$power, collapse = ", "), ")")) + expect_equal(x7e$futilityBounds, c(NA_real_, 0.64692592), tolerance = 1e-07, label = paste0("c(", paste0(x7e$futilityBounds, collapse = ", "), ")")) + expect_equal(x7e$alphaSpent, c(0.0030525896, 0.025803646, 0.09), tolerance = 1e-07, label = paste0("c(", paste0(x7e$alphaSpent, collapse = ", "), ")")) + expect_equal(x7e$betaSpent, c(0, 0.037469343, 0.11), tolerance = 1e-07, label = paste0("c(", paste0(x7e$betaSpent, collapse = ", "), ")")) + expect_equal(x7e$criticalValues, c(2.9623919, 2.2442359, 1.7391729), tolerance = 1e-07, label = paste0("c(", paste0(x7e$criticalValues, collapse = ", "), ")")) + expect_equal(x7e$stageLevels, c(0.0015262948, 0.012408614, 0.041002179), tolerance = 1e-07, label = paste0("c(", paste0(x7e$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x7e), NA))) + expect_output(print(x7e)$show()) + invisible(capture.output(expect_error(summary(x7e), NA))) + expect_output(summary(x7e)$show()) + suppressWarnings(x7eCodeBased <- eval(parse(text = getObjectRCode(x7e, stringWrapParagraphWidth = NULL)))) + expect_equal(x7eCodeBased$power, x7e$power, tolerance = 1e-07) + expect_equal(x7eCodeBased$futilityBounds, x7e$futilityBounds, tolerance = 1e-07) + expect_equal(x7eCodeBased$alphaSpent, x7e$alphaSpent, tolerance = 1e-07) + expect_equal(x7eCodeBased$betaSpent, x7e$betaSpent, tolerance = 1e-07) + expect_equal(x7eCodeBased$criticalValues, x7e$criticalValues, tolerance = 1e-07) + expect_equal(x7eCodeBased$stageLevels, x7e$stageLevels, tolerance = 1e-07) + expect_type(names(x7e), "character") + df <- as.data.frame(x7e) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x7e) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignGroupSequential' with type of design = 'asOF' and 'bsOF', binding futility bounds and delayed response (kMax = 3)", { + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:alphaSpendingConcept} + # @refFS[Formula]{fs:alphaSpendingOBrienFleming} + # @refFS[Formula]{fs:betaSpendingApproach} + # @refFS[Formula]{fs:betaSpendingOBrienFleming} + # @refFS[Formula]{fs:delayedResponseCondition1} + # @refFS[Formula]{fs:delayedResponseCondition2} + # @refFS[Formula]{fs:delayedResponsePower} + suppressWarnings(dl1 <- getDesignGroupSequential( + kMax = 3, alpha = 0.05, beta = 0.1, sided = 1, + typeOfDesign = "asOF", typeBetaSpending = "bsOF", + informationRates = c(0.4, 0.65, 1), + bindingFutility = TRUE, + delayedInformation = c(0.1, 0.2) + )) + + ## Comparison of the results of TrialDesignGroupSequential object 'dl1' with expected results + expect_equal(dl1$power, c(0.15998522, 0.59313184, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl1$power, collapse = ", "), ")")) + expect_equal(dl1$futilityBounds, c(-0.46043472, 0.64445014), tolerance = 1e-07, label = paste0("c(", paste0(dl1$futilityBounds, collapse = ", "), ")")) + expect_equal(dl1$alphaSpent, c(0.001941913, 0.015055713, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(dl1$alphaSpent, collapse = ", "), ")")) + expect_equal(dl1$betaSpent, c(0.00930224, 0.041331422, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(dl1$betaSpent, collapse = ", "), ")")) + expect_equal(dl1$criticalValues, c(2.8874465, 2.1853011, 1.6575593), tolerance = 1e-07, label = paste0("c(", paste0(dl1$criticalValues, collapse = ", "), ")")) + expect_equal(dl1$stageLevels, c(0.001941913, 0.014433388, 0.048703222), tolerance = 1e-07, label = paste0("c(", paste0(dl1$stageLevels, collapse = ", "), ")")) + expect_equal(dl1$decisionCriticalValues, c(1.3388855, 1.5378695, 1.6575593), tolerance = 1e-07, label = paste0("c(", paste0(dl1$decisionCriticalValues, collapse = ", "), ")")) + expect_equal(dl1$reversalProbabilities, c(1.7563249e-06, 0.0014674026), tolerance = 1e-07, label = paste0("c(", paste0(dl1$reversalProbabilities, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dl1), NA))) + expect_output(print(dl1)$show()) + invisible(capture.output(expect_error(summary(dl1), NA))) + expect_output(summary(dl1)$show()) + suppressWarnings(dl1CodeBased <- eval(parse(text = getObjectRCode(dl1, stringWrapParagraphWidth = NULL)))) + expect_equal(dl1CodeBased$power, dl1$power, tolerance = 1e-07) + expect_equal(dl1CodeBased$futilityBounds, dl1$futilityBounds, tolerance = 1e-07) + expect_equal(dl1CodeBased$alphaSpent, dl1$alphaSpent, tolerance = 1e-07) + expect_equal(dl1CodeBased$betaSpent, dl1$betaSpent, tolerance = 1e-07) + expect_equal(dl1CodeBased$criticalValues, dl1$criticalValues, tolerance = 1e-07) + expect_equal(dl1CodeBased$stageLevels, dl1$stageLevels, tolerance = 1e-07) + expect_equal(dl1CodeBased$decisionCriticalValues, dl1$decisionCriticalValues, tolerance = 1e-07) + expect_equal(dl1CodeBased$reversalProbabilities, dl1$reversalProbabilities, tolerance = 1e-07) + expect_type(names(dl1), "character") + df <- as.data.frame(dl1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dl1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + dl2 <- getDesignCharacteristics(dl1) + + ## Comparison of the results of TrialDesignCharacteristics object 'dl2' with expected results + expect_equal(dl2$nFixed, 8.5638474, tolerance = 1e-07, label = paste0("c(", paste0(dl2$nFixed, collapse = ", "), ")")) + expect_equal(dl2$shift, 8.8633082, tolerance = 1e-07, label = paste0("c(", paste0(dl2$shift, collapse = ", "), ")")) + expect_equal(dl2$inflationFactor, 1.034968, tolerance = 1e-07, label = paste0("c(", paste0(dl2$inflationFactor, collapse = ", "), ")")) + expect_equal(dl2$information, c(3.5453233, 5.7611503, 8.8633082), tolerance = 1e-07, label = paste0("c(", paste0(dl2$information, collapse = ", "), ")")) + expect_equal(dl2$power, c(0.15755984, 0.59089729, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl2$power, collapse = ", "), ")")) + expect_equal(dl2$rejectionProbabilities, c(0.15755984, 0.43333745, 0.30910271), tolerance = 1e-07, label = paste0("c(", paste0(dl2$rejectionProbabilities, collapse = ", "), ")")) + expect_equal(dl2$futilityProbabilities, c(0.0095560402, 0.032904105), tolerance = 1e-07, label = paste0("c(", paste0(dl2$futilityProbabilities, collapse = ", "), ")")) + expect_equal(dl2$averageSampleNumber1, 0.87652961, tolerance = 1e-07, label = paste0("c(", paste0(dl2$averageSampleNumber1, collapse = ", "), ")")) + expect_equal(dl2$averageSampleNumber01, 0.92477729, tolerance = 1e-07, label = paste0("c(", paste0(dl2$averageSampleNumber01, collapse = ", "), ")")) + expect_equal(dl2$averageSampleNumber0, 0.79932679, tolerance = 1e-07, label = paste0("c(", paste0(dl2$averageSampleNumber0, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dl2), NA))) + expect_output(print(dl2)$show()) + invisible(capture.output(expect_error(summary(dl2), NA))) + expect_output(summary(dl2)$show()) + suppressWarnings(dl2CodeBased <- eval(parse(text = getObjectRCode(dl2, stringWrapParagraphWidth = NULL)))) + expect_equal(dl2CodeBased$nFixed, dl2$nFixed, tolerance = 1e-07) + expect_equal(dl2CodeBased$shift, dl2$shift, tolerance = 1e-07) + expect_equal(dl2CodeBased$inflationFactor, dl2$inflationFactor, tolerance = 1e-07) + expect_equal(dl2CodeBased$information, dl2$information, tolerance = 1e-07) + expect_equal(dl2CodeBased$power, dl2$power, tolerance = 1e-07) + expect_equal(dl2CodeBased$rejectionProbabilities, dl2$rejectionProbabilities, tolerance = 1e-07) + expect_equal(dl2CodeBased$futilityProbabilities, dl2$futilityProbabilities, tolerance = 1e-07) + expect_equal(dl2CodeBased$averageSampleNumber1, dl2$averageSampleNumber1, tolerance = 1e-07) + expect_equal(dl2CodeBased$averageSampleNumber01, dl2$averageSampleNumber01, tolerance = 1e-07) + expect_equal(dl2CodeBased$averageSampleNumber0, dl2$averageSampleNumber0, tolerance = 1e-07) + expect_type(names(dl2), "character") + df <- as.data.frame(dl2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dl2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + suppressWarnings(dl3 <- getDesignGroupSequential( + kMax = 3, alpha = 0.05, beta = 0.1, sided = 1, + typeOfDesign = "asOF", typeBetaSpending = "bsOF", + informationRates = c(0.4, 0.65, 1), + bindingFutility = TRUE, + delayedInformation = c(0, 0.2) + )) + + ## Comparison of the results of TrialDesignGroupSequential object 'dl3' with expected results + expect_equal(dl3$power, c(0.15998522, 0.59313184, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl3$power, collapse = ", "), ")")) + expect_equal(dl3$futilityBounds, c(-0.46043472, 0.64445014), tolerance = 1e-07, label = paste0("c(", paste0(dl3$futilityBounds, collapse = ", "), ")")) + expect_equal(dl3$alphaSpent, c(0.001941913, 0.015055713, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(dl3$alphaSpent, collapse = ", "), ")")) + expect_equal(dl3$betaSpent, c(0.00930224, 0.041331422, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(dl3$betaSpent, collapse = ", "), ")")) + expect_equal(dl3$criticalValues, c(2.8874465, 2.1853011, 1.6575593), tolerance = 1e-07, label = paste0("c(", paste0(dl3$criticalValues, collapse = ", "), ")")) + expect_equal(dl3$stageLevels, c(0.001941913, 0.014433388, 0.048703222), tolerance = 1e-07, label = paste0("c(", paste0(dl3$stageLevels, collapse = ", "), ")")) + expect_equal(dl3$decisionCriticalValues, c(NA_real_, 1.5378695, 1.6575593), tolerance = 1e-07, label = paste0("c(", paste0(dl3$decisionCriticalValues, collapse = ", "), ")")) + expect_equal(dl3$reversalProbabilities, c(NA_real_, 0.0014674026), tolerance = 1e-07, label = paste0("c(", paste0(dl3$reversalProbabilities, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dl3), NA))) + expect_output(print(dl3)$show()) + invisible(capture.output(expect_error(summary(dl3), NA))) + expect_output(summary(dl3)$show()) + suppressWarnings(dl3CodeBased <- eval(parse(text = getObjectRCode(dl3, stringWrapParagraphWidth = NULL)))) + expect_equal(dl3CodeBased$power, dl3$power, tolerance = 1e-07) + expect_equal(dl3CodeBased$futilityBounds, dl3$futilityBounds, tolerance = 1e-07) + expect_equal(dl3CodeBased$alphaSpent, dl3$alphaSpent, tolerance = 1e-07) + expect_equal(dl3CodeBased$betaSpent, dl3$betaSpent, tolerance = 1e-07) + expect_equal(dl3CodeBased$criticalValues, dl3$criticalValues, tolerance = 1e-07) + expect_equal(dl3CodeBased$stageLevels, dl3$stageLevels, tolerance = 1e-07) + expect_equal(dl3CodeBased$decisionCriticalValues, dl3$decisionCriticalValues, tolerance = 1e-07) + expect_equal(dl3CodeBased$reversalProbabilities, dl3$reversalProbabilities, tolerance = 1e-07) + expect_type(names(dl3), "character") + df <- as.data.frame(dl3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dl3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + dl4 <- getDesignCharacteristics(dl3) + + ## Comparison of the results of TrialDesignCharacteristics object 'dl4' with expected results + expect_equal(dl4$nFixed, 8.5638474, tolerance = 1e-07, label = paste0("c(", paste0(dl4$nFixed, collapse = ", "), ")")) + expect_equal(dl4$shift, 8.8633608, tolerance = 1e-07, label = paste0("c(", paste0(dl4$shift, collapse = ", "), ")")) + expect_equal(dl4$inflationFactor, 1.0349742, tolerance = 1e-07, label = paste0("c(", paste0(dl4$inflationFactor, collapse = ", "), ")")) + expect_equal(dl4$information, c(3.5453443, 5.7611845, 8.8633608), tolerance = 1e-07, label = paste0("c(", paste0(dl4$information, collapse = ", "), ")")) + expect_equal(dl4$power, c(0.15755967, 0.59089852, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl4$power, collapse = ", "), ")")) + expect_equal(dl4$rejectionProbabilities, c(0.15755967, 0.43333886, 0.30910148), tolerance = 1e-07, label = paste0("c(", paste0(dl4$rejectionProbabilities, collapse = ", "), ")")) + expect_equal(dl4$futilityProbabilities, c(0.0095558971, 0.032903612), tolerance = 1e-07, label = paste0("c(", paste0(dl4$futilityProbabilities, collapse = ", "), ")")) + expect_equal(dl4$averageSampleNumber1, 0.85923802, tolerance = 1e-07, label = paste0("c(", paste0(dl4$averageSampleNumber1, collapse = ", "), ")")) + expect_equal(dl4$averageSampleNumber01, 0.91378094, tolerance = 1e-07, label = paste0("c(", paste0(dl4$averageSampleNumber01, collapse = ", "), ")")) + expect_equal(dl4$averageSampleNumber0, 0.76574207, tolerance = 1e-07, label = paste0("c(", paste0(dl4$averageSampleNumber0, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dl4), NA))) + expect_output(print(dl4)$show()) + invisible(capture.output(expect_error(summary(dl4), NA))) + expect_output(summary(dl4)$show()) + suppressWarnings(dl4CodeBased <- eval(parse(text = getObjectRCode(dl4, stringWrapParagraphWidth = NULL)))) + expect_equal(dl4CodeBased$nFixed, dl4$nFixed, tolerance = 1e-07) + expect_equal(dl4CodeBased$shift, dl4$shift, tolerance = 1e-07) + expect_equal(dl4CodeBased$inflationFactor, dl4$inflationFactor, tolerance = 1e-07) + expect_equal(dl4CodeBased$information, dl4$information, tolerance = 1e-07) + expect_equal(dl4CodeBased$power, dl4$power, tolerance = 1e-07) + expect_equal(dl4CodeBased$rejectionProbabilities, dl4$rejectionProbabilities, tolerance = 1e-07) + expect_equal(dl4CodeBased$futilityProbabilities, dl4$futilityProbabilities, tolerance = 1e-07) + expect_equal(dl4CodeBased$averageSampleNumber1, dl4$averageSampleNumber1, tolerance = 1e-07) + expect_equal(dl4CodeBased$averageSampleNumber01, dl4$averageSampleNumber01, tolerance = 1e-07) + expect_equal(dl4CodeBased$averageSampleNumber0, dl4$averageSampleNumber0, tolerance = 1e-07) + expect_type(names(dl4), "character") + df <- as.data.frame(dl4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dl4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + suppressWarnings(dl5 <- getDesignGroupSequential( + kMax = 3, alpha = 0.05, beta = 0.1, sided = 1, + typeOfDesign = "asOF", typeBetaSpending = "bsOF", + informationRates = c(0.4, 0.65, 1), + bindingFutility = TRUE, + delayedInformation = 0.3 + )) + + ## Comparison of the results of TrialDesignGroupSequential object 'dl5' with expected results + expect_equal(dl5$power, c(0.15998522, 0.59313184, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl5$power, collapse = ", "), ")")) + expect_equal(dl5$futilityBounds, c(-0.46043472, 0.64445014), tolerance = 1e-07, label = paste0("c(", paste0(dl5$futilityBounds, collapse = ", "), ")")) + expect_equal(dl5$alphaSpent, c(0.001941913, 0.015055713, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(dl5$alphaSpent, collapse = ", "), ")")) + expect_equal(dl5$betaSpent, c(0.00930224, 0.041331422, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(dl5$betaSpent, collapse = ", "), ")")) + expect_equal(dl5$criticalValues, c(2.8874465, 2.1853011, 1.6575593), tolerance = 1e-07, label = paste0("c(", paste0(dl5$criticalValues, collapse = ", "), ")")) + expect_equal(dl5$stageLevels, c(0.001941913, 0.014433388, 0.048703222), tolerance = 1e-07, label = paste0("c(", paste0(dl5$stageLevels, collapse = ", "), ")")) + expect_equal(dl5$decisionCriticalValues, c(1.505831, 1.5735979, 1.6575593), tolerance = 1e-07, label = paste0("c(", paste0(dl5$decisionCriticalValues, collapse = ", "), ")")) + expect_equal(dl5$reversalProbabilities, c(0.00018341474, 0.0027022502), tolerance = 1e-07, label = paste0("c(", paste0(dl5$reversalProbabilities, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dl5), NA))) + expect_output(print(dl5)$show()) + invisible(capture.output(expect_error(summary(dl5), NA))) + expect_output(summary(dl5)$show()) + suppressWarnings(dl5CodeBased <- eval(parse(text = getObjectRCode(dl5, stringWrapParagraphWidth = NULL)))) + expect_equal(dl5CodeBased$power, dl5$power, tolerance = 1e-07) + expect_equal(dl5CodeBased$futilityBounds, dl5$futilityBounds, tolerance = 1e-07) + expect_equal(dl5CodeBased$alphaSpent, dl5$alphaSpent, tolerance = 1e-07) + expect_equal(dl5CodeBased$betaSpent, dl5$betaSpent, tolerance = 1e-07) + expect_equal(dl5CodeBased$criticalValues, dl5$criticalValues, tolerance = 1e-07) + expect_equal(dl5CodeBased$stageLevels, dl5$stageLevels, tolerance = 1e-07) + expect_equal(dl5CodeBased$decisionCriticalValues, dl5$decisionCriticalValues, tolerance = 1e-07) + expect_equal(dl5CodeBased$reversalProbabilities, dl5$reversalProbabilities, tolerance = 1e-07) + expect_type(names(dl5), "character") + df <- as.data.frame(dl5) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dl5) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + dl6 <- getDesignCharacteristics(dl5) + + ## Comparison of the results of TrialDesignCharacteristics object 'dl6' with expected results + expect_equal(dl6$nFixed, 8.5638474, tolerance = 1e-07, label = paste0("c(", paste0(dl6$nFixed, collapse = ", "), ")")) + expect_equal(dl6$shift, 8.7180222, tolerance = 1e-07, label = paste0("c(", paste0(dl6$shift, collapse = ", "), ")")) + expect_equal(dl6$inflationFactor, 1.018003, tolerance = 1e-07, label = paste0("c(", paste0(dl6$inflationFactor, collapse = ", "), ")")) + expect_equal(dl6$information, c(3.4872089, 5.6667144, 8.7180222), tolerance = 1e-07, label = paste0("c(", paste0(dl6$information, collapse = ", "), ")")) + expect_equal(dl6$power, c(0.15429254, 0.58752252, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl6$power, collapse = ", "), ")")) + expect_equal(dl6$rejectionProbabilities, c(0.15429254, 0.43322998, 0.31247748), tolerance = 1e-07, label = paste0("c(", paste0(dl6$rejectionProbabilities, collapse = ", "), ")")) + expect_equal(dl6$futilityProbabilities, c(0.0099602552, 0.03429374), tolerance = 1e-07, label = paste0("c(", paste0(dl6$futilityProbabilities, collapse = ", "), ")")) + expect_equal(dl6$averageSampleNumber1, 0.94451255, tolerance = 1e-07, label = paste0("c(", paste0(dl6$averageSampleNumber1, collapse = ", "), ")")) + expect_equal(dl6$averageSampleNumber01, 0.96721799, tolerance = 1e-07, label = paste0("c(", paste0(dl6$averageSampleNumber01, collapse = ", "), ")")) + expect_equal(dl6$averageSampleNumber0, 0.89669187, tolerance = 1e-07, label = paste0("c(", paste0(dl6$averageSampleNumber0, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dl6), NA))) + expect_output(print(dl6)$show()) + invisible(capture.output(expect_error(summary(dl6), NA))) + expect_output(summary(dl6)$show()) + suppressWarnings(dl6CodeBased <- eval(parse(text = getObjectRCode(dl6, stringWrapParagraphWidth = NULL)))) + expect_equal(dl6CodeBased$nFixed, dl6$nFixed, tolerance = 1e-07) + expect_equal(dl6CodeBased$shift, dl6$shift, tolerance = 1e-07) + expect_equal(dl6CodeBased$inflationFactor, dl6$inflationFactor, tolerance = 1e-07) + expect_equal(dl6CodeBased$information, dl6$information, tolerance = 1e-07) + expect_equal(dl6CodeBased$power, dl6$power, tolerance = 1e-07) + expect_equal(dl6CodeBased$rejectionProbabilities, dl6$rejectionProbabilities, tolerance = 1e-07) + expect_equal(dl6CodeBased$futilityProbabilities, dl6$futilityProbabilities, tolerance = 1e-07) + expect_equal(dl6CodeBased$averageSampleNumber1, dl6$averageSampleNumber1, tolerance = 1e-07) + expect_equal(dl6CodeBased$averageSampleNumber01, dl6$averageSampleNumber01, tolerance = 1e-07) + expect_equal(dl6CodeBased$averageSampleNumber0, dl6$averageSampleNumber0, tolerance = 1e-07) + expect_type(names(dl6), "character") + df <- as.data.frame(dl6) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dl6) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignGroupSequential' with type of design = 'asP' and 'bsP', non-binding futility bounds and delayed response (kMax = 3)", { + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:alphaSpendingConcept} + # @refFS[Formula]{fs:alphaSpendingOBrienFleming} + # @refFS[Formula]{fs:betaSpendingApproach} + # @refFS[Formula]{fs:betaSpendingOBrienFleming} + # @refFS[Formula]{fs:delayedResponseCondition1} + # @refFS[Formula]{fs:delayedResponseCondition2} + # @refFS[Formula]{fs:delayedResponsePower} + suppressWarnings(dl1 <- getDesignGroupSequential( + kMax = 3, alpha = 0.05, beta = 0.1, sided = 1, + typeOfDesign = "asP", typeBetaSpending = "bsP", + informationRates = c(0.4, 0.65, 1), + bindingFutility = FALSE, + delayedInformation = c(0.1, 0.2) + )) + + ## Comparison of the results of TrialDesignGroupSequential object 'dl1' with expected results + expect_equal(dl1$power, c(0.58983431, 0.79279807, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl1$power, collapse = ", "), ")")) + expect_equal(dl1$futilityBounds, c(0.5448398, 1.0899149), tolerance = 1e-07, label = paste0("c(", paste0(dl1$futilityBounds, collapse = ", "), ")")) + expect_equal(dl1$alphaSpent, c(0.026156858, 0.037497241, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(dl1$alphaSpent, collapse = ", "), ")")) + expect_equal(dl1$betaSpent, c(0.052313716, 0.074994481, 0.099999999), tolerance = 1e-07, label = paste0("c(", paste0(dl1$betaSpent, collapse = ", "), ")")) + expect_equal(dl1$criticalValues, c(1.9405431, 2.0327662, 1.9734104), tolerance = 1e-07, label = paste0("c(", paste0(dl1$criticalValues, collapse = ", "), ")")) + expect_equal(dl1$stageLevels, c(0.026156858, 0.021038075, 0.02422441), tolerance = 1e-07, label = paste0("c(", paste0(dl1$stageLevels, collapse = ", "), ")")) + expect_equal(dl1$decisionCriticalValues, c(1.3362296, 1.657468, 1.9734104), tolerance = 1e-07, label = paste0("c(", paste0(dl1$decisionCriticalValues, collapse = ", "), ")")) + expect_equal(dl1$reversalProbabilities, c(0.0020439695, 0.0026967589), tolerance = 1e-07, label = paste0("c(", paste0(dl1$reversalProbabilities, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dl1), NA))) + expect_output(print(dl1)$show()) + invisible(capture.output(expect_error(summary(dl1), NA))) + expect_output(summary(dl1)$show()) + suppressWarnings(dl1CodeBased <- eval(parse(text = getObjectRCode(dl1, stringWrapParagraphWidth = NULL)))) + expect_equal(dl1CodeBased$power, dl1$power, tolerance = 1e-07) + expect_equal(dl1CodeBased$futilityBounds, dl1$futilityBounds, tolerance = 1e-07) + expect_equal(dl1CodeBased$alphaSpent, dl1$alphaSpent, tolerance = 1e-07) + expect_equal(dl1CodeBased$betaSpent, dl1$betaSpent, tolerance = 1e-07) + expect_equal(dl1CodeBased$criticalValues, dl1$criticalValues, tolerance = 1e-07) + expect_equal(dl1CodeBased$stageLevels, dl1$stageLevels, tolerance = 1e-07) + expect_equal(dl1CodeBased$decisionCriticalValues, dl1$decisionCriticalValues, tolerance = 1e-07) + expect_equal(dl1CodeBased$reversalProbabilities, dl1$reversalProbabilities, tolerance = 1e-07) + expect_type(names(dl1), "character") + df <- as.data.frame(dl1) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dl1) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + dl2 <- getDesignCharacteristics(dl1) + + ## Comparison of the results of TrialDesignCharacteristics object 'dl2' with expected results + expect_equal(dl2$nFixed, 8.5638474, tolerance = 1e-07, label = paste0("c(", paste0(dl2$nFixed, collapse = ", "), ")")) + expect_equal(dl2$shift, 11.345796, tolerance = 1e-07, label = paste0("c(", paste0(dl2$shift, collapse = ", "), ")")) + expect_equal(dl2$inflationFactor, 1.324848, tolerance = 1e-07, label = paste0("c(", paste0(dl2$inflationFactor, collapse = ", "), ")")) + expect_equal(dl2$information, c(4.5383183, 7.3747672, 11.345796), tolerance = 1e-07, label = paste0("c(", paste0(dl2$information, collapse = ", "), ")")) + expect_equal(dl2$power, c(0.57788702, 0.78847934, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl2$power, collapse = ", "), ")")) + expect_equal(dl2$rejectionProbabilities, c(0.57788702, 0.21059232, 0.11152066), tolerance = 1e-07, label = paste0("c(", paste0(dl2$rejectionProbabilities, collapse = ", "), ")")) + expect_equal(dl2$futilityProbabilities, c(0.056427171, 0.024888086), tolerance = 1e-07, label = paste0("c(", paste0(dl2$futilityProbabilities, collapse = ", "), ")")) + expect_equal(dl2$averageSampleNumber1, 0.86088771, tolerance = 1e-07, label = paste0("c(", paste0(dl2$averageSampleNumber1, collapse = ", "), ")")) + expect_equal(dl2$averageSampleNumber01, 0.9483049, tolerance = 1e-07, label = paste0("c(", paste0(dl2$averageSampleNumber01, collapse = ", "), ")")) + expect_equal(dl2$averageSampleNumber0, 0.80259202, tolerance = 1e-07, label = paste0("c(", paste0(dl2$averageSampleNumber0, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dl2), NA))) + expect_output(print(dl2)$show()) + invisible(capture.output(expect_error(summary(dl2), NA))) + expect_output(summary(dl2)$show()) + suppressWarnings(dl2CodeBased <- eval(parse(text = getObjectRCode(dl2, stringWrapParagraphWidth = NULL)))) + expect_equal(dl2CodeBased$nFixed, dl2$nFixed, tolerance = 1e-07) + expect_equal(dl2CodeBased$shift, dl2$shift, tolerance = 1e-07) + expect_equal(dl2CodeBased$inflationFactor, dl2$inflationFactor, tolerance = 1e-07) + expect_equal(dl2CodeBased$information, dl2$information, tolerance = 1e-07) + expect_equal(dl2CodeBased$power, dl2$power, tolerance = 1e-07) + expect_equal(dl2CodeBased$rejectionProbabilities, dl2$rejectionProbabilities, tolerance = 1e-07) + expect_equal(dl2CodeBased$futilityProbabilities, dl2$futilityProbabilities, tolerance = 1e-07) + expect_equal(dl2CodeBased$averageSampleNumber1, dl2$averageSampleNumber1, tolerance = 1e-07) + expect_equal(dl2CodeBased$averageSampleNumber01, dl2$averageSampleNumber01, tolerance = 1e-07) + expect_equal(dl2CodeBased$averageSampleNumber0, dl2$averageSampleNumber0, tolerance = 1e-07) + expect_type(names(dl2), "character") + df <- as.data.frame(dl2) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dl2) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + suppressWarnings(dl3 <- getDesignGroupSequential( + kMax = 3, alpha = 0.05, beta = 0.1, sided = 1, + typeOfDesign = "asP", typeBetaSpending = "bsP", + informationRates = c(0.4, 0.65, 1), + bindingFutility = FALSE, + delayedInformation = c(0, 0.2) + )) + + ## Comparison of the results of TrialDesignGroupSequential object 'dl3' with expected results + expect_equal(dl3$power, c(0.58983431, 0.79279807, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl3$power, collapse = ", "), ")")) + expect_equal(dl3$futilityBounds, c(0.5448398, 1.0899149), tolerance = 1e-07, label = paste0("c(", paste0(dl3$futilityBounds, collapse = ", "), ")")) + expect_equal(dl3$alphaSpent, c(0.026156858, 0.037497241, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(dl3$alphaSpent, collapse = ", "), ")")) + expect_equal(dl3$betaSpent, c(0.052313716, 0.074994481, 0.099999999), tolerance = 1e-07, label = paste0("c(", paste0(dl3$betaSpent, collapse = ", "), ")")) + expect_equal(dl3$criticalValues, c(1.9405431, 2.0327662, 1.9734104), tolerance = 1e-07, label = paste0("c(", paste0(dl3$criticalValues, collapse = ", "), ")")) + expect_equal(dl3$stageLevels, c(0.026156858, 0.021038075, 0.02422441), tolerance = 1e-07, label = paste0("c(", paste0(dl3$stageLevels, collapse = ", "), ")")) + expect_equal(dl3$decisionCriticalValues, c(NA_real_, 1.657468, 1.9734104), tolerance = 1e-07, label = paste0("c(", paste0(dl3$decisionCriticalValues, collapse = ", "), ")")) + expect_equal(dl3$reversalProbabilities, c(NA_real_, 0.0026967589), tolerance = 1e-07, label = paste0("c(", paste0(dl3$reversalProbabilities, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dl3), NA))) + expect_output(print(dl3)$show()) + invisible(capture.output(expect_error(summary(dl3), NA))) + expect_output(summary(dl3)$show()) + suppressWarnings(dl3CodeBased <- eval(parse(text = getObjectRCode(dl3, stringWrapParagraphWidth = NULL)))) + expect_equal(dl3CodeBased$power, dl3$power, tolerance = 1e-07) + expect_equal(dl3CodeBased$futilityBounds, dl3$futilityBounds, tolerance = 1e-07) + expect_equal(dl3CodeBased$alphaSpent, dl3$alphaSpent, tolerance = 1e-07) + expect_equal(dl3CodeBased$betaSpent, dl3$betaSpent, tolerance = 1e-07) + expect_equal(dl3CodeBased$criticalValues, dl3$criticalValues, tolerance = 1e-07) + expect_equal(dl3CodeBased$stageLevels, dl3$stageLevels, tolerance = 1e-07) + expect_equal(dl3CodeBased$decisionCriticalValues, dl3$decisionCriticalValues, tolerance = 1e-07) + expect_equal(dl3CodeBased$reversalProbabilities, dl3$reversalProbabilities, tolerance = 1e-07) + expect_type(names(dl3), "character") + df <- as.data.frame(dl3) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dl3) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + dl4 <- getDesignCharacteristics(dl3) + + ## Comparison of the results of TrialDesignCharacteristics object 'dl4' with expected results + expect_equal(dl4$nFixed, 8.5638474, tolerance = 1e-07, label = paste0("c(", paste0(dl4$nFixed, collapse = ", "), ")")) + expect_equal(dl4$shift, 11.462579, tolerance = 1e-07, label = paste0("c(", paste0(dl4$shift, collapse = ", "), ")")) + expect_equal(dl4$inflationFactor, 1.3384848, tolerance = 1e-07, label = paste0("c(", paste0(dl4$inflationFactor, collapse = ", "), ")")) + expect_equal(dl4$information, c(4.5850317, 7.4506765, 11.462579), tolerance = 1e-07, label = paste0("c(", paste0(dl4$information, collapse = ", "), ")")) + expect_equal(dl4$power, c(0.57954342, 0.78973163, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl4$power, collapse = ", "), ")")) + expect_equal(dl4$rejectionProbabilities, c(0.57954342, 0.21018821, 0.11026837), tolerance = 1e-07, label = paste0("c(", paste0(dl4$rejectionProbabilities, collapse = ", "), ")")) + expect_equal(dl4$futilityProbabilities, c(0.055196532, 0.024225352), tolerance = 1e-07, label = paste0("c(", paste0(dl4$futilityProbabilities, collapse = ", "), ")")) + expect_equal(dl4$averageSampleNumber1, 0.7829433, tolerance = 1e-07, label = paste0("c(", paste0(dl4$averageSampleNumber1, collapse = ", "), ")")) + expect_equal(dl4$averageSampleNumber01, 0.89251343, tolerance = 1e-07, label = paste0("c(", paste0(dl4$averageSampleNumber01, collapse = ", "), ")")) + expect_equal(dl4$averageSampleNumber0, 0.71271214, tolerance = 1e-07, label = paste0("c(", paste0(dl4$averageSampleNumber0, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dl4), NA))) + expect_output(print(dl4)$show()) + invisible(capture.output(expect_error(summary(dl4), NA))) + expect_output(summary(dl4)$show()) + suppressWarnings(dl4CodeBased <- eval(parse(text = getObjectRCode(dl4, stringWrapParagraphWidth = NULL)))) + expect_equal(dl4CodeBased$nFixed, dl4$nFixed, tolerance = 1e-07) + expect_equal(dl4CodeBased$shift, dl4$shift, tolerance = 1e-07) + expect_equal(dl4CodeBased$inflationFactor, dl4$inflationFactor, tolerance = 1e-07) + expect_equal(dl4CodeBased$information, dl4$information, tolerance = 1e-07) + expect_equal(dl4CodeBased$power, dl4$power, tolerance = 1e-07) + expect_equal(dl4CodeBased$rejectionProbabilities, dl4$rejectionProbabilities, tolerance = 1e-07) + expect_equal(dl4CodeBased$futilityProbabilities, dl4$futilityProbabilities, tolerance = 1e-07) + expect_equal(dl4CodeBased$averageSampleNumber1, dl4$averageSampleNumber1, tolerance = 1e-07) + expect_equal(dl4CodeBased$averageSampleNumber01, dl4$averageSampleNumber01, tolerance = 1e-07) + expect_equal(dl4CodeBased$averageSampleNumber0, dl4$averageSampleNumber0, tolerance = 1e-07) + expect_type(names(dl4), "character") + df <- as.data.frame(dl4) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dl4) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + expect_warning( + dl5 <- getDesignGroupSequential( + kMax = 3, alpha = 0.05, beta = 0.1, sided = 1, + typeOfDesign = "asP", typeBetaSpending = "bsP", + informationRates = c(0.4, 0.65, 1), + bindingFutility = FALSE, + delayedInformation = 0 + ) + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'dl5' with expected results + expect_equal(dl5$power, c(0.58983431, 0.79279807, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl5$power, collapse = ", "), ")")) + expect_equal(dl5$futilityBounds, c(0.5448398, 1.0899149), tolerance = 1e-07, label = paste0("c(", paste0(dl5$futilityBounds, collapse = ", "), ")")) + expect_equal(dl5$alphaSpent, c(0.026156858, 0.037497241, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(dl5$alphaSpent, collapse = ", "), ")")) + expect_equal(dl5$betaSpent, c(0.052313716, 0.074994481, 0.099999999), tolerance = 1e-07, label = paste0("c(", paste0(dl5$betaSpent, collapse = ", "), ")")) + expect_equal(dl5$criticalValues, c(1.9405431, 2.0327662, 1.9734104), tolerance = 1e-07, label = paste0("c(", paste0(dl5$criticalValues, collapse = ", "), ")")) + expect_equal(dl5$stageLevels, c(0.026156858, 0.021038075, 0.02422441), tolerance = 1e-07, label = paste0("c(", paste0(dl5$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dl5), NA))) + expect_output(print(dl5)$show()) + invisible(capture.output(expect_error(summary(dl5), NA))) + expect_output(summary(dl5)$show()) + suppressWarnings(dl5CodeBased <- eval(parse(text = getObjectRCode(dl5, stringWrapParagraphWidth = NULL)))) + expect_equal(dl5CodeBased$power, dl5$power, tolerance = 1e-07) + expect_equal(dl5CodeBased$futilityBounds, dl5$futilityBounds, tolerance = 1e-07) + expect_equal(dl5CodeBased$alphaSpent, dl5$alphaSpent, tolerance = 1e-07) + expect_equal(dl5CodeBased$betaSpent, dl5$betaSpent, tolerance = 1e-07) + expect_equal(dl5CodeBased$criticalValues, dl5$criticalValues, tolerance = 1e-07) + expect_equal(dl5CodeBased$stageLevels, dl5$stageLevels, tolerance = 1e-07) + expect_type(names(dl5), "character") + df <- as.data.frame(dl5) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dl5) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + dl6 <- getDesignCharacteristics(dl5) + + ## Comparison of the results of TrialDesignCharacteristics object 'dl6' with expected results + expect_equal(dl6$nFixed, 8.5638474, tolerance = 1e-07, label = paste0("c(", paste0(dl6$nFixed, collapse = ", "), ")")) + expect_equal(dl6$shift, 11.746896, tolerance = 1e-07, label = paste0("c(", paste0(dl6$shift, collapse = ", "), ")")) + expect_equal(dl6$inflationFactor, 1.3716844, tolerance = 1e-07, label = paste0("c(", paste0(dl6$inflationFactor, collapse = ", "), ")")) + expect_equal(dl6$information, c(4.6987583, 7.6354822, 11.746896), tolerance = 1e-07, label = paste0("c(", paste0(dl6$information, collapse = ", "), ")")) + expect_equal(dl6$power, c(0.58983431, 0.79279807, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(dl6$power, collapse = ", "), ")")) + expect_equal(dl6$rejectionProbabilities, c(0.58983431, 0.20296375, 0.10720193), tolerance = 1e-07, label = paste0("c(", paste0(dl6$rejectionProbabilities, collapse = ", "), ")")) + expect_equal(dl6$futilityProbabilities, c(0.052313716, 0.022680765), tolerance = 1e-07, label = paste0("c(", paste0(dl6$futilityProbabilities, collapse = ", "), ")")) + expect_equal(dl6$averageSampleNumber1, 0.73486016, tolerance = 1e-07, label = paste0("c(", paste0(dl6$averageSampleNumber1, collapse = ", "), ")")) + expect_equal(dl6$averageSampleNumber01, 0.8455149, tolerance = 1e-07, label = paste0("c(", paste0(dl6$averageSampleNumber01, collapse = ", "), ")")) + expect_equal(dl6$averageSampleNumber0, 0.67993383, tolerance = 1e-07, label = paste0("c(", paste0(dl6$averageSampleNumber0, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(dl6), NA))) + expect_output(print(dl6)$show()) + invisible(capture.output(expect_error(summary(dl6), NA))) + expect_output(summary(dl6)$show()) + suppressWarnings(dl6CodeBased <- eval(parse(text = getObjectRCode(dl6, stringWrapParagraphWidth = NULL)))) + expect_equal(dl6CodeBased$nFixed, dl6$nFixed, tolerance = 1e-07) + expect_equal(dl6CodeBased$shift, dl6$shift, tolerance = 1e-07) + expect_equal(dl6CodeBased$inflationFactor, dl6$inflationFactor, tolerance = 1e-07) + expect_equal(dl6CodeBased$information, dl6$information, tolerance = 1e-07) + expect_equal(dl6CodeBased$power, dl6$power, tolerance = 1e-07) + expect_equal(dl6CodeBased$rejectionProbabilities, dl6$rejectionProbabilities, tolerance = 1e-07) + expect_equal(dl6CodeBased$futilityProbabilities, dl6$futilityProbabilities, tolerance = 1e-07) + expect_equal(dl6CodeBased$averageSampleNumber1, dl6$averageSampleNumber1, tolerance = 1e-07) + expect_equal(dl6CodeBased$averageSampleNumber01, dl6$averageSampleNumber01, tolerance = 1e-07) + expect_equal(dl6CodeBased$averageSampleNumber0, dl6$averageSampleNumber0, tolerance = 1e-07) + expect_type(names(dl6), "character") + df <- as.data.frame(dl6) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(dl6) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignGroupSequential' with binding futility bounds", { + + .skipTestIfDisabled() + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:criticalValuesWithFutility} + # @refFS[Formula]{fs:criticalValuesWangTiatis} + x8a <- getDesignGroupSequential( + kMax = 4, alpha = 0.025, futilityBounds = rep(0.5244, 3), + bindingFutility = TRUE, typeOfDesign = "WT", deltaWT = 0.4 + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x8a' with expected results + expect_equal(x8a$alphaSpent, c(0.0062828133, 0.013876673, 0.02015684, 0.02499999), tolerance = 1e-07, label = paste0("c(", paste0(x8a$alphaSpent, collapse = ", "), ")")) + expect_equal(x8a$criticalValues, c(2.4958485, 2.328709, 2.2361766, 2.1727623), tolerance = 1e-07, label = paste0("c(", paste0(x8a$criticalValues, collapse = ", "), ")")) + expect_equal(x8a$stageLevels, c(0.0062828133, 0.0099372444, 0.012670104, 0.014899106), tolerance = 1e-07, label = paste0("c(", paste0(x8a$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x8a), NA))) + expect_output(print(x8a)$show()) + invisible(capture.output(expect_error(summary(x8a), NA))) + expect_output(summary(x8a)$show()) + x8aCodeBased <- eval(parse(text = getObjectRCode(x8a, stringWrapParagraphWidth = NULL))) + expect_equal(x8aCodeBased$alphaSpent, x8a$alphaSpent, tolerance = 1e-07) + expect_equal(x8aCodeBased$criticalValues, x8a$criticalValues, tolerance = 1e-07) + expect_equal(x8aCodeBased$stageLevels, x8a$stageLevels, tolerance = 1e-07) + expect_type(names(x8a), "character") + df <- as.data.frame(x8a) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x8a) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:criticalValuesWangTiatis} + x8b <- getDesignGroupSequential( + kMax = 3, alpha = 0.025, sided = 2, informationRates = c(0.3, 0.8, 1), + typeOfDesign = "WT", deltaWT = 0.24 + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x8b' with expected results + expect_equal(x8b$alphaSpent, c(0.0013603353, 0.013978861, 0.02499999), tolerance = 1e-07, label = paste0("c(", paste0(x8b$alphaSpent, collapse = ", "), ")")) + expect_equal(x8b$criticalValues, c(3.2029374, 2.4819703, 2.3420706), tolerance = 1e-07, label = paste0("c(", paste0(x8b$criticalValues, collapse = ", "), ")")) + expect_equal(x8b$stageLevels, c(0.00068016766, 0.0065329078, 0.0095885436), tolerance = 1e-07, label = paste0("c(", paste0(x8b$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x8b), NA))) + expect_output(print(x8b)$show()) + invisible(capture.output(expect_error(summary(x8b), NA))) + expect_output(summary(x8b)$show()) + x8bCodeBased <- eval(parse(text = getObjectRCode(x8b, stringWrapParagraphWidth = NULL))) + expect_equal(x8bCodeBased$alphaSpent, x8b$alphaSpent, tolerance = 1e-07) + expect_equal(x8bCodeBased$criticalValues, x8b$criticalValues, tolerance = 1e-07) + expect_equal(x8bCodeBased$stageLevels, x8b$stageLevels, tolerance = 1e-07) + expect_type(names(x8b), "character") + df <- as.data.frame(x8b) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x8b) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:criticalValuesWangTiatis} + x8c <- getDesignGroupSequential( + kMax = 3, alpha = 0.025, sided = 1, informationRates = c(0.3, 0.8, 1), + typeOfDesign = "WToptimum", beta = 0.23 + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x8c' with expected results + expect_equal(x8c$power, c(0.17785982, 0.63184407, 0.77), tolerance = 1e-07, label = paste0("c(", paste0(x8c$power, collapse = ", "), ")")) + expect_equal(x8c$deltaWT, 0.393, tolerance = 1e-07, label = paste0("c(", paste0(x8c$deltaWT, collapse = ", "), ")")) + expect_equal(x8c$alphaSpent, c(0.0067542296, 0.01805085, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(x8c$alphaSpent, collapse = ", "), ")")) + expect_equal(x8c$criticalValues, c(2.4700754, 2.2239834, 2.1715117), tolerance = 1e-07, label = paste0("c(", paste0(x8c$criticalValues, collapse = ", "), ")")) + expect_equal(x8c$stageLevels, c(0.0067542296, 0.013074779, 0.014946256), tolerance = 1e-07, label = paste0("c(", paste0(x8c$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x8c), NA))) + expect_output(print(x8c)$show()) + invisible(capture.output(expect_error(summary(x8c), NA))) + expect_output(summary(x8c)$show()) + x8cCodeBased <- eval(parse(text = getObjectRCode(x8c, stringWrapParagraphWidth = NULL))) + expect_equal(x8cCodeBased$power, x8c$power, tolerance = 1e-07) + expect_equal(x8cCodeBased$deltaWT, x8c$deltaWT, tolerance = 1e-07) + expect_equal(x8cCodeBased$alphaSpent, x8c$alphaSpent, tolerance = 1e-07) + expect_equal(x8cCodeBased$criticalValues, x8c$criticalValues, tolerance = 1e-07) + expect_equal(x8cCodeBased$stageLevels, x8c$stageLevels, tolerance = 1e-07) + expect_type(names(x8c), "character") + df <- as.data.frame(x8c) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x8c) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:criticalValuesWangTiatis} + x8d <- getDesignGroupSequential( + kMax = 4, alpha = 0.025, sided = 2, informationRates = c(0.3, 0.6, 0.8, 1), + typeOfDesign = "WToptimum", beta = 0.1, optimizationCriterion = "ASNH1" + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x8d' with expected results + expect_equal(x8d$power, c(0.27905065, 0.63899817, 0.80432197, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(x8d$power, collapse = ", "), ")")) + expect_equal(x8d$deltaWT, 0.479, tolerance = 1e-07, label = paste0("c(", paste0(x8d$deltaWT, collapse = ", "), ")")) + expect_equal(x8d$alphaSpent, c(0.0082066211, 0.015417447, 0.020576899, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(x8d$alphaSpent, collapse = ", "), ")")) + expect_equal(x8d$criticalValues, c(2.6434487, 2.6052491, 2.5895574, 2.577451), tolerance = 1e-07, label = paste0("c(", paste0(x8d$criticalValues, collapse = ", "), ")")) + expect_equal(x8d$stageLevels, c(0.0041033106, 0.0045903747, 0.0048049705, 0.0049765989), tolerance = 1e-07, label = paste0("c(", paste0(x8d$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x8d), NA))) + expect_output(print(x8d)$show()) + invisible(capture.output(expect_error(summary(x8d), NA))) + expect_output(summary(x8d)$show()) + x8dCodeBased <- eval(parse(text = getObjectRCode(x8d, stringWrapParagraphWidth = NULL))) + expect_equal(x8dCodeBased$power, x8d$power, tolerance = 1e-07) + expect_equal(x8dCodeBased$deltaWT, x8d$deltaWT, tolerance = 1e-07) + expect_equal(x8dCodeBased$alphaSpent, x8d$alphaSpent, tolerance = 1e-07) + expect_equal(x8dCodeBased$criticalValues, x8d$criticalValues, tolerance = 1e-07) + expect_equal(x8dCodeBased$stageLevels, x8d$stageLevels, tolerance = 1e-07) + expect_type(names(x8d), "character") + df <- as.data.frame(x8d) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x8d) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:criticalValuesWangTiatis} + x8e <- getDesignGroupSequential( + kMax = 4, alpha = 0.025, sided = 2, informationRates = c(0.3, 0.6, 0.8, 1), + typeOfDesign = "WToptimum", beta = 0.1, optimizationCriterion = "ASNsum" + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x8e' with expected results + expect_equal(x8e$power, c(0.068425642, 0.50677837, 0.76253381, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(x8e$power, collapse = ", "), ")")) + expect_equal(x8e$deltaWT, 0.181, tolerance = 1e-07, label = paste0("c(", paste0(x8e$deltaWT, collapse = ", "), ")")) + expect_equal(x8e$alphaSpent, c(0.00055484217, 0.0059655413, 0.01417086, 0.02499999), tolerance = 1e-07, label = paste0("c(", paste0(x8e$alphaSpent, collapse = ", "), ")")) + expect_equal(x8e$criticalValues, c(3.4527796, 2.7678356, 2.5251363, 2.3516384), tolerance = 1e-07, label = paste0("c(", paste0(x8e$criticalValues, collapse = ", "), ")")) + expect_equal(x8e$stageLevels, c(0.00027742108, 0.0028214959, 0.0057826708, 0.0093454685), tolerance = 1e-07, label = paste0("c(", paste0(x8e$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x8e), NA))) + expect_output(print(x8e)$show()) + invisible(capture.output(expect_error(summary(x8e), NA))) + expect_output(summary(x8e)$show()) + x8eCodeBased <- eval(parse(text = getObjectRCode(x8e, stringWrapParagraphWidth = NULL))) + expect_equal(x8eCodeBased$power, x8e$power, tolerance = 1e-07) + expect_equal(x8eCodeBased$deltaWT, x8e$deltaWT, tolerance = 1e-07) + expect_equal(x8eCodeBased$alphaSpent, x8e$alphaSpent, tolerance = 1e-07) + expect_equal(x8eCodeBased$criticalValues, x8e$criticalValues, tolerance = 1e-07) + expect_equal(x8eCodeBased$stageLevels, x8e$stageLevels, tolerance = 1e-07) + expect_type(names(x8e), "character") + df <- as.data.frame(x8e) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x8e) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignGroupSequential' with Haybittle Peto boundaries", { + + .skipTestIfDisabled() + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:criticalValuesHaybittlePeto} + x9 <- getDesignGroupSequential(kMax = 4, alpha = 0.025, typeOfDesign = "HP") + + ## Comparison of the results of TrialDesignGroupSequential object 'x9' with expected results + expect_equal(x9$alphaSpent, c(0.001349898, 0.0024617416, 0.0033695882, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(x9$alphaSpent, collapse = ", "), ")")) + expect_equal(x9$criticalValues, c(3, 3, 3, 1.9827514), tolerance = 1e-07, label = paste0("c(", paste0(x9$criticalValues, collapse = ", "), ")")) + expect_equal(x9$stageLevels, c(0.001349898, 0.001349898, 0.001349898, 0.023697604), tolerance = 1e-07, label = paste0("c(", paste0(x9$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x9), NA))) + expect_output(print(x9)$show()) + invisible(capture.output(expect_error(summary(x9), NA))) + expect_output(summary(x9)$show()) + x9CodeBased <- eval(parse(text = getObjectRCode(x9, stringWrapParagraphWidth = NULL))) + expect_equal(x9CodeBased$alphaSpent, x9$alphaSpent, tolerance = 1e-07) + expect_equal(x9CodeBased$criticalValues, x9$criticalValues, tolerance = 1e-07) + expect_equal(x9CodeBased$stageLevels, x9$stageLevels, tolerance = 1e-07) + expect_type(names(x9), "character") + df <- as.data.frame(x9) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x9) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignGroupSequential' with Pampallona Tsiatis boundaries, binding and non-binding futility bounds", { + + .skipTestIfDisabled() + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:criticalValuesPampallonaTiatis} + x10 <- getDesignGroupSequential( + kMax = 3, alpha = 0.035, beta = 0.1, + informationRates = c(0.3, 0.8, 1), typeOfDesign = "PT", sided = 1, + bindingFutility = TRUE, deltaPT1 = 0.2, deltaPT0 = 0.3 + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x10' with expected results + expect_equal(x10$power, c(0.19834666, 0.83001122, 0.9), tolerance = 1e-07, label = paste0("c(", paste0(x10$power, collapse = ", "), ")")) + expect_equal(x10$futilityBounds, c(-0.042079545, 1.4407359), tolerance = 1e-07, label = paste0("c(", paste0(x10$futilityBounds, collapse = ", "), ")")) + expect_equal(x10$alphaSpent, c(0.0038332428, 0.024917169, 0.035), tolerance = 1e-07, label = paste0("c(", paste0(x10$alphaSpent, collapse = ", "), ")")) + expect_equal(x10$betaSpent, c(0.031375368, 0.080734151, 0.1), tolerance = 1e-07, label = paste0("c(", paste0(x10$betaSpent, collapse = ", "), ")")) + expect_equal(x10$criticalValues, c(2.6664156, 1.9867225, 1.8580792), tolerance = 1e-07, label = paste0("c(", paste0(x10$criticalValues, collapse = ", "), ")")) + expect_equal(x10$stageLevels, c(0.0038332428, 0.023476576, 0.031578886), tolerance = 1e-07, label = paste0("c(", paste0(x10$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x10), NA))) + expect_output(print(x10)$show()) + invisible(capture.output(expect_error(summary(x10), NA))) + expect_output(summary(x10)$show()) + x10CodeBased <- eval(parse(text = getObjectRCode(x10, stringWrapParagraphWidth = NULL))) + expect_equal(x10CodeBased$power, x10$power, tolerance = 1e-07) + expect_equal(x10CodeBased$futilityBounds, x10$futilityBounds, tolerance = 1e-07) + expect_equal(x10CodeBased$alphaSpent, x10$alphaSpent, tolerance = 1e-07) + expect_equal(x10CodeBased$betaSpent, x10$betaSpent, tolerance = 1e-07) + expect_equal(x10CodeBased$criticalValues, x10$criticalValues, tolerance = 1e-07) + expect_equal(x10CodeBased$stageLevels, x10$stageLevels, tolerance = 1e-07) + expect_type(names(x10), "character") + df <- as.data.frame(x10) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x10) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:criticalValuesPampallonaTiatis} + x11 <- getDesignGroupSequential( + kMax = 3, alpha = 0.035, beta = 0.05, + informationRates = c(0.3, 0.8, 1), typeOfDesign = "PT", sided = 2, + bindingFutility = TRUE, deltaPT1 = 0.2, deltaPT0 = 0.3 + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x11' with expected results + expect_equal(x11$power, c(0.16615376, 0.88013007, 0.94999991), tolerance = 1e-07, label = paste0("c(", paste0(x11$power, collapse = ", "), ")")) + expect_equal(x11$futilityBounds, c(NA_real_, 1.671433), tolerance = 1e-07, label = paste0("c(", paste0(x11$futilityBounds, collapse = ", "), ")")) + expect_equal(x11$alphaSpent, c(0.0019236202, 0.022017713, 0.035), tolerance = 1e-07, label = paste0("c(", paste0(x11$alphaSpent, collapse = ", "), ")")) + expect_equal(x11$betaSpent, c(0, 0.035025978, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(x11$betaSpent, collapse = ", "), ")")) + expect_equal(x11$criticalValues, c(3.1017782, 2.3111074, 2.1614596), tolerance = 1e-07, label = paste0("c(", paste0(x11$criticalValues, collapse = ", "), ")")) + expect_equal(x11$stageLevels, c(0.00096181012, 0.010413463, 0.015329928), tolerance = 1e-07, label = paste0("c(", paste0(x11$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x11), NA))) + expect_output(print(x11)$show()) + invisible(capture.output(expect_error(summary(x11), NA))) + expect_output(summary(x11)$show()) + x11CodeBased <- eval(parse(text = getObjectRCode(x11, stringWrapParagraphWidth = NULL))) + expect_equal(x11CodeBased$power, x11$power, tolerance = 1e-07) + expect_equal(x11CodeBased$futilityBounds, x11$futilityBounds, tolerance = 1e-07) + expect_equal(x11CodeBased$alphaSpent, x11$alphaSpent, tolerance = 1e-07) + expect_equal(x11CodeBased$betaSpent, x11$betaSpent, tolerance = 1e-07) + expect_equal(x11CodeBased$criticalValues, x11$criticalValues, tolerance = 1e-07) + expect_equal(x11CodeBased$stageLevels, x11$stageLevels, tolerance = 1e-07) + expect_type(names(x11), "character") + df <- as.data.frame(x11) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x11) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:criticalValuesPampallonaTiatis} + x12 <- getDesignGroupSequential( + kMax = 3, alpha = 0.035, beta = 0.05, + informationRates = c(0.3, 0.8, 1), typeOfDesign = "PT", sided = 2, + bindingFutility = FALSE, deltaPT1 = 0.2, deltaPT0 = 0.3 + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x12' with expected results + expect_equal(x12$power, c(0.15712278, 0.87874666, 0.94999994), tolerance = 1e-07, label = paste0("c(", paste0(x12$power, collapse = ", "), ")")) + expect_equal(x12$futilityBounds, c(NA_real_, 1.7090472), tolerance = 1e-07, label = paste0("c(", paste0(x12$futilityBounds, collapse = ", "), ")")) + expect_equal(x12$alphaSpent, c(0.0015647742, 0.019435851, 0.035), tolerance = 1e-07, label = paste0("c(", paste0(x12$alphaSpent, collapse = ", "), ")")) + expect_equal(x12$betaSpent, c(0, 0.034947415, 0.05), tolerance = 1e-07, label = paste0("c(", paste0(x12$betaSpent, collapse = ", "), ")")) + expect_equal(x12$criticalValues, c(3.1623945, 2.356272, 2.2036998), tolerance = 1e-07, label = paste0("c(", paste0(x12$criticalValues, collapse = ", "), ")")) + expect_equal(x12$stageLevels, c(0.00078238709, 0.0092296971, 0.013772733), tolerance = 1e-07, label = paste0("c(", paste0(x12$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x12), NA))) + expect_output(print(x12)$show()) + invisible(capture.output(expect_error(summary(x12), NA))) + expect_output(summary(x12)$show()) + x12CodeBased <- eval(parse(text = getObjectRCode(x12, stringWrapParagraphWidth = NULL))) + expect_equal(x12CodeBased$power, x12$power, tolerance = 1e-07) + expect_equal(x12CodeBased$futilityBounds, x12$futilityBounds, tolerance = 1e-07) + expect_equal(x12CodeBased$alphaSpent, x12$alphaSpent, tolerance = 1e-07) + expect_equal(x12CodeBased$betaSpent, x12$betaSpent, tolerance = 1e-07) + expect_equal(x12CodeBased$criticalValues, x12$criticalValues, tolerance = 1e-07) + expect_equal(x12CodeBased$stageLevels, x12$stageLevels, tolerance = 1e-07) + expect_type(names(x12), "character") + df <- as.data.frame(x12) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x12) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:criticalValuesPampallonaTiatis} + x13 <- getDesignGroupSequential( + kMax = 4, alpha = 0.035, beta = 0.05, + informationRates = c(0.2, 0.4, 0.8, 1), typeOfDesign = "PT", sided = 1, + bindingFutility = FALSE, deltaPT1 = 0.1, deltaPT0 = 0.45 + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x13' with expected results + expect_equal(x13$power, c(0.029518378, 0.38853658, 0.90760886, 0.95), tolerance = 1e-07, label = paste0("c(", paste0(x13$power, collapse = ", "), ")")) + expect_equal(x13$futilityBounds, c(-0.41499566, 0.38106631, 1.4738957), tolerance = 1e-07, label = paste0("c(", paste0(x13$futilityBounds, collapse = ", "), ")")) + expect_equal(x13$alphaSpent, c(0.00014050218, 0.0030266381, 0.0199021, 0.035), tolerance = 1e-07, label = paste0("c(", paste0(x13$alphaSpent, collapse = ", "), ")")) + expect_equal(x13$betaSpent, c(0.015413989, 0.028721092, 0.043215976, 0.049999999), tolerance = 1e-07, label = paste0("c(", paste0(x13$betaSpent, collapse = ", "), ")")) + expect_equal(x13$criticalValues, c(3.6322099, 2.7527004, 2.0861568, 1.9080201), tolerance = 1e-07, label = paste0("c(", paste0(x13$criticalValues, collapse = ", "), ")")) + expect_equal(x13$stageLevels, c(0.00014050218, 0.002955298, 0.018482211, 0.02819431), tolerance = 1e-07, label = paste0("c(", paste0(x13$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x13), NA))) + expect_output(print(x13)$show()) + invisible(capture.output(expect_error(summary(x13), NA))) + expect_output(summary(x13)$show()) + x13CodeBased <- eval(parse(text = getObjectRCode(x13, stringWrapParagraphWidth = NULL))) + expect_equal(x13CodeBased$power, x13$power, tolerance = 1e-07) + expect_equal(x13CodeBased$futilityBounds, x13$futilityBounds, tolerance = 1e-07) + expect_equal(x13CodeBased$alphaSpent, x13$alphaSpent, tolerance = 1e-07) + expect_equal(x13CodeBased$betaSpent, x13$betaSpent, tolerance = 1e-07) + expect_equal(x13CodeBased$criticalValues, x13$criticalValues, tolerance = 1e-07) + expect_equal(x13CodeBased$stageLevels, x13$stageLevels, tolerance = 1e-07) + expect_type(names(x13), "character") + df <- as.data.frame(x13) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x13) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + + # @refFS[Tab.]{fs:tab:output:getDesignGroupSequential} + # @refFS[Formula]{fs:criticalValuesPampallonaTiatis} + x14 <- getDesignGroupSequential( + kMax = 6, alpha = 0.25, beta = 0.01, + typeOfDesign = "PT", sided = 2, + bindingFutility = TRUE, deltaPT1 = 0.02, deltaPT0 = 0.49, twoSidedPower = TRUE + ) + + ## Comparison of the results of TrialDesignGroupSequential object 'x14' with expected results + expect_equal(x14$power, c(0.076493626, 0.52863814, 0.83456395, 0.94950066, 0.98346861, 0.99), tolerance = 1e-07, label = paste0("c(", paste0(x14$power, collapse = ", "), ")")) + expect_equal(x14$futilityBounds, c(NA_real_, NA_real_, 0.12661836, 0.55308248, 0.92800873), tolerance = 1e-07, label = paste0("c(", paste0(x14$futilityBounds, collapse = ", "), ")")) + expect_equal(x14$alphaSpent, c(0.0027626806, 0.03301126, 0.088857236, 0.15440485, 0.2156594, 0.25), tolerance = 1e-07, label = paste0("c(", paste0(x14$alphaSpent, collapse = ", "), ")")) + expect_equal(x14$betaSpent, c(0, 0, 0.0026196848, 0.0066701046, 0.0089493411, 0.01), tolerance = 1e-07, label = paste0("c(", paste0(x14$betaSpent, collapse = ", "), ")")) + expect_equal(x14$criticalValues, c(2.9929798, 2.1458995, 1.7663859, 1.5385619, 1.3822869, 1.2664591), tolerance = 1e-07, label = paste0("c(", paste0(x14$criticalValues, collapse = ", "), ")")) + expect_equal(x14$stageLevels, c(0.0013813403, 0.015940498, 0.038665568, 0.061955638, 0.08344182, 0.10267438), tolerance = 1e-07, label = paste0("c(", paste0(x14$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x14), NA))) + expect_output(print(x14)$show()) + invisible(capture.output(expect_error(summary(x14), NA))) + expect_output(summary(x14)$show()) + x14CodeBased <- eval(parse(text = getObjectRCode(x14, stringWrapParagraphWidth = NULL))) + expect_equal(x14CodeBased$power, x14$power, tolerance = 1e-07) + expect_equal(x14CodeBased$futilityBounds, x14$futilityBounds, tolerance = 1e-07) + expect_equal(x14CodeBased$alphaSpent, x14$alphaSpent, tolerance = 1e-07) + expect_equal(x14CodeBased$betaSpent, x14$betaSpent, tolerance = 1e-07) + expect_equal(x14CodeBased$criticalValues, x14$criticalValues, tolerance = 1e-07) + expect_equal(x14CodeBased$stageLevels, x14$stageLevels, tolerance = 1e-07) + expect_type(names(x14), "character") + df <- as.data.frame(x14) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x14) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + +}) + +test_that("'getDesignGroupSequential' with type of design = 'noEarlyEfficacy'", { + + .skipTestIfDisabled() + + # @refFS[Tab.]{fs:tab:output:getDesignInverseNormal} + # @refFS[Formula]{fs:alphaSpendingConcept} + x15 <- getDesignGroupSequential( + typeOfDesign = "noEarlyEfficacy", + futilityBounds = c(0, 0.5) + ) + + + ## Comparison of the results of TrialDesignGroupSequential object 'x15' with expected results + expect_equal(x15$alphaSpent, c(6.6613381e-16, -1.3145041e-13, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(x15$alphaSpent, collapse = ", "), ")")) + expect_equal(x15$criticalValues, c(Inf, Inf, 1.959964), tolerance = 1e-07, label = paste0("c(", paste0(x15$criticalValues, collapse = ", "), ")")) + expect_equal(x15$stageLevels, c(0, 0, 0.025), tolerance = 1e-07, label = paste0("c(", paste0(x15$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x15), NA))) + expect_output(print(x15)$show()) + invisible(capture.output(expect_error(summary(x15), NA))) + expect_output(summary(x15)$show()) + x15CodeBased <- eval(parse(text = getObjectRCode(x15, stringWrapParagraphWidth = NULL))) + expect_equal(x15CodeBased$alphaSpent, x15$alphaSpent, tolerance = 1e-07) + expect_equal(x15CodeBased$criticalValues, x15$criticalValues, tolerance = 1e-07) + expect_equal(x15CodeBased$stageLevels, x15$stageLevels, tolerance = 1e-07) + expect_type(names(x15), "character") + df <- as.data.frame(x15) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x15) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } + x16 <- getDesignGroupSequential( + typeOfDesign = "noEarlyEfficacy", + futilityBounds = c(0, 0.5, 1), + bindingFutility = TRUE + ) + + + ## Comparison of the results of TrialDesignGroupSequential object 'x16' with expected results + expect_equal(x16$alphaSpent, c(6.6613381e-16, 1.110223e-15, 4.8067383e-11, 0.02499999), tolerance = 1e-07, label = paste0("c(", paste0(x16$alphaSpent, collapse = ", "), ")")) + expect_equal(x16$criticalValues, c(Inf, Inf, Inf, 1.8848634), tolerance = 1e-07, label = paste0("c(", paste0(x16$criticalValues, collapse = ", "), ")")) + expect_equal(x16$stageLevels, c(0, 0, 0, 0.029724142), tolerance = 1e-07, label = paste0("c(", paste0(x16$stageLevels, collapse = ", "), ")")) + if (isTRUE(.isCompleteUnitTestSetEnabled())) { + invisible(capture.output(expect_error(print(x16), NA))) + expect_output(print(x16)$show()) + invisible(capture.output(expect_error(summary(x16), NA))) + expect_output(summary(x16)$show()) + x16CodeBased <- eval(parse(text = getObjectRCode(x16, stringWrapParagraphWidth = NULL))) + expect_equal(x16CodeBased$alphaSpent, x16$alphaSpent, tolerance = 1e-07) + expect_equal(x16CodeBased$criticalValues, x16$criticalValues, tolerance = 1e-07) + expect_equal(x16CodeBased$stageLevels, x16$stageLevels, tolerance = 1e-07) + expect_type(names(x16), "character") + df <- as.data.frame(x16) + expect_s3_class(df, "data.frame") + expect_true(nrow(df) > 0 && ncol(df) > 0) + mtx <- as.matrix(x16) + expect_true(is.matrix(mtx)) + expect_true(nrow(mtx) > 0 && ncol(mtx) > 0) + } +}) + +test_that("'getDesignInverseNormal': illegal arguments throw exceptions as expected", { + + expect_error(getDesignInverseNormal( + typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, + userAlphaSpending = c(0.01, 0.02, 0.023, 0.023, 0.025), kMax = 4 + ), + paste0( + "Conflicting arguments: length of 'userAlphaSpending' (5) ", + "must be equal to 'kMax' (4)" + ), + fixed = TRUE + ) + + expect_error(getDesignInverseNormal( + typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, + userAlphaSpending = c(0.01, 0.02, 0.023, 0.023, 0.021) + ), + paste0( + "'userAlphaSpending' = c(0.01, 0.02, 0.023, 0.023, 0.021) must be a vector that ", + "satisfies the following condition: 0 <= alpha_1 <= .. <= alpha_5 <= alpha = 0.021" + ), + fixed = TRUE + ) + + expect_error(getDesignInverseNormal( + typeOfDesign = "asUser", + userAlphaSpending = c(0.01, 0.02, 0.023), alpha = 0.02 + ), + paste0( + "'userAlphaSpending' = c(0.01, 0.02, 0.023) must be a vector that ", + "satisfies the following condition: 0 <= alpha_1 <= .. <= alpha_3 <= alpha = 0.02" + ), + fixed = TRUE + ) + + expect_error(getDesignInverseNormal(typeOfDesign = C_TYPE_OF_DESIGN_WT, deltaWT = NA_real_), + "Missing argument: parameter 'deltaWT' must be specified in design", + fixed = TRUE + ) + + expect_error(getDesignInverseNormal( + typeOfDesign = C_TYPE_OF_DESIGN_WT_OPTIMUM, + optimizationCriterion = "x" + ), + "Illegal argument: optimization criterion must be one of the following: 'ASNH1', 'ASNIFH1', 'ASNsum'", + fixed = TRUE + ) + + expect_error(getDesignInverseNormal(typeOfDesign = C_TYPE_OF_DESIGN_AS_KD, gammaA = NA_real_), + "Missing argument: parameter 'gammaA' must be specified in design", + fixed = TRUE + ) + + expect_error(getDesignInverseNormal(typeOfDesign = C_TYPE_OF_DESIGN_AS_HSD, gammaA = NA_real_), + "Missing argument: parameter 'gammaA' must be specified in design", + fixed = TRUE + ) + + expect_error(getDesignInverseNormal(typeOfDesign = C_TYPE_OF_DESIGN_AS_USER), + "Missing argument: parameter 'userAlphaSpending' must be specified in design", + fixed = TRUE + ) + + expect_error(getDesignInverseNormal( + typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, + userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = "x" + ), + "Illegal argument: type of beta spending must be one of the following: 'none', 'bsP', 'bsOF', 'bsKD', 'bsHSD', 'bsUser'", + fixed = TRUE + ) + + expect_error(getDesignInverseNormal( + typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, + userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER + ), + "Missing argument: parameter 'userBetaSpending' must be specified in design", + fixed = TRUE + ) + + expect_error(getDesignInverseNormal( + typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, + userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER, + userBetaSpending = c(0.1, 0.2) + ), + paste0( + "Conflicting arguments: length of 'userBetaSpending' (2) must ", + "be equal to length of 'informationRates' (3)" + ), + fixed = TRUE + ) + + expect_error(getDesignInverseNormal( + typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, + userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER, + userBetaSpending = c(0.2, 0.1, 0.05) + ), + paste0( + "'userBetaSpending' = c(0.2, 0.1, 0.05) must be a vector that satisfies the ", + "following condition: 0 <= beta_1 <= .. <= beta_3 <= beta = 0.05" + ), + fixed = TRUE + ) + + expect_error(getDesignInverseNormal( + typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, + userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER, + userBetaSpending = c(0.1, 0.2, 0.3), beta = 0.2 + ), + paste0( + "'userBetaSpending' = c(0.1, 0.2, 0.3) must be a vector that satisfies the ", + "following condition: 0 <= beta_1 <= .. <= beta_3 <= beta = 0.2" + ), + fixed = TRUE + ) + + expect_error(getDesignInverseNormal(kMax = Inf), + paste0( + "Argument out of bounds: 'kMax' (Inf) is out of bounds [1; ", + C_KMAX_UPPER_BOUND, "]" + ), + fixed = TRUE + ) + + expect_error(getDesignInverseNormal(kMax = -Inf), + paste0( + "Argument out of bounds: 'kMax' (-Inf) is out of bounds [1; ", + C_KMAX_UPPER_BOUND, "]" + ), + fixed = TRUE + ) + + expect_error(getDesignInverseNormal(kMax = -Inf), "Argument out of bounds: 'kMax' (-Inf) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = -10), "Argument out of bounds: 'kMax' (-10) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = -9), "Argument out of bounds: 'kMax' (-9) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = -8), "Argument out of bounds: 'kMax' (-8) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = -7), "Argument out of bounds: 'kMax' (-7) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = -6), "Argument out of bounds: 'kMax' (-6) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = -5), "Argument out of bounds: 'kMax' (-5) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = -4), "Argument out of bounds: 'kMax' (-4) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = -3), "Argument out of bounds: 'kMax' (-3) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = -2), "Argument out of bounds: 'kMax' (-2) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = -1), "Argument out of bounds: 'kMax' (-1) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 0), "Argument out of bounds: 'kMax' (0) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 21), "Argument out of bounds: 'kMax' (21) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 22), "Argument out of bounds: 'kMax' (22) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 23), "Argument out of bounds: 'kMax' (23) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 24), "Argument out of bounds: 'kMax' (24) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 25), "Argument out of bounds: 'kMax' (25) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 26), "Argument out of bounds: 'kMax' (26) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 27), "Argument out of bounds: 'kMax' (27) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 28), "Argument out of bounds: 'kMax' (28) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 29), "Argument out of bounds: 'kMax' (29) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 30), "Argument out of bounds: 'kMax' (30) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = Inf), "Argument out of bounds: 'kMax' (Inf) is out of bounds [1; 20]", fixed = TRUE) + + expect_error(getDesignInverseNormal(kMax = 2, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (2) - 1", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 3, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (3) - 1", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 4, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (4) - 1", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 6, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (6) - 1", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 7, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (7) - 1", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 8, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (8) - 1", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 9, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (9) - 1", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 10, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (10) - 1", fixed = TRUE) + + expect_warning(expect_error(getDesignInverseNormal(kMax = 11, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (11) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 12, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (12) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 13, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (13) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 14, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (14) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 15, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (15) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 16, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (16) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 17, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (17) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 18, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (18) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 19, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (19) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 20, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (20) - 1", fixed = TRUE)) + + expect_error(getDesignInverseNormal(futilityBounds = c(-7, 5)), + "Illegal argument: 'futilityBounds' (-7, 5) too extreme for this situation", + fixed = TRUE + ) + + expect_error(getDesignInverseNormal(futilityBounds = c(1, 7)), + "Argument out of bounds: 'futilityBounds' (1, 7) is out of bounds [-Inf; 6]", + fixed = TRUE + ) + +}) + +test_that("'getDesignGroupSequential': illegal arguments throw exceptions as expected", { + + expect_error(getDesignGroupSequential( + typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, + userAlphaSpending = c(0.01, 0.02, 0.023, 0.023, 0.025), kMax = 4 + ), + paste0( + "Conflicting arguments: length of 'userAlphaSpending' (5) ", + "must be equal to 'kMax' (4)" + ), + fixed = TRUE + ) + + expect_error(getDesignGroupSequential( + typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, + userAlphaSpending = c(0.01, 0.02, 0.023, 0.023, 0.021) + ), + paste0( + "'userAlphaSpending' = c(0.01, 0.02, 0.023, 0.023, 0.021) must be a vector that ", + "satisfies the following condition: 0 <= alpha_1 <= .. <= alpha_5 <= alpha = 0.021" + ), + fixed = TRUE + ) + + expect_error(getDesignGroupSequential( + typeOfDesign = "asUser", + userAlphaSpending = c(0.01, 0.02, 0.023), alpha = 0.02 + ), + paste0( + "'userAlphaSpending' = c(0.01, 0.02, 0.023) must be a vector that ", + "satisfies the following condition: 0 <= alpha_1 <= .. <= alpha_3 <= alpha = 0.02" + ), + fixed = TRUE + ) + + expect_equal(getDesignGroupSequential( + typeOfDesign = "asUser", + userAlphaSpending = c(0.01, 0.02, 0.023) + )$alpha, 0.023) + + expect_error(getDesignGroupSequential(typeOfDesign = C_TYPE_OF_DESIGN_WT, deltaWT = NA_real_), + "Missing argument: parameter 'deltaWT' must be specified in design", + fixed = TRUE + ) + + expect_error(getDesignGroupSequential( + typeOfDesign = C_TYPE_OF_DESIGN_WT_OPTIMUM, + optimizationCriterion = "x" + ), + "Illegal argument: optimization criterion must be one of the following: 'ASNH1', 'ASNIFH1', 'ASNsum'", + fixed = TRUE + ) + + expect_error(getDesignGroupSequential(typeOfDesign = C_TYPE_OF_DESIGN_AS_KD, gammaA = NA_real_), + "Missing argument: parameter 'gammaA' must be specified in design", + fixed = TRUE + ) + + expect_error(getDesignGroupSequential(typeOfDesign = C_TYPE_OF_DESIGN_AS_HSD, gammaA = NA_real_), + "Missing argument: parameter 'gammaA' must be specified in design", + fixed = TRUE + ) + + expect_error(getDesignGroupSequential(typeOfDesign = C_TYPE_OF_DESIGN_AS_USER), + "Missing argument: parameter 'userAlphaSpending' must be specified in design", + fixed = TRUE + ) + + expect_error(getDesignGroupSequential( + typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, + userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = "x" + ), + paste0( + "Illegal argument: type of beta spending must be one of the following: ", + "'none', 'bsP', 'bsOF', 'bsKD', 'bsHSD', 'bsUser'" + ), + fixed = TRUE + ) + + expect_error(getDesignGroupSequential( + typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, + userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER + ), + "Missing argument: parameter 'userBetaSpending' must be specified in design", + fixed = TRUE + ) + + expect_error(getDesignGroupSequential( + typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, + userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER, + userBetaSpending = c(0.1, 0.2) + ), + paste0( + "Conflicting arguments: length of 'userBetaSpending' (2) must ", + "be equal to length of 'informationRates' (3)" + ), + fixed = TRUE + ) + + expect_error(getDesignGroupSequential( + typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, + userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER, + userBetaSpending = c(0.2, 0.1, 0.05) + ), + paste0( + "'userBetaSpending' = c(0.2, 0.1, 0.05) must be a vector that satisfies the ", + "following condition: 0 <= beta_1 <= .. <= beta_3 <= beta = 0.05" + ), + fixed = TRUE + ) + + expect_error(getDesignGroupSequential( + typeOfDesign = C_TYPE_OF_DESIGN_AS_USER, + userAlphaSpending = c(0.01, 0.02, 0.025), typeBetaSpending = C_TYPE_OF_DESIGN_BS_USER, + userBetaSpending = c(0.1, 0.2, 0.3), beta = 0.2 + ), + paste0( + "'userBetaSpending' = c(0.1, 0.2, 0.3) must be a vector that satisfies the ", + "following condition: 0 <= beta_1 <= .. <= beta_3 <= beta = 0.2" + ), + fixed = TRUE + ) + + expect_error(getDesignGroupSequential(kMax = Inf), + paste0( + "Argument out of bounds: 'kMax' (Inf) is out of bounds [1; ", + C_KMAX_UPPER_BOUND, "]" + ), + fixed = TRUE + ) + + expect_error(getDesignGroupSequential(kMax = -Inf), + paste0( + "Argument out of bounds: 'kMax' (-Inf) is out of bounds [1; ", + C_KMAX_UPPER_BOUND, "]" + ), + fixed = TRUE + ) + + expect_error(getDesignInverseNormal(kMax = -5), "Argument out of bounds: 'kMax' (-5) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 0), "Argument out of bounds: 'kMax' (0) is out of bounds [1; 20]", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 21), "Argument out of bounds: 'kMax' (21) is out of bounds [1; 20]", fixed = TRUE) + + expect_error(getDesignInverseNormal(kMax = 2, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (2) - 1", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 3, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (3) - 1", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 4, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (4) - 1", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 6, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (6) - 1", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 7, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (7) - 1", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 8, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (8) - 1", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 9, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (9) - 1", fixed = TRUE) + expect_error(getDesignInverseNormal(kMax = 10, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (10) - 1", fixed = TRUE) + + expect_warning(expect_error(getDesignInverseNormal(kMax = 11, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (11) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 12, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (12) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 13, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (13) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 14, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (14) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 15, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (15) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 16, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (16) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 17, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (17) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 18, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (18) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 19, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (19) - 1", fixed = TRUE)) + expect_warning(expect_error(getDesignInverseNormal(kMax = 20, futilityBounds = c(0, 0, 1, 2)), "Conflicting arguments: length of 'futilityBounds' (4) must be equal to 'kMax' (20) - 1", fixed = TRUE)) + + expect_error(getDesignGroupSequential(futilityBounds = c(-7, 5)), + "Illegal argument: 'futilityBounds' (-7, 5) too extreme for this situation", + fixed = TRUE + ) + + expect_error(getDesignGroupSequential(futilityBounds = c(1, 7)), + "Argument out of bounds: 'futilityBounds' (1, 7) is out of bounds [-Inf; 6]", + fixed = TRUE + ) +}) + diff --git a/tests/testthat/test-f_parameter_set_utilities.R b/tests/testthat/test-f_parameter_set_utilities.R index d5d433e3..1de0caff 100644 --- a/tests/testthat/test-f_parameter_set_utilities.R +++ b/tests/testthat/test-f_parameter_set_utilities.R @@ -1,87 +1,86 @@ -## | -## | *Unit tests* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | RPACT package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File name: test-f_parameter_set_utilities.R -## | Creation date: 08 November 2023, 09:10:53 -## | File version: $Revision$ -## | Last changed: $Date$ -## | Last changed by: $Author$ -## | - -test_plan_section("Testing Parameter Set Utility Functions") - - -test_that("'.getParameterValueFormatted' produce correct results if parameter is an array", { - x1 <- getSimulationMultiArmMeans(getDesignInverseNormal(kMax = 2), plannedSubjects = c(30, 60), muMaxVector = 0, seed = 123, maxNumberOfIterations = 50L) - y1 <- .getParameterValueFormatted(x1, "sampleSizes") - - expect_equal("sampleSizes", y1$paramName) - expect_equal(c(x1$.design$kMax, length(x1$muMaxVector), x1$activeArms + 1), dim(y1$paramValue)) - expect_equal(length(as.vector(y1$paramValue)), length(y1$paramValueFormatted)) - expect_equal("character", class(y1$paramValueFormatted)[1]) - expect_equal("array", y1$type) - - x2 <- getSimulationMultiArmMeans(getDesignInverseNormal(kMax = 2), plannedSubjects = c(50, 100), muMaxVector = c(0, 1), seed = 123, maxNumberOfIterations = 50L) - lines2a <- capture.output(print(x2)) - lines2 <- lines2a[grepl("Sample sizes ", lines2a)] - expect_match(lines2[1], "^ *Sample sizes \\(1\\) \\[1\\] *: 50, 50 *$") - expect_match(lines2[2], "^ *Sample sizes \\(1\\) \\[2\\] *: 17, 0 *$") - expect_match(lines2[3], "^ *Sample sizes \\(2\\) \\[1\\] *: 50, 50 *$") - expect_match(lines2[4], "^ *Sample sizes \\(2\\) \\[2\\] *: 17, 3.3 *$") - expect_match(lines2[5], "^ *Sample sizes \\(3\\) \\[1\\] *: 50, 50 *$") - expect_match(lines2[6], "^ *Sample sizes \\(3\\) \\[2\\] *: 16, 46.7 *$") - expect_match(lines2[7], "^ *Sample sizes \\(4\\) \\[1\\] *: 50, 50 *$") - expect_match(lines2[8], "^ *Sample sizes \\(4\\) \\[2\\] *: 50, 50 *$") - - x3 <- getSimulationMultiArmMeans(getDesignInverseNormal(kMax = 1), plannedSubjects = 50, muMaxVector = c(0, 1), seed = 123, maxNumberOfIterations = 50L) - - y3 <- .getParameterValueFormatted(x3, "sampleSizes") - - expect_equal("sampleSizes", y3$paramName) - expect_equal(c(x3$.design$kMax, length(x3$muMaxVector), x3$activeArms + 1), dim(y3$paramValue)) - expect_equal(length(as.vector(y3$paramValue)), length(y3$paramValueFormatted) * 2) - expect_equal("character", class(y3$paramValueFormatted)[1]) - expect_equal("array", y3$type) - - lines3a <- capture.output(print(x3)) - lines3 <- lines3a[grepl("Sample sizes ", lines3a)] - expect_match(lines3[1], "^ *Sample sizes \\(1\\) *: 50, 50 *$") - expect_match(lines3[2], "^ *Sample sizes \\(2\\) *: 50, 50 *$") - expect_match(lines3[3], "^ *Sample sizes \\(3\\) *: 50, 50 *$") - expect_match(lines3[4], "^ *Sample sizes \\(4\\) *: 50, 50 *$") - - x4 <- getSimulationMultiArmMeans(getDesignInverseNormal(kMax = 2), plannedSubjects = c(50, 100), muMaxVector = 0, seed = 123, maxNumberOfIterations = 50L) - - y4 <- .getParameterValueFormatted(x4, "sampleSizes") - - expect_equal("sampleSizes", y4$paramName) - expect_equal(c(x4$.design$kMax, length(x4$muMaxVector), x4$activeArms + 1), dim(y4$paramValue)) - expect_equal(length(as.vector(y4$paramValue)), length(y4$paramValueFormatted)) - expect_equal("character", class(y4$paramValueFormatted)[1]) - expect_equal("array", y4$type) - - lines4a <- capture.output(print(x4)) - lines4 <- lines4a[grepl("Sample sizes ", lines4a)] - expect_match(lines4[1], "^ *Sample sizes \\(1\\) \\[1\\] *: 50 *$") - expect_match(lines4[2], "^ *Sample sizes \\(1\\) \\[2\\] *: 17 *$") - expect_match(lines4[3], "^ *Sample sizes \\(2\\) \\[1\\] *: 50 *$") - expect_match(lines4[4], "^ *Sample sizes \\(2\\) \\[2\\] *: 17 *$") - expect_match(lines4[5], "^ *Sample sizes \\(3\\) \\[1\\] *: 50 *$") - expect_match(lines4[6], "^ *Sample sizes \\(3\\) \\[2\\] *: 16 *$") - expect_match(lines4[7], "^ *Sample sizes \\(4\\) \\[1\\] *: 50 *$") - expect_match(lines4[8], "^ *Sample sizes \\(4\\) \\[2\\] *: 50 *$") - -}) - +## | +## | *Unit tests* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | RPACT package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File name: test-f_parameter_set_utilities.R +## | Creation date: 08 November 2023, 09:10:53 +## | File version: $Revision$ +## | Last changed: $Date$ +## | Last changed by: $Author$ +## | + +test_plan_section("Testing Parameter Set Utility Functions") + + +test_that("'.getParameterValueFormatted' produce correct results if parameter is an array", { + x1 <- getSimulationMultiArmMeans(getDesignInverseNormal(kMax = 2), plannedSubjects = c(30, 60), muMaxVector = 0, seed = 123, maxNumberOfIterations = 50L) + y1 <- .getParameterValueFormatted(x1, "sampleSizes") + + expect_equal("sampleSizes", y1$paramName) + expect_equal(c(x1$.design$kMax, length(x1$muMaxVector), x1$activeArms + 1), dim(y1$paramValue)) + expect_equal(length(as.vector(y1$paramValue)), length(y1$paramValueFormatted)) + expect_equal("character", class(y1$paramValueFormatted)[1]) + expect_equal("array", y1$type) + + x2 <- getSimulationMultiArmMeans(getDesignInverseNormal(kMax = 2), plannedSubjects = c(50, 100), muMaxVector = c(0, 1), seed = 123, maxNumberOfIterations = 50L) + lines2a <- capture.output(print(x2)) + lines2 <- lines2a[grepl("Sample sizes ", lines2a)] + expect_match(lines2[1], "^ *Sample sizes \\(1\\) \\[1\\] *: 50, 50 *$") + expect_match(lines2[2], "^ *Sample sizes \\(1\\) \\[2\\] *: 17, 0 *$") + expect_match(lines2[3], "^ *Sample sizes \\(2\\) \\[1\\] *: 50, 50 *$") + expect_match(lines2[4], "^ *Sample sizes \\(2\\) \\[2\\] *: 17, 3.3 *$") + expect_match(lines2[5], "^ *Sample sizes \\(3\\) \\[1\\] *: 50, 50 *$") + expect_match(lines2[6], "^ *Sample sizes \\(3\\) \\[2\\] *: 16, 46.7 *$") + expect_match(lines2[7], "^ *Sample sizes \\(4\\) \\[1\\] *: 50, 50 *$") + expect_match(lines2[8], "^ *Sample sizes \\(4\\) \\[2\\] *: 50, 50 *$") + + x3 <- getSimulationMultiArmMeans(getDesignInverseNormal(kMax = 1), plannedSubjects = 50, muMaxVector = c(0, 1), seed = 123, maxNumberOfIterations = 50L) + + y3 <- .getParameterValueFormatted(x3, "sampleSizes") + + expect_equal("sampleSizes", y3$paramName) + expect_equal(c(x3$.design$kMax, length(x3$muMaxVector), x3$activeArms + 1), dim(y3$paramValue)) + expect_equal(length(as.vector(y3$paramValue)), length(y3$paramValueFormatted) * 2) + expect_equal("character", class(y3$paramValueFormatted)[1]) + expect_equal("array", y3$type) + + lines3a <- capture.output(print(x3)) + lines3 <- lines3a[grepl("Sample sizes ", lines3a)] + expect_match(lines3[1], "^ *Sample sizes \\(1\\) *: 50, 50 *$") + expect_match(lines3[2], "^ *Sample sizes \\(2\\) *: 50, 50 *$") + expect_match(lines3[3], "^ *Sample sizes \\(3\\) *: 50, 50 *$") + expect_match(lines3[4], "^ *Sample sizes \\(4\\) *: 50, 50 *$") + + x4 <- getSimulationMultiArmMeans(getDesignInverseNormal(kMax = 2), plannedSubjects = c(50, 100), muMaxVector = 0, seed = 123, maxNumberOfIterations = 50L) + + y4 <- .getParameterValueFormatted(x4, "sampleSizes") + + expect_equal("sampleSizes", y4$paramName) + expect_equal(c(x4$.design$kMax, length(x4$muMaxVector), x4$activeArms + 1), dim(y4$paramValue)) + expect_equal(length(as.vector(y4$paramValue)), length(y4$paramValueFormatted)) + expect_equal("character", class(y4$paramValueFormatted)[1]) + expect_equal("array", y4$type) + + lines4a <- capture.output(print(x4)) + lines4 <- lines4a[grepl("Sample sizes ", lines4a)] + expect_match(lines4[1], "^ *Sample sizes \\(1\\) \\[1\\] *: 50 *$") + expect_match(lines4[2], "^ *Sample sizes \\(1\\) \\[2\\] *: 17 *$") + expect_match(lines4[3], "^ *Sample sizes \\(2\\) \\[1\\] *: 50 *$") + expect_match(lines4[4], "^ *Sample sizes \\(2\\) \\[2\\] *: 17 *$") + expect_match(lines4[5], "^ *Sample sizes \\(3\\) \\[1\\] *: 50 *$") + expect_match(lines4[6], "^ *Sample sizes \\(3\\) \\[2\\] *: 16 *$") + expect_match(lines4[7], "^ *Sample sizes \\(4\\) \\[1\\] *: 50 *$") + expect_match(lines4[8], "^ *Sample sizes \\(4\\) \\[2\\] *: 50 *$") +}) + diff --git a/tests/testthat/test-generic_functions.R b/tests/testthat/test-generic_functions.R index e2ec753c..ddbdf8b5 100644 --- a/tests/testthat/test-generic_functions.R +++ b/tests/testthat/test-generic_functions.R @@ -1,160 +1,159 @@ -## | -## | *Unit tests* -## | -## | This file is part of the R package rpact: -## | Confirmatory Adaptive Clinical Trial Design and Analysis -## | -## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD -## | Licensed under "GNU Lesser General Public License" version 3 -## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 -## | -## | RPACT company website: https://www.rpact.com -## | RPACT package website: https://www.rpact.org -## | -## | Contact us for information about our services: info@rpact.com -## | -## | File name: test-generic_functions.R -## | Creation date: 08 November 2023, 09:12:05 -## | File version: $Revision$ -## | Last changed: $Date$ -## | Last changed by: $Author$ -## | - -test_plan_section("Testing Class 'SummaryFactory'") - - -test_that("Testing 'summary.ParameterSet': no errors occur", { - .skipTestIfDisabled() - - design <- getDesignGroupSequential( - alpha = 0.05, kMax = 4, - sided = 1, typeOfDesign = "WT", deltaWT = 0.1 - ) - - designFisher <- getDesignFisher( - kMax = 4, alpha = 0.025, - informationRates = c(0.2, 0.5, 0.8, 1), alpha0Vec = rep(0.4, 3) - ) - - designCharacteristics <- getDesignCharacteristics(design) - - powerAndASN <- getPowerAndAverageSampleNumber(design, theta = 1, nMax = 100) - - designSet <- getDesignSet(design = design, deltaWT = c(0.3, 0.4)) - - dataset <- getDataset( - n1 = c(22, 11, 22, 11), - n2 = c(22, 13, 22, 13), - means1 = c(1, 1.1, 1, 1), - means2 = c(1.4, 1.5, 3, 2.5), - stDevs1 = c(1, 2, 2, 1.3), - stDevs2 = c(1, 2, 2, 1.3) - ) - - stageResults <- getStageResults(design, dataset) - - suppressWarnings(designPlan <- getSampleSizeMeans(design)) - - simulationResults <- getSimulationSurvival(design, - maxNumberOfSubjects = 1200, plannedEvents = c(50, 100, 150, 200), seed = 12345 - ) - - piecewiseSurvivalTime <- getPiecewiseSurvivalTime(list( - "0 - <6" = 0.025, - "6 - <9" = 0.04, - "9 - <15" = 0.015, - "15 - <21" = 0.01, - ">=21" = 0.007 - ), hazardRatio = 0.8) - - accrualTime <- getAccrualTime(list( - "0 - <12" = 15, - "12 - <13" = 21, - "13 - <14" = 27, - "14 - <15" = 33, - "15 - <16" = 39, - ">=16" = 45 - ), maxNumberOfSubjects = 1400) - - expect_vector(names(design)) - expect_vector(names(designFisher)) - expect_vector(names(designCharacteristics)) - expect_vector(names(powerAndASN)) - expect_vector(names(designSet)) - expect_vector(names(dataset)) - expect_vector(names(stageResults)) - expect_vector(names(designPlan)) - expect_vector(names(simulationResults)) - expect_vector(names(piecewiseSurvivalTime)) - expect_vector(names(accrualTime)) - - expect_output(print(design)) - expect_output(print(designFisher)) - expect_output(print(designCharacteristics)) - expect_output(print(powerAndASN)) - expect_output(print(designSet)) - expect_output(print(dataset)) - expect_output(print(stageResults)) - expect_output(print(designPlan)) - expect_output(print(simulationResults)) - expect_output(print(piecewiseSurvivalTime)) - expect_output(print(accrualTime)) - - expect_output(summary(design)$show()) - expect_output(summary(designFisher)$show()) - expect_output(summary(designCharacteristics)$show()) - expect_output(summary(powerAndASN)) - expect_output(print(summary(designSet))) - expect_output(summary(dataset)$show()) - expect_output(summary(stageResults)) - expect_output(summary(designPlan)$show()) - expect_output(summary(simulationResults)$show()) - expect_output(summary(piecewiseSurvivalTime)) - expect_output(summary(accrualTime)) - - expect_named(as.data.frame(design)) - expect_named(as.data.frame(designFisher)) - expect_named(as.data.frame(designCharacteristics)) - expect_named(as.data.frame(powerAndASN)) - expect_named(as.data.frame(designSet)) - expect_named(as.data.frame(dataset)) - expect_named(as.data.frame(stageResults)) - expect_named(as.data.frame(designPlan)) - expect_named(as.data.frame(simulationResults)) - expect_named(as.data.frame(piecewiseSurvivalTime)) - expect_named(as.data.frame(accrualTime)) - - expect_s3_class(as.data.frame(design, niceColumnNamesEnabled = FALSE), "data.frame") - expect_s3_class(as.data.frame(designFisher, niceColumnNamesEnabled = FALSE), "data.frame") - expect_s3_class(as.data.frame(designCharacteristics, niceColumnNamesEnabled = FALSE), "data.frame") - expect_s3_class(as.data.frame(powerAndASN, niceColumnNamesEnabled = FALSE), "data.frame") - expect_s3_class(as.data.frame(designSet, niceColumnNamesEnabled = FALSE), "data.frame") - expect_s3_class(as.data.frame(dataset, niceColumnNamesEnabled = FALSE), "data.frame") - expect_s3_class(as.data.frame(stageResults, niceColumnNamesEnabled = FALSE), "data.frame") - expect_s3_class(as.data.frame(designPlan, niceColumnNamesEnabled = FALSE), "data.frame") - expect_s3_class(as.data.frame(simulationResults, niceColumnNamesEnabled = FALSE), "data.frame") - expect_s3_class(as.data.frame(piecewiseSurvivalTime, niceColumnNamesEnabled = FALSE), "data.frame") - expect_s3_class(as.data.frame(accrualTime, niceColumnNamesEnabled = FALSE), "data.frame") - - expect_type(as.matrix(design), "character") - expect_type(as.matrix(designFisher), "character") - expect_type(as.matrix(designCharacteristics), "double") - expect_type(as.matrix(powerAndASN), "double") - expect_type(as.matrix(designSet), "character") - expect_type(as.matrix(dataset), "double") - expect_type(as.matrix(stageResults), "character") - expect_type(as.matrix(designPlan), "double") - expect_type(as.matrix(simulationResults), "double") - expect_type(as.matrix(piecewiseSurvivalTime), "double") - expect_type(as.matrix(accrualTime), "double") - - suppressWarnings(analysisResults <- getAnalysisResults(design, dataset)) - expect_vector(names(analysisResults)) - expect_output(print(analysisResults)) - expect_output(summary(analysisResults)$show()) - expect_named(as.data.frame(analysisResults)) - expect_s3_class(as.data.frame(analysisResults, niceColumnNamesEnabled = FALSE), "data.frame") - expect_type(as.matrix(analysisResults), "character") - -}) - +## | +## | *Unit tests* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | RPACT package website: https://www.rpact.org +## | +## | Contact us for information about our services: info@rpact.com +## | +## | File name: test-generic_functions.R +## | Creation date: 08 November 2023, 09:12:05 +## | File version: $Revision$ +## | Last changed: $Date$ +## | Last changed by: $Author$ +## | + +test_plan_section("Testing Class 'SummaryFactory'") + + +test_that("Testing 'summary.ParameterSet': no errors occur", { + .skipTestIfDisabled() + + design <- getDesignGroupSequential( + alpha = 0.05, kMax = 4, + sided = 1, typeOfDesign = "WT", deltaWT = 0.1 + ) + + designFisher <- getDesignFisher( + kMax = 4, alpha = 0.025, + informationRates = c(0.2, 0.5, 0.8, 1), alpha0Vec = rep(0.4, 3) + ) + + designCharacteristics <- getDesignCharacteristics(design) + + powerAndASN <- getPowerAndAverageSampleNumber(design, theta = 1, nMax = 100) + + designSet <- getDesignSet(design = design, deltaWT = c(0.3, 0.4)) + + dataset <- getDataset( + n1 = c(22, 11, 22, 11), + n2 = c(22, 13, 22, 13), + means1 = c(1, 1.1, 1, 1), + means2 = c(1.4, 1.5, 3, 2.5), + stDevs1 = c(1, 2, 2, 1.3), + stDevs2 = c(1, 2, 2, 1.3) + ) + + stageResults <- getStageResults(design, dataset) + + suppressWarnings(designPlan <- getSampleSizeMeans(design)) + + simulationResults <- getSimulationSurvival(design, + maxNumberOfSubjects = 1200, plannedEvents = c(50, 100, 150, 200), seed = 12345 + ) + + piecewiseSurvivalTime <- getPiecewiseSurvivalTime(list( + "0 - <6" = 0.025, + "6 - <9" = 0.04, + "9 - <15" = 0.015, + "15 - <21" = 0.01, + ">=21" = 0.007 + ), hazardRatio = 0.8) + + accrualTime <- getAccrualTime(list( + "0 - <12" = 15, + "12 - <13" = 21, + "13 - <14" = 27, + "14 - <15" = 33, + "15 - <16" = 39, + ">=16" = 45 + ), maxNumberOfSubjects = 1400) + + expect_vector(names(design)) + expect_vector(names(designFisher)) + expect_vector(names(designCharacteristics)) + expect_vector(names(powerAndASN)) + expect_vector(names(designSet)) + expect_vector(names(dataset)) + expect_vector(names(stageResults)) + expect_vector(names(designPlan)) + expect_vector(names(simulationResults)) + expect_vector(names(piecewiseSurvivalTime)) + expect_vector(names(accrualTime)) + + expect_output(print(design)) + expect_output(print(designFisher)) + expect_output(print(designCharacteristics)) + expect_output(print(powerAndASN)) + expect_output(print(designSet)) + expect_output(print(dataset)) + expect_output(print(stageResults)) + expect_output(print(designPlan)) + expect_output(print(simulationResults)) + expect_output(print(piecewiseSurvivalTime)) + expect_output(print(accrualTime)) + + expect_output(summary(design)$show()) + expect_output(summary(designFisher)$show()) + expect_output(summary(designCharacteristics)$show()) + expect_output(summary(powerAndASN)) + expect_output(print(summary(designSet))) + expect_output(summary(dataset)$show()) + expect_output(summary(stageResults)) + expect_output(summary(designPlan)$show()) + expect_output(summary(simulationResults)$show()) + expect_output(summary(piecewiseSurvivalTime)) + expect_output(summary(accrualTime)) + + expect_named(as.data.frame(design)) + expect_named(as.data.frame(designFisher)) + expect_named(as.data.frame(designCharacteristics)) + expect_named(as.data.frame(powerAndASN)) + expect_named(as.data.frame(designSet)) + expect_named(as.data.frame(dataset)) + expect_named(as.data.frame(stageResults)) + expect_named(as.data.frame(designPlan)) + expect_named(as.data.frame(simulationResults)) + expect_named(as.data.frame(piecewiseSurvivalTime)) + expect_named(as.data.frame(accrualTime)) + + expect_s3_class(as.data.frame(design, niceColumnNamesEnabled = FALSE), "data.frame") + expect_s3_class(as.data.frame(designFisher, niceColumnNamesEnabled = FALSE), "data.frame") + expect_s3_class(as.data.frame(designCharacteristics, niceColumnNamesEnabled = FALSE), "data.frame") + expect_s3_class(as.data.frame(powerAndASN, niceColumnNamesEnabled = FALSE), "data.frame") + expect_s3_class(as.data.frame(designSet, niceColumnNamesEnabled = FALSE), "data.frame") + expect_s3_class(as.data.frame(dataset, niceColumnNamesEnabled = FALSE), "data.frame") + expect_s3_class(as.data.frame(stageResults, niceColumnNamesEnabled = FALSE), "data.frame") + expect_s3_class(as.data.frame(designPlan, niceColumnNamesEnabled = FALSE), "data.frame") + expect_s3_class(as.data.frame(simulationResults, niceColumnNamesEnabled = FALSE), "data.frame") + expect_s3_class(as.data.frame(piecewiseSurvivalTime, niceColumnNamesEnabled = FALSE), "data.frame") + expect_s3_class(as.data.frame(accrualTime, niceColumnNamesEnabled = FALSE), "data.frame") + + expect_type(as.matrix(design), "character") + expect_type(as.matrix(designFisher), "character") + expect_type(as.matrix(designCharacteristics), "double") + expect_type(as.matrix(powerAndASN), "double") + expect_type(as.matrix(designSet), "character") + expect_type(as.matrix(dataset), "double") + expect_type(as.matrix(stageResults), "character") + expect_type(as.matrix(designPlan), "double") + expect_type(as.matrix(simulationResults), "double") + expect_type(as.matrix(piecewiseSurvivalTime), "double") + expect_type(as.matrix(accrualTime), "double") + + suppressWarnings(analysisResults <- getAnalysisResults(design, dataset)) + expect_vector(names(analysisResults)) + expect_output(print(analysisResults)) + expect_output(summary(analysisResults)$show()) + expect_named(as.data.frame(analysisResults)) + expect_s3_class(as.data.frame(analysisResults, niceColumnNamesEnabled = FALSE), "data.frame") + expect_type(as.matrix(analysisResults), "character") +}) + From 8a5d3b94c2d39e38f3fe0d197896865a70f054c9 Mon Sep 17 00:00:00 2001 From: Till Jensen Date: Thu, 14 Mar 2024 12:22:22 +0100 Subject: [PATCH 17/28] removed whitespace changes --- tests/testthat/test-f_simulation_performance_score.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-f_simulation_performance_score.R b/tests/testthat/test-f_simulation_performance_score.R index b2c5534f..a7a4c0b1 100644 --- a/tests/testthat/test-f_simulation_performance_score.R +++ b/tests/testthat/test-f_simulation_performance_score.R @@ -111,7 +111,7 @@ test_that("getPerformanceScore issues warning", { ) }) -# Test to check if the correct values are returned +# Test to check if the correct values are returned test_that("getPerformanceScore returns correct result object", { simulationResult <- createCorrectSimulationResultObject("SimulationResultsMeans") suppressWarnings(result <- getPerformanceScore(simulationResult)) @@ -160,7 +160,7 @@ test_that("Print getPerformanceScore of simualtion means results", { # Test to check if the correct values are returned (rates) test_that("Print getPerformanceScore of simualtion rates results", { .skipTestIfDisabled() - + design <- getDesignGroupSequential( kMax = 2, alpha = 0.025, @@ -182,7 +182,7 @@ test_that("Print getPerformanceScore of simualtion rates results", { seed = 4378258 ) suppressWarnings(result <- getPerformanceScore(simulationResult)) - + ## Comparison of the results of PerformanceScore object 'result' with expected results expect_equal(result$locationSampleSize, c(0.33333333, 0.76333333, 0.6331616, NaN), tolerance = 1e-07, label = paste0(result$locationSampleSize)) expect_equal(result$variationSampleSize, c(NA_real_, 0.32538077, 0.33802988, NA_real_), tolerance = 1e-07, label = paste0(result$variationSampleSize)) @@ -191,6 +191,6 @@ test_that("Print getPerformanceScore of simualtion rates results", { expect_equal(result$variationConditionalPower, c(NA_real_, 0.99864022, 0.99927015, NA_real_), tolerance = 1e-07, label = paste0(result$variationConditionalPower)) expect_equal(result$subscoreConditionalPower, c(0.32576, 0.99882806, 0.99927071, NaN), tolerance = 1e-07, label = paste0(result$subscoreConditionalPower)) expect_equal(result$performanceScore, c(0.32954667, 0.77159255, 0.74243323, NaN), tolerance = 1e-07, label = paste0(result$performanceScore)) - + expect_true(any(grepl("Performance score", capture.output(result)))) }) From fd20471303a296e13c94cd2387f4e11b5a2cf8e4 Mon Sep 17 00:00:00 2001 From: Till Jensen Date: Thu, 14 Mar 2024 12:28:25 +0100 Subject: [PATCH 18/28] removed whitespace changes --- R/f_core_assertions.R | 44 +++++++++++++++--------------- R/f_simulation_performance_score.R | 10 +++---- 2 files changed, 27 insertions(+), 27 deletions(-) diff --git a/R/f_core_assertions.R b/R/f_core_assertions.R index af0bf237..04539dd4 100644 --- a/R/f_core_assertions.R +++ b/R/f_core_assertions.R @@ -780,29 +780,29 @@ NULL } .showParameterOutOfValidatedBoundsMessage <- function( - parameterValue, - parameterName, ..., - lowerBound = NA_real_, - upperBound = NA_real_, + parameterValue, + parameterName, ..., + lowerBound = NA_real_, + upperBound = NA_real_, spendingFunctionName = NA_character_, closedLowerBound = TRUE, closedUpperBound = TRUE, suffix = NA_character_) { - + .assertIsSingleNumber(lowerBound, "lowerBound", naAllowed = TRUE) .assertIsSingleNumber(upperBound, "upperBound", naAllowed = TRUE) if (is.na(lowerBound) && is.na(upperBound)) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'lowerBound' or 'upperBound' must be defined") } - + if (is.na(lowerBound)) { lowerBound <- -Inf } - + if (is.na(upperBound)) { upperBound <- Inf } - + if (closedLowerBound) { bracketLowerBound <- "[" conditionLowerBound <- parameterValue < lowerBound @@ -817,43 +817,43 @@ NULL bracketUpperBound <- ")" conditionUpperBound <- parameterValue >= upperBound } - + if (conditionLowerBound || conditionUpperBound) { if (!is.null(spendingFunctionName) && !is.na(spendingFunctionName)) { spendingFunctionName <- paste0("for ", spendingFunctionName, " function ") } else { spendingFunctionName <- "" } - + if (is.na(suffix)) { suffix <- "" } else { suffix <- paste0(" ", trimws(suffix)) } - + type <- getOption("rpact.out.of.validated.bounds.message.type", "warning") if (identical(type, "warning")) { - warning("The parameter ", sQuote(parameterName), " (", parameterValue, ") ", - spendingFunctionName, "is out of validated bounds ", + warning("The parameter ", sQuote(parameterName), " (", parameterValue, ") ", + spendingFunctionName, "is out of validated bounds ", bracketLowerBound, lowerBound, "; ", upperBound, bracketUpperBound, suffix, call. = FALSE) - } + } else if (identical(type, "message")) { - message("Note that parameter ", sQuote(parameterName), " (", parameterValue, ") ", - spendingFunctionName, "is out of validated bounds ", + message("Note that parameter ", sQuote(parameterName), " (", parameterValue, ") ", + spendingFunctionName, "is out of validated bounds ", bracketLowerBound, lowerBound, "; ", upperBound, bracketUpperBound, suffix) - } + } } } .assertIsValidAlpha <- function(alpha) { .assertIsSingleNumber(alpha, "alpha") - .assertIsInOpenInterval(alpha, "alpha", lower = 0, upper = NULL) + .assertIsInOpenInterval(alpha, "alpha", lower = 0, upper = NULL) .showParameterOutOfValidatedBoundsMessage(alpha, "alpha", lowerBound = 1e-06, upperBound = 0.5, closedUpperBound = FALSE) } .assertIsValidKappa <- function(kappa) { .assertIsSingleNumber(kappa, "kappa") - .assertIsInOpenInterval(kappa, "kappa", lower = 0, upper = NULL) + .assertIsInOpenInterval(kappa, "kappa", lower = 0, upper = NULL) } .assertIsValidLambda <- function(lambda, lambdaNumber = 0) { @@ -922,9 +922,9 @@ NULL .assertIsValidBeta <- function(beta, alpha) { .assertIsSingleNumber(beta, "beta") .assertIsSingleNumber(alpha, "alpha") - .assertIsInOpenInterval(beta, "beta", lower = 0, upper = NULL) - .showParameterOutOfValidatedBoundsMessage(beta, "beta", lowerBound = 1e-04, - upperBound = 1 - alpha, closedUpperBound = FALSE, + .assertIsInOpenInterval(beta, "beta", lower = 0, upper = NULL) + .showParameterOutOfValidatedBoundsMessage(beta, "beta", lowerBound = 1e-04, + upperBound = 1 - alpha, closedUpperBound = FALSE, suffix = "condition: 1e-06 <= alpha < 1 - beta <= 1 - 1e-04") } diff --git a/R/f_simulation_performance_score.R b/R/f_simulation_performance_score.R index 6c461281..8b03703d 100644 --- a/R/f_simulation_performance_score.R +++ b/R/f_simulation_performance_score.R @@ -23,9 +23,9 @@ #' Get Performance Score #' #' @description -#' Calculates the conditional performance score, its sub-scores and components according to -#' [Herrmann et al. (2020)](https://doi.org/10.1002/sim.8534) and -#' [Bokelmann et al. (2024)](https://doi.org/10.1186/s12874-024-02150-4) for a given +#' Calculates the conditional performance score, its sub-scores and components according to +#' [Herrmann et al. (2020)](https://doi.org/10.1002/sim.8534) and +#' [Bokelmann et al. (2024)](https://doi.org/10.1186/s12874-024-02150-4) for a given #' simulation result from a two-stage design with continuous or binary endpoint. #' Larger (sub-)score and component values refer to a better performance. #' @@ -39,7 +39,7 @@ #' The term conditional refers to an evaluation perspective where the interim results #' suggest a trial continuation with a second stage. #' The score can take values between 0 and 1. More details on the performance score -#' can be found in [Herrmann et al. (2020)](https://doi.org/10.1002/sim.8534) and +#' can be found in [Herrmann et al. (2020)](https://doi.org/10.1002/sim.8534) and #' [Bokelmann et al. (2024)](https://doi.org/10.1186/s12874-024-02150-4). #' #' @template examples_get_performance_score @@ -53,7 +53,7 @@ getPerformanceScore <- function(simulationResult) { design <- simulationResult$.design - if (!inherits(simulationResult, "SimulationResultsMeans") && !inherits(simulationResult, "SimulationResultsRates")) { + if (!inherits(simulationResult, "SimulationResultsMeans") && !inherits(simulationResult, "SimulationResultsRates")) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "performance score so far implemented only for single comparisons with continuous and binary endpoints" From 12e78b5d064e826d64d0bd824ee2a47e18155a15 Mon Sep 17 00:00:00 2001 From: Friedrich Pahlke Date: Fri, 15 Mar 2024 08:15:04 +0100 Subject: [PATCH 19/28] Code syntax style improved --- R/RcppExports.R | 1 - R/class_analysis_dataset.R | 14 +- R/class_analysis_results.R | 2364 ++++++++--------- R/class_analysis_stage_results.R | 1894 ++++++------- R/class_core_parameter_set.R | 509 ++-- R/class_core_plot_settings.R | 6 +- R/class_design.R | 1254 +++++---- R/class_design_plan.R | 49 +- R/class_design_power_and_asn.R | 4 +- R/class_design_set.R | 42 +- R/class_dictionary.R | 34 +- R/class_event_probabilities.R | 46 +- R/class_simulation_results.R | 52 +- R/class_summary.R | 18 +- R/class_time.R | 8 +- R/f_analysis_base.R | 2 +- R/f_analysis_base_rates.R | 10 +- R/f_analysis_multiarm.R | 134 +- R/f_analysis_utilities.R | 1 - R/f_as251.R | 6 +- R/f_core_assertions.R | 64 +- R/f_core_constants.R | 6 +- R/f_core_output_formats.R | 4 +- R/f_core_plot.R | 18 +- R/f_core_utilities.R | 15 +- R/f_design_fisher_combination_test.R | 2 +- R/f_design_group_sequential.R | 29 +- R/f_design_plan_count_data.R | 27 +- R/f_design_plan_means.R | 18 +- R/f_design_plan_plot.R | 112 +- R/f_design_plan_rates.R | 7 +- R/f_design_plan_survival.R | 9 +- R/f_design_plan_utilities.R | 46 +- R/f_object_r_code.R | 132 +- R/f_parameter_set_utilities.R | 4 +- R/f_quality_assurance.R | 18 +- R/f_simulation_base_rates.R | 3 +- R/f_simulation_enrichment_rates.R | 2 +- R/f_simulation_enrichment_survival.R | 2 +- R/f_simulation_multiarm_survival.R | 2 +- R/f_simulation_performance_score.R | 14 +- R/f_simulation_plot.R | 9 +- R/f_simulation_utilities.R | 20 +- R/parameter_descriptions.R | 16 +- man/AccrualTime.Rd | 2 - man/AnalysisResults.Rd | 2 - man/AnalysisResultsConditionalDunnett.Rd | 2 - man/AnalysisResultsEnrichment.Rd | 2 - man/AnalysisResultsEnrichmentFisher.Rd | 2 - man/AnalysisResultsEnrichmentInverseNormal.Rd | 2 - man/AnalysisResultsFisher.Rd | 2 - man/AnalysisResultsGroupSequential.Rd | 2 - man/AnalysisResultsInverseNormal.Rd | 2 - man/AnalysisResultsMultiArm.Rd | 2 - ...ss.Rd => AnalysisResultsMultiArmFisher.Rd} | 5 +- man/AnalysisResultsMultiArmInverseNormal.Rd | 2 - man/AnalysisResultsMultiHypotheses.Rd | 2 - man/ClosedCombinationTestResults.Rd | 2 - man/ConditionalPowerResults.Rd | 2 - man/ConditionalPowerResultsEnrichmentMeans.Rd | 2 - man/ConditionalPowerResultsEnrichmentRates.Rd | 2 - man/ConditionalPowerResultsMeans.Rd | 2 - man/ConditionalPowerResultsRates.Rd | 2 - man/ConditionalPowerResultsSurvival.Rd | 2 - man/Dataset.Rd | 2 - man/DatasetMeans.Rd | 2 - man/DatasetRates.Rd | 2 - man/DatasetSurvival.Rd | 3 - man/EventProbabilities.Rd | 2 - man/FieldSet.Rd | 2 - man/NumberOfSubjects.Rd | 2 - man/ParameterSet.Rd | 2 - man/PerformanceScore.Rd | 2 - man/PiecewiseSurvivalTime.Rd | 2 - man/PlotSettings.Rd | 28 - man/PowerAndAverageSampleNumberResult.Rd | 2 - man/SimulationResults.Rd | 2 - man/SimulationResultsEnrichmentMeans.Rd | 2 - man/SimulationResultsEnrichmentRates.Rd | 2 - man/SimulationResultsEnrichmentSurvival.Rd | 2 - man/SimulationResultsMeans.Rd | 2 - man/SimulationResultsMultiArmMeans.Rd | 2 - man/SimulationResultsMultiArmRates.Rd | 2 - man/SimulationResultsMultiArmSurvival.Rd | 2 - man/SimulationResultsRates.Rd | 2 - man/SimulationResultsSurvival.Rd | 2 - man/StageResults.Rd | 2 - man/StageResultsEnrichmentMeans.Rd | 2 - man/StageResultsEnrichmentRates.Rd | 2 - man/StageResultsEnrichmentSurvival.Rd | 2 - man/StageResultsMeans.Rd | 2 - man/StageResultsMultiArmMeans.Rd | 2 - man/StageResultsMultiArmRates.Rd | 2 - man/StageResultsMultiArmSurvival.Rd | 2 - man/StageResultsRates.Rd | 2 - man/StageResultsSurvival.Rd | 2 - man/SummaryFactory.Rd | 2 - man/TrialDesign.Rd | 2 - man/TrialDesignCharacteristics.Rd | 2 - man/TrialDesignConditionalDunnett.Rd | 2 - man/TrialDesignFisher.Rd | 2 - man/TrialDesignGroupSequential.Rd | 2 - man/TrialDesignInverseNormal.Rd | 2 - man/TrialDesignPlan.Rd | 2 - man/TrialDesignPlanCountData.Rd | 2 - man/TrialDesignPlanMeans.Rd | 2 - man/TrialDesignPlanRates.Rd | 2 - man/TrialDesignPlanSurvival.Rd | 2 - man/TrialDesignSet.Rd | 7 - 109 files changed, 3515 insertions(+), 3677 deletions(-) rename man/{AnalysisResultsMultiArmFisher-class.Rd => AnalysisResultsMultiArmFisher.Rd} (97%) diff --git a/R/RcppExports.R b/R/RcppExports.R index b10466c9..f298ad3a 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -92,4 +92,3 @@ getCipheredValue <- function(x) { getFraction <- function(x, epsilon = 1.0e-6, maxNumberOfSearchSteps = 30L) { .Call(`_rpact_getFraction`, x, epsilon, maxNumberOfSearchSteps) } - diff --git a/R/class_analysis_dataset.R b/R/class_analysis_dataset.R index a4646f9f..7c57fa4c 100644 --- a/R/class_analysis_dataset.R +++ b/R/class_analysis_dataset.R @@ -457,7 +457,7 @@ writeDatasets <- function(datasets, file, ..., append = FALSE, quote = TRUE, sep if (length(args) == 2 && !is.null(design)) { dataset <- .getDatasetFromArgs(...) if (!is.null(dataset)) { - dataset <- dataset$clone(deep = TRUE) #TODO was $copy shallow + dataset <- dataset$clone(deep = TRUE) # TODO was $copy shallow dataset$.design <- design return(dataset) } @@ -483,7 +483,7 @@ writeDatasets <- function(datasets, file, ..., append = FALSE, quote = TRUE, sep dataFrame <- .getDataFrameFromArgs(...) design <- .getDesignFromArgs(...) - + if (is.null(dataFrame)) { args <- .removeDesignFromArgs(args) @@ -1361,8 +1361,8 @@ getDataSet <- function(..., floatingPointNumbersEnabled = FALSE) { #' @importFrom methods new #' Dataset <- R6::R6Class("Dataset", - inherit = ParameterSet, - public = list( + inherit = ParameterSet, + public = list( .data = NULL, .plotSettings = NULL, .id = NULL, @@ -1377,11 +1377,11 @@ Dataset <- R6::R6Class("Dataset", subsets = NULL, initialize = function(dataFrame, ..., floatingPointNumbersEnabled = FALSE, enrichmentEnabled = FALSE, .design = NULL) { super$initialize(...) - + self$.floatingPointNumbersEnabled <- floatingPointNumbersEnabled self$.enrichmentEnabled <- enrichmentEnabled self$.design <- .design - + self$.plotSettings <- PlotSettings$new() self$.id <- NA_integer_ @@ -2343,7 +2343,7 @@ DatasetMeans <- R6::R6Class("DatasetMeans", } else { n <- dataset$getSampleSize(stage = stage, group = group) n <- floor(n / numberOfVisits) - + randomData <- stats::rnorm( n = sampleSize, mean = dataset$getMean(stage = stage, group = group), diff --git a/R/class_analysis_results.R b/R/class_analysis_results.R index 51daf369..7838a869 100644 --- a/R/class_analysis_results.R +++ b/R/class_analysis_results.R @@ -26,8 +26,8 @@ #' #' @description #' Class for conditional power calculations -#' -#' @template field_nPlanned +#' +#' @template field_nPlanned #' @template field_allocationRatioPlanned #' @template field_iterations #' @template field_seed @@ -45,86 +45,86 @@ #' @importFrom methods new #' ConditionalPowerResults <- R6::R6Class("ConditionalPowerResults", - inherit = ParameterSet, - public = list( - .plotSettings = NULL, - .design = NULL, - .stageResults = NULL, - .plotData = NULL, - nPlanned = NULL, - allocationRatioPlanned = NULL, - iterations = NULL, - seed = NULL, - simulated = NULL, - initialize = function(..., .design = NULL, .stageResults = NULL, .plotData = NULL, nPlanned = NULL, allocationRatioPlanned = NULL, iterations = NULL, seed = NULL, simulated = NULL) { - self$.design <- .design - self$.stageResults <- .stageResults - self$.plotData <- .plotData - self$nPlanned <- nPlanned - self$allocationRatioPlanned <- allocationRatioPlanned - self$iterations <- iterations - self$seed <- seed - self$simulated <- simulated - - super$initialize(...) - - self$.plotSettings <- PlotSettings$new() - - if (!is.null(self$.stageResults) && is.null(self$.design)) { - self$.design <- self$.stageResults$.design - } - - if (is.null(self$simulated) || length(self$simulated) == 0 || is.na(self$simulated)) { - self$simulated <- FALSE - } - - if (!is.null(self$.design) && length(self$.design$kMax) == 1 && self$.design$kMax == 1L) { - self$.setParameterType("nPlanned", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("allocationRatioPlanned", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("conditionalPower", C_PARAM_NOT_APPLICABLE) - } else { - self$.setParameterType("nPlanned", C_PARAM_GENERATED) - self$.setParameterType("allocationRatioPlanned", C_PARAM_USER_DEFINED) - self$.setParameterType("conditionalPower", C_PARAM_GENERATED) - } - self$.setParameterType("simulated", C_PARAM_NOT_APPLICABLE) - }, - show = function(showType = 1, digits = NA_integer_) { - self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) - }, - .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { - "Method for automatically printing conditional power result objects" - self$.resetCat() - if (showType == 2) { - super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) - } else { - if (!is.null(self$.design) && length(self$.design$kMax) == 1 && self$.design$kMax == 1) { - self$.cat(self$.toString(), ": not applicable for fixed design (kMax = 1)\n", - heading = 1, - consoleOutputEnabled = consoleOutputEnabled - ) - } else { - self$.cat(self$.toString(), ":\n\n", - heading = 1, - consoleOutputEnabled = consoleOutputEnabled - ) - } - self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Output", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - } - }, - .toString = function(startWithUpperCase = FALSE) { - return("Conditional power results") - } - ) + inherit = ParameterSet, + public = list( + .plotSettings = NULL, + .design = NULL, + .stageResults = NULL, + .plotData = NULL, + nPlanned = NULL, + allocationRatioPlanned = NULL, + iterations = NULL, + seed = NULL, + simulated = NULL, + initialize = function(..., .design = NULL, .stageResults = NULL, .plotData = NULL, nPlanned = NULL, allocationRatioPlanned = NULL, iterations = NULL, seed = NULL, simulated = NULL) { + self$.design <- .design + self$.stageResults <- .stageResults + self$.plotData <- .plotData + self$nPlanned <- nPlanned + self$allocationRatioPlanned <- allocationRatioPlanned + self$iterations <- iterations + self$seed <- seed + self$simulated <- simulated + + super$initialize(...) + + self$.plotSettings <- PlotSettings$new() + + if (!is.null(self$.stageResults) && is.null(self$.design)) { + self$.design <- self$.stageResults$.design + } + + if (is.null(self$simulated) || length(self$simulated) == 0 || is.na(self$simulated)) { + self$simulated <- FALSE + } + + if (!is.null(self$.design) && length(self$.design$kMax) == 1 && self$.design$kMax == 1L) { + self$.setParameterType("nPlanned", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("allocationRatioPlanned", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("conditionalPower", C_PARAM_NOT_APPLICABLE) + } else { + self$.setParameterType("nPlanned", C_PARAM_GENERATED) + self$.setParameterType("allocationRatioPlanned", C_PARAM_USER_DEFINED) + self$.setParameterType("conditionalPower", C_PARAM_GENERATED) + } + self$.setParameterType("simulated", C_PARAM_NOT_APPLICABLE) + }, + show = function(showType = 1, digits = NA_integer_) { + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + }, + .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { + "Method for automatically printing conditional power result objects" + self$.resetCat() + if (showType == 2) { + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + } else { + if (!is.null(self$.design) && length(self$.design$kMax) == 1 && self$.design$kMax == 1) { + self$.cat(self$.toString(), ": not applicable for fixed design (kMax = 1)\n", + heading = 1, + consoleOutputEnabled = consoleOutputEnabled + ) + } else { + self$.cat(self$.toString(), ":\n\n", + heading = 1, + consoleOutputEnabled = consoleOutputEnabled + ) + } + self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Output", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + } + }, + .toString = function(startWithUpperCase = FALSE) { + return("Conditional power results") + } + ) ) #' @@ -132,11 +132,11 @@ ConditionalPowerResults <- R6::R6Class("ConditionalPowerResults", #' #' @title #' Conditional Power Results Means -#' +#' #' @description #' Class for conditional power calculations of means data -#' -#' @template field_nPlanned +#' +#' @template field_nPlanned #' @template field_allocationRatioPlanned #' @template field_iterations #' @template field_seed @@ -154,110 +154,110 @@ ConditionalPowerResults <- R6::R6Class("ConditionalPowerResults", #' @importFrom methods new #' ConditionalPowerResultsMeans <- R6::R6Class("ConditionalPowerResultsMeans", - inherit = ConditionalPowerResults, - public = list( - conditionalPower = NULL, - thetaH1 = NULL, - assumedStDev = NULL, - initialize = function(..., conditionalPower = NULL, thetaH1 = NULL, assumedStDev = NULL) { - self$conditionalPower<- conditionalPower - self$thetaH1<- thetaH1 - self$assumedStDev<- assumedStDev - - super$initialize(...) - - if ((is.null(self$conditionalPower) || length(self$conditionalPower) == 0) && - !is.null(self$.design) && !is.null(self$.design$kMax) && length(self$.design$kMax) > 0) { - self$conditionalPower <- rep(NA_real_, self$.design$kMax) - } - - if (is.null(self$thetaH1) || length(self$thetaH1) == 0 || all(is.na(self$thetaH1))) { - self$thetaH1 <- NA_real_ - } - if (is.null(self$assumedStDev) || length(self$assumedStDev) == 0 || all(is.na(self$assumedStDev))) { - self$assumedStDev <- NA_real_ - } - }, - .toString = function(startWithUpperCase = FALSE) { - return("Conditional power results means") - } - ) + inherit = ConditionalPowerResults, + public = list( + conditionalPower = NULL, + thetaH1 = NULL, + assumedStDev = NULL, + initialize = function(..., conditionalPower = NULL, thetaH1 = NULL, assumedStDev = NULL) { + self$conditionalPower <- conditionalPower + self$thetaH1 <- thetaH1 + self$assumedStDev <- assumedStDev + + super$initialize(...) + + if ((is.null(self$conditionalPower) || length(self$conditionalPower) == 0) && + !is.null(self$.design) && !is.null(self$.design$kMax) && length(self$.design$kMax) > 0) { + self$conditionalPower <- rep(NA_real_, self$.design$kMax) + } + + if (is.null(self$thetaH1) || length(self$thetaH1) == 0 || all(is.na(self$thetaH1))) { + self$thetaH1 <- NA_real_ + } + if (is.null(self$assumedStDev) || length(self$assumedStDev) == 0 || all(is.na(self$assumedStDev))) { + self$assumedStDev <- NA_real_ + } + }, + .toString = function(startWithUpperCase = FALSE) { + return("Conditional power results means") + } + ) ) ConditionalPowerResultsMultiHypotheses <- R6::R6Class("ConditionalPowerResultsMultiHypotheses", - inherit = ConditionalPowerResults, - public = list( - conditionalPower = NULL, - initialize = function(..., conditionalPower = NULL) { - self$conditionalPower <- conditionalPower - super$initialize(...) - - if (self$.readyForInitialization()) { - gMax <- self$getGMax() - kMax <- self$.design$kMax - if (is.null(self$conditionalPower) || (nrow(self$conditionalPower) == 0 && ncol(self$conditionalPower) == 0)) { - self$conditionalPower <- matrix(rep(NA_real_, gMax * kMax), nrow = gMax, ncol = kMax) - } - } - }, - .toString = function(startWithUpperCase = FALSE) { - s <- "Conditional power results" - s <- paste0(s, " ", ifelse(grepl("Enrichment", .getClassName(self$.stageResults)), "enrichment", "multi-arm")) - if (grepl("Means", .getClassName(self))) { - s <- paste0(s, " means") - } else if (grepl("Rates", .getClassName(self))) { - s <- paste0(s, " rates") - } else if (grepl("Survival", .getClassName(self))) { - s <- paste0(s, " survival") - } - return(s) - }, - getGMax = function() { - return(self$.stageResults$getGMax()) - }, - .readyForInitialization = function() { - if (is.null(self$.design)) { - return(FALSE) - } - - if (length(self$.design$kMax) != 1) { - return(FALSE) - } - - if (is.null(self$.stageResults)) { - return(FALSE) - } - - if (is.null(self$.stageResults$testStatistics)) { - return(FALSE) - } - - return(TRUE) - } - ) + inherit = ConditionalPowerResults, + public = list( + conditionalPower = NULL, + initialize = function(..., conditionalPower = NULL) { + self$conditionalPower <- conditionalPower + super$initialize(...) + + if (self$.readyForInitialization()) { + gMax <- self$getGMax() + kMax <- self$.design$kMax + if (is.null(self$conditionalPower) || (nrow(self$conditionalPower) == 0 && ncol(self$conditionalPower) == 0)) { + self$conditionalPower <- matrix(rep(NA_real_, gMax * kMax), nrow = gMax, ncol = kMax) + } + } + }, + .toString = function(startWithUpperCase = FALSE) { + s <- "Conditional power results" + s <- paste0(s, " ", ifelse(grepl("Enrichment", .getClassName(self$.stageResults)), "enrichment", "multi-arm")) + if (grepl("Means", .getClassName(self))) { + s <- paste0(s, " means") + } else if (grepl("Rates", .getClassName(self))) { + s <- paste0(s, " rates") + } else if (grepl("Survival", .getClassName(self))) { + s <- paste0(s, " survival") + } + return(s) + }, + getGMax = function() { + return(self$.stageResults$getGMax()) + }, + .readyForInitialization = function() { + if (is.null(self$.design)) { + return(FALSE) + } + + if (length(self$.design$kMax) != 1) { + return(FALSE) + } + + if (is.null(self$.stageResults)) { + return(FALSE) + } + + if (is.null(self$.stageResults$testStatistics)) { + return(FALSE) + } + + return(TRUE) + } + ) ) ConditionalPowerResultsMultiArmMeans <- R6::R6Class("ConditionalPowerResultsMultiArmMeans", - inherit = ConditionalPowerResultsMultiHypotheses, - public = list( - thetaH1 = NULL, - assumedStDevs = NULL, - initialize = function(..., thetaH1 = NULL, assumedStDevs = NULL) { - self$thetaH1 <- thetaH1 - self$assumedStDevs <- assumedStDevs - super$initialize(...) - - if (self$.readyForInitialization()) { - gMax <- self$getGMax() - if (is.null(self$thetaH1) || length(self$thetaH1) == 0 || all(is.na(self$thetaH1))) { - self$thetaH1 <- rep(NA_real_, gMax) - } - if (is.null(self$assumedStDevs) || length(self$assumedStDevs) == 0 || all(is.na(self$assumedStDevs))) { - self$assumedStDevs <- rep(NA_real_, gMax) - } - } - } - ) + inherit = ConditionalPowerResultsMultiHypotheses, + public = list( + thetaH1 = NULL, + assumedStDevs = NULL, + initialize = function(..., thetaH1 = NULL, assumedStDevs = NULL) { + self$thetaH1 <- thetaH1 + self$assumedStDevs <- assumedStDevs + super$initialize(...) + + if (self$.readyForInitialization()) { + gMax <- self$getGMax() + if (is.null(self$thetaH1) || length(self$thetaH1) == 0 || all(is.na(self$thetaH1))) { + self$thetaH1 <- rep(NA_real_, gMax) + } + if (is.null(self$assumedStDevs) || length(self$assumedStDevs) == 0 || all(is.na(self$assumedStDevs))) { + self$assumedStDevs <- rep(NA_real_, gMax) + } + } + } + ) ) #' @@ -265,11 +265,11 @@ ConditionalPowerResultsMultiArmMeans <- R6::R6Class("ConditionalPowerResultsMult #' #' @title #' Conditional Power Results Rates -#' +#' #' @description #' Class for conditional power calculations of rates data -#' -#' @template field_nPlanned +#' +#' @template field_nPlanned #' @template field_allocationRatioPlanned #' @template field_iterations #' @template field_seed @@ -287,59 +287,59 @@ ConditionalPowerResultsMultiArmMeans <- R6::R6Class("ConditionalPowerResultsMult #' @importFrom methods new #' ConditionalPowerResultsRates <- R6::R6Class("ConditionalPowerResultsRates", - inherit = ConditionalPowerResults, - public = list( - conditionalPower = NULL, - pi1 = NULL, - pi2 = NULL, - initialize = function(..., conditionalPower = NULL, - pi1 = NULL, - pi2 = NULL) { - self$conditionalPower <- conditionalPower - self$pi1 <- pi1 - self$pi2 <- pi2 - - super$initialize(...) - - if ((is.null(self$conditionalPower) || length(self$conditionalPower) == 0) && - !is.null(self$.design) && !is.null(self$.design$kMax) && length(self$.design$kMax) > 0) { - self$conditionalPower <- rep(NA_real_, self$.design$kMax) - } - - if (is.null(self$pi1) || length(self$pi1) == 0 || all(is.na(self$pi1))) { - self$pi1 <- NA_real_ - } - if (is.null(self$pi2) || length(self$pi2) == 0 || all(is.na(self$pi2))) { - self$pi2 <- NA_real_ - } - }, - .toString = function(startWithUpperCase = FALSE) { - return("Conditional power results rates") - } - ) + inherit = ConditionalPowerResults, + public = list( + conditionalPower = NULL, + pi1 = NULL, + pi2 = NULL, + initialize = function(..., conditionalPower = NULL, + pi1 = NULL, + pi2 = NULL) { + self$conditionalPower <- conditionalPower + self$pi1 <- pi1 + self$pi2 <- pi2 + + super$initialize(...) + + if ((is.null(self$conditionalPower) || length(self$conditionalPower) == 0) && + !is.null(self$.design) && !is.null(self$.design$kMax) && length(self$.design$kMax) > 0) { + self$conditionalPower <- rep(NA_real_, self$.design$kMax) + } + + if (is.null(self$pi1) || length(self$pi1) == 0 || all(is.na(self$pi1))) { + self$pi1 <- NA_real_ + } + if (is.null(self$pi2) || length(self$pi2) == 0 || all(is.na(self$pi2))) { + self$pi2 <- NA_real_ + } + }, + .toString = function(startWithUpperCase = FALSE) { + return("Conditional power results rates") + } + ) ) ConditionalPowerResultsMultiArmRates <- R6::R6Class("ConditionalPowerResultsMultiArmRates", - inherit = ConditionalPowerResultsMultiHypotheses, - public = list( - piTreatments = NULL, - piControl = NULL, - initialize = function(..., piTreatments = NULL, piControl = NULL) { - self$piTreatments <- piTreatments - self$piControl <- piControl - super$initialize(...) - - if (self$.readyForInitialization()) { - gMax <- self$getGMax() - if (is.null(self$piControl) || length(self$piControl) == 0 || all(is.na(self$piControl))) { - self$piControl <- NA_real_ - } - if (is.null(self$piTreatments) || length(self$piTreatments) == 0 || all(is.na(self$piTreatments))) { - self$piTreatments <- rep(NA_real_, gMax) - } - } - } - ) + inherit = ConditionalPowerResultsMultiHypotheses, + public = list( + piTreatments = NULL, + piControl = NULL, + initialize = function(..., piTreatments = NULL, piControl = NULL) { + self$piTreatments <- piTreatments + self$piControl <- piControl + super$initialize(...) + + if (self$.readyForInitialization()) { + gMax <- self$getGMax() + if (is.null(self$piControl) || length(self$piControl) == 0 || all(is.na(self$piControl))) { + self$piControl <- NA_real_ + } + if (is.null(self$piTreatments) || length(self$piTreatments) == 0 || all(is.na(self$piTreatments))) { + self$piTreatments <- rep(NA_real_, gMax) + } + } + } + ) ) #' @@ -347,11 +347,11 @@ ConditionalPowerResultsMultiArmRates <- R6::R6Class("ConditionalPowerResultsMult #' #' @title #' Conditional Power Results Survival -#' +#' #' @description #' Class for conditional power calculations of survival data -#' -#' @template field_nPlanned +#' +#' @template field_nPlanned #' @template field_allocationRatioPlanned #' @template field_iterations #' @template field_seed @@ -368,46 +368,46 @@ ConditionalPowerResultsMultiArmRates <- R6::R6Class("ConditionalPowerResultsMult #' @importFrom methods new #' ConditionalPowerResultsSurvival <- R6::R6Class("ConditionalPowerResultsSurvival", - inherit = ConditionalPowerResults, - public = list( - conditionalPower = NULL, - thetaH1 = NULL, - initialize = function(..., conditionalPower = NULL, thetaH1 = NULL) { - self$conditionalPower <- conditionalPower - self$thetaH1 <- thetaH1 - super$initialize(...) - - if ((is.null(self$conditionalPower) || length(self$conditionalPower) == 0) && - !is.null(self$.design) && !is.null(self$.design$kMax) && length(self$.design$kMax) > 0) { - self$conditionalPower <- rep(NA_real_, self$.design$kMax) - } - - if (is.null(self$thetaH1) || length(self$thetaH1) == 0 || all(is.na(self$thetaH1))) { - self$thetaH1 <- NA_real_ - } - }, - .toString = function(startWithUpperCase = FALSE) { - return("Conditional power results survival") - } - ) + inherit = ConditionalPowerResults, + public = list( + conditionalPower = NULL, + thetaH1 = NULL, + initialize = function(..., conditionalPower = NULL, thetaH1 = NULL) { + self$conditionalPower <- conditionalPower + self$thetaH1 <- thetaH1 + super$initialize(...) + + if ((is.null(self$conditionalPower) || length(self$conditionalPower) == 0) && + !is.null(self$.design) && !is.null(self$.design$kMax) && length(self$.design$kMax) > 0) { + self$conditionalPower <- rep(NA_real_, self$.design$kMax) + } + + if (is.null(self$thetaH1) || length(self$thetaH1) == 0 || all(is.na(self$thetaH1))) { + self$thetaH1 <- NA_real_ + } + }, + .toString = function(startWithUpperCase = FALSE) { + return("Conditional power results survival") + } + ) ) ConditionalPowerResultsMultiArmSurvival <- R6::R6Class("ConditionalPowerResultsMultiArmSurvival", - inherit = ConditionalPowerResultsMultiHypotheses, - public = list( - thetaH1 = NULL, - initialize = function(..., thetaH1 = NULL) { - self$thetaH1 <- thetaH1 - super$initialize(...) - - if (self$.readyForInitialization()) { - gMax <- self$getGMax() - if (is.null(self$thetaH1) || length(self$thetaH1) == 0 || all(is.na(self$thetaH1))) { - self$thetaH1 <- rep(NA_real_, gMax) - } - } - } - ) + inherit = ConditionalPowerResultsMultiHypotheses, + public = list( + thetaH1 = NULL, + initialize = function(..., thetaH1 = NULL) { + self$thetaH1 <- thetaH1 + super$initialize(...) + + if (self$.readyForInitialization()) { + gMax <- self$getGMax() + if (is.null(self$thetaH1) || length(self$thetaH1) == 0 || all(is.na(self$thetaH1))) { + self$thetaH1 <- rep(NA_real_, gMax) + } + } + } + ) ) #' @@ -415,11 +415,11 @@ ConditionalPowerResultsMultiArmSurvival <- R6::R6Class("ConditionalPowerResultsM #' #' @title #' Conditional Power Results Enrichment Means -#' +#' #' @description #' Class for conditional power calculations of enrichment means data -#' -#' @template field_nPlanned +#' +#' @template field_nPlanned #' @template field_allocationRatioPlanned #' @template field_iterations #' @template field_seed @@ -437,7 +437,7 @@ ConditionalPowerResultsMultiArmSurvival <- R6::R6Class("ConditionalPowerResultsM #' @importFrom methods new #' ConditionalPowerResultsEnrichmentMeans <- R6::R6Class("ConditionalPowerResultsEnrichmentMeans", - inherit = ConditionalPowerResultsMultiArmMeans + inherit = ConditionalPowerResultsMultiArmMeans ) #' @@ -445,11 +445,11 @@ ConditionalPowerResultsEnrichmentMeans <- R6::R6Class("ConditionalPowerResultsEn #' #' @title #' Conditional Power Results Enrichment Rates -#' +#' #' @description #' Class for conditional power calculations of enrichment rates data -#' -#' @template field_nPlanned +#' +#' @template field_nPlanned #' @template field_allocationRatioPlanned #' @template field_iterations #' @template field_seed @@ -467,31 +467,31 @@ ConditionalPowerResultsEnrichmentMeans <- R6::R6Class("ConditionalPowerResultsEn #' @importFrom methods new #' ConditionalPowerResultsEnrichmentRates <- R6::R6Class("ConditionalPowerResultsEnrichmentRates", - inherit = ConditionalPowerResultsMultiHypotheses, - public = list( - piTreatments = NULL, - piControls = NULL, - initialize = function(..., piTreatments = NULL, piControls = NULL) { - self$piTreatments <- piTreatments - self$piControls <- piControls - super$initialize(...) - - if (self$.readyForInitialization()) { - gMax <- self$getGMax() - if (is.null(self$piControls) || length(self$piControls) == 0 || all(is.na(self$piControls))) { - self$piControls <- rep(NA_real_, gMax) - } - if (is.null(self$piTreatments) || length(self$piTreatments) == 0 || all(is.na(self$piTreatments))) { - self$piTreatments <- rep(NA_real_, gMax) - } - } - } - ) + inherit = ConditionalPowerResultsMultiHypotheses, + public = list( + piTreatments = NULL, + piControls = NULL, + initialize = function(..., piTreatments = NULL, piControls = NULL) { + self$piTreatments <- piTreatments + self$piControls <- piControls + super$initialize(...) + + if (self$.readyForInitialization()) { + gMax <- self$getGMax() + if (is.null(self$piControls) || length(self$piControls) == 0 || all(is.na(self$piControls))) { + self$piControls <- rep(NA_real_, gMax) + } + if (is.null(self$piTreatments) || length(self$piTreatments) == 0 || all(is.na(self$piTreatments))) { + self$piTreatments <- rep(NA_real_, gMax) + } + } + } + ) ) ConditionalPowerResultsEnrichmentSurvival <- R6::R6Class("ConditionalPowerResultsEnrichmentSurvival", - inherit = ConditionalPowerResultsMultiArmSurvival + inherit = ConditionalPowerResultsMultiArmSurvival ) #' @@ -512,7 +512,7 @@ ConditionalPowerResultsEnrichmentSurvival <- R6::R6Class("ConditionalPowerResult #' @template field_secondStagePValues #' @template field_rejected #' @template field_rejectedIntersections -#' +#' #' @details #' This object cannot be created directly; use \code{\link{getAnalysisResults}} #' with suitable arguments to create the multi-arm analysis results of a closed combination test design. @@ -522,165 +522,165 @@ ConditionalPowerResultsEnrichmentSurvival <- R6::R6Class("ConditionalPowerResult #' @importFrom methods new #' ClosedCombinationTestResults <- R6::R6Class("ClosedCombinationTestResults", - inherit = ParameterSet, - public = list( - .plotSettings = NULL, - .design = NULL, - .enrichment = NULL, - intersectionTest = NULL, - indices = NULL, - adjustedStageWisePValues = NULL, - overallAdjustedTestStatistics = NULL, - separatePValues = NULL, - conditionalErrorRate = NULL, - secondStagePValues = NULL, - rejected = NULL, - rejectedIntersections = NULL, - initialize = function(..., .design = NULL, - .enrichment = NULL, - intersectionTest = NULL, - indices = NULL, - adjustedStageWisePValues = NULL, - overallAdjustedTestStatistics = NULL, - separatePValues = NULL, - conditionalErrorRate = NULL, - secondStagePValues = NULL, - rejected = NULL, - rejectedIntersections = NULL) { - self$.design <- .design - self$.enrichment <- .enrichment - self$intersectionTest <- intersectionTest - self$indices <- indices - self$adjustedStageWisePValues <- adjustedStageWisePValues - self$overallAdjustedTestStatistics <- overallAdjustedTestStatistics - self$separatePValues <- separatePValues - self$conditionalErrorRate <- conditionalErrorRate - self$secondStagePValues <- secondStagePValues - self$rejected <- rejected - self$rejectedIntersections <- rejectedIntersections - - super$initialize(...) - - self$.plotSettings <- PlotSettings$new() - - self$.setParameterType("intersectionTest", C_PARAM_USER_DEFINED) - - parametersGenerated <- c( - "indices", - "separatePValues", - "rejected", - "rejectedIntersections" - ) - if (inherits(self$.design, "TrialDesignConditionalDunnett")) { - parametersGenerated <- c( - parametersGenerated, - "conditionalErrorRate", - "secondStagePValues" - ) - } else { - parametersGenerated <- c( - parametersGenerated, - "adjustedStageWisePValues", - "overallAdjustedTestStatistics" - ) - } - for (param in parametersGenerated) { - self$.setParameterType(param, C_PARAM_GENERATED) - } - }, - show = function(showType = 1, digits = NA_integer_) { - self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) - }, - .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { - "Method for automatically printing closed combination test result objects" - self$.resetCat() - if (showType == 2) { - super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) - } else { - self$.cat(self$.toString(), ":\n\n", - heading = 1, - consoleOutputEnabled = consoleOutputEnabled - ) - - self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - - designParametersToShow <- c( - ".design$stages", - ".design$alpha" - ) - if (inherits(self$.design, "TrialDesignConditionalDunnett")) { - designParametersToShow <- c( - designParametersToShow, - ".design$informationAtInterim", - ".design$secondStageConditioning" - ) - } - self$.showParametersOfOneGroup(designParametersToShow, "Design parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - - self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Output", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - - self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - - self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) - if (isTRUE(self$.enrichment)) { - self$.cat(paste0(" S[i]: population i\n"), consoleOutputEnabled = consoleOutputEnabled) - self$.cat(paste0(" F: full population\n"), consoleOutputEnabled = consoleOutputEnabled) - } else { - self$.cat(paste0( - " (i): results of treatment arm i vs. control group ", - (nrow(self$separatePValues) + 1), "\n" - ), consoleOutputEnabled = consoleOutputEnabled) - self$.cat(" [i]: hypothesis number\n", - consoleOutputEnabled = consoleOutputEnabled - ) - } - } - }, - .toString = function(startWithUpperCase = FALSE) { - s <- "Closed combination test results" - if (inherits(self$.design, "TrialDesignConditionalDunnett")) { - s <- paste0(s, " (Conditional Dunnett)") - } - return(s) - }, - .getHypothesisTreatmentArms = function(number) { - result <- c() - for (i in 1:ncol(self$indices)) { - if (self$indices[number, i] == 1) { - result <- c(result, i) - } - } - return(result) - }, - .getHypothesisTreatmentArmVariants = function() { - result <- c() - for (number in 1:nrow(self$indices)) { - arms <- self$.getHypothesisTreatmentArms(number) - result <- c(result, paste0(arms, collapse = ", ")) - } - return(result) - }, - .getHypothesisPopulationVariants = function() { - result <- c() - gMax <- 1 - for (number in 1:nrow(self$indices)) { - arms <- self$.getHypothesisTreatmentArms(number) - if (number == 1) { - gMax <- length(arms) - } - arms <- paste0("S", arms) - arms[arms == paste0("S", gMax)] <- "F" - result <- c(result, paste0(arms, collapse = ", ")) - } - return(result) - } - ) + inherit = ParameterSet, + public = list( + .plotSettings = NULL, + .design = NULL, + .enrichment = NULL, + intersectionTest = NULL, + indices = NULL, + adjustedStageWisePValues = NULL, + overallAdjustedTestStatistics = NULL, + separatePValues = NULL, + conditionalErrorRate = NULL, + secondStagePValues = NULL, + rejected = NULL, + rejectedIntersections = NULL, + initialize = function(..., .design = NULL, + .enrichment = NULL, + intersectionTest = NULL, + indices = NULL, + adjustedStageWisePValues = NULL, + overallAdjustedTestStatistics = NULL, + separatePValues = NULL, + conditionalErrorRate = NULL, + secondStagePValues = NULL, + rejected = NULL, + rejectedIntersections = NULL) { + self$.design <- .design + self$.enrichment <- .enrichment + self$intersectionTest <- intersectionTest + self$indices <- indices + self$adjustedStageWisePValues <- adjustedStageWisePValues + self$overallAdjustedTestStatistics <- overallAdjustedTestStatistics + self$separatePValues <- separatePValues + self$conditionalErrorRate <- conditionalErrorRate + self$secondStagePValues <- secondStagePValues + self$rejected <- rejected + self$rejectedIntersections <- rejectedIntersections + + super$initialize(...) + + self$.plotSettings <- PlotSettings$new() + + self$.setParameterType("intersectionTest", C_PARAM_USER_DEFINED) + + parametersGenerated <- c( + "indices", + "separatePValues", + "rejected", + "rejectedIntersections" + ) + if (inherits(self$.design, "TrialDesignConditionalDunnett")) { + parametersGenerated <- c( + parametersGenerated, + "conditionalErrorRate", + "secondStagePValues" + ) + } else { + parametersGenerated <- c( + parametersGenerated, + "adjustedStageWisePValues", + "overallAdjustedTestStatistics" + ) + } + for (param in parametersGenerated) { + self$.setParameterType(param, C_PARAM_GENERATED) + } + }, + show = function(showType = 1, digits = NA_integer_) { + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + }, + .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { + "Method for automatically printing closed combination test result objects" + self$.resetCat() + if (showType == 2) { + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + } else { + self$.cat(self$.toString(), ":\n\n", + heading = 1, + consoleOutputEnabled = consoleOutputEnabled + ) + + self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + + designParametersToShow <- c( + ".design$stages", + ".design$alpha" + ) + if (inherits(self$.design, "TrialDesignConditionalDunnett")) { + designParametersToShow <- c( + designParametersToShow, + ".design$informationAtInterim", + ".design$secondStageConditioning" + ) + } + self$.showParametersOfOneGroup(designParametersToShow, "Design parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + + self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Output", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + + self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) + if (isTRUE(self$.enrichment)) { + self$.cat(paste0(" S[i]: population i\n"), consoleOutputEnabled = consoleOutputEnabled) + self$.cat(paste0(" F: full population\n"), consoleOutputEnabled = consoleOutputEnabled) + } else { + self$.cat(paste0( + " (i): results of treatment arm i vs. control group ", + (nrow(self$separatePValues) + 1), "\n" + ), consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" [i]: hypothesis number\n", + consoleOutputEnabled = consoleOutputEnabled + ) + } + } + }, + .toString = function(startWithUpperCase = FALSE) { + s <- "Closed combination test results" + if (inherits(self$.design, "TrialDesignConditionalDunnett")) { + s <- paste0(s, " (Conditional Dunnett)") + } + return(s) + }, + .getHypothesisTreatmentArms = function(number) { + result <- c() + for (i in 1:ncol(self$indices)) { + if (self$indices[number, i] == 1) { + result <- c(result, i) + } + } + return(result) + }, + .getHypothesisTreatmentArmVariants = function() { + result <- c() + for (number in 1:nrow(self$indices)) { + arms <- self$.getHypothesisTreatmentArms(number) + result <- c(result, paste0(arms, collapse = ", ")) + } + return(result) + }, + .getHypothesisPopulationVariants = function() { + result <- c() + gMax <- 1 + for (number in 1:nrow(self$indices)) { + arms <- self$.getHypothesisTreatmentArms(number) + if (number == 1) { + gMax <- length(arms) + } + arms <- paste0("S", arms) + arms[arms == paste0("S", gMax)] <- "F" + result <- c(result, paste0(arms, collapse = ", ")) + } + return(result) + } + ) ) #' @@ -717,289 +717,289 @@ ClosedCombinationTestResults <- R6::R6Class("ClosedCombinationTestResults", #' @importFrom methods new #' AnalysisResults <- R6::R6Class("AnalysisResults", - inherit = ParameterSet, - public = list( - .plotSettings = NULL, - .design = NULL, - .dataInput = NULL, - .stageResults = NULL, - .conditionalPowerResults = NULL, - normalApproximation = NULL, - directionUpper = NULL, - thetaH0 = NULL, - pi1 = NULL, - pi2 = NULL, - nPlanned = NULL, - allocationRatioPlanned = NULL, - initialize = function(design, dataInput, ..., .stageResults = NULL, .conditionalPowerResults = NULL, directionUpper = NULL, thetaH0 = NULL) { - self$.design <- design - self$.dataInput <- dataInput - self$.stageResults <- .stageResults - self$.conditionalPowerResults <- .conditionalPowerResults - self$directionUpper <- directionUpper - self$thetaH0 <- thetaH0 - - super$initialize(...) - - self$.plotSettings <- PlotSettings$new() - }, - .setStageResults = function(stageResults) { - self$.stageResults <- stageResults - }, - getPlotSettings = function() { - return(self$.plotSettings) - }, - show = function(showType = 1, digits = NA_integer_) { - self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) - }, - .getStageResultParametersToShow = function() { - stageResultParametersToShow <- c() - if (self$.design$kMax > 1) { - if (!grepl("Rates", .getClassName(self$.dataInput)) || self$.dataInput$getNumberOfGroups() > 1) { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$effectSizes") - } - - if (grepl("Means", .getClassName(self$.dataInput))) { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallStDevs") - } - if (grepl("Rates", .getClassName(self$.dataInput))) { - if (.isMultiArmAnalysisResults(self)) { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPiTreatments") - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPiControl") - } else if (.isEnrichmentAnalysisResults(self)) { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPisTreatment") - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPisControl") - } else { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPi1") - if (self$.dataInput$getNumberOfGroups() > 1) { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPi2") - } - } - } - } - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$testStatistics") - if (grepl("(MultiArm|Dunnett|Enrichment)", .getClassName(self))) { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$separatePValues") - } else { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$pValues") - } - - if (self$.design$kMax == 1) { - # return(stageResultParametersToShow) - } - - # show combination test statistics - if (.isTrialDesignInverseNormal(self$.design)) { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$combInverseNormal") - } else if (.isTrialDesignGroupSequential(self$.design)) { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallTestStatistics") - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPValues") - } else if (.isTrialDesignFisher(self$.design)) { - stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$combFisher") - } - return(stageResultParametersToShow) - }, - .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { - "Method for automatically printing analysis result objects" - self$.resetCat() - if (showType == 2) { - super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) - } else { - self$.cat(self$.toString(startWithUpperCase = TRUE), ":\n\n", - heading = 1, - consoleOutputEnabled = consoleOutputEnabled - ) - - self$.showParametersOfOneGroup(.getDesignParametersToShow(self), "Design parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - - self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - - self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - - self$.showParametersOfOneGroup(self$.getStageResultParametersToShow(), "Stage results", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - - # show multi-arm parameters - if (grepl("(MultiArm|Dunnett|Enrichment)", .getClassName(self))) { - if (.isTrialDesignConditionalDunnett(self$.design)) { - self$.showParametersOfOneGroup(".closedTestResults$conditionalErrorRate", - "Conditional error rate", - orderByParameterName = FALSE, - consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(".closedTestResults$secondStagePValues", - "Second stage p-values", - orderByParameterName = FALSE, - consoleOutputEnabled = consoleOutputEnabled - ) - } else { - self$.showParametersOfOneGroup(".closedTestResults$adjustedStageWisePValues", - "Adjusted stage-wise p-values", - orderByParameterName = FALSE, - consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(".closedTestResults$overallAdjustedTestStatistics", - "Overall adjusted test statistics", - orderByParameterName = FALSE, - consoleOutputEnabled = consoleOutputEnabled - ) - } - - self$.showParametersOfOneGroup(".closedTestResults$rejected", "Test actions", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - } - - generatedParams <- self$.getGeneratedParameters() - generatedParams <- generatedParams[!(generatedParams %in% - c("assumedStDevs", "thetaH1", "pi1", "pi2", "piTreatments", "piTreatments", "piControl", "piControls"))] - - if (grepl("(MultiArm|Dunnett|Enrichment)", .getClassName(self))) { - if (all(c("conditionalPowerSimulated", "conditionalRejectionProbabilities") %in% generatedParams)) { - generatedParams <- .moveValue( - generatedParams, - "conditionalPowerSimulated", "conditionalRejectionProbabilities" - ) - } - - self$.showParametersOfOneGroup(generatedParams, "Further analysis results", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - } else { - self$.showParametersOfOneGroup(generatedParams, "Analysis results", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - } - - self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - - if (grepl("(MultiArm|Dunnett)", .getClassName(self))) { - self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) - self$.cat( - paste0( - " (i): results of treatment arm i vs. control group ", - self$.dataInput$getNumberOfGroups(), "\n" - ), - consoleOutputEnabled = consoleOutputEnabled - ) - } else if (.isEnrichmentAnalysisResults(self)) { - self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) - self$.cat(paste0(" S[i]: population i\n"), consoleOutputEnabled = consoleOutputEnabled) - self$.cat(paste0(" F: full population\n"), consoleOutputEnabled = consoleOutputEnabled) - } else if (grepl("Rates", .getClassName(self$.dataInput)) && self$.dataInput$getNumberOfGroups() == 2) { - self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) - self$.cat(" (i): values of treatment arm i\n", consoleOutputEnabled = consoleOutputEnabled) - } - } - }, - .toString = function(startWithUpperCase = FALSE) { - str <- "analysis results" - if (inherits(self, "AnalysisResultsMultiArm")) { - str <- paste0("multi-arm ", str) - } else if (inherits(self, "AnalysisResultsEnrichment")) { - str <- paste0("enrichment ", str) - } - if (startWithUpperCase) { - str <- .firstCharacterToUpperCase(str) - } - - numberOfGroups <- self$.dataInput$getNumberOfGroups() - str <- paste0(str, " (") - - str <- paste0(str, tolower(sub("Dataset(Enrichment)?", "", .getClassName(self$.dataInput)))) - if (grepl("Survival", .getClassName(.getClassName))) { - str <- paste0(str, " data") - } - - if (numberOfGroups == 1) { - str <- paste0(str, " of one group") - } else { - str <- paste0(str, " of ", numberOfGroups, " groups") - } - - if (self$.design$kMax > 1) { - if (grepl("GroupSequential", .getClassName(self))) { - str <- paste0(str, ", group sequential design") - } else if (grepl("InverseNormal", .getClassName(self))) { - str <- paste0(str, ", inverse normal combination test design") - } else if (grepl("Fisher", .getClassName(self))) { - str <- paste0(str, ", Fisher's combination test design") - } else if (grepl("Dunnett", .getClassName(self))) { - str <- paste0(str, ", conditional Dunnett design") - } - } else { - str <- paste0(str, ", fixed sample size design") - } - - str <- paste0(str, ")") - return(str) - }, - getNumberOfStages = function() { - return(self$.stageResults$getNumberOfStages()) - }, - getDataInput = function() { - return(self$.dataInput) - } - ) + inherit = ParameterSet, + public = list( + .plotSettings = NULL, + .design = NULL, + .dataInput = NULL, + .stageResults = NULL, + .conditionalPowerResults = NULL, + normalApproximation = NULL, + directionUpper = NULL, + thetaH0 = NULL, + pi1 = NULL, + pi2 = NULL, + nPlanned = NULL, + allocationRatioPlanned = NULL, + initialize = function(design, dataInput, ..., .stageResults = NULL, .conditionalPowerResults = NULL, directionUpper = NULL, thetaH0 = NULL) { + self$.design <- design + self$.dataInput <- dataInput + self$.stageResults <- .stageResults + self$.conditionalPowerResults <- .conditionalPowerResults + self$directionUpper <- directionUpper + self$thetaH0 <- thetaH0 + + super$initialize(...) + + self$.plotSettings <- PlotSettings$new() + }, + .setStageResults = function(stageResults) { + self$.stageResults <- stageResults + }, + getPlotSettings = function() { + return(self$.plotSettings) + }, + show = function(showType = 1, digits = NA_integer_) { + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + }, + .getStageResultParametersToShow = function() { + stageResultParametersToShow <- c() + if (self$.design$kMax > 1) { + if (!grepl("Rates", .getClassName(self$.dataInput)) || self$.dataInput$getNumberOfGroups() > 1) { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$effectSizes") + } + + if (grepl("Means", .getClassName(self$.dataInput))) { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallStDevs") + } + if (grepl("Rates", .getClassName(self$.dataInput))) { + if (.isMultiArmAnalysisResults(self)) { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPiTreatments") + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPiControl") + } else if (.isEnrichmentAnalysisResults(self)) { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPisTreatment") + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPisControl") + } else { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPi1") + if (self$.dataInput$getNumberOfGroups() > 1) { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPi2") + } + } + } + } + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$testStatistics") + if (grepl("(MultiArm|Dunnett|Enrichment)", .getClassName(self))) { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$separatePValues") + } else { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$pValues") + } + + if (self$.design$kMax == 1) { + # return(stageResultParametersToShow) + } + + # show combination test statistics + if (.isTrialDesignInverseNormal(self$.design)) { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$combInverseNormal") + } else if (.isTrialDesignGroupSequential(self$.design)) { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallTestStatistics") + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$overallPValues") + } else if (.isTrialDesignFisher(self$.design)) { + stageResultParametersToShow <- c(stageResultParametersToShow, ".stageResults$combFisher") + } + return(stageResultParametersToShow) + }, + .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { + "Method for automatically printing analysis result objects" + self$.resetCat() + if (showType == 2) { + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + } else { + self$.cat(self$.toString(startWithUpperCase = TRUE), ":\n\n", + heading = 1, + consoleOutputEnabled = consoleOutputEnabled + ) + + self$.showParametersOfOneGroup(.getDesignParametersToShow(self), "Design parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + + self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + + self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + + self$.showParametersOfOneGroup(self$.getStageResultParametersToShow(), "Stage results", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + + # show multi-arm parameters + if (grepl("(MultiArm|Dunnett|Enrichment)", .getClassName(self))) { + if (.isTrialDesignConditionalDunnett(self$.design)) { + self$.showParametersOfOneGroup(".closedTestResults$conditionalErrorRate", + "Conditional error rate", + orderByParameterName = FALSE, + consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(".closedTestResults$secondStagePValues", + "Second stage p-values", + orderByParameterName = FALSE, + consoleOutputEnabled = consoleOutputEnabled + ) + } else { + self$.showParametersOfOneGroup(".closedTestResults$adjustedStageWisePValues", + "Adjusted stage-wise p-values", + orderByParameterName = FALSE, + consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(".closedTestResults$overallAdjustedTestStatistics", + "Overall adjusted test statistics", + orderByParameterName = FALSE, + consoleOutputEnabled = consoleOutputEnabled + ) + } + + self$.showParametersOfOneGroup(".closedTestResults$rejected", "Test actions", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + } + + generatedParams <- self$.getGeneratedParameters() + generatedParams <- generatedParams[!(generatedParams %in% + c("assumedStDevs", "thetaH1", "pi1", "pi2", "piTreatments", "piTreatments", "piControl", "piControls"))] + + if (grepl("(MultiArm|Dunnett|Enrichment)", .getClassName(self))) { + if (all(c("conditionalPowerSimulated", "conditionalRejectionProbabilities") %in% generatedParams)) { + generatedParams <- .moveValue( + generatedParams, + "conditionalPowerSimulated", "conditionalRejectionProbabilities" + ) + } + + self$.showParametersOfOneGroup(generatedParams, "Further analysis results", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + } else { + self$.showParametersOfOneGroup(generatedParams, "Analysis results", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + } + + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + + if (grepl("(MultiArm|Dunnett)", .getClassName(self))) { + self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) + self$.cat( + paste0( + " (i): results of treatment arm i vs. control group ", + self$.dataInput$getNumberOfGroups(), "\n" + ), + consoleOutputEnabled = consoleOutputEnabled + ) + } else if (.isEnrichmentAnalysisResults(self)) { + self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(paste0(" S[i]: population i\n"), consoleOutputEnabled = consoleOutputEnabled) + self$.cat(paste0(" F: full population\n"), consoleOutputEnabled = consoleOutputEnabled) + } else if (grepl("Rates", .getClassName(self$.dataInput)) && self$.dataInput$getNumberOfGroups() == 2) { + self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" (i): values of treatment arm i\n", consoleOutputEnabled = consoleOutputEnabled) + } + } + }, + .toString = function(startWithUpperCase = FALSE) { + str <- "analysis results" + if (inherits(self, "AnalysisResultsMultiArm")) { + str <- paste0("multi-arm ", str) + } else if (inherits(self, "AnalysisResultsEnrichment")) { + str <- paste0("enrichment ", str) + } + if (startWithUpperCase) { + str <- .firstCharacterToUpperCase(str) + } + + numberOfGroups <- self$.dataInput$getNumberOfGroups() + str <- paste0(str, " (") + + str <- paste0(str, tolower(sub("Dataset(Enrichment)?", "", .getClassName(self$.dataInput)))) + if (grepl("Survival", .getClassName(.getClassName))) { + str <- paste0(str, " data") + } + + if (numberOfGroups == 1) { + str <- paste0(str, " of one group") + } else { + str <- paste0(str, " of ", numberOfGroups, " groups") + } + + if (self$.design$kMax > 1) { + if (grepl("GroupSequential", .getClassName(self))) { + str <- paste0(str, ", group sequential design") + } else if (grepl("InverseNormal", .getClassName(self))) { + str <- paste0(str, ", inverse normal combination test design") + } else if (grepl("Fisher", .getClassName(self))) { + str <- paste0(str, ", Fisher's combination test design") + } else if (grepl("Dunnett", .getClassName(self))) { + str <- paste0(str, ", conditional Dunnett design") + } + } else { + str <- paste0(str, ", fixed sample size design") + } + + str <- paste0(str, ")") + return(str) + }, + getNumberOfStages = function() { + return(self$.stageResults$getNumberOfStages()) + }, + getDataInput = function() { + return(self$.dataInput) + } + ) ) AnalysisResultsBase <- R6::R6Class("AnalysisResultsBase", - inherit = AnalysisResults, - public = list( - thetaH1 = NULL, - assumedStDev = NULL, - equalVariances = NULL, - testActions = NULL, - conditionalRejectionProbabilities = NULL, - conditionalPower = NULL, - repeatedConfidenceIntervalLowerBounds = NULL, - repeatedConfidenceIntervalUpperBounds = NULL, - repeatedPValues = NULL, - finalStage = NULL, - finalPValues = NULL, - finalConfidenceIntervalLowerBounds = NULL, - finalConfidenceIntervalUpperBounds = NULL, - medianUnbiasedEstimates = NULL, - initialize = function(design, dataInput, ..., thetaH1 = NULL, - assumedStDev = NULL, - equalVariances = NULL, - testActions = NULL, - conditionalRejectionProbabilities = NULL, - conditionalPower = NULL, - repeatedConfidenceIntervalLowerBounds = NULL, - repeatedConfidenceIntervalUpperBounds = NULL, - repeatedPValues = NULL, - finalStage = NULL, - finalPValues = NULL, - finalConfidenceIntervalLowerBounds = NULL, - finalConfidenceIntervalUpperBounds = NULL, - medianUnbiasedEstimates = NULL) { - self$thetaH1 <- thetaH1 - self$assumedStDev <- assumedStDev - self$equalVariances <- equalVariances - self$testActions <- testActions - self$conditionalRejectionProbabilities <- conditionalRejectionProbabilities - self$conditionalPower <- conditionalPower - self$repeatedConfidenceIntervalLowerBounds <- repeatedConfidenceIntervalLowerBounds - self$repeatedConfidenceIntervalUpperBounds <- repeatedConfidenceIntervalUpperBounds - self$repeatedPValues <- repeatedPValues - self$finalStage <- finalStage - self$finalPValues <- finalPValues - self$finalConfidenceIntervalLowerBounds <- finalConfidenceIntervalLowerBounds - self$finalConfidenceIntervalUpperBounds <- finalConfidenceIntervalUpperBounds - self$medianUnbiasedEstimates <- medianUnbiasedEstimates - - super$initialize(design = design, dataInput = dataInput, ...) - self$finalStage <- NA_integer_ - } - ) + inherit = AnalysisResults, + public = list( + thetaH1 = NULL, + assumedStDev = NULL, + equalVariances = NULL, + testActions = NULL, + conditionalRejectionProbabilities = NULL, + conditionalPower = NULL, + repeatedConfidenceIntervalLowerBounds = NULL, + repeatedConfidenceIntervalUpperBounds = NULL, + repeatedPValues = NULL, + finalStage = NULL, + finalPValues = NULL, + finalConfidenceIntervalLowerBounds = NULL, + finalConfidenceIntervalUpperBounds = NULL, + medianUnbiasedEstimates = NULL, + initialize = function(design, dataInput, ..., thetaH1 = NULL, + assumedStDev = NULL, + equalVariances = NULL, + testActions = NULL, + conditionalRejectionProbabilities = NULL, + conditionalPower = NULL, + repeatedConfidenceIntervalLowerBounds = NULL, + repeatedConfidenceIntervalUpperBounds = NULL, + repeatedPValues = NULL, + finalStage = NULL, + finalPValues = NULL, + finalConfidenceIntervalLowerBounds = NULL, + finalConfidenceIntervalUpperBounds = NULL, + medianUnbiasedEstimates = NULL) { + self$thetaH1 <- thetaH1 + self$assumedStDev <- assumedStDev + self$equalVariances <- equalVariances + self$testActions <- testActions + self$conditionalRejectionProbabilities <- conditionalRejectionProbabilities + self$conditionalPower <- conditionalPower + self$repeatedConfidenceIntervalLowerBounds <- repeatedConfidenceIntervalLowerBounds + self$repeatedConfidenceIntervalUpperBounds <- repeatedConfidenceIntervalUpperBounds + self$repeatedPValues <- repeatedPValues + self$finalStage <- finalStage + self$finalPValues <- finalPValues + self$finalConfidenceIntervalLowerBounds <- finalConfidenceIntervalLowerBounds + self$finalConfidenceIntervalUpperBounds <- finalConfidenceIntervalUpperBounds + self$medianUnbiasedEstimates <- medianUnbiasedEstimates + + super$initialize(design = design, dataInput = dataInput, ...) + self$finalStage <- NA_integer_ + } + ) ) #' @@ -1030,48 +1030,48 @@ AnalysisResultsBase <- R6::R6Class("AnalysisResultsBase", #' @importFrom methods new #' AnalysisResultsMultiHypotheses <- R6::R6Class("AnalysisResultsMultiHypotheses", - inherit = AnalysisResults, - public = list( - .closedTestResults = NULL, - thetaH1 = NULL, # means only - assumedStDevs = NULL, # means only - piTreatments = NULL, # rates only - intersectionTest = NULL, - varianceOption = NULL, - conditionalRejectionProbabilities = NULL, - conditionalPower = NULL, - repeatedConfidenceIntervalLowerBounds = NULL, - repeatedConfidenceIntervalUpperBounds = NULL, - repeatedPValues = NULL, - initialize = function(design, dataInput, ..., .closedTestResults = NULL, - thetaH1 = NULL, - assumedStDevs = NULL, - piTreatments = NULL, - intersectionTest = NULL, - varianceOption = NULL, - conditionalRejectionProbabilities = NULL, - conditionalPower = NULL, - repeatedConfidenceIntervalLowerBounds = NULL, - repeatedConfidenceIntervalUpperBounds = NULL, - repeatedPValues = NULL) { - self$.closedTestResults <- .closedTestResults - self$thetaH1 <- thetaH1 - self$assumedStDevs <- assumedStDevs - self$piTreatments <- piTreatments - self$intersectionTest <- intersectionTest - self$varianceOption <- varianceOption - self$conditionalRejectionProbabilities <- conditionalRejectionProbabilities - self$conditionalPower <- conditionalPower - self$repeatedConfidenceIntervalLowerBounds <- repeatedConfidenceIntervalLowerBounds - self$repeatedConfidenceIntervalUpperBounds <- repeatedConfidenceIntervalUpperBounds - self$repeatedPValues <- repeatedPValues - super$initialize(design = design, dataInput = dataInput, ...) - - for (param in c("thetaH1", "assumedStDevs", "piTreatments")) { - self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) - } - } - ) + inherit = AnalysisResults, + public = list( + .closedTestResults = NULL, + thetaH1 = NULL, # means only + assumedStDevs = NULL, # means only + piTreatments = NULL, # rates only + intersectionTest = NULL, + varianceOption = NULL, + conditionalRejectionProbabilities = NULL, + conditionalPower = NULL, + repeatedConfidenceIntervalLowerBounds = NULL, + repeatedConfidenceIntervalUpperBounds = NULL, + repeatedPValues = NULL, + initialize = function(design, dataInput, ..., .closedTestResults = NULL, + thetaH1 = NULL, + assumedStDevs = NULL, + piTreatments = NULL, + intersectionTest = NULL, + varianceOption = NULL, + conditionalRejectionProbabilities = NULL, + conditionalPower = NULL, + repeatedConfidenceIntervalLowerBounds = NULL, + repeatedConfidenceIntervalUpperBounds = NULL, + repeatedPValues = NULL) { + self$.closedTestResults <- .closedTestResults + self$thetaH1 <- thetaH1 + self$assumedStDevs <- assumedStDevs + self$piTreatments <- piTreatments + self$intersectionTest <- intersectionTest + self$varianceOption <- varianceOption + self$conditionalRejectionProbabilities <- conditionalRejectionProbabilities + self$conditionalPower <- conditionalPower + self$repeatedConfidenceIntervalLowerBounds <- repeatedConfidenceIntervalLowerBounds + self$repeatedConfidenceIntervalUpperBounds <- repeatedConfidenceIntervalUpperBounds + self$repeatedPValues <- repeatedPValues + super$initialize(design = design, dataInput = dataInput, ...) + + for (param in c("thetaH1", "assumedStDevs", "piTreatments")) { + self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) + } + } + ) ) #' @@ -1103,29 +1103,29 @@ AnalysisResultsMultiHypotheses <- R6::R6Class("AnalysisResultsMultiHypotheses", #' @importFrom methods new #' AnalysisResultsMultiArm <- R6::R6Class("AnalysisResultsMultiArm", - inherit = AnalysisResultsMultiHypotheses, - public = list( - piControl = NULL, # rates only - initialize = function(design, dataInput, ..., piControl = NULL) { - self$piControl <- piControl - super$initialize(design = design, dataInput = dataInput, ...) - self$.setParameterType("piControl", C_PARAM_NOT_APPLICABLE) - }, - .getParametersToShow = function() { - parametersToShow <- self$.getVisibleFieldNames() - - if ("piTreatments" %in% parametersToShow && "piControl" %in% parametersToShow) { - index <- which(parametersToShow == "piTreatments") - parametersToShow <- parametersToShow[parametersToShow != "piControl"] - parametersToShow <- c( - parametersToShow[1:index], - "piControl", parametersToShow[(index + 1):length(parametersToShow)] - ) - } - - return(parametersToShow) - } - ) + inherit = AnalysisResultsMultiHypotheses, + public = list( + piControl = NULL, # rates only + initialize = function(design, dataInput, ..., piControl = NULL) { + self$piControl <- piControl + super$initialize(design = design, dataInput = dataInput, ...) + self$.setParameterType("piControl", C_PARAM_NOT_APPLICABLE) + }, + .getParametersToShow = function() { + parametersToShow <- self$.getVisibleFieldNames() + + if ("piTreatments" %in% parametersToShow && "piControl" %in% parametersToShow) { + index <- which(parametersToShow == "piTreatments") + parametersToShow <- parametersToShow[parametersToShow != "piControl"] + parametersToShow <- c( + parametersToShow[1:index], + "piControl", parametersToShow[(index + 1):length(parametersToShow)] + ) + } + + return(parametersToShow) + } + ) ) #' @@ -1156,15 +1156,15 @@ AnalysisResultsMultiArm <- R6::R6Class("AnalysisResultsMultiArm", #' @importFrom methods new #' AnalysisResultsEnrichment <- R6::R6Class("AnalysisResultsEnrichment", - inherit = AnalysisResultsMultiHypotheses, - public = list( - piControls = NULL, # rates only - initialize = function(design, dataInput, ..., piControls = NULL) { - self$piControls <- piControls - super$initialize(design = design, dataInput = dataInput, ...) - self$.setParameterType("piControls", C_PARAM_NOT_APPLICABLE) - } - ) + inherit = AnalysisResultsMultiHypotheses, + public = list( + piControls = NULL, # rates only + initialize = function(design, dataInput, ..., piControls = NULL) { + self$piControls <- piControls + super$initialize(design = design, dataInput = dataInput, ...) + self$.setParameterType("piControls", C_PARAM_NOT_APPLICABLE) + } + ) ) #' @@ -1191,7 +1191,7 @@ AnalysisResultsEnrichment <- R6::R6Class("AnalysisResultsEnrichment", #' @keywords internal #' summary.AnalysisResults <- function(object, ..., type = 1, digits = NA_integer_) { - return(summary.ParameterSet(object = object, ..., type = type, digits = digits)) + return(summary.ParameterSet(object = object, ..., type = type, digits = digits)) } #' @@ -1254,12 +1254,12 @@ as.data.frame.AnalysisResults <- function(x, row.names = NULL, optional = FALSE, #' @keywords internal #' names.AnalysisResults <- function(x) { - namesToShow <- c(".design", ".dataInput", ".stageResults", ".conditionalPowerResults") - if (.isMultiArmAnalysisResults(x)) { - namesToShow <- c(namesToShow, ".closedTestResults") - } - namesToShow <- c(namesToShow, x$.getVisibleFieldNames()) - return(namesToShow) + namesToShow <- c(".design", ".dataInput", ".stageResults", ".conditionalPowerResults") + if (.isMultiArmAnalysisResults(x)) { + namesToShow <- c(namesToShow, ".closedTestResults") + } + namesToShow <- c(namesToShow, x$.getVisibleFieldNames()) + return(namesToShow) } #' @@ -1294,7 +1294,7 @@ names.AnalysisResults <- function(x) { #' @template field_medianUnbiasedEstimates #' @template field_maxInformation #' @template field_informationEpsilon -#' +#' #' @details #' This object cannot be created directly; use \code{\link{getAnalysisResults}} #' with suitable arguments to create the analysis results of a group sequential design. @@ -1310,20 +1310,20 @@ names.AnalysisResults <- function(x) { #' @importFrom methods new #' AnalysisResultsGroupSequential <- R6::R6Class("AnalysisResultsGroupSequential", - inherit = AnalysisResultsBase, - public = list( - maxInformation = NULL, - informationEpsilon = NULL, - initialize = function(design, dataInput, ..., maxInformation = NULL, informationEpsilon = NULL) { - self$maxInformation <- maxInformation - self$informationEpsilon <- informationEpsilon - - super$initialize(design = design, dataInput = dataInput, ...) - - self$.setParameterType("maxInformation", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("informationEpsilon", C_PARAM_NOT_APPLICABLE) - } - ) + inherit = AnalysisResultsBase, + public = list( + maxInformation = NULL, + informationEpsilon = NULL, + initialize = function(design, dataInput, ..., maxInformation = NULL, informationEpsilon = NULL) { + self$maxInformation <- maxInformation + self$informationEpsilon <- informationEpsilon + + super$initialize(design = design, dataInput = dataInput, ...) + + self$.setParameterType("maxInformation", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("informationEpsilon", C_PARAM_NOT_APPLICABLE) + } + ) ) #' @@ -1356,7 +1356,7 @@ AnalysisResultsGroupSequential <- R6::R6Class("AnalysisResultsGroupSequential", #' @template field_finalConfidenceIntervalLowerBounds #' @template field_finalConfidenceIntervalUpperBounds #' @template field_medianUnbiasedEstimates -#' +#' #' @details #' This object cannot be created directly; use \code{\link{getAnalysisResults}} #' with suitable arguments to create the analysis results of a inverse normal design. @@ -1372,7 +1372,7 @@ AnalysisResultsGroupSequential <- R6::R6Class("AnalysisResultsGroupSequential", #' @importFrom methods new #' AnalysisResultsInverseNormal <- R6::R6Class("AnalysisResultsInverseNormal", - inherit = AnalysisResultsBase + inherit = AnalysisResultsBase ) #' @@ -1402,7 +1402,7 @@ AnalysisResultsInverseNormal <- R6::R6Class("AnalysisResultsInverseNormal", #' @template field_repeatedConfidenceIntervalUpperBounds #' @template field_repeatedPValues #' @template field_piControl -#' +#' #' @details #' This object cannot be created directly; use \code{\link{getAnalysisResults}} #' with suitable arguments to create the multi-arm analysis results of an inverse normal design. @@ -1418,7 +1418,7 @@ AnalysisResultsInverseNormal <- R6::R6Class("AnalysisResultsInverseNormal", #' @importFrom methods new #' AnalysisResultsMultiArmInverseNormal <- R6::R6Class("AnalysisResultsMultiArmInverseNormal", - inherit = AnalysisResultsMultiArm + inherit = AnalysisResultsMultiArm ) #' @@ -1449,7 +1449,7 @@ AnalysisResultsMultiArmInverseNormal <- R6::R6Class("AnalysisResultsMultiArmInve #' @template field_repeatedPValues #' @template field_piControls #' @template field_stratifiedAnalysis -#' +#' #' @details #' This object cannot be created directly; use \code{\link{getAnalysisResults}} #' with suitable arguments to create the enrichment analysis results of an inverse normal design. @@ -1465,10 +1465,10 @@ AnalysisResultsMultiArmInverseNormal <- R6::R6Class("AnalysisResultsMultiArmInve #' @importFrom methods new #' AnalysisResultsEnrichmentInverseNormal <- R6::R6Class("AnalysisResultsEnrichmentInverseNormal", - inherit = AnalysisResultsEnrichment, - public = list( - stratifiedAnalysis = NULL - ) + inherit = AnalysisResultsEnrichment, + public = list( + stratifiedAnalysis = NULL + ) ) #' @@ -1504,7 +1504,7 @@ AnalysisResultsEnrichmentInverseNormal <- R6::R6Class("AnalysisResultsEnrichment #' @template field_conditionalPowerSimulated #' @template field_iterations #' @template field_seed -#' +#' #' @details #' This object cannot be created directly; use \code{\link{getAnalysisResults}} #' with suitable arguments to create the analysis results of a Fisher combination test design. @@ -1520,18 +1520,18 @@ AnalysisResultsEnrichmentInverseNormal <- R6::R6Class("AnalysisResultsEnrichment #' @importFrom methods new #' AnalysisResultsFisher <- R6::R6Class("AnalysisResultsFisher", - inherit = AnalysisResultsBase, - public = list( - conditionalPowerSimulated = NULL, - iterations = NULL, - seed = NULL, - initialize = function(design, dataInput, ..., iterations = NULL, seed = NULL) { - self$iterations <- iterations - self$seed <- seed - super$initialize(design = design, dataInput = dataInput, ...) - self$conditionalPowerSimulated <- -1 - } - ) + inherit = AnalysisResultsBase, + public = list( + conditionalPowerSimulated = NULL, + iterations = NULL, + seed = NULL, + initialize = function(design, dataInput, ..., iterations = NULL, seed = NULL) { + self$iterations <- iterations + self$seed <- seed + super$initialize(design = design, dataInput = dataInput, ...) + self$conditionalPowerSimulated <- -1 + } + ) ) #' @@ -1562,7 +1562,7 @@ AnalysisResultsFisher <- R6::R6Class("AnalysisResultsFisher", #' @template field_conditionalPowerSimulated #' @template field_iterations #' @template field_seed -#' +#' #' @details #' This object cannot be created directly; use \code{\link{getAnalysisResults}} #' with suitable arguments to create the multi-arm analysis results of a Fisher combination test design. @@ -1578,12 +1578,12 @@ AnalysisResultsFisher <- R6::R6Class("AnalysisResultsFisher", #' @importFrom methods new #' AnalysisResultsMultiArmFisher <- R6::R6Class("AnalysisResultsMultiArmFisher", - inherit = AnalysisResultsMultiArm, - public = list( - conditionalPowerSimulated = NULL, - iterations = NULL, - seed = NULL - ) + inherit = AnalysisResultsMultiArm, + public = list( + conditionalPowerSimulated = NULL, + iterations = NULL, + seed = NULL + ) ) #' @@ -1615,8 +1615,8 @@ AnalysisResultsMultiArmFisher <- R6::R6Class("AnalysisResultsMultiArmFisher", #' @template field_iterations #' @template field_seed #' @template field_stratifiedAnalysis -#' -#' +#' +#' #' @details #' This object cannot be created directly; use \code{\link{getAnalysisResults}} #' with suitable arguments to create the multi-arm analysis results of a Fisher combination test design. @@ -1632,13 +1632,13 @@ AnalysisResultsMultiArmFisher <- R6::R6Class("AnalysisResultsMultiArmFisher", #' @importFrom methods new #' AnalysisResultsEnrichmentFisher <- R6::R6Class("AnalysisResultsEnrichmentFisher", - inherit = AnalysisResultsEnrichment, - public = list( - conditionalPowerSimulated = NULL, - iterations = NULL, - seed = NULL, - stratifiedAnalysis = NULL - ) + inherit = AnalysisResultsEnrichment, + public = list( + conditionalPowerSimulated = NULL, + iterations = NULL, + seed = NULL, + stratifiedAnalysis = NULL + ) ) #' @@ -1668,7 +1668,7 @@ AnalysisResultsEnrichmentFisher <- R6::R6Class("AnalysisResultsEnrichmentFisher" #' @template field_repeatedConfidenceIntervalUpperBounds #' @template field_repeatedPValues #' @template field_piControl -#' +#' #' @details #' This object cannot be created directly; use \code{\link{getAnalysisResults}} #' with suitable arguments to create the multi-arm analysis results of a conditional Dunnett test design. @@ -1678,103 +1678,103 @@ AnalysisResultsEnrichmentFisher <- R6::R6Class("AnalysisResultsEnrichmentFisher" #' @importFrom methods new #' AnalysisResultsConditionalDunnett <- R6::R6Class("AnalysisResultsConditionalDunnett", - inherit = AnalysisResultsMultiArm, - public = list() + inherit = AnalysisResultsMultiArm, + public = list() ) .getAnalysisResultsPlotArguments <- function(x, - nPlanned = NA_real_, allocationRatioPlanned = NA_real_) { - if (all(is.na(nPlanned))) { - nPlanned <- stats::na.omit(x$nPlanned) - } - - if (is.na(allocationRatioPlanned) && length(x$allocationRatioPlanned) == 1) { - allocationRatioPlanned <- x$allocationRatioPlanned - } - - if (length(allocationRatioPlanned) != 1) { - allocationRatioPlanned <- NA_real_ - } - - if ((.isConditionalPowerEnabled(x$nPlanned) || .isConditionalPowerEnabled(nPlanned)) && is.na(allocationRatioPlanned)) { - allocationRatioPlanned <- 1 - } - - return(list( - stageResults = x$.stageResults, - nPlanned = nPlanned, - allocationRatioPlanned = allocationRatioPlanned - )) + nPlanned = NA_real_, allocationRatioPlanned = NA_real_) { + if (all(is.na(nPlanned))) { + nPlanned <- stats::na.omit(x$nPlanned) + } + + if (is.na(allocationRatioPlanned) && length(x$allocationRatioPlanned) == 1) { + allocationRatioPlanned <- x$allocationRatioPlanned + } + + if (length(allocationRatioPlanned) != 1) { + allocationRatioPlanned <- NA_real_ + } + + if ((.isConditionalPowerEnabled(x$nPlanned) || .isConditionalPowerEnabled(nPlanned)) && is.na(allocationRatioPlanned)) { + allocationRatioPlanned <- 1 + } + + return(list( + stageResults = x$.stageResults, + nPlanned = nPlanned, + allocationRatioPlanned = allocationRatioPlanned + )) } .getConfidenceIntervalPlotLegendLabels <- function(x, treatmentArmsToShow) { - if (.isEnrichmentAnalysisResults(x)) { - gMax <- x$.stageResults$getGMax() - labels <- paste0("S", treatmentArmsToShow) - labels[treatmentArmsToShow == gMax] <- "F" - labels <- factor(labels, levels = unique(labels)) - return(labels) - } - - return(paste0(treatmentArmsToShow, " vs control")) + if (.isEnrichmentAnalysisResults(x)) { + gMax <- x$.stageResults$getGMax() + labels <- paste0("S", treatmentArmsToShow) + labels[treatmentArmsToShow == gMax] <- "F" + labels <- factor(labels, levels = unique(labels)) + return(labels) + } + + return(paste0(treatmentArmsToShow, " vs control")) } .getConfidenceIntervalData <- function(x, treatmentArmsToShow = NULL) { - data <- .getConfidenceIntervalDataPerBound(x, "lower", treatmentArmsToShow) - data$upper <- .getConfidenceIntervalDataPerBound(x, "upper", treatmentArmsToShow)$upper - data$yValues <- (data$upper + data$lower) / 2 - data <- na.omit(data) - return(data) + data <- .getConfidenceIntervalDataPerBound(x, "lower", treatmentArmsToShow) + data$upper <- .getConfidenceIntervalDataPerBound(x, "upper", treatmentArmsToShow)$upper + data$yValues <- (data$upper + data$lower) / 2 + data <- na.omit(data) + return(data) } .getConfidenceIntervalDataPerBound <- function(x, ciName = c("lower", "upper"), treatmentArmsToShow = NULL) { - ciName <- match.arg(ciName) - paramName <- ifelse(ciName == "lower", "repeatedConfidenceIntervalLowerBounds", "repeatedConfidenceIntervalUpperBounds") - data <- x[[paramName]] - - if (is.matrix(data) && !is.null(treatmentArmsToShow) && - length(treatmentArmsToShow) > 0 && !any(is.na(treatmentArmsToShow))) { - data <- data[treatmentArmsToShow, ] - } - - if (is.matrix(data) && nrow(data) == 1) { - data <- as.numeric(data) - } - - if (is.matrix(data)) { - kMax <- ncol(data) - if (is.null(treatmentArmsToShow) || length(treatmentArmsToShow) == 0 || all(is.na(treatmentArmsToShow))) { - treatmentArmsToShow <- 1:nrow(data) + ciName <- match.arg(ciName) + paramName <- ifelse(ciName == "lower", "repeatedConfidenceIntervalLowerBounds", "repeatedConfidenceIntervalUpperBounds") + data <- x[[paramName]] + + if (is.matrix(data) && !is.null(treatmentArmsToShow) && + length(treatmentArmsToShow) > 0 && !any(is.na(treatmentArmsToShow))) { + data <- data[treatmentArmsToShow, ] } - groups <- length(treatmentArmsToShow) - result <- data.frame(ci = data[, 1]) - colnames(result) <- ciName - result$xValues <- rep(1, groups) - result$categories <- .getConfidenceIntervalPlotLegendLabels(x, treatmentArmsToShow) - if (kMax == 1) { - return(result) + + if (is.matrix(data) && nrow(data) == 1) { + data <- as.numeric(data) } - - for (stage in 2:kMax) { - resultPart <- data.frame(ci = data[, stage]) - colnames(resultPart) <- ciName - resultPart$xValues <- rep(stage, groups) - resultPart$categories <- .getConfidenceIntervalPlotLegendLabels(x, treatmentArmsToShow) - result <- rbind(result, resultPart) + + if (is.matrix(data)) { + kMax <- ncol(data) + if (is.null(treatmentArmsToShow) || length(treatmentArmsToShow) == 0 || all(is.na(treatmentArmsToShow))) { + treatmentArmsToShow <- 1:nrow(data) + } + groups <- length(treatmentArmsToShow) + result <- data.frame(ci = data[, 1]) + colnames(result) <- ciName + result$xValues <- rep(1, groups) + result$categories <- .getConfidenceIntervalPlotLegendLabels(x, treatmentArmsToShow) + if (kMax == 1) { + return(result) + } + + for (stage in 2:kMax) { + resultPart <- data.frame(ci = data[, stage]) + colnames(resultPart) <- ciName + resultPart$xValues <- rep(stage, groups) + resultPart$categories <- .getConfidenceIntervalPlotLegendLabels(x, treatmentArmsToShow) + result <- rbind(result, resultPart) + } + return(result) } + + if (is.null(treatmentArmsToShow) || length(treatmentArmsToShow) == 0 || all(is.na(treatmentArmsToShow))) { + treatmentArmsToShow <- 1 + } + + kMax <- length(data) + result <- data.frame(ci = data) + colnames(result) <- ciName + result$xValues <- 1:kMax + result$categories <- rep(.getConfidenceIntervalPlotLegendLabels(x, treatmentArmsToShow), kMax) return(result) - } - - if (is.null(treatmentArmsToShow) || length(treatmentArmsToShow) == 0 || all(is.na(treatmentArmsToShow))) { - treatmentArmsToShow <- 1 - } - - kMax <- length(data) - result <- data.frame(ci = data) - colnames(result) <- ciName - result$xValues <- 1:kMax - result$categories <- rep(.getConfidenceIntervalPlotLegendLabels(x, treatmentArmsToShow), kMax) - return(result) } #' @@ -1826,241 +1826,241 @@ AnalysisResultsConditionalDunnett <- R6::R6Class("AnalysisResultsConditionalDunn #' @export #' 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) { - .assertGgplotIsInstalled() - functionCall <- match.call(expand.dots = TRUE) - analysisResultsName <- as.character(functionCall$x)[1] - .assertIsSingleInteger(grid, "grid", validateType = FALSE) - typeNumbers <- .getPlotTypeNumber(type, x) - p <- NULL - plotList <- list() - for (typeNumber in typeNumbers) { - p <- .plotAnalysisResults( - x = x, y = y, type = typeNumber, - nPlanned = nPlanned, - allocationRatioPlanned = allocationRatioPlanned, - main = main, xlab = xlab, ylab = ylab, - legendTitle = legendTitle, palette = palette, legendPosition = legendPosition, - showSource = showSource, functionCall = functionCall, - analysisResultsName = analysisResultsName, plotSettings = plotSettings, ... - ) - .printPlotShowSourceSeparator(showSource, typeNumber, typeNumbers) - if (length(typeNumbers) > 1) { - caption <- .getPlotCaption(x, typeNumber, stopIfNotFound = TRUE) - plotList[[caption]] <- p + 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) { + .assertGgplotIsInstalled() + functionCall <- match.call(expand.dots = TRUE) + analysisResultsName <- as.character(functionCall$x)[1] + .assertIsSingleInteger(grid, "grid", validateType = FALSE) + typeNumbers <- .getPlotTypeNumber(type, x) + p <- NULL + plotList <- list() + for (typeNumber in typeNumbers) { + p <- .plotAnalysisResults( + x = x, y = y, type = typeNumber, + nPlanned = nPlanned, + allocationRatioPlanned = allocationRatioPlanned, + main = main, xlab = xlab, ylab = ylab, + legendTitle = legendTitle, palette = palette, legendPosition = legendPosition, + showSource = showSource, functionCall = functionCall, + analysisResultsName = analysisResultsName, plotSettings = plotSettings, ... + ) + .printPlotShowSourceSeparator(showSource, typeNumber, typeNumbers) + if (length(typeNumbers) > 1) { + caption <- .getPlotCaption(x, typeNumber, stopIfNotFound = TRUE) + plotList[[caption]] <- p + } } - } - if (length(typeNumbers) == 1) { + if (length(typeNumbers) == 1) { + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(p)) + } + + return(p) + } + if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(p)) + return(invisible(plotList)) } - - return(p) - } - - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(plotList)) - } - - return(.createPlotResultObject(plotList, grid)) + + return(.createPlotResultObject(plotList, grid)) } .plotAnalysisResultsRCI <- function(..., - x, y, nPlanned, allocationRatioPlanned, main, xlab, ylab, - legendTitle, palette, legendPosition, showSource, analysisResultsName, plotSettings = NULL) { - .assertIsAnalysisResults(x) - .warnInCaseOfUnknownArguments(functionName = "plot", ignore = c("treatmentArms", "populations"), ...) - - if (.isEnrichmentAnalysisResults(x)) { - gMax <- x$.stageResults$getGMax() - treatmentArmsToShow <- .getPopulationsToShow(x, gMax = gMax, ...) - } else { - treatmentArmsToShow <- .getTreatmentArmsToShow(x, ...) - } - - data <- .getConfidenceIntervalData(x, treatmentArmsToShow) - if (nrow(data) == 0) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "unable to create plot because no RCIs are available in the specified analysis result" - ) - } - - .warnInCaseOfUnusedArgument(nPlanned, "nPlanned", NA_real_, "plot") - .warnInCaseOfUnusedArgument(allocationRatioPlanned, "allocationRatioPlanned", NA_real_, "plot") - - plotData <- list( - main = "Repeated Confidence Intervals", - xlab = "Stage", - ylab = "RCI", - sub = NA_character_ # subtitle - ) - - if (is.na(legendPosition)) { - if (!.isMultiHypothesesAnalysisResults(x)) { - legendPosition <- ifelse(length(treatmentArmsToShow) == 1 && treatmentArmsToShow == 1, - -1, C_POSITION_RIGHT_CENTER - ) + x, y, nPlanned, allocationRatioPlanned, main, xlab, ylab, + legendTitle, palette, legendPosition, showSource, analysisResultsName, plotSettings = NULL) { + .assertIsAnalysisResults(x) + .warnInCaseOfUnknownArguments(functionName = "plot", ignore = c("treatmentArms", "populations"), ...) + + if (.isEnrichmentAnalysisResults(x)) { + gMax <- x$.stageResults$getGMax() + treatmentArmsToShow <- .getPopulationsToShow(x, gMax = gMax, ...) } else { - legendPosition <- C_POSITION_RIGHT_TOP + treatmentArmsToShow <- .getTreatmentArmsToShow(x, ...) + } + + data <- .getConfidenceIntervalData(x, treatmentArmsToShow) + if (nrow(data) == 0) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "unable to create plot because no RCIs are available in the specified analysis result" + ) + } + + .warnInCaseOfUnusedArgument(nPlanned, "nPlanned", NA_real_, "plot") + .warnInCaseOfUnusedArgument(allocationRatioPlanned, "allocationRatioPlanned", NA_real_, "plot") + + plotData <- list( + main = "Repeated Confidence Intervals", + xlab = "Stage", + ylab = "RCI", + sub = NA_character_ # subtitle + ) + + if (is.na(legendPosition)) { + if (!.isMultiHypothesesAnalysisResults(x)) { + legendPosition <- ifelse(length(treatmentArmsToShow) == 1 && treatmentArmsToShow == 1, + -1, C_POSITION_RIGHT_CENTER + ) + } else { + legendPosition <- C_POSITION_RIGHT_TOP + } + } + + treatmentArmsToShowCmd <- "" + if (!is.null(treatmentArmsToShow) && !identical(sort(unique(treatmentArmsToShow)), 1:nrow(data))) { + treatmentArmsToShowCmd <- paste0(", ", .arrayToString(treatmentArmsToShow, mode = "vector")) } - } - - treatmentArmsToShowCmd <- "" - if (!is.null(treatmentArmsToShow) && !identical(sort(unique(treatmentArmsToShow)), 1:nrow(data))) { - treatmentArmsToShowCmd <- paste0(", ", .arrayToString(treatmentArmsToShow, mode = "vector")) - } - dataCmd <- paste0("rpact:::.getConfidenceIntervalData(", analysisResultsName, treatmentArmsToShowCmd, ")") - srcCmd <- .showPlotSourceInformation( - objectName = analysisResultsName, - xParameterName = paste0(dataCmd, "$xValues"), - yParameterNames = c( - paste0(dataCmd, "$lower"), - paste0(dataCmd, "$yValues"), - paste0(dataCmd, "$upper") - ), - type = 2L, showSource = showSource, lineType = FALSE - ) - - p <- .createAnalysisResultsPlotObject(x, - data = data, plotData = plotData, main = main, xlab = xlab, ylab = ylab, - legendTitle = legendTitle, palette = palette, legendPosition = legendPosition, - kMax = x$.design$kMax, plotSettings = plotSettings - ) - p <- p + ggplot2::expand_limits(x = c(1, x$.design$kMax)) - return(p) + dataCmd <- paste0("rpact:::.getConfidenceIntervalData(", analysisResultsName, treatmentArmsToShowCmd, ")") + srcCmd <- .showPlotSourceInformation( + objectName = analysisResultsName, + xParameterName = paste0(dataCmd, "$xValues"), + yParameterNames = c( + paste0(dataCmd, "$lower"), + paste0(dataCmd, "$yValues"), + paste0(dataCmd, "$upper") + ), + type = 2L, showSource = showSource, lineType = FALSE + ) + + p <- .createAnalysisResultsPlotObject(x, + data = data, plotData = plotData, main = main, xlab = xlab, ylab = ylab, + legendTitle = legendTitle, palette = palette, legendPosition = legendPosition, + kMax = x$.design$kMax, plotSettings = plotSettings + ) + p <- p + ggplot2::expand_limits(x = c(1, x$.design$kMax)) + return(p) } .plotAnalysisResults <- function(..., - x, y, type, nPlanned, allocationRatioPlanned, main, xlab, ylab, - legendTitle, palette, legendPosition, showSource, functionCall, - analysisResultsName, plotSettings = NULL) { - .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) - if (!(type %in% c(1, 2))) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is not allowed; must be 1 or 2") - } - - .assertIsAnalysisResults(x) - .assertIsValidLegendPosition(legendPosition = legendPosition) - - if (type == 2) { - return(.plotAnalysisResultsRCI( - x = x, y = y, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, - main = main, xlab = xlab, ylab = ylab, - legendTitle = legendTitle, palette = palette, - legendPosition = legendPosition, showSource = showSource, - analysisResultsName = analysisResultsName, - plotSettings = plotSettings, ... - )) - } - - if (!.isConditionalPowerEnabled(x$nPlanned) && !.isConditionalPowerEnabled(nPlanned)) { - stop("'nPlanned' must be defined to create conditional power plot") - } - - .warnInCaseOfUnknownArguments( - functionName = "plot", - ignore = c("thetaRange", "assumedStDev", "assumedStDevs", "treatmentArms", "populations", "pi2", "piTreatmentRange"), - ... - ) - - if (is.na(legendPosition)) { - legendPosition <- C_POSITION_RIGHT_CENTER - } - - plotArgs <- .getAnalysisResultsPlotArguments( - x = x, nPlanned = nPlanned, - allocationRatioPlanned = allocationRatioPlanned - ) - - functionCall$x <- x$.stageResults - functionCall$y <- NULL - functionCall$stageResultsName <- paste0(analysisResultsName, "$.stageResults") - functionCall$nPlanned <- plotArgs$nPlanned - functionCall$main <- main - functionCall$xlab <- xlab - functionCall$ylab <- ylab - functionCall$legendTitle <- legendTitle - functionCall$palette <- palette - functionCall$legendPosition <- legendPosition - functionCall$type <- type - functionCall$plotSettings <- plotSettings - functionCall$allocationRatioPlanned <- plotArgs$allocationRatioPlanned - if (.isTrialDesignFisher(x$.design)) { - functionCall$iterations <- x$iterations - functionCall$seed <- x$seed - } - - if (x$getDataInput()$isDatasetMeans()) { - if (.isMultiHypothesesAnalysisResults(x)) { - assumedStDevs <- eval.parent(functionCall$assumedStDevs) - if (is.null(assumedStDevs)) { - assumedStDevs <- as.numeric(x$assumedStDevs) - } - - gMax <- x$.stageResults$getGMax() - .assertIsValidAssumedStDevs(assumedStDevs, gMax) - - functionCall$assumedStDevs <- assumedStDevs - } else { - assumedStDev <- eval.parent(functionCall$assumedStDev) - if (is.null(assumedStDev)) { - assumedStDev <- x$assumedStDev - } - functionCall$assumedStDev <- assumedStDev + x, y, type, nPlanned, allocationRatioPlanned, main, xlab, ylab, + legendTitle, palette, legendPosition, showSource, functionCall, + analysisResultsName, plotSettings = NULL) { + .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) + if (!(type %in% c(1, 2))) { + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, ") is not allowed; must be 1 or 2") } - } - - if (x$getDataInput()$isDatasetMeans() || x$getDataInput()$isDatasetSurvival()) { - thetaRange <- eval.parent(functionCall$thetaRange) - if (is.null(thetaRange)) { - thetaRangeMin <- min(x$thetaH0, min(na.omit(as.numeric(x$thetaH1)))) - thetaRangeMax <- 2 * max(x$thetaH0, max(na.omit(as.numeric(x$thetaH1)))) - thetaRange <- seq( - thetaRangeMin, thetaRangeMax, - (thetaRangeMax - thetaRangeMin) / C_THETA_RANGE_SEQUENCE_LENGTH_DEFAULT - ) - } else { - thetaRange <- .assertIsValidThetaRange( - thetaRange = thetaRange, - survivalDataEnabled = x$getDataInput()$isDatasetSurvival() - ) + + .assertIsAnalysisResults(x) + .assertIsValidLegendPosition(legendPosition = legendPosition) + + if (type == 2) { + return(.plotAnalysisResultsRCI( + x = x, y = y, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, + main = main, xlab = xlab, ylab = ylab, + legendTitle = legendTitle, palette = palette, + legendPosition = legendPosition, showSource = showSource, + analysisResultsName = analysisResultsName, + plotSettings = plotSettings, ... + )) } - functionCall$thetaRange <- thetaRange - } else if (x$getDataInput()$isDatasetRates()) { - if (.isMultiArmAnalysisResults(x)) { - piControl <- eval.parent(functionCall$piControl) - if (is.null(piControl)) { - piControl <- as.numeric(x$piControl) - } - functionCall$piControl <- piControl - } else if (.isEnrichmentAnalysisResults(x)) { - piControl <- eval.parent(functionCall$piControl) - if (is.null(piControl)) { - piControls <- as.numeric(x$piControls) - } - functionCall$piControls <- piControls - } else { - pi2 <- eval.parent(functionCall$pi2) - if (is.null(pi2)) { - pi2 <- x$pi2 - } - functionCall$pi2 <- pi2 + + if (!.isConditionalPowerEnabled(x$nPlanned) && !.isConditionalPowerEnabled(nPlanned)) { + stop("'nPlanned' must be defined to create conditional power plot") } - - piTreatmentRange <- eval.parent(functionCall$piTreatmentRange) - if (is.null(piTreatmentRange)) { - piTreatmentRange <- seq(0, 1, 1 / C_THETA_RANGE_SEQUENCE_LENGTH_DEFAULT) # default - } else { - piTreatmentRange <- .assertIsValidPiTreatmentRange(piTreatmentRange = piTreatmentRange) + + .warnInCaseOfUnknownArguments( + functionName = "plot", + ignore = c("thetaRange", "assumedStDev", "assumedStDevs", "treatmentArms", "populations", "pi2", "piTreatmentRange"), + ... + ) + + if (is.na(legendPosition)) { + legendPosition <- C_POSITION_RIGHT_CENTER } - functionCall$piTreatmentRange <- piTreatmentRange - } - - functionCall[[1L]] <- as.name("plot") - return(eval.parent(functionCall)) + + plotArgs <- .getAnalysisResultsPlotArguments( + x = x, nPlanned = nPlanned, + allocationRatioPlanned = allocationRatioPlanned + ) + + functionCall$x <- x$.stageResults + functionCall$y <- NULL + functionCall$stageResultsName <- paste0(analysisResultsName, "$.stageResults") + functionCall$nPlanned <- plotArgs$nPlanned + functionCall$main <- main + functionCall$xlab <- xlab + functionCall$ylab <- ylab + functionCall$legendTitle <- legendTitle + functionCall$palette <- palette + functionCall$legendPosition <- legendPosition + functionCall$type <- type + functionCall$plotSettings <- plotSettings + functionCall$allocationRatioPlanned <- plotArgs$allocationRatioPlanned + if (.isTrialDesignFisher(x$.design)) { + functionCall$iterations <- x$iterations + functionCall$seed <- x$seed + } + + if (x$getDataInput()$isDatasetMeans()) { + if (.isMultiHypothesesAnalysisResults(x)) { + assumedStDevs <- eval.parent(functionCall$assumedStDevs) + if (is.null(assumedStDevs)) { + assumedStDevs <- as.numeric(x$assumedStDevs) + } + + gMax <- x$.stageResults$getGMax() + .assertIsValidAssumedStDevs(assumedStDevs, gMax) + + functionCall$assumedStDevs <- assumedStDevs + } else { + assumedStDev <- eval.parent(functionCall$assumedStDev) + if (is.null(assumedStDev)) { + assumedStDev <- x$assumedStDev + } + functionCall$assumedStDev <- assumedStDev + } + } + + if (x$getDataInput()$isDatasetMeans() || x$getDataInput()$isDatasetSurvival()) { + thetaRange <- eval.parent(functionCall$thetaRange) + if (is.null(thetaRange)) { + thetaRangeMin <- min(x$thetaH0, min(na.omit(as.numeric(x$thetaH1)))) + thetaRangeMax <- 2 * max(x$thetaH0, max(na.omit(as.numeric(x$thetaH1)))) + thetaRange <- seq( + thetaRangeMin, thetaRangeMax, + (thetaRangeMax - thetaRangeMin) / C_THETA_RANGE_SEQUENCE_LENGTH_DEFAULT + ) + } else { + thetaRange <- .assertIsValidThetaRange( + thetaRange = thetaRange, + survivalDataEnabled = x$getDataInput()$isDatasetSurvival() + ) + } + functionCall$thetaRange <- thetaRange + } else if (x$getDataInput()$isDatasetRates()) { + if (.isMultiArmAnalysisResults(x)) { + piControl <- eval.parent(functionCall$piControl) + if (is.null(piControl)) { + piControl <- as.numeric(x$piControl) + } + functionCall$piControl <- piControl + } else if (.isEnrichmentAnalysisResults(x)) { + piControl <- eval.parent(functionCall$piControl) + if (is.null(piControl)) { + piControls <- as.numeric(x$piControls) + } + functionCall$piControls <- piControls + } else { + pi2 <- eval.parent(functionCall$pi2) + if (is.null(pi2)) { + pi2 <- x$pi2 + } + functionCall$pi2 <- pi2 + } + + piTreatmentRange <- eval.parent(functionCall$piTreatmentRange) + if (is.null(piTreatmentRange)) { + piTreatmentRange <- seq(0, 1, 1 / C_THETA_RANGE_SEQUENCE_LENGTH_DEFAULT) # default + } else { + piTreatmentRange <- .assertIsValidPiTreatmentRange(piTreatmentRange = piTreatmentRange) + } + functionCall$piTreatmentRange <- piTreatmentRange + } + + functionCall[[1L]] <- as.name("plot") + return(eval.parent(functionCall)) } diff --git a/R/class_analysis_stage_results.R b/R/class_analysis_stage_results.R index b003828e..8c159439 100644 --- a/R/class_analysis_stage_results.R +++ b/R/class_analysis_stage_results.R @@ -63,190 +63,190 @@ #' @importFrom methods new #' StageResults <- R6::R6Class("StageResults", - inherit = ParameterSet, - public = list( - .plotSettings = NULL, - .design = NULL, - .dataInput = NULL, - stage = NULL, - stages = NULL, - pValues = NULL, - weightsFisher = NULL, - weightsInverseNormal = NULL, - thetaH0 = NULL, - direction = NULL, - initialize = function(..., stage = NULL, stages = NULL, pValues = NULL, weightsFisher = NULL, weightsInverseNormal = NULL, thetaH0 = NULL, direction = NULL) { - self$stage <- stage - self$stages <- stages - self$pValues <- pValues - self$weightsFisher <- weightsFisher - self$weightsInverseNormal <- weightsInverseNormal - self$thetaH0 <- thetaH0 - self$direction <- direction - super$initialize(...) - }, - init = function(design, dataInput) { - self$.design <- design - self$.dataInput <- dataInput - - self$.plotSettings <- PlotSettings$new() - if (!missing(design)) { - self$stages <- c(1:design$kMax) - if (design$kMax == C_KMAX_DEFAULT) { - self$.setParameterType("stages", C_PARAM_DEFAULT_VALUE) - } else { - self$.setParameterType("stages", C_PARAM_USER_DEFINED) - } - } - - self$.setParameterType("stage", C_PARAM_NOT_APPLICABLE) - - self$.setParameterType("pValues", ifelse( - self$.isMultiArm(), C_PARAM_NOT_APPLICABLE, C_PARAM_GENERATED - )) - self$.setParameterType("thetaH0", ifelse( - identical(self$thetaH0, C_THETA_H0_MEANS_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - self$.setParameterType("direction", ifelse( - identical(self$direction, C_DIRECTION_UPPER), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - }, - getPlotSettings = function() { - return(self$.plotSettings) - }, - show = function(showType = 1, digits = NA_integer_) { - self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) - }, - .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { - "Method for automatically printing stage results" - self$.resetCat() - if (showType == 2) { - super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) - } else { - self$.cat(self$.toString(startWithUpperCase = TRUE), ":\n\n", - heading = 1, - consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Output", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - - if (grepl("Enrichment", .getClassName(self))) { - self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) - self$.cat(paste0(" S[i]: population i\n"), consoleOutputEnabled = consoleOutputEnabled) - self$.cat(paste0(" F: full population\n"), consoleOutputEnabled = consoleOutputEnabled) - } else if (grepl("MultiArm", .getClassName(self))) { - self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) - self$.cat( - paste0( - " (i): results of treatment arm i vs. control group ", - self$.dataInput$getNumberOfGroups(), "\n" - ), - consoleOutputEnabled = consoleOutputEnabled - ) - } else if (self$.dataInput$getNumberOfGroups(survivalCorrectionEnabled = FALSE) >= 2) { - self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) - self$.cat(" (i): values of treatment arm i\n", consoleOutputEnabled = consoleOutputEnabled) - } - } - }, - isDirectionUpper = function() { - return(self$direction == C_DIRECTION_UPPER) - }, - .isMultiArm = function() { - return(grepl("multi", tolower(.getClassName(self)))) - }, - .isEnrichment = function() { - return(grepl("enrichment", tolower(.getClassName(self)))) - }, - getGMax = function() { - if (!is.matrix(self$testStatistics)) { - return(1L) - } - - gMax <- nrow(self$testStatistics) - if (is.null(gMax) || gMax == 0) { - gMax <- 1L - } - return(gMax) - }, - .getParametersToShow = function() { - return(c("stages")) - }, - .toString = function(startWithUpperCase = FALSE) { - s <- "stage results of" - - if (grepl("MultiArm", .getClassName(self))) { - s <- paste(s, "multi-arm") - } else if (grepl("Enrichment", .getClassName(self))) { - s <- paste(s, "enrichment") - } - - if (grepl("Means", .getClassName(self))) { - s <- paste(s, "means") - } - - if (grepl("Rates", .getClassName(self))) { - s <- paste(s, "rates") - } - - if (grepl("Survival", .getClassName(self))) { - s <- paste(s, "survival data") - } - - if (startWithUpperCase) { - s <- .firstCharacterToUpperCase(s) - } - - return(s) - }, - getDataInput = function() { - return(self$.dataInput) - }, - getNumberOfGroups = function() { - return(self$.dataInput$getNumberOfGroups()) - }, - isOneSampleDataset = function() { - return(self$getNumberOfGroups() == 1) - }, - isTwoSampleDataset = function() { - return(self$getNumberOfGroups() == 2) - }, - isDatasetMeans = function() { - return(self$.dataInput$isDatasetMeans()) - }, - isDatasetRates = function() { - return(self$.dataInput$isDatasetRates()) - }, - isDatasetSurvival = function() { - return(self$.dataInput$isDatasetSurvival()) - }, - getNumberOfStages = function() { - if (self$.isMultiArm()) { - if (inherits(self, "StageResultsMultiArmRates")) { - return(max( - ncol(stats::na.omit(self$testStatistics)), - ncol(stats::na.omit(self$separatePValues)) - )) - } - return(max( - ncol(stats::na.omit(self$effectSizes)), - ncol(stats::na.omit(self$separatePValues)) - )) - } - return(max( - length(stats::na.omit(self$effectSizes)), - length(stats::na.omit(self$pValues)) - )) - } - ) + inherit = ParameterSet, + public = list( + .plotSettings = NULL, + .design = NULL, + .dataInput = NULL, + stage = NULL, + stages = NULL, + pValues = NULL, + weightsFisher = NULL, + weightsInverseNormal = NULL, + thetaH0 = NULL, + direction = NULL, + initialize = function(..., stage = NULL, stages = NULL, pValues = NULL, weightsFisher = NULL, weightsInverseNormal = NULL, thetaH0 = NULL, direction = NULL) { + self$stage <- stage + self$stages <- stages + self$pValues <- pValues + self$weightsFisher <- weightsFisher + self$weightsInverseNormal <- weightsInverseNormal + self$thetaH0 <- thetaH0 + self$direction <- direction + super$initialize(...) + }, + init = function(design, dataInput) { + self$.design <- design + self$.dataInput <- dataInput + + self$.plotSettings <- PlotSettings$new() + if (!missing(design)) { + self$stages <- c(1:design$kMax) + if (design$kMax == C_KMAX_DEFAULT) { + self$.setParameterType("stages", C_PARAM_DEFAULT_VALUE) + } else { + self$.setParameterType("stages", C_PARAM_USER_DEFINED) + } + } + + self$.setParameterType("stage", C_PARAM_NOT_APPLICABLE) + + self$.setParameterType("pValues", ifelse( + self$.isMultiArm(), C_PARAM_NOT_APPLICABLE, C_PARAM_GENERATED + )) + self$.setParameterType("thetaH0", ifelse( + identical(self$thetaH0, C_THETA_H0_MEANS_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + self$.setParameterType("direction", ifelse( + identical(self$direction, C_DIRECTION_UPPER), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + }, + getPlotSettings = function() { + return(self$.plotSettings) + }, + show = function(showType = 1, digits = NA_integer_) { + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + }, + .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { + "Method for automatically printing stage results" + self$.resetCat() + if (showType == 2) { + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + } else { + self$.cat(self$.toString(startWithUpperCase = TRUE), ":\n\n", + heading = 1, + consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Output", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + + if (grepl("Enrichment", .getClassName(self))) { + self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(paste0(" S[i]: population i\n"), consoleOutputEnabled = consoleOutputEnabled) + self$.cat(paste0(" F: full population\n"), consoleOutputEnabled = consoleOutputEnabled) + } else if (grepl("MultiArm", .getClassName(self))) { + self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) + self$.cat( + paste0( + " (i): results of treatment arm i vs. control group ", + self$.dataInput$getNumberOfGroups(), "\n" + ), + consoleOutputEnabled = consoleOutputEnabled + ) + } else if (self$.dataInput$getNumberOfGroups(survivalCorrectionEnabled = FALSE) >= 2) { + self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" (i): values of treatment arm i\n", consoleOutputEnabled = consoleOutputEnabled) + } + } + }, + isDirectionUpper = function() { + return(self$direction == C_DIRECTION_UPPER) + }, + .isMultiArm = function() { + return(grepl("multi", tolower(.getClassName(self)))) + }, + .isEnrichment = function() { + return(grepl("enrichment", tolower(.getClassName(self)))) + }, + getGMax = function() { + if (!is.matrix(self$testStatistics)) { + return(1L) + } + + gMax <- nrow(self$testStatistics) + if (is.null(gMax) || gMax == 0) { + gMax <- 1L + } + return(gMax) + }, + .getParametersToShow = function() { + return(c("stages")) + }, + .toString = function(startWithUpperCase = FALSE) { + s <- "stage results of" + + if (grepl("MultiArm", .getClassName(self))) { + s <- paste(s, "multi-arm") + } else if (grepl("Enrichment", .getClassName(self))) { + s <- paste(s, "enrichment") + } + + if (grepl("Means", .getClassName(self))) { + s <- paste(s, "means") + } + + if (grepl("Rates", .getClassName(self))) { + s <- paste(s, "rates") + } + + if (grepl("Survival", .getClassName(self))) { + s <- paste(s, "survival data") + } + + if (startWithUpperCase) { + s <- .firstCharacterToUpperCase(s) + } + + return(s) + }, + getDataInput = function() { + return(self$.dataInput) + }, + getNumberOfGroups = function() { + return(self$.dataInput$getNumberOfGroups()) + }, + isOneSampleDataset = function() { + return(self$getNumberOfGroups() == 1) + }, + isTwoSampleDataset = function() { + return(self$getNumberOfGroups() == 2) + }, + isDatasetMeans = function() { + return(self$.dataInput$isDatasetMeans()) + }, + isDatasetRates = function() { + return(self$.dataInput$isDatasetRates()) + }, + isDatasetSurvival = function() { + return(self$.dataInput$isDatasetSurvival()) + }, + getNumberOfStages = function() { + if (self$.isMultiArm()) { + if (inherits(self, "StageResultsMultiArmRates")) { + return(max( + ncol(stats::na.omit(self$testStatistics)), + ncol(stats::na.omit(self$separatePValues)) + )) + } + return(max( + ncol(stats::na.omit(self$effectSizes)), + ncol(stats::na.omit(self$separatePValues)) + )) + } + return(max( + length(stats::na.omit(self$effectSizes)), + length(stats::na.omit(self$pValues)) + )) + } + ) ) #' @@ -273,7 +273,7 @@ StageResults <- R6::R6Class("StageResults", #' @template field_combInverseNormal #' @template field_weightsInverseNormal #' @field ... Names of \code{dataInput}. -#' +#' #' @details #' This object cannot be created directly; use \code{getStageResults} #' with suitable arguments to create the stage results of a dataset of means. @@ -288,145 +288,145 @@ StageResults <- R6::R6Class("StageResults", #' @importFrom methods new #' StageResultsMeans <- R6::R6Class("StageResultsMeans", - inherit = StageResults, - public = list( - combInverseNormal = NULL, - combFisher = NULL, - overallTestStatistics = NULL, - overallPValues = NULL, - effectSizes = NULL, - testStatistics = NULL, - overallMeans = NULL, - overallMeans1 = NULL, - overallMeans2 = NULL, - overallStDevs = NULL, - overallStDevs1 = NULL, - overallStDevs2 = NULL, - overallSampleSizes = NULL, - overallSampleSizes1 = NULL, - overallSampleSizes2 = NULL, - equalVariances = NULL, - normalApproximation = NULL, - initialize = function(design, dataInput, ..., - combInverseNormal = NULL, - combFisher = NULL, - overallTestStatistics = NULL, - overallPValues = NULL, - effectSizes = NULL, - testStatistics = NULL, - overallMeans = NULL, - overallMeans1 = NULL, - overallMeans2 = NULL, - overallStDevs = NULL, - overallStDevs1 = NULL, - overallStDevs2 = NULL, - overallSampleSizes = NULL, - overallSampleSizes1 = NULL, - overallSampleSizes2 = NULL, - equalVariances = TRUE, normalApproximation = FALSE) { - super$initialize(.design = design, .dataInput = dataInput, ...)#TODO - - self$combInverseNormal <- combInverseNormal - self$combFisher <- combFisher - self$overallTestStatistics <- overallTestStatistics - self$overallPValues <- overallPValues - self$effectSizes <- effectSizes - self$testStatistics <- testStatistics - self$overallMeans <- overallMeans - self$overallMeans1 <- overallMeans1 - self$overallMeans2 <- overallMeans2 - self$overallStDevs <- overallStDevs - self$overallStDevs1 <- overallStDevs1 - self$overallStDevs2 <- overallStDevs2 - self$overallSampleSizes <- overallSampleSizes - self$overallSampleSizes1 <- overallSampleSizes1 - self$overallSampleSizes2 <- overallSampleSizes2 - - self$equalVariances <- equalVariances - self$normalApproximation <- normalApproximation - - self$init(design = design, dataInput = dataInput) - - for (param in c( - "weightsFisher", - "weightsInverseNormal", - "combFisher", - "combInverseNormal" - )) { - self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) - } - - for (param in self$.getParametersToShow()) { - if (self$.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { - self$.setParameterType(param, C_PARAM_GENERATED) - } - } - - self$.setParameterType("equalVariances", ifelse( - identical(self$equalVariances, TRUE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - self$.setParameterType("normalApproximation", ifelse( - identical(self$normalApproximation, FALSE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - }, - .getParametersToShow = function() { - parametersToShow <- c( - "stages", - "overallTestStatistics", - "overallPValues" - ) - if (self$.dataInput$getNumberOfGroups() == 1) { - parametersToShow <- c( - parametersToShow, - "overallMeans", - "overallStDevs", - "overallSampleSizes" - ) - } else if (self$.dataInput$getNumberOfGroups() == 2) { - parametersToShow <- c( - parametersToShow, - "overallMeans1", - "overallMeans2", - "overallStDevs1", - "overallStDevs2", - "overallSampleSizes1", - "overallSampleSizes2" - ) - } - parametersToShow <- c( - parametersToShow, - "testStatistics", - "pValues", - "effectSizes" - ) - if (.isTrialDesignInverseNormal(self$.design)) { - parametersToShow <- c( - parametersToShow, - "combInverseNormal", - "weightsInverseNormal" - ) - } else if (.isTrialDesignFisher(self$.design)) { - parametersToShow <- c( - parametersToShow, - "combFisher", - "weightsFisher" - ) - } - parametersToShow <- c( - parametersToShow, - "thetaH0", - "direction", - "normalApproximation" - ) - if (self$.dataInput$getNumberOfGroups() == 2) { - parametersToShow <- c( - parametersToShow, - "equalVariances" - ) - } - return(parametersToShow) - } - ) + inherit = StageResults, + public = list( + combInverseNormal = NULL, + combFisher = NULL, + overallTestStatistics = NULL, + overallPValues = NULL, + effectSizes = NULL, + testStatistics = NULL, + overallMeans = NULL, + overallMeans1 = NULL, + overallMeans2 = NULL, + overallStDevs = NULL, + overallStDevs1 = NULL, + overallStDevs2 = NULL, + overallSampleSizes = NULL, + overallSampleSizes1 = NULL, + overallSampleSizes2 = NULL, + equalVariances = NULL, + normalApproximation = NULL, + initialize = function(design, dataInput, ..., + combInverseNormal = NULL, + combFisher = NULL, + overallTestStatistics = NULL, + overallPValues = NULL, + effectSizes = NULL, + testStatistics = NULL, + overallMeans = NULL, + overallMeans1 = NULL, + overallMeans2 = NULL, + overallStDevs = NULL, + overallStDevs1 = NULL, + overallStDevs2 = NULL, + overallSampleSizes = NULL, + overallSampleSizes1 = NULL, + overallSampleSizes2 = NULL, + equalVariances = TRUE, normalApproximation = FALSE) { + super$initialize(.design = design, .dataInput = dataInput, ...) # TODO + + self$combInverseNormal <- combInverseNormal + self$combFisher <- combFisher + self$overallTestStatistics <- overallTestStatistics + self$overallPValues <- overallPValues + self$effectSizes <- effectSizes + self$testStatistics <- testStatistics + self$overallMeans <- overallMeans + self$overallMeans1 <- overallMeans1 + self$overallMeans2 <- overallMeans2 + self$overallStDevs <- overallStDevs + self$overallStDevs1 <- overallStDevs1 + self$overallStDevs2 <- overallStDevs2 + self$overallSampleSizes <- overallSampleSizes + self$overallSampleSizes1 <- overallSampleSizes1 + self$overallSampleSizes2 <- overallSampleSizes2 + + self$equalVariances <- equalVariances + self$normalApproximation <- normalApproximation + + self$init(design = design, dataInput = dataInput) + + for (param in c( + "weightsFisher", + "weightsInverseNormal", + "combFisher", + "combInverseNormal" + )) { + self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) + } + + for (param in self$.getParametersToShow()) { + if (self$.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { + self$.setParameterType(param, C_PARAM_GENERATED) + } + } + + self$.setParameterType("equalVariances", ifelse( + identical(self$equalVariances, TRUE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + self$.setParameterType("normalApproximation", ifelse( + identical(self$normalApproximation, FALSE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + }, + .getParametersToShow = function() { + parametersToShow <- c( + "stages", + "overallTestStatistics", + "overallPValues" + ) + if (self$.dataInput$getNumberOfGroups() == 1) { + parametersToShow <- c( + parametersToShow, + "overallMeans", + "overallStDevs", + "overallSampleSizes" + ) + } else if (self$.dataInput$getNumberOfGroups() == 2) { + parametersToShow <- c( + parametersToShow, + "overallMeans1", + "overallMeans2", + "overallStDevs1", + "overallStDevs2", + "overallSampleSizes1", + "overallSampleSizes2" + ) + } + parametersToShow <- c( + parametersToShow, + "testStatistics", + "pValues", + "effectSizes" + ) + if (.isTrialDesignInverseNormal(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combInverseNormal", + "weightsInverseNormal" + ) + } else if (.isTrialDesignFisher(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combFisher", + "weightsFisher" + ) + } + parametersToShow <- c( + parametersToShow, + "thetaH0", + "direction", + "normalApproximation" + ) + if (self$.dataInput$getNumberOfGroups() == 2) { + parametersToShow <- c( + parametersToShow, + "equalVariances" + ) + } + return(parametersToShow) + } + ) ) #' @name StageResultsMultiArmMeans @@ -439,7 +439,7 @@ StageResultsMeans <- R6::R6Class("StageResultsMeans", #' #' @template field_stages #' @template field_testStatistics -#' @template field_pValues +#' @template field_pValues #' @template field_combInverseNormal #' @template field_combFisher #' @template field_effectSizes @@ -464,7 +464,7 @@ StageResultsMeans <- R6::R6Class("StageResultsMeans", #' @details #' This object cannot be created directly; use \code{getStageResults} #' with suitable arguments to create the stage results of a dataset of multi arm means. -#' +#' #' @include class_core_parameter_set.R #' @include class_design.R #' @include class_analysis_dataset.R @@ -475,113 +475,113 @@ StageResultsMeans <- R6::R6Class("StageResultsMeans", #' @importFrom methods new #' StageResultsMultiArmMeans <- R6::R6Class("StageResultsMultiArmMeans", - inherit = StageResults, - public = list( - combInverseNormal = NULL, - combFisher = NULL, - overallTestStatistics = NULL, - overallStDevs = NULL, - overallPooledStDevs = NULL, - overallPValues = NULL, - testStatistics = NULL, - separatePValues = NULL, - effectSizes = NULL, - singleStepAdjustedPValues = NULL, - intersectionTest = NULL, - varianceOption = NULL, - normalApproximation = NULL, - directionUpper = NULL, - initialize = function(design, dataInput, ..., - combInverseNormal = NULL, - combFisher = NULL, - overallTestStatistics = NULL, - overallStDevs = NULL, - overallPooledStDevs = NULL, - overallPValues = NULL, - testStatistics = NULL, - separatePValues = NULL, - effectSizes = NULL, - singleStepAdjustedPValues = NULL, - intersectionTest = NULL,varianceOption = C_VARIANCE_OPTION_MULTIARMED_DEFAULT, - normalApproximation = FALSE, directionUpper = NULL) { - super$initialize(...) - self$combInverseNormal <- combInverseNormal - self$combFisher <- combFisher - self$overallTestStatistics <- overallTestStatistics - self$overallStDevs <- overallStDevs - self$overallPooledStDevs <- overallPooledStDevs - self$overallPValues <- overallPValues - self$testStatistics <- testStatistics - self$separatePValues <- separatePValues - self$effectSizes <- effectSizes - self$singleStepAdjustedPValues <- singleStepAdjustedPValues - self$varianceOption <- varianceOption - self$normalApproximation <- normalApproximation - self$directionUpper <- directionUpper - - - self$init(design = design, dataInput = dataInput) - - for (param in c( - "singleStepAdjustedPValues", - "weightsFisher", - "weightsInverseNormal", - "combFisher", - "combInverseNormal" - )) { - self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) - } - - for (param in self$.getParametersToShow()) { - if (self$.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { - self$.setParameterType(param, C_PARAM_GENERATED) - } - } - - self$.setParameterType("varianceOption", ifelse( - identical(self$varianceOption, C_VARIANCE_OPTION_MULTIARMED_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - self$.setParameterType("normalApproximation", ifelse( - identical(self$normalApproximation, FALSE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - self$.setParameterType("directionUpper", ifelse( - identical(self$directionUpper, C_DIRECTION_UPPER_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - }, - .getParametersToShow = function() { - parametersToShow <- c( - "stages", - "thetaH0", - "direction", - "normalApproximation", - "directionUpper", - "varianceOption", - "intersectionTest", - "overallTestStatistics", - "overallPValues", - "overallStDevs", - "overallPooledStDevs", - "testStatistics", - "separatePValues", - "effectSizes", - "singleStepAdjustedPValues" - ) - if (.isTrialDesignInverseNormal(self$.design)) { - parametersToShow <- c( - parametersToShow, - "combInverseNormal", - "weightsInverseNormal" - ) - } else if (.isTrialDesignFisher(self$.design)) { - parametersToShow <- c( - parametersToShow, - "combFisher", - "weightsFisher" - ) - } - return(parametersToShow) - } - ) + inherit = StageResults, + public = list( + combInverseNormal = NULL, + combFisher = NULL, + overallTestStatistics = NULL, + overallStDevs = NULL, + overallPooledStDevs = NULL, + overallPValues = NULL, + testStatistics = NULL, + separatePValues = NULL, + effectSizes = NULL, + singleStepAdjustedPValues = NULL, + intersectionTest = NULL, + varianceOption = NULL, + normalApproximation = NULL, + directionUpper = NULL, + initialize = function(design, dataInput, ..., + combInverseNormal = NULL, + combFisher = NULL, + overallTestStatistics = NULL, + overallStDevs = NULL, + overallPooledStDevs = NULL, + overallPValues = NULL, + testStatistics = NULL, + separatePValues = NULL, + effectSizes = NULL, + singleStepAdjustedPValues = NULL, + intersectionTest = NULL, varianceOption = C_VARIANCE_OPTION_MULTIARMED_DEFAULT, + normalApproximation = FALSE, directionUpper = NULL) { + super$initialize(...) + self$combInverseNormal <- combInverseNormal + self$combFisher <- combFisher + self$overallTestStatistics <- overallTestStatistics + self$overallStDevs <- overallStDevs + self$overallPooledStDevs <- overallPooledStDevs + self$overallPValues <- overallPValues + self$testStatistics <- testStatistics + self$separatePValues <- separatePValues + self$effectSizes <- effectSizes + self$singleStepAdjustedPValues <- singleStepAdjustedPValues + self$varianceOption <- varianceOption + self$normalApproximation <- normalApproximation + self$directionUpper <- directionUpper + + + self$init(design = design, dataInput = dataInput) + + for (param in c( + "singleStepAdjustedPValues", + "weightsFisher", + "weightsInverseNormal", + "combFisher", + "combInverseNormal" + )) { + self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) + } + + for (param in self$.getParametersToShow()) { + if (self$.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { + self$.setParameterType(param, C_PARAM_GENERATED) + } + } + + self$.setParameterType("varianceOption", ifelse( + identical(self$varianceOption, C_VARIANCE_OPTION_MULTIARMED_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + self$.setParameterType("normalApproximation", ifelse( + identical(self$normalApproximation, FALSE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + self$.setParameterType("directionUpper", ifelse( + identical(self$directionUpper, C_DIRECTION_UPPER_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + }, + .getParametersToShow = function() { + parametersToShow <- c( + "stages", + "thetaH0", + "direction", + "normalApproximation", + "directionUpper", + "varianceOption", + "intersectionTest", + "overallTestStatistics", + "overallPValues", + "overallStDevs", + "overallPooledStDevs", + "testStatistics", + "separatePValues", + "effectSizes", + "singleStepAdjustedPValues" + ) + if (.isTrialDesignInverseNormal(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combInverseNormal", + "weightsInverseNormal" + ) + } else if (.isTrialDesignFisher(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combFisher", + "weightsFisher" + ) + } + return(parametersToShow) + } + ) ) #' @@ -592,7 +592,7 @@ StageResultsMultiArmMeans <- R6::R6Class("StageResultsMultiArmMeans", #' #' @description #' Class for stage results of rates. -#' +#' #' @template field_stages #' @template field_testStatistics #' @template field_overallTestStatistics @@ -623,134 +623,134 @@ StageResultsMultiArmMeans <- R6::R6Class("StageResultsMultiArmMeans", #' @importFrom methods new #' StageResultsRates <- R6::R6Class("StageResultsRates", - inherit = StageResults, - public = list( - combInverseNormal = NULL, - combFisher = NULL, - overallTestStatistics = NULL, - overallPValues = NULL, - effectSizes = NULL, - testStatistics = NULL, - overallPi1 = NULL, - overallPi2 = NULL, - overallEvents = NULL, - overallEvents1 = NULL, - overallEvents2 = NULL, - overallSampleSizes = NULL, - overallSampleSizes1 = NULL, - overallSampleSizes2 = NULL, - normalApproximation = NULL, - initialize = function(design, dataInput, ..., - combInverseNormal = NULL, - combFisher = NULL, - overallTestStatistics = NULL, - overallPValues = NULL, - effectSizes = NULL, - testStatistics = NULL, - overallPi1 = NULL, - overallPi2 = NULL, - overallEvents = NULL, - overallEvents1 = NULL, - overallEvents2 = NULL, - overallSampleSizes = NULL, - overallSampleSizes1 = NULL, - overallSampleSizes2 = NULL, - normalApproximation = TRUE) { - super$initialize(.design = design, .dataInput = dataInput, ...)#TODO - - self$combInverseNormal <- combInverseNormal - self$combFisher <- combFisher - self$overallTestStatistics <- overallTestStatistics - self$overallPValues <- overallPValues - self$effectSizes <- effectSizes - self$testStatistics <- testStatistics - self$overallPi1 <- overallPi1 - self$overallPi2 <- overallPi2 - self$overallEvents <- overallEvents - self$overallEvents1 <- overallEvents1 - self$overallEvents2 <- overallEvents2 - self$overallSampleSizes <- overallSampleSizes - self$overallSampleSizes1 <- overallSampleSizes1 - self$overallSampleSizes2 <- overallSampleSizes2 - - self$normalApproximation <- normalApproximation - - self$init(design = design, dataInput = dataInput) - - for (param in c( - "weightsFisher", - "weightsInverseNormal", - "combFisher", - "combInverseNormal" - )) { - self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) - } - - for (param in self$.getParametersToShow()) { - if (self$.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { - self$.setParameterType(param, C_PARAM_GENERATED) - } - } - - self$.setParameterType("normalApproximation", ifelse( - identical(self$normalApproximation, TRUE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - }, - .getParametersToShow = function() { - parametersToShow <- c( - "stages", - "overallTestStatistics", - "overallPValues" - ) - if (self$.dataInput$getNumberOfGroups() == 1) { - parametersToShow <- c( - parametersToShow, - "overallEvents", - "overallSampleSizes", - "overallPi1" - ) - } else if (self$.dataInput$getNumberOfGroups() == 2) { - parametersToShow <- c( - parametersToShow, - "overallEvents1", - "overallEvents2", - "overallSampleSizes1", - "overallSampleSizes2", - "overallPi1", - "overallPi2" - ) - } - parametersToShow <- c( - parametersToShow, - "testStatistics", - "pValues" - ) - if (self$.dataInput$getNumberOfGroups() > 1) { - parametersToShow <- c(parametersToShow, "effectSizes") - } - - if (.isTrialDesignInverseNormal(self$.design)) { - parametersToShow <- c( - parametersToShow, - "combInverseNormal", - "weightsInverseNormal" - ) - } else if (.isTrialDesignFisher(self$.design)) { - parametersToShow <- c( - parametersToShow, - "combFisher", - "weightsFisher" - ) - } - parametersToShow <- c( - parametersToShow, - "thetaH0", - "direction", - "normalApproximation" - ) - return(parametersToShow) - } - ) + inherit = StageResults, + public = list( + combInverseNormal = NULL, + combFisher = NULL, + overallTestStatistics = NULL, + overallPValues = NULL, + effectSizes = NULL, + testStatistics = NULL, + overallPi1 = NULL, + overallPi2 = NULL, + overallEvents = NULL, + overallEvents1 = NULL, + overallEvents2 = NULL, + overallSampleSizes = NULL, + overallSampleSizes1 = NULL, + overallSampleSizes2 = NULL, + normalApproximation = NULL, + initialize = function(design, dataInput, ..., + combInverseNormal = NULL, + combFisher = NULL, + overallTestStatistics = NULL, + overallPValues = NULL, + effectSizes = NULL, + testStatistics = NULL, + overallPi1 = NULL, + overallPi2 = NULL, + overallEvents = NULL, + overallEvents1 = NULL, + overallEvents2 = NULL, + overallSampleSizes = NULL, + overallSampleSizes1 = NULL, + overallSampleSizes2 = NULL, + normalApproximation = TRUE) { + super$initialize(.design = design, .dataInput = dataInput, ...) # TODO + + self$combInverseNormal <- combInverseNormal + self$combFisher <- combFisher + self$overallTestStatistics <- overallTestStatistics + self$overallPValues <- overallPValues + self$effectSizes <- effectSizes + self$testStatistics <- testStatistics + self$overallPi1 <- overallPi1 + self$overallPi2 <- overallPi2 + self$overallEvents <- overallEvents + self$overallEvents1 <- overallEvents1 + self$overallEvents2 <- overallEvents2 + self$overallSampleSizes <- overallSampleSizes + self$overallSampleSizes1 <- overallSampleSizes1 + self$overallSampleSizes2 <- overallSampleSizes2 + + self$normalApproximation <- normalApproximation + + self$init(design = design, dataInput = dataInput) + + for (param in c( + "weightsFisher", + "weightsInverseNormal", + "combFisher", + "combInverseNormal" + )) { + self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) + } + + for (param in self$.getParametersToShow()) { + if (self$.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { + self$.setParameterType(param, C_PARAM_GENERATED) + } + } + + self$.setParameterType("normalApproximation", ifelse( + identical(self$normalApproximation, TRUE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + }, + .getParametersToShow = function() { + parametersToShow <- c( + "stages", + "overallTestStatistics", + "overallPValues" + ) + if (self$.dataInput$getNumberOfGroups() == 1) { + parametersToShow <- c( + parametersToShow, + "overallEvents", + "overallSampleSizes", + "overallPi1" + ) + } else if (self$.dataInput$getNumberOfGroups() == 2) { + parametersToShow <- c( + parametersToShow, + "overallEvents1", + "overallEvents2", + "overallSampleSizes1", + "overallSampleSizes2", + "overallPi1", + "overallPi2" + ) + } + parametersToShow <- c( + parametersToShow, + "testStatistics", + "pValues" + ) + if (self$.dataInput$getNumberOfGroups() > 1) { + parametersToShow <- c(parametersToShow, "effectSizes") + } + + if (.isTrialDesignInverseNormal(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combInverseNormal", + "weightsInverseNormal" + ) + } else if (.isTrialDesignFisher(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combFisher", + "weightsFisher" + ) + } + parametersToShow <- c( + parametersToShow, + "thetaH0", + "direction", + "normalApproximation" + ) + return(parametersToShow) + } + ) ) #' @name StageResultsMultiArmRates @@ -763,7 +763,7 @@ StageResultsRates <- R6::R6Class("StageResultsRates", #' #' @template field_stages #' @template field_testStatistics -#' @template field_pValues +#' @template field_pValues #' @template field_combInverseNormal #' @template field_combFisher #' @template field_effectSizes @@ -785,7 +785,7 @@ StageResultsRates <- R6::R6Class("StageResultsRates", #' @details #' This object cannot be created directly; use \code{getStageResults} #' with suitable arguments to create the stage results of a dataset of multi arm rates. -#' +#' #' @include class_core_parameter_set.R #' @include class_design.R #' @include class_analysis_dataset.R @@ -796,109 +796,109 @@ StageResultsRates <- R6::R6Class("StageResultsRates", #' @importFrom methods new #' StageResultsMultiArmRates <- R6::R6Class("StageResultsMultiArmRates", - inherit = StageResults, - public = list( - stage = NULL, - overallPiTreatments = NULL, - overallPiControl = NULL, - combInverseNormal = NULL, - combFisher = NULL, - overallTestStatistics = NULL, - overallPValues = NULL, - testStatistics = NULL, - separatePValues = NULL, - effectSizes = NULL, - singleStepAdjustedPValues = NULL, - intersectionTest = NULL, - normalApproximation = NULL, - directionUpper = NULL, - initialize = function(design, dataInput, ..., - overallPiTreatments = NULL, - overallPiControl = NULL, - combInverseNormal = NULL, - combFisher = NULL, - overallTestStatistics = NULL, - overallPValues = NULL, - testStatistics = NULL, - separatePValues = NULL, - effectSizes = NULL, - singleStepAdjustedPValues = NULL, - intersectionTest = NULL, - normalApproximation = FALSE, - directionUpper = NULL) { - super$initialize(.design = design, .dataInput = dataInput, ...)#TODO - - self$overallPiTreatments <- overallPiTreatments - self$overallPiControl <- overallPiControl - self$combInverseNormal <- combInverseNormal - self$combFisher <- combFisher - self$overallTestStatistics <- overallTestStatistics - self$overallPValues <- overallPValues - self$testStatistics <- testStatistics - self$separatePValues <- separatePValues - self$effectSizes <- effectSizes - self$singleStepAdjustedPValues <- singleStepAdjustedPValues - self$intersectionTest <- intersectionTest - self$normalApproximation <- normalApproximation - self$directionUpper <- directionUpper - - self$init(design = design, dataInput = dataInput) - - for (param in c( - "singleStepAdjustedPValues", - "weightsFisher", - "weightsInverseNormal", - "combFisher", - "combInverseNormal" - )) { - self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) - } - - for (param in self$.getParametersToShow()) { - if (self$.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { - self$.setParameterType(param, C_PARAM_GENERATED) - } - } - - self$.setParameterType("normalApproximation", ifelse( - identical(self$normalApproximation, FALSE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - self$.setParameterType("directionUpper", ifelse( - identical(self$directionUpper, C_DIRECTION_UPPER_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - }, - .getParametersToShow = function() { - parametersToShow <- c( - "stages", - "thetaH0", - "direction", - "normalApproximation", - "directionUpper", - "overallPiControl", - "overallPiTreatments", - "intersectionTest", - "overallTestStatistics", - "overallPValues", - "testStatistics", - "separatePValues", - "singleStepAdjustedPValues" - ) - if (.isTrialDesignInverseNormal(self$.design)) { - parametersToShow <- c( - parametersToShow, - "combInverseNormal", - "weightsInverseNormal" - ) - } else if (.isTrialDesignFisher(self$.design)) { - parametersToShow <- c( - parametersToShow, - "combFisher", - "weightsFisher" - ) - } - return(parametersToShow) - } - ) + inherit = StageResults, + public = list( + stage = NULL, + overallPiTreatments = NULL, + overallPiControl = NULL, + combInverseNormal = NULL, + combFisher = NULL, + overallTestStatistics = NULL, + overallPValues = NULL, + testStatistics = NULL, + separatePValues = NULL, + effectSizes = NULL, + singleStepAdjustedPValues = NULL, + intersectionTest = NULL, + normalApproximation = NULL, + directionUpper = NULL, + initialize = function(design, dataInput, ..., + overallPiTreatments = NULL, + overallPiControl = NULL, + combInverseNormal = NULL, + combFisher = NULL, + overallTestStatistics = NULL, + overallPValues = NULL, + testStatistics = NULL, + separatePValues = NULL, + effectSizes = NULL, + singleStepAdjustedPValues = NULL, + intersectionTest = NULL, + normalApproximation = FALSE, + directionUpper = NULL) { + super$initialize(.design = design, .dataInput = dataInput, ...) # TODO + + self$overallPiTreatments <- overallPiTreatments + self$overallPiControl <- overallPiControl + self$combInverseNormal <- combInverseNormal + self$combFisher <- combFisher + self$overallTestStatistics <- overallTestStatistics + self$overallPValues <- overallPValues + self$testStatistics <- testStatistics + self$separatePValues <- separatePValues + self$effectSizes <- effectSizes + self$singleStepAdjustedPValues <- singleStepAdjustedPValues + self$intersectionTest <- intersectionTest + self$normalApproximation <- normalApproximation + self$directionUpper <- directionUpper + + self$init(design = design, dataInput = dataInput) + + for (param in c( + "singleStepAdjustedPValues", + "weightsFisher", + "weightsInverseNormal", + "combFisher", + "combInverseNormal" + )) { + self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) + } + + for (param in self$.getParametersToShow()) { + if (self$.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { + self$.setParameterType(param, C_PARAM_GENERATED) + } + } + + self$.setParameterType("normalApproximation", ifelse( + identical(self$normalApproximation, FALSE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + self$.setParameterType("directionUpper", ifelse( + identical(self$directionUpper, C_DIRECTION_UPPER_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + }, + .getParametersToShow = function() { + parametersToShow <- c( + "stages", + "thetaH0", + "direction", + "normalApproximation", + "directionUpper", + "overallPiControl", + "overallPiTreatments", + "intersectionTest", + "overallTestStatistics", + "overallPValues", + "testStatistics", + "separatePValues", + "singleStepAdjustedPValues" + ) + if (.isTrialDesignInverseNormal(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combInverseNormal", + "weightsInverseNormal" + ) + } else if (.isTrialDesignFisher(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combFisher", + "weightsFisher" + ) + } + return(parametersToShow) + } + ) ) #' @@ -909,7 +909,7 @@ StageResultsMultiArmRates <- R6::R6Class("StageResultsMultiArmRates", #' #' @description #' Class for stage results survival data. -#' +#' #' @template field_stages #' @template field_testStatistics #' @template field_overallTestStatistics @@ -943,94 +943,94 @@ StageResultsMultiArmRates <- R6::R6Class("StageResultsMultiArmRates", #' @importFrom methods new #' StageResultsSurvival <- R6::R6Class("StageResultsSurvival", - inherit = StageResults, - public = list( - combInverseNormal = NULL, - combFisher = NULL, - overallPValues = NULL, - effectSizes = NULL, - overallTestStatistics = NULL, - overallEvents = NULL, - overallAllocationRatios = NULL, - events = NULL, - allocationRatios = NULL, - testStatistics = NULL, - initialize = function(design, dataInput, ..., - combInverseNormal = NULL, - combFisher = NULL, - overallPValues = NULL, - effectSizes = NULL, - overallTestStatistics = NULL, - overallEvents = NULL, - overallAllocationRatios = NULL, - events = NULL, - allocationRatios = NULL, - testStatistics = NULL) { - super$initialize(.design = design, .dataInput = dataInput, ...)#TODO - - self$combInverseNormal <- combInverseNormal - self$combFisher <- combFisher - self$overallPValues <- overallPValues - self$effectSizes <- effectSizes - self$overallTestStatistics <- overallTestStatistics - self$overallEvents <- overallEvents - self$overallAllocationRatios <- overallAllocationRatios - self$events <- events - self$allocationRatios <- allocationRatios - self$testStatistics <- testStatistics - - self$init(design = design, dataInput = dataInput) - - for (param in c( - "weightsFisher", - "weightsInverseNormal", - "combFisher", - "combInverseNormal" - )) { - self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) - } - - for (param in self$.getParametersToShow()) { - if (self$.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { - self$.setParameterType(param, C_PARAM_GENERATED) - } - } - }, - .getParametersToShow = function() { - parametersToShow <- c( - "stages", - "overallTestStatistics", - "overallPValues", - "overallEvents", - "overallAllocationRatios", - "events", - "allocationRatios", - "testStatistics", - "pValues", - "overallPValues", - "effectSizes" - ) - if (.isTrialDesignInverseNormal(self$.design)) { - parametersToShow <- c( - parametersToShow, - "combInverseNormal", - "weightsInverseNormal" - ) - } else if (.isTrialDesignFisher(self$.design)) { - parametersToShow <- c( - parametersToShow, - "combFisher", - "weightsFisher" - ) - } - parametersToShow <- c( - parametersToShow, - "thetaH0", - "direction" - ) - return(parametersToShow) - } - ) + inherit = StageResults, + public = list( + combInverseNormal = NULL, + combFisher = NULL, + overallPValues = NULL, + effectSizes = NULL, + overallTestStatistics = NULL, + overallEvents = NULL, + overallAllocationRatios = NULL, + events = NULL, + allocationRatios = NULL, + testStatistics = NULL, + initialize = function(design, dataInput, ..., + combInverseNormal = NULL, + combFisher = NULL, + overallPValues = NULL, + effectSizes = NULL, + overallTestStatistics = NULL, + overallEvents = NULL, + overallAllocationRatios = NULL, + events = NULL, + allocationRatios = NULL, + testStatistics = NULL) { + super$initialize(.design = design, .dataInput = dataInput, ...) # TODO + + self$combInverseNormal <- combInverseNormal + self$combFisher <- combFisher + self$overallPValues <- overallPValues + self$effectSizes <- effectSizes + self$overallTestStatistics <- overallTestStatistics + self$overallEvents <- overallEvents + self$overallAllocationRatios <- overallAllocationRatios + self$events <- events + self$allocationRatios <- allocationRatios + self$testStatistics <- testStatistics + + self$init(design = design, dataInput = dataInput) + + for (param in c( + "weightsFisher", + "weightsInverseNormal", + "combFisher", + "combInverseNormal" + )) { + self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) + } + + for (param in self$.getParametersToShow()) { + if (self$.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { + self$.setParameterType(param, C_PARAM_GENERATED) + } + } + }, + .getParametersToShow = function() { + parametersToShow <- c( + "stages", + "overallTestStatistics", + "overallPValues", + "overallEvents", + "overallAllocationRatios", + "events", + "allocationRatios", + "testStatistics", + "pValues", + "overallPValues", + "effectSizes" + ) + if (.isTrialDesignInverseNormal(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combInverseNormal", + "weightsInverseNormal" + ) + } else if (.isTrialDesignFisher(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combFisher", + "weightsFisher" + ) + } + parametersToShow <- c( + parametersToShow, + "thetaH0", + "direction" + ) + return(parametersToShow) + } + ) ) #' @name StageResultsMultiArmSurvival @@ -1043,7 +1043,7 @@ StageResultsSurvival <- R6::R6Class("StageResultsSurvival", #' #' @template field_stages #' @template field_testStatistics -#' @template field_pValues +#' @template field_pValues #' @template field_combInverseNormal #' @template field_combFisher #' @template field_effectSizes @@ -1064,7 +1064,7 @@ StageResultsSurvival <- R6::R6Class("StageResultsSurvival", #' @details #' This object cannot be created directly; use \code{getStageResults} #' with suitable arguments to create the stage results of a dataset of multi arm survival. -#' +#' #' @include class_core_parameter_set.R #' @include class_design.R #' @include class_analysis_dataset.R @@ -1075,95 +1075,95 @@ StageResultsSurvival <- R6::R6Class("StageResultsSurvival", #' @importFrom methods new #' StageResultsMultiArmSurvival <- R6::R6Class("StageResultsMultiArmSurvival", - inherit = StageResults, - public = list( - stage = NULL, - combInverseNormal = NULL, - combFisher = NULL, - overallTestStatistics = NULL, - overallPValues = NULL, - testStatistics = NULL, - separatePValues = NULL, - effectSizes = NULL, - singleStepAdjustedPValues = NULL, - intersectionTest = NULL, - directionUpper = NULL, - initialize = function(design, dataInput, ..., - combInverseNormal = NULL, - combFisher = NULL, - overallTestStatistics = NULL, - overallPValues = NULL, - testStatistics = NULL, - separatePValues = NULL, - effectSizes = NULL, - singleStepAdjustedPValues = NULL, - intersectionTest = NULL, - directionUpper = NULL) { - super$initialize(.design = design, .dataInput = dataInput, ...) #TODO - - self$combInverseNormal <- combInverseNormal - self$combFisher <- combFisher - self$overallTestStatistics <- overallTestStatistics - self$overallPValues <- overallPValues - self$testStatistics <- testStatistics - self$separatePValues <- separatePValues - self$effectSizes <- effectSizes - self$singleStepAdjustedPValues <- singleStepAdjustedPValues - self$intersectionTest <- intersectionTest - self$directionUpper <- directionUpper - - self$init(design = design, dataInput = dataInput) - - for (param in c( - "singleStepAdjustedPValues", - "weightsFisher", - "weightsInverseNormal", - "combFisher", - "combInverseNormal" - )) { - self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) - } - - for (param in self$.getParametersToShow()) { - if (self$.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { - self$.setParameterType(param, C_PARAM_GENERATED) - } - } - - self$.setParameterType("directionUpper", ifelse( - identical(self$directionUpper, C_DIRECTION_UPPER_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - }, - .getParametersToShow = function() { - parametersToShow <- c( - "stages", - "thetaH0", - "direction", - "directionUpper", - "intersectionTest", - "overallTestStatistics", - "overallPValues", - "testStatistics", - "separatePValues", - "effectSizes", - "singleStepAdjustedPValues" - ) - if (.isTrialDesignInverseNormal(self$.design)) { - parametersToShow <- c( - parametersToShow, - "combInverseNormal", - "weightsInverseNormal" - ) - } else if (.isTrialDesignFisher(self$.design)) { - parametersToShow <- c( - parametersToShow, - "combFisher", - "weightsFisher" - ) - } - return(parametersToShow) - } - ) + inherit = StageResults, + public = list( + stage = NULL, + combInverseNormal = NULL, + combFisher = NULL, + overallTestStatistics = NULL, + overallPValues = NULL, + testStatistics = NULL, + separatePValues = NULL, + effectSizes = NULL, + singleStepAdjustedPValues = NULL, + intersectionTest = NULL, + directionUpper = NULL, + initialize = function(design, dataInput, ..., + combInverseNormal = NULL, + combFisher = NULL, + overallTestStatistics = NULL, + overallPValues = NULL, + testStatistics = NULL, + separatePValues = NULL, + effectSizes = NULL, + singleStepAdjustedPValues = NULL, + intersectionTest = NULL, + directionUpper = NULL) { + super$initialize(.design = design, .dataInput = dataInput, ...) # TODO + + self$combInverseNormal <- combInverseNormal + self$combFisher <- combFisher + self$overallTestStatistics <- overallTestStatistics + self$overallPValues <- overallPValues + self$testStatistics <- testStatistics + self$separatePValues <- separatePValues + self$effectSizes <- effectSizes + self$singleStepAdjustedPValues <- singleStepAdjustedPValues + self$intersectionTest <- intersectionTest + self$directionUpper <- directionUpper + + self$init(design = design, dataInput = dataInput) + + for (param in c( + "singleStepAdjustedPValues", + "weightsFisher", + "weightsInverseNormal", + "combFisher", + "combInverseNormal" + )) { + self$.setParameterType(param, C_PARAM_NOT_APPLICABLE) + } + + for (param in self$.getParametersToShow()) { + if (self$.getParameterType(param) == C_PARAM_TYPE_UNKNOWN) { + self$.setParameterType(param, C_PARAM_GENERATED) + } + } + + self$.setParameterType("directionUpper", ifelse( + identical(self$directionUpper, C_DIRECTION_UPPER_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + }, + .getParametersToShow = function() { + parametersToShow <- c( + "stages", + "thetaH0", + "direction", + "directionUpper", + "intersectionTest", + "overallTestStatistics", + "overallPValues", + "testStatistics", + "separatePValues", + "effectSizes", + "singleStepAdjustedPValues" + ) + if (.isTrialDesignInverseNormal(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combInverseNormal", + "weightsInverseNormal" + ) + } else if (.isTrialDesignFisher(self$.design)) { + parametersToShow <- c( + parametersToShow, + "combFisher", + "weightsFisher" + ) + } + return(parametersToShow) + } + ) ) #' @@ -1184,7 +1184,7 @@ StageResultsMultiArmSurvival <- R6::R6Class("StageResultsMultiArmSurvival", #' @template field_intersectionTest #' @template field_testStatistics #' @template field_overallTestStatistics -#' @template field_pValues +#' @template field_pValues #' @template field_overallPValues #' @template field_overallStDevs #' @template field_overallPooledStDevs @@ -1206,15 +1206,15 @@ StageResultsMultiArmSurvival <- R6::R6Class("StageResultsMultiArmSurvival", #' @importFrom methods new #' StageResultsEnrichmentMeans <- R6::R6Class("StageResultsEnrichmentMeans", - inherit = StageResultsMultiArmMeans, - public = list( - .overallSampleSizes1 = NULL, - .overallSampleSizes2 = NULL, - stratifiedAnalysis = NULL, - .getParametersToShow = function() {#TODO init - return(c(super$.getParametersToShow(), "stratifiedAnalysis")) - } - ) + inherit = StageResultsMultiArmMeans, + public = list( + .overallSampleSizes1 = NULL, + .overallSampleSizes2 = NULL, + stratifiedAnalysis = NULL, + .getParametersToShow = function() { # TODO init + return(c(super$.getParametersToShow(), "stratifiedAnalysis")) + } + ) ) #' @@ -1228,7 +1228,7 @@ StageResultsEnrichmentMeans <- R6::R6Class("StageResultsEnrichmentMeans", #' #' @template field_stages #' @template field_testStatistics -#' @template field_pValues +#' @template field_pValues #' @template field_combInverseNormal #' @template field_combFisher #' @template field_effectSizes @@ -1245,19 +1245,19 @@ StageResultsEnrichmentMeans <- R6::R6Class("StageResultsEnrichmentMeans", #' @importFrom methods new #' StageResultsEnrichmentRates <- R6::R6Class("StageResultsEnrichmentRates", - inherit = StageResultsMultiArmRates, - public = list( - .overallSampleSizes1 = NULL, - .overallSampleSizes2 = NULL, - overallPisTreatment = NULL, - overallPisControl = NULL, - stratifiedAnalysis = NULL, - .getParametersToShow = function() { - parametersToShow <- super$.getParametersToShow() - parametersToShow <- parametersToShow[!(parametersToShow %in% c("overallPiTreatments", "overallPiControl"))] - return(c(parametersToShow, "stratifiedAnalysis", "overallPisTreatment", "overallPisControl")) - } - ) + inherit = StageResultsMultiArmRates, + public = list( + .overallSampleSizes1 = NULL, + .overallSampleSizes2 = NULL, + overallPisTreatment = NULL, + overallPisControl = NULL, + stratifiedAnalysis = NULL, + .getParametersToShow = function() { + parametersToShow <- super$.getParametersToShow() + parametersToShow <- parametersToShow[!(parametersToShow %in% c("overallPiTreatments", "overallPiControl"))] + return(c(parametersToShow, "stratifiedAnalysis", "overallPisTreatment", "overallPisControl")) + } + ) ) #' @@ -1271,7 +1271,7 @@ StageResultsEnrichmentRates <- R6::R6Class("StageResultsEnrichmentRates", #' #' @template field_stages #' @template field_testStatistics -#' @template field_pValues +#' @template field_pValues #' @template field_combInverseNormal #' @template field_combFisher #' @template field_effectSizes @@ -1288,14 +1288,14 @@ StageResultsEnrichmentRates <- R6::R6Class("StageResultsEnrichmentRates", #' @importFrom methods new #' StageResultsEnrichmentSurvival <- R6::R6Class("StageResultsEnrichmentSurvival", - inherit = StageResultsMultiArmSurvival, - public = list( - stratifiedAnalysis = NULL, - .overallEvents = NULL, - .getParametersToShow = function() { - return(c(super$.getParametersToShow(), "stratifiedAnalysis")) - } - ) + inherit = StageResultsMultiArmSurvival, + public = list( + stratifiedAnalysis = NULL, + .overallEvents = NULL, + .getParametersToShow = function() { + return(c(super$.getParametersToShow(), "stratifiedAnalysis")) + } + ) ) #' @@ -1317,7 +1317,7 @@ StageResultsEnrichmentSurvival <- R6::R6Class("StageResultsEnrichmentSurvival", #' @keywords internal #' names.StageResults <- function(x) { - return(x$.getParametersToShow()) + return(x$.getParametersToShow()) } #' @@ -1381,72 +1381,72 @@ as.data.frame.StageResults <- function(x, row.names = NULL, } .getTreatmentArmsToShow <- function(x, ...) { - dataInput <- x - if (!inherits(dataInput, "Dataset")) { - dataInput <- x[[".dataInput"]] - } - if (is.null(dataInput) || !inherits(dataInput, "Dataset")) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to get 'dataInput' from ", .getClassName(x)) - } - - numberOfTreatments <- dataInput$getNumberOfGroups() - if (numberOfTreatments > 1) { - validComparisons <- 1L:as.integer(numberOfTreatments - 1) - } else { - validComparisons <- 1L - } - - treatmentArmsToShow <- .getOptionalArgument("treatmentArms", ...) - if (!is.null(treatmentArmsToShow)) { - treatmentArmsToShow <- as.integer(na.omit(treatmentArmsToShow)) - } - if (is.null(treatmentArmsToShow) || length(treatmentArmsToShow) == 0 || - all(is.na(treatmentArmsToShow)) || !is.numeric(treatmentArmsToShow)) { - treatmentArmsToShow <- validComparisons - } else if (!all(treatmentArmsToShow %in% validComparisons)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'treatmentArms' (", - .arrayToString(treatmentArmsToShow), ") must be a vector ", - "containing one or more values of ", .arrayToString(validComparisons) - ) - } - treatmentArmsToShow <- sort(unique(treatmentArmsToShow)) - return(treatmentArmsToShow) + dataInput <- x + if (!inherits(dataInput, "Dataset")) { + dataInput <- x[[".dataInput"]] + } + if (is.null(dataInput) || !inherits(dataInput, "Dataset")) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to get 'dataInput' from ", .getClassName(x)) + } + + numberOfTreatments <- dataInput$getNumberOfGroups() + if (numberOfTreatments > 1) { + validComparisons <- 1L:as.integer(numberOfTreatments - 1) + } else { + validComparisons <- 1L + } + + treatmentArmsToShow <- .getOptionalArgument("treatmentArms", ...) + if (!is.null(treatmentArmsToShow)) { + treatmentArmsToShow <- as.integer(na.omit(treatmentArmsToShow)) + } + if (is.null(treatmentArmsToShow) || length(treatmentArmsToShow) == 0 || + all(is.na(treatmentArmsToShow)) || !is.numeric(treatmentArmsToShow)) { + treatmentArmsToShow <- validComparisons + } else if (!all(treatmentArmsToShow %in% validComparisons)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'treatmentArms' (", + .arrayToString(treatmentArmsToShow), ") must be a vector ", + "containing one or more values of ", .arrayToString(validComparisons) + ) + } + treatmentArmsToShow <- sort(unique(treatmentArmsToShow)) + return(treatmentArmsToShow) } .getPopulationsToShow <- function(x, ..., gMax) { - dataInput <- x - if (!inherits(dataInput, "Dataset")) { - dataInput <- x[[".dataInput"]] - } - if (is.null(dataInput) || !inherits(dataInput, "Dataset")) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to get 'dataInput' from ", .getClassName(x)) - } - - numberOfPopulations <- gMax - if (numberOfPopulations > 1) { - validComparisons <- 1L:as.integer(numberOfPopulations) - } else { - validComparisons <- 1L - } - - populationsToShow <- .getOptionalArgument("populations", ...) - - if (!is.null(populationsToShow)) { - populationsToShow <- as.integer(na.omit(populationsToShow)) - } - if (is.null(populationsToShow) || length(populationsToShow) == 0 || - all(is.na(populationsToShow)) || !is.numeric(populationsToShow)) { - populationsToShow <- validComparisons - } else if (!all(populationsToShow %in% validComparisons)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'populations' (", - .arrayToString(populationsToShow), ") must be a vector ", - "containing one or more values of ", .arrayToString(validComparisons) - ) - } - populationsToShow <- sort(unique(populationsToShow)) - return(populationsToShow) + dataInput <- x + if (!inherits(dataInput, "Dataset")) { + dataInput <- x[[".dataInput"]] + } + if (is.null(dataInput) || !inherits(dataInput, "Dataset")) { + stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to get 'dataInput' from ", .getClassName(x)) + } + + numberOfPopulations <- gMax + if (numberOfPopulations > 1) { + validComparisons <- 1L:as.integer(numberOfPopulations) + } else { + validComparisons <- 1L + } + + populationsToShow <- .getOptionalArgument("populations", ...) + + if (!is.null(populationsToShow)) { + populationsToShow <- as.integer(na.omit(populationsToShow)) + } + if (is.null(populationsToShow) || length(populationsToShow) == 0 || + all(is.na(populationsToShow)) || !is.numeric(populationsToShow)) { + populationsToShow <- validComparisons + } else if (!all(populationsToShow %in% validComparisons)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'populations' (", + .arrayToString(populationsToShow), ") must be a vector ", + "containing one or more values of ", .arrayToString(validComparisons) + ) + } + populationsToShow <- sort(unique(populationsToShow)) + return(populationsToShow) } #' @@ -1456,7 +1456,7 @@ as.data.frame.StageResults <- function(x, row.names = NULL, #' @description #' Plots the conditional power together with the likelihood function. #' -#' @param x The stage results at given stage, obtained from \code{\link[=getStageResults]{getStageResults()}} or +#' @param x The stage results at given stage, obtained from \code{\link[=getStageResults]{getStageResults()}} or #' \code{\link[=getAnalysisResults]{getAnalysisResults()}}. #' @param y Not available for this kind of plot (is only defined to be compatible to the generic plot function). #' @inheritParams param_stage @@ -1508,11 +1508,11 @@ as.data.frame.StageResults <- function(x, row.names = NULL, #' ) #' #' stageResults <- getStageResults(design, dataExample, thetaH0 = 20) -#' +#' #' \dontrun{ #' if (require(ggplot2)) plot(stageResults, nPlanned = c(30), thetaRange = c(0, 100)) #' } -#' +#' #' @export #' plot.StageResults <- function(x, y, ..., type = 1L, diff --git a/R/class_core_parameter_set.R b/R/class_core_parameter_set.R index 4f48573f..eb73a726 100644 --- a/R/class_core_parameter_set.R +++ b/R/class_core_parameter_set.R @@ -42,24 +42,26 @@ NULL #' @importFrom methods new #' FieldSet <- R6::R6Class("FieldSet", - public = list( - .parameterTypes = NULL, - .showParameterTypeEnabled = NULL, - .catLines = NULL, - .deprecatedFieldNames = NULL, - .getFieldNames = function() { - return(unlist(lapply(class(self)[1:(length(class(self))-1)],function(x) {names(get(x)$public_fields)}))) - }, - .getVisibleFieldNames = function() { - fieldNames <- self$.getFieldNames() - fieldNames <- fieldNames[!startsWith(fieldNames, ".")] - fieldNames <- fieldNames[!(fieldNames %in% self$.deprecatedFieldNames)] - return(fieldNames) - }, - .resetCat = function() { - self$.catLines <- character() - }, - .cat = function(..., file = "", sep = "", fill = FALSE, labels = NULL, + public = list( + .parameterTypes = NULL, + .showParameterTypeEnabled = NULL, + .catLines = NULL, + .deprecatedFieldNames = NULL, + .getFieldNames = function() { + return(unlist(lapply(class(self)[1:(length(class(self)) - 1)], function(x) { + names(get(x)$public_fields) + }))) + }, + .getVisibleFieldNames = function() { + fieldNames <- self$.getFieldNames() + fieldNames <- fieldNames[!startsWith(fieldNames, ".")] + fieldNames <- fieldNames[!(fieldNames %in% self$.deprecatedFieldNames)] + return(fieldNames) + }, + .resetCat = function() { + self$.catLines <- character() + }, + .cat = function(..., file = "", sep = "", fill = FALSE, labels = NULL, append = FALSE, heading = 0, tableColumns = 0, consoleOutputEnabled = TRUE, na = NA_character_) { if (consoleOutputEnabled) { @@ -154,19 +156,19 @@ FieldSet <- R6::R6Class("FieldSet", .catLines <<- c(.catLines, line) } return(invisible()) - }, - .getFields = function(values) { - flds <- self$.getFieldNames() - if (!missing(values)) { - flds <- flds[flds %in% values] - } - result <- setNames(vector("list", length(flds)), flds) - for (fld in flds) { - result[[fld]] <- self[[fld]] - } - return(result) - } - ) + }, + .getFields = function(values) { + flds <- self$.getFieldNames() + if (!missing(values)) { + flds <- flds[flds %in% values] + } + result <- setNames(vector("list", length(flds)), flds) + for (fld in flds) { + result[[fld]] <- self[[fld]] + } + return(result) + } + ) ) #' @@ -191,216 +193,216 @@ FieldSet <- R6::R6Class("FieldSet", #' @importFrom methods new #' ParameterSet <- R6::R6Class("ParameterSet", - inherit = FieldSet, - public = list( - initialize = function(..., .showParameterTypeEnabled = TRUE) { - self$.showParameterTypeEnabled <- .showParameterTypeEnabled - self$.parameterTypes <- list() - self$.catLines <- character() - self$.deprecatedFieldNames <- character() - }, - .toString = function(startWithUpperCase = FALSE) { - s <- .formatCamelCase(.getClassName(self)) - return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) - }, - .initParameterTypes = function() { - self$.parameterTypes <- list() - for (parameterName in self$.getVisibleFieldNames()) { - self$.parameterTypes[[parameterName]] <- C_PARAM_TYPE_UNKNOWN - } - }, - .getParameterType = function(parameterName) { - if (is.null(parameterName) || length(parameterName) == 0 || is.na(parameterName)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'parameterName' must be a valid character with length > 0" - ) - } - - parameterType <- self$.parameterTypes[[parameterName]] - if (is.null(parameterType)) { - return(C_PARAM_TYPE_UNKNOWN) - } - - return(parameterType[1]) - }, - .getParametersToShow = function() { - return(self$.getVisibleFieldNames()) - }, - .setParameterType = function(parameterName, parameterType) { - if (is.null(parameterName) || length(parameterName) == 0 || is.na(parameterName)) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'parameterName' must be a valid character with length > 0" - ) - } - - parameterType <- parameterType[1] - - if (!all(parameterType %in% c( - C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE, - C_PARAM_GENERATED, C_PARAM_DERIVED, C_PARAM_NOT_APPLICABLE - ))) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'parameterType' ('", parameterType, "') is invalid" - ) - } - - self$.parameterTypes[[parameterName]] <- parameterType - - invisible(parameterType) - }, - isUserDefinedParameter = function(parameterName) { - return(self$.getParameterType(parameterName) == C_PARAM_USER_DEFINED) - }, - isDefaultParameter = function(parameterName) { - return(self$.getParameterType(parameterName) == C_PARAM_DEFAULT_VALUE) - }, - isGeneratedParameter = function(parameterName) { - return(self$.getParameterType(parameterName) == C_PARAM_GENERATED) - }, - isDerivedParameter = function(parameterName) { - return(self$.getParameterType(parameterName) == C_PARAM_DERIVED) - }, - isUndefinedParameter = function(parameterName) { - return(self$.getParameterType(parameterName) == C_PARAM_TYPE_UNKNOWN) - }, - .getInputParameters = function() { - params <- self$.getParametersOfOneGroup(c(C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE)) - return(params) - }, - .getUserDefinedParameters = function() { - return(self$.getParametersOfOneGroup(C_PARAM_USER_DEFINED)) - }, - .getDefaultParameters = function() { - return(self$.getParametersOfOneGroup(C_PARAM_DEFAULT_VALUE)) - }, - .getGeneratedParameters = function() { - return(self$.getParametersOfOneGroup(C_PARAM_GENERATED)) - }, - .getDerivedParameters = function() { - return(self$.getParametersOfOneGroup(C_PARAM_DERIVED)) - }, - .getUndefinedParameters = function() { - return(self$.getParametersOfOneGroup(C_PARAM_TYPE_UNKNOWN)) - }, - .getParameterValueIfUserDefinedOrDefault = function(parameterName) { - if (self$isUserDefinedParameter(parameterName) || self$isDefaultParameter(parameterName)) { - return(self[[parameterName]]) - } - - parameterType <- self$getRefClass()$fields()[[parameterName]] - if (parameterType == "numeric") { - return(NA_real_) - } - - if (parameterType == "integer") { - return(NA_integer_) - } - - if (parameterType == "character") { - return(NA_character_) - } - - return(NA) - }, - .getParametersOfOneGroup = function(parameterType) { - if (length(parameterType) == 1) { - parameterNames <- names(self$.parameterTypes[self$.parameterTypes == parameterType]) - } else { - parameterNames <- names(self$.parameterTypes[which(self$.parameterTypes %in% parameterType)]) - } - parametersToShow <- self$.getParametersToShow() - if (is.null(parametersToShow) || length(parametersToShow) == 0) { - return(parameterNames) - } - - return(parametersToShow[parametersToShow %in% parameterNames]) - }, - .showParameterType = function(parameterName) { - if (!self$.showParameterTypeEnabled) { - return(" ") - } - - return(paste0("[", self$.getParameterType(parameterName), "]")) - }, - .showAllParameters = function(consoleOutputEnabled = TRUE) { - parametersToShow <- self$.getVisibleFieldNamesOrdered() - for (parameter in parametersToShow) { - self$.showParameter(parameter, - showParameterType = TRUE, - consoleOutputEnabled = consoleOutputEnabled - ) - } - }, - .getVisibleFieldNamesOrdered = function() { - visibleFieldNames <- self$.getVisibleFieldNames() - - parametersToShowSorted <- self$.getParametersToShow() - if (is.null(parametersToShowSorted) || length(parametersToShowSorted) == 0) { - return(visibleFieldNames) - } - - visibleFieldNames <- visibleFieldNames[!(visibleFieldNames %in% parametersToShowSorted)] - visibleFieldNames <- c(parametersToShowSorted, visibleFieldNames) - return(visibleFieldNames) - }, - .show = function(..., consoleOutputEnabled = FALSE) { - showType <- .getOptionalArgument("showType", ...) - if (!is.null(showType) && showType == 2) { - self$.cat("Technical developer summary of the ", self$.toString(), " object (", - methods::classLabel(class(self)), "):\n\n", - sep = "", heading = 1, - consoleOutputEnabled = consoleOutputEnabled - ) - self$.showAllParameters(consoleOutputEnabled = consoleOutputEnabled) - self$.showParameterTypeDescription(consoleOutputEnabled = consoleOutputEnabled) - } else { - stop( - C_EXCEPTION_TYPE_RUNTIME_ISSUE, - "method '.show()' is not implemented in class '", .getClassName(self), "'" - ) - } - }, - .catMarkdownText = function(...) { - 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 <- "" - if (is.null(parameters) || length(parameters) == 0 || all(is.na(parameters))) { - if (!missing(title) && !is.null(title) && !is.na(title) && consoleOutputEnabled) { - output <- paste0(title, ": not available\n\n") - self$.cat(output, heading = 2, consoleOutputEnabled = consoleOutputEnabled) - } - invisible(output) - } else { - if (orderByParameterName) { - parameters <- sort(parameters) - } - - if (!missing(title) && !is.null(title) && !is.na(title)) { - output <- paste0(title, ":\n") - self$.cat(output, heading = 2, consoleOutputEnabled = consoleOutputEnabled) - } - for (parameterName in parameters) { - output <- paste0(output, self$.showParameter(parameterName, - consoleOutputEnabled = consoleOutputEnabled - )) - } - self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) - output <- paste0(output, "\n") - invisible(output) - } - }, + inherit = FieldSet, + public = list( + initialize = function(..., .showParameterTypeEnabled = TRUE) { + self$.showParameterTypeEnabled <- .showParameterTypeEnabled + self$.parameterTypes <- list() + self$.catLines <- character() + self$.deprecatedFieldNames <- character() + }, + .toString = function(startWithUpperCase = FALSE) { + s <- .formatCamelCase(.getClassName(self)) + return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) + }, + .initParameterTypes = function() { + self$.parameterTypes <- list() + for (parameterName in self$.getVisibleFieldNames()) { + self$.parameterTypes[[parameterName]] <- C_PARAM_TYPE_UNKNOWN + } + }, + .getParameterType = function(parameterName) { + if (is.null(parameterName) || length(parameterName) == 0 || is.na(parameterName)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'parameterName' must be a valid character with length > 0" + ) + } + + parameterType <- self$.parameterTypes[[parameterName]] + if (is.null(parameterType)) { + return(C_PARAM_TYPE_UNKNOWN) + } + + return(parameterType[1]) + }, + .getParametersToShow = function() { + return(self$.getVisibleFieldNames()) + }, + .setParameterType = function(parameterName, parameterType) { + if (is.null(parameterName) || length(parameterName) == 0 || is.na(parameterName)) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'parameterName' must be a valid character with length > 0" + ) + } + + parameterType <- parameterType[1] + + if (!all(parameterType %in% c( + C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE, + C_PARAM_GENERATED, C_PARAM_DERIVED, C_PARAM_NOT_APPLICABLE + ))) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'parameterType' ('", parameterType, "') is invalid" + ) + } + + self$.parameterTypes[[parameterName]] <- parameterType + + invisible(parameterType) + }, + isUserDefinedParameter = function(parameterName) { + return(self$.getParameterType(parameterName) == C_PARAM_USER_DEFINED) + }, + isDefaultParameter = function(parameterName) { + return(self$.getParameterType(parameterName) == C_PARAM_DEFAULT_VALUE) + }, + isGeneratedParameter = function(parameterName) { + return(self$.getParameterType(parameterName) == C_PARAM_GENERATED) + }, + isDerivedParameter = function(parameterName) { + return(self$.getParameterType(parameterName) == C_PARAM_DERIVED) + }, + isUndefinedParameter = function(parameterName) { + return(self$.getParameterType(parameterName) == C_PARAM_TYPE_UNKNOWN) + }, + .getInputParameters = function() { + params <- self$.getParametersOfOneGroup(c(C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE)) + return(params) + }, + .getUserDefinedParameters = function() { + return(self$.getParametersOfOneGroup(C_PARAM_USER_DEFINED)) + }, + .getDefaultParameters = function() { + return(self$.getParametersOfOneGroup(C_PARAM_DEFAULT_VALUE)) + }, + .getGeneratedParameters = function() { + return(self$.getParametersOfOneGroup(C_PARAM_GENERATED)) + }, + .getDerivedParameters = function() { + return(self$.getParametersOfOneGroup(C_PARAM_DERIVED)) + }, + .getUndefinedParameters = function() { + return(self$.getParametersOfOneGroup(C_PARAM_TYPE_UNKNOWN)) + }, + .getParameterValueIfUserDefinedOrDefault = function(parameterName) { + if (self$isUserDefinedParameter(parameterName) || self$isDefaultParameter(parameterName)) { + return(self[[parameterName]]) + } + + parameterType <- self$getRefClass()$fields()[[parameterName]] + if (parameterType == "numeric") { + return(NA_real_) + } + + if (parameterType == "integer") { + return(NA_integer_) + } + + if (parameterType == "character") { + return(NA_character_) + } + + return(NA) + }, + .getParametersOfOneGroup = function(parameterType) { + if (length(parameterType) == 1) { + parameterNames <- names(self$.parameterTypes[self$.parameterTypes == parameterType]) + } else { + parameterNames <- names(self$.parameterTypes[which(self$.parameterTypes %in% parameterType)]) + } + parametersToShow <- self$.getParametersToShow() + if (is.null(parametersToShow) || length(parametersToShow) == 0) { + return(parameterNames) + } + + return(parametersToShow[parametersToShow %in% parameterNames]) + }, + .showParameterType = function(parameterName) { + if (!self$.showParameterTypeEnabled) { + return(" ") + } + + return(paste0("[", self$.getParameterType(parameterName), "]")) + }, + .showAllParameters = function(consoleOutputEnabled = TRUE) { + parametersToShow <- self$.getVisibleFieldNamesOrdered() + for (parameter in parametersToShow) { + self$.showParameter(parameter, + showParameterType = TRUE, + consoleOutputEnabled = consoleOutputEnabled + ) + } + }, + .getVisibleFieldNamesOrdered = function() { + visibleFieldNames <- self$.getVisibleFieldNames() + + parametersToShowSorted <- self$.getParametersToShow() + if (is.null(parametersToShowSorted) || length(parametersToShowSorted) == 0) { + return(visibleFieldNames) + } + + visibleFieldNames <- visibleFieldNames[!(visibleFieldNames %in% parametersToShowSorted)] + visibleFieldNames <- c(parametersToShowSorted, visibleFieldNames) + return(visibleFieldNames) + }, + .show = function(..., consoleOutputEnabled = FALSE) { + showType <- .getOptionalArgument("showType", ...) + if (!is.null(showType) && showType == 2) { + self$.cat("Technical developer summary of the ", self$.toString(), " object (", + methods::classLabel(class(self)), "):\n\n", + sep = "", heading = 1, + consoleOutputEnabled = consoleOutputEnabled + ) + self$.showAllParameters(consoleOutputEnabled = consoleOutputEnabled) + self$.showParameterTypeDescription(consoleOutputEnabled = consoleOutputEnabled) + } else { + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, + "method '.show()' is not implemented in class '", .getClassName(self), "'" + ) + } + }, + .catMarkdownText = function(...) { + 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 <- "" + if (is.null(parameters) || length(parameters) == 0 || all(is.na(parameters))) { + if (!missing(title) && !is.null(title) && !is.na(title) && consoleOutputEnabled) { + output <- paste0(title, ": not available\n\n") + self$.cat(output, heading = 2, consoleOutputEnabled = consoleOutputEnabled) + } + invisible(output) + } else { + if (orderByParameterName) { + parameters <- sort(parameters) + } + + if (!missing(title) && !is.null(title) && !is.na(title)) { + output <- paste0(title, ":\n") + self$.cat(output, heading = 2, consoleOutputEnabled = consoleOutputEnabled) + } + for (parameterName in parameters) { + output <- paste0(output, self$.showParameter(parameterName, + consoleOutputEnabled = consoleOutputEnabled + )) + } + self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) + output <- paste0(output, "\n") + invisible(output) + } + }, .showParameter = function(parameterName, showParameterType = FALSE, consoleOutputEnabled = TRUE) { tryCatch( { @@ -540,7 +542,7 @@ ParameterSet <- R6::R6Class("ParameterSet", d <- regexpr("\\..+\\$", parameterName) if (d[1] != 1) { return(list( - parameterName = parameterName, + parameterName = parameterName, paramValue = base::get(parameterName, envir = self) )) } @@ -677,7 +679,7 @@ ParameterSet <- R6::R6Class("ParameterSet", if (length(fieldNames) == 0) { return(40) } - + fieldCaptions <- character() for (parameterName in fieldNames) { fieldCaptions <- c(fieldCaptions, .getParameterCaption(parameterName, self)) @@ -696,7 +698,6 @@ ParameterSet <- R6::R6Class("ParameterSet", .printAsDataFrame = function(parameterNames, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, handleParameterNamesAsToBeExcluded = FALSE, lineBreakEnabled = FALSE) { - if (.isTrialDesignPlan(self)) { parameterNames <- NULL } @@ -785,7 +786,7 @@ ParameterSet <- R6::R6Class("ParameterSet", if (length(parameterName) == 0 || parameterName == "") { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'parameterName' must be a valid parameter name") } - + if (!niceColumnNamesEnabled) { return(parameterName) } @@ -858,14 +859,14 @@ ParameterSet <- R6::R6Class("ParameterSet", # .getSubListByNames = function(x, listEntryNames) { "Returns a sub-list." - if (!is.list(x) && !inherits(x, "Dictionary")) { + if (!is.list(x) && !inherits(x, "Dictionary")) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'x' must be a list or Dictionary (is ", .getClassName(x), ")") } if (!is.character(listEntryNames)) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'listEntryNames' must be a character vector") } - + if (inherits(x, "Dictionary")) { return(getDictionarySubset(x, listEntryNames)) } @@ -1095,7 +1096,8 @@ ParameterSet <- R6::R6Class("ParameterSet", } dataFrame$populations <- rep(populations, numberOfStages) populationsCaption <- parameterSet$.getDataFrameColumnCaption( - "populations", niceColumnNamesEnabled) + "populations", niceColumnNamesEnabled + ) names(dataFrame) <- c(stagesCaption, populationsCaption) } @@ -1104,7 +1106,8 @@ ParameterSet <- R6::R6Class("ParameterSet", { if (!is.null(variedParameter) && variedParameter != "stages") { variedParameterCaption <- parameterSet$.getDataFrameColumnCaption( - variedParameter, niceColumnNamesEnabled) + variedParameter, niceColumnNamesEnabled + ) dataFrame[[variedParameterCaption]] <- rep(parameterSet[[variedParameter]], numberOfStages) } }, @@ -1130,7 +1133,8 @@ ParameterSet <- R6::R6Class("ParameterSet", ) if (!is.null(columnValues)) { columnCaption <- parameterSet$.getDataFrameColumnCaption( - parameterName, niceColumnNamesEnabled) + parameterName, niceColumnNamesEnabled + ) dataFrame[[columnCaption]] <- columnValues if (returnParametersAsCharacter) { parameterSet$.formatDataFrameParametersAsCharacter( @@ -1180,7 +1184,8 @@ ParameterSet <- R6::R6Class("ParameterSet", !is.matrix(value) && !is.array(value) && !is.data.frame(value) && (is.numeric(value) || is.character(value) || is.logical(value))) { columnCaption <- parameterSet$.getDataFrameColumnCaption( - extraParameter, niceColumnNamesEnabled) + extraParameter, niceColumnNamesEnabled + ) if (length(value) == 1) { dataFrame[[columnCaption]] <- rep(value, nrow(dataFrame)) @@ -1306,7 +1311,7 @@ ParameterSet <- R6::R6Class("ParameterSet", (.isTrialDesignPlanCountData(parameterSet) && length(parameterSet$theta) > 1)) { return(.addDelayedInformationRates(.getAsDataFrameMultidimensional( parameterSet, parameterNames, niceColumnNamesEnabled, - includeAllParameters, returnParametersAsCharacter, + includeAllParameters, returnParametersAsCharacter, mandatoryParameterNames ))) } diff --git a/R/class_core_plot_settings.R b/R/class_core_plot_settings.R index 51a2b233..6cb0d925 100644 --- a/R/class_core_plot_settings.R +++ b/R/class_core_plot_settings.R @@ -29,7 +29,7 @@ PlotSubTitleItem <- R6::R6Class("PlotSubTitleItem", self$value <- value self$subscript <- trimws(subscript) self$digits <- digits - + self$value <- round(value, digits) }, show = function() { @@ -63,7 +63,7 @@ PlotSubTitleItems <- R6::R6Class("PlotSubTitleItems", initialize = function(..., title = NULL, subtitle = NULL) { self$title <- title self$subtitle <- subtitle - + self$items <- list() }, show = function() { @@ -83,7 +83,7 @@ PlotSubTitleItems <- R6::R6Class("PlotSubTitleItems", if (isFALSE(condition)) { return(invisible()) } - + titleTemp <- title if (length(self$items) == 0) { titleTemp <- .formatCamelCase(titleTemp, title = TRUE) diff --git a/R/class_design.R b/R/class_design.R index 96c77d36..ed19bef0 100644 --- a/R/class_design.R +++ b/R/class_design.R @@ -87,87 +87,87 @@ TrialDesign <- R6::R6Class("TrialDesign", bindingFutility = NA, tolerance = 1e-06 # C_ANALYSIS_TOLERANCE_DEFAULT ) { - self$kMax <- kMax #NEW - self$alpha <- alpha - self$informationRates <- informationRates - self$userAlphaSpending <- userAlphaSpending - self$criticalValues <- criticalValues - self$stageLevels <- stageLevels - self$alphaSpent <- alphaSpent - self$bindingFutility <- bindingFutility - self$tolerance <- tolerance - super$initialize(...) + self$kMax <- kMax # NEW + self$alpha <- alpha + self$informationRates <- informationRates + self$userAlphaSpending <- userAlphaSpending + self$criticalValues <- criticalValues + self$stageLevels <- stageLevels + self$alphaSpent <- alphaSpent + self$bindingFutility <- bindingFutility + self$tolerance <- tolerance + super$initialize(...) self$.plotSettings <- PlotSettings$new() - self$.initStages() - }, - show = function(showType = 1, digits = NA_integer_) { - self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) - }, - .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { - "Method for automatically printing trial design objects" - self$.resetCat() - if (showType == 3) { - .createSummary(self, digits = digits)$.show( - showType = 1, - digits = digits, consoleOutputEnabled = consoleOutputEnabled - ) - } else if (showType == 2) { - super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) - } else { - self$.cat("Design parameters and output of ", self$.toString(), ":\n\n", - heading = 1, - consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(self$.getDerivedParameters(), "Derived from user defined parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Output", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - } - }, - .toString = function(startWithUpperCase = FALSE) { - s <- "unknown trial design" - if (.isTrialDesignGroupSequential(self)) { - s <- "group sequential design" - } else if (.isTrialDesignInverseNormal(self)) { - s <- "inverse normal combination test design" - } else if (.isTrialDesignFisher(self)) { - s <- "Fisher's combination test design" - } else if (.isTrialDesignConditionalDunnett(self)) { - s <- "conditional Dunnett test design" - } - return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) - }, - .initStages = function() { - if (length(self$kMax) == 1 && !is.na(self$kMax) && self$kMax > 0) { - self$stages <- c(1L:self$kMax) - if (self$kMax == C_KMAX_DEFAULT) { - self$.setParameterType("stages", C_PARAM_DEFAULT_VALUE) - } else { - type <- self$.getParameterType("kMax") - self$.setParameterType("stages", ifelse(type != C_PARAM_TYPE_UNKNOWN, type, C_PARAM_USER_DEFINED)) - } - } else { - self$.setParameterType("stages", C_PARAM_NOT_APPLICABLE) - } - }, - .isDelayedResponseDesign = function() { - return((inherits(self, "TrialDesignGroupSequential") || inherits(self, "TrialDesignInverseNormal")) && - self$kMax > 1 && - !is.null(self[["delayedInformation"]]) && - !any(is.na(self$delayedInformation)) && any(self$delayedInformation > 0)) - } - ) + self$.initStages() + }, + show = function(showType = 1, digits = NA_integer_) { + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + }, + .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { + "Method for automatically printing trial design objects" + self$.resetCat() + if (showType == 3) { + .createSummary(self, digits = digits)$.show( + showType = 1, + digits = digits, consoleOutputEnabled = consoleOutputEnabled + ) + } else if (showType == 2) { + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + } else { + self$.cat("Design parameters and output of ", self$.toString(), ":\n\n", + heading = 1, + consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getDerivedParameters(), "Derived from user defined parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showParametersOfOneGroup(self$.getGeneratedParameters(), "Output", + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + } + }, + .toString = function(startWithUpperCase = FALSE) { + s <- "unknown trial design" + if (.isTrialDesignGroupSequential(self)) { + s <- "group sequential design" + } else if (.isTrialDesignInverseNormal(self)) { + s <- "inverse normal combination test design" + } else if (.isTrialDesignFisher(self)) { + s <- "Fisher's combination test design" + } else if (.isTrialDesignConditionalDunnett(self)) { + s <- "conditional Dunnett test design" + } + return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) + }, + .initStages = function() { + if (length(self$kMax) == 1 && !is.na(self$kMax) && self$kMax > 0) { + self$stages <- c(1L:self$kMax) + if (self$kMax == C_KMAX_DEFAULT) { + self$.setParameterType("stages", C_PARAM_DEFAULT_VALUE) + } else { + type <- self$.getParameterType("kMax") + self$.setParameterType("stages", ifelse(type != C_PARAM_TYPE_UNKNOWN, type, C_PARAM_USER_DEFINED)) + } + } else { + self$.setParameterType("stages", C_PARAM_NOT_APPLICABLE) + } + }, + .isDelayedResponseDesign = function() { + return((inherits(self, "TrialDesignGroupSequential") || inherits(self, "TrialDesignInverseNormal")) && + self$kMax > 1 && + !is.null(self[["delayedInformation"]]) && + !any(is.na(self$delayedInformation)) && any(self$delayedInformation > 0)) + } + ) ) #' @@ -206,67 +206,66 @@ TrialDesign <- R6::R6Class("TrialDesign", #' @importFrom methods new #' TrialDesignCharacteristics <- R6::R6Class("TrialDesignCharacteristics", - inherit = ParameterSet, - public = list( - .design = NULL, - .probs = NULL, - nFixed = NULL, - shift = NULL, - inflationFactor = NULL, - stages = NULL, - information = NULL, - power = NULL, - rejectionProbabilities = NULL, # efficacy probabilities - futilityProbabilities = NULL, - averageSampleNumber1 = NULL, - averageSampleNumber01 = NULL, - averageSampleNumber0 = NULL, - initialize = function(design, ...) { - - self$.design <- design - super$initialize(...) - self$.initStages() - }, - show = function(showType = 1, digits = NA_integer_) { - self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) - }, - .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { - "Method for automatically printing trial design characteristics objects" - self$.resetCat() - if (showType == 2) { - super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) - } else { - self$.showParametersOfOneGroup(self$.getGeneratedParameters(), - title = self$.toString(startWithUpperCase = TRUE), - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled - ) - self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - } - }, - .initStages = function() { - if (!is.na(self$.design$kMax) && self$.design$kMax > 0) { - self$stages <- c(1L:self$.design$kMax) - if (self$.design$kMax == C_KMAX_DEFAULT) { - self$.setParameterType("stages", C_PARAM_DEFAULT_VALUE) - } else { - self$.setParameterType("stages", C_PARAM_USER_DEFINED) - } - } else { - self$.setParameterType("stages", C_PARAM_NOT_APPLICABLE) - } - }, - .toString = function(startWithUpperCase = FALSE) { - if (self$.design$.isDelayedResponseDesign()) { - prefix <- "delayed response" - if (startWithUpperCase) { - prefix <- .firstCharacterToUpperCase(prefix) - } - return(paste(prefix, self$.design$.toString(startWithUpperCase = FALSE), "characteristics")) - } - - return(paste(self$.design$.toString(startWithUpperCase = startWithUpperCase), "characteristics")) - } - ) + inherit = ParameterSet, + public = list( + .design = NULL, + .probs = NULL, + nFixed = NULL, + shift = NULL, + inflationFactor = NULL, + stages = NULL, + information = NULL, + power = NULL, + rejectionProbabilities = NULL, # efficacy probabilities + futilityProbabilities = NULL, + averageSampleNumber1 = NULL, + averageSampleNumber01 = NULL, + averageSampleNumber0 = NULL, + initialize = function(design, ...) { + self$.design <- design + super$initialize(...) + self$.initStages() + }, + show = function(showType = 1, digits = NA_integer_) { + self$.show(showType = showType, digits = digits, consoleOutputEnabled = TRUE) + }, + .show = function(showType = 1, digits = NA_integer_, consoleOutputEnabled = TRUE) { + "Method for automatically printing trial design characteristics objects" + self$.resetCat() + if (showType == 2) { + super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + } else { + self$.showParametersOfOneGroup(self$.getGeneratedParameters(), + title = self$.toString(startWithUpperCase = TRUE), + orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + ) + self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) + } + }, + .initStages = function() { + if (!is.na(self$.design$kMax) && self$.design$kMax > 0) { + self$stages <- c(1L:self$.design$kMax) + if (self$.design$kMax == C_KMAX_DEFAULT) { + self$.setParameterType("stages", C_PARAM_DEFAULT_VALUE) + } else { + self$.setParameterType("stages", C_PARAM_USER_DEFINED) + } + } else { + self$.setParameterType("stages", C_PARAM_NOT_APPLICABLE) + } + }, + .toString = function(startWithUpperCase = FALSE) { + if (self$.design$.isDelayedResponseDesign()) { + prefix <- "delayed response" + if (startWithUpperCase) { + prefix <- .firstCharacterToUpperCase(prefix) + } + return(paste(prefix, self$.design$.toString(startWithUpperCase = FALSE), "characteristics")) + } + + return(paste(self$.design$.toString(startWithUpperCase = startWithUpperCase), "characteristics")) + } + ) ) #' @@ -288,10 +287,10 @@ TrialDesignCharacteristics <- R6::R6Class("TrialDesignCharacteristics", #' @export #' print.TrialDesignCharacteristics <- function(x, ..., markdown = FALSE, showDesign = TRUE) { - if (showDesign) { - print.ParameterSet(x$.design, ..., markdown = markdown) - } - print.ParameterSet(x, ..., markdown = markdown) + if (showDesign) { + print.ParameterSet(x$.design, ..., markdown = markdown) + } + print.ParameterSet(x, ..., markdown = markdown) } #' @@ -377,105 +376,103 @@ as.data.frame.TrialDesignCharacteristics <- function(x, row.names = NULL, #' @importFrom methods new #' TrialDesignFisher <- R6::R6Class("TrialDesignFisher", - inherit = TrialDesign, - public = list( - method = NULL, - alpha0Vec = NULL, - scale = NULL, - nonStochasticCurtailment = NULL, - sided = NULL, - simAlpha = NULL, - iterations = NULL, - seed = NULL, - initialize = function(..., - method = NA_character_, - alpha0Vec = NA_real_, - scale = NA_real_, - nonStochasticCurtailment = FALSE, - sided = as.integer(C_SIDED_DEFAULT), - simAlpha = NA_real_, - iterations = 0L, - seed = NA_real_, - tolerance = C_ANALYSIS_TOLERANCE_FISHER_DEFAULT) { - - - self$method <- method - self$alpha0Vec <- alpha0Vec - self$scale <- scale - self$nonStochasticCurtailment <- nonStochasticCurtailment - self$sided <- sided - self$simAlpha <- simAlpha - super$initialize(...)#TODO dont move to first line of constructor - self$iterations <- iterations - self$seed <- seed - self$tolerance <- tolerance - - self$.initParameterTypes() - self$.setParameterType("iterations", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("seed", C_PARAM_NOT_APPLICABLE) - self$.initStages() - }, - hasChanged = function(kMax, alpha, sided, method, informationRates, alpha0Vec, userAlphaSpending, bindingFutility) { - informationRatesTemp <- informationRates - if (any(is.na(informationRatesTemp))) { - informationRatesTemp <- .getInformationRatesDefault(kMax) - } - alpha0VecTemp <- alpha0Vec[1:(kMax - 1)] - if (any(is.na(alpha0VecTemp))) { - alpha0VecTemp <- rep(C_FUTILITY_BOUNDS_DEFAULT, kMax - 1) - } - - if (!identical(kMax, self$kMax)) { - return(TRUE) - } - if (!identical(alpha, self$alpha)) { - return(TRUE) - } - if (!identical(sided, self$sided)) { - return(TRUE) - } - if (!identical(method, self$method)) { - return(TRUE) - } - if (!identical(informationRatesTemp, self$informationRates)) { - return(TRUE) - } - if (!identical(alpha0VecTemp, self$alpha0Vec)) { - return(TRUE) - } - if (!identical(userAlphaSpending, self$userAlphaSpending)) { - return(TRUE) - } - if (!identical(bindingFutility, self$bindingFutility)) { - return(TRUE) - } - return(FALSE) - }, - - # Defines the order of the parameter output - .getParametersToShow = function() { - return(c( - "method", - "kMax", - "stages", - "informationRates", - "alpha", - "alpha0Vec", - "bindingFutility", - "sided", - "tolerance", - "iterations", - "seed", - "alphaSpent", - "userAlphaSpending", - "criticalValues", - "stageLevels", - "scale", - "simAlpha", - "nonStochasticCurtailment" - )) - } - ) + inherit = TrialDesign, + public = list( + method = NULL, + alpha0Vec = NULL, + scale = NULL, + nonStochasticCurtailment = NULL, + sided = NULL, + simAlpha = NULL, + iterations = NULL, + seed = NULL, + initialize = function(..., + method = NA_character_, + alpha0Vec = NA_real_, + scale = NA_real_, + nonStochasticCurtailment = FALSE, + sided = as.integer(C_SIDED_DEFAULT), + simAlpha = NA_real_, + iterations = 0L, + seed = NA_real_, + tolerance = C_ANALYSIS_TOLERANCE_FISHER_DEFAULT) { + self$method <- method + self$alpha0Vec <- alpha0Vec + self$scale <- scale + self$nonStochasticCurtailment <- nonStochasticCurtailment + self$sided <- sided + self$simAlpha <- simAlpha + super$initialize(...) # TODO dont move to first line of constructor + self$iterations <- iterations + self$seed <- seed + self$tolerance <- tolerance + + self$.initParameterTypes() + self$.setParameterType("iterations", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("seed", C_PARAM_NOT_APPLICABLE) + self$.initStages() + }, + hasChanged = function(kMax, alpha, sided, method, informationRates, alpha0Vec, userAlphaSpending, bindingFutility) { + informationRatesTemp <- informationRates + if (any(is.na(informationRatesTemp))) { + informationRatesTemp <- .getInformationRatesDefault(kMax) + } + alpha0VecTemp <- alpha0Vec[1:(kMax - 1)] + if (any(is.na(alpha0VecTemp))) { + alpha0VecTemp <- rep(C_FUTILITY_BOUNDS_DEFAULT, kMax - 1) + } + + if (!identical(kMax, self$kMax)) { + return(TRUE) + } + if (!identical(alpha, self$alpha)) { + return(TRUE) + } + if (!identical(sided, self$sided)) { + return(TRUE) + } + if (!identical(method, self$method)) { + return(TRUE) + } + if (!identical(informationRatesTemp, self$informationRates)) { + return(TRUE) + } + if (!identical(alpha0VecTemp, self$alpha0Vec)) { + return(TRUE) + } + if (!identical(userAlphaSpending, self$userAlphaSpending)) { + return(TRUE) + } + if (!identical(bindingFutility, self$bindingFutility)) { + return(TRUE) + } + return(FALSE) + }, + + # Defines the order of the parameter output + .getParametersToShow = function() { + return(c( + "method", + "kMax", + "stages", + "informationRates", + "alpha", + "alpha0Vec", + "bindingFutility", + "sided", + "tolerance", + "iterations", + "seed", + "alphaSpent", + "userAlphaSpending", + "criticalValues", + "stageLevels", + "scale", + "simAlpha", + "nonStochasticCurtailment" + )) + } + ) ) #' @@ -533,246 +530,243 @@ TrialDesignFisher <- R6::R6Class("TrialDesignFisher", #' @importFrom methods new #' TrialDesignInverseNormal <- R6::R6Class("TrialDesignInverseNormal", - inherit = TrialDesign, - public = list( - typeOfDesign = NULL, - beta = NULL, - deltaWT = NULL, - deltaPT1 = NULL, - deltaPT0 = NULL, - futilityBounds = NULL, - gammaA = NULL, - gammaB = NULL, - optimizationCriterion = NULL, - sided = NULL, - betaSpent = NULL, - typeBetaSpending = NULL, - userBetaSpending = NULL, - power = NULL, - twoSidedPower = NULL, - constantBoundsHP = NULL, - betaAdjustment = NULL, - delayedInformation = NULL, - decisionCriticalValues = NULL, - reversalProbabilities = NULL, - initialize = function(..., - beta = C_BETA_DEFAULT, - betaSpent = NA_real_, - sided = C_SIDED_DEFAULT, - futilityBounds = NA_real_, - typeOfDesign = C_DEFAULT_TYPE_OF_DESIGN, - deltaWT = NA_real_, - deltaPT1 = NA_real_, - deltaPT0 = NA_real_, - optimizationCriterion = C_OPTIMIZATION_CRITERION_DEFAULT, - gammaA = NA_real_, - gammaB = NA_real_, - typeBetaSpending = C_TYPE_OF_DESIGN_BS_NONE, - userBetaSpending = NA_real_, - power = NA_real_, - twoSidedPower = C_TWO_SIDED_POWER_DEFAULT, - constantBoundsHP = NA_real_, - betaAdjustment = TRUE, # impl as constant - delayedInformation = NA_real_) { - - - self$beta <- beta - self$betaSpent <- betaSpent - self$sided <- sided - self$futilityBounds <- futilityBounds - self$typeOfDesign <- typeOfDesign - self$deltaWT <- deltaWT - self$deltaPT1 <- deltaPT1 - self$deltaPT0 <- deltaPT0 - self$optimizationCriterion <- optimizationCriterion - self$gammaA <- gammaA - self$gammaB <- gammaB - self$typeBetaSpending <- typeBetaSpending - self$userBetaSpending <- userBetaSpending - self$power <- power - self$twoSidedPower <- twoSidedPower - self$constantBoundsHP <- constantBoundsHP - self$betaAdjustment <- betaAdjustment - self$delayedInformation <- delayedInformation - super$initialize(...) + inherit = TrialDesign, + public = list( + typeOfDesign = NULL, + beta = NULL, + deltaWT = NULL, + deltaPT1 = NULL, + deltaPT0 = NULL, + futilityBounds = NULL, + gammaA = NULL, + gammaB = NULL, + optimizationCriterion = NULL, + sided = NULL, + betaSpent = NULL, + typeBetaSpending = NULL, + userBetaSpending = NULL, + power = NULL, + twoSidedPower = NULL, + constantBoundsHP = NULL, + betaAdjustment = NULL, + delayedInformation = NULL, + decisionCriticalValues = NULL, + reversalProbabilities = NULL, + initialize = function(..., + beta = C_BETA_DEFAULT, + betaSpent = NA_real_, + sided = C_SIDED_DEFAULT, + futilityBounds = NA_real_, + typeOfDesign = C_DEFAULT_TYPE_OF_DESIGN, + deltaWT = NA_real_, + deltaPT1 = NA_real_, + deltaPT0 = NA_real_, + optimizationCriterion = C_OPTIMIZATION_CRITERION_DEFAULT, + gammaA = NA_real_, + gammaB = NA_real_, + typeBetaSpending = C_TYPE_OF_DESIGN_BS_NONE, + userBetaSpending = NA_real_, + power = NA_real_, + twoSidedPower = C_TWO_SIDED_POWER_DEFAULT, + constantBoundsHP = NA_real_, + betaAdjustment = TRUE, # impl as constant + delayedInformation = NA_real_) { + self$beta <- beta + self$betaSpent <- betaSpent + self$sided <- sided + self$futilityBounds <- futilityBounds + self$typeOfDesign <- typeOfDesign + self$deltaWT <- deltaWT + self$deltaPT1 <- deltaPT1 + self$deltaPT0 <- deltaPT0 + self$optimizationCriterion <- optimizationCriterion + self$gammaA <- gammaA + self$gammaB <- gammaB + self$typeBetaSpending <- typeBetaSpending + self$userBetaSpending <- userBetaSpending + self$power <- power + self$twoSidedPower <- twoSidedPower + self$constantBoundsHP <- constantBoundsHP + self$betaAdjustment <- betaAdjustment + self$delayedInformation <- delayedInformation + super$initialize(...) + + self$.initParameterTypes() + self$.initStages() + + self$.setParameterType("betaAdjustment", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("delayedInformation", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("decisionCriticalValues", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("reversalProbabilities", C_PARAM_NOT_APPLICABLE) + }, + .formatComparisonResult = function(x) { + if (is.null(x) || length(x) == 0 || !is.numeric(x)) { + return(x) + } + + s <- sprintf("%.9f", x) + s <- sub("\\.0+", "", s) + return(s) + }, + .pasteComparisonResult = function(name, newValue, oldValue) { + return(paste0( + name, "_new = ", .arrayToString(.formatComparisonResult(newValue)), " (", .getClassName(newValue), "), ", + name, "_old = ", .arrayToString(.formatComparisonResult(oldValue)), " (", .getClassName(oldValue), ")" + )) + }, + hasChanged = function(..., + kMax, + alpha, + beta, + sided, + typeOfDesign, + deltaWT, + deltaPT1, + deltaPT0, + informationRates, + futilityBounds, + optimizationCriterion, + typeBetaSpending, + gammaA, + gammaB, + bindingFutility, + userAlphaSpending, + userBetaSpending, + twoSidedPower, + constantBoundsHP, + betaAdjustment = TRUE, + delayedInformation = NA_real_) { + informationRatesTemp <- informationRates + if (any(is.na(informationRatesTemp))) { + informationRatesTemp <- .getInformationRatesDefault(kMax) + } + futilityBoundsTemp <- futilityBounds[1:(kMax - 1)] + if (any(is.na(futilityBoundsTemp))) { + futilityBoundsTemp <- rep(C_FUTILITY_BOUNDS_DEFAULT, kMax - 1) + } - self$.initParameterTypes() - self$.initStages() - - self$.setParameterType("betaAdjustment", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("delayedInformation", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("decisionCriticalValues", C_PARAM_NOT_APPLICABLE) - self$.setParameterType("reversalProbabilities", C_PARAM_NOT_APPLICABLE) - - }, - .formatComparisonResult = function(x) { - if (is.null(x) || length(x) == 0 || !is.numeric(x)) { - return(x) - } - - s <- sprintf("%.9f", x) - s <- sub("\\.0+", "", s) - return(s) - }, - .pasteComparisonResult = function(name, newValue, oldValue) { - return(paste0( - name, "_new = ", .arrayToString(.formatComparisonResult(newValue)), " (", .getClassName(newValue), "), ", - name, "_old = ", .arrayToString(.formatComparisonResult(oldValue)), " (", .getClassName(oldValue), ")" - )) - }, - hasChanged = function(..., - kMax, - alpha, - beta, - sided, - typeOfDesign, - deltaWT, - deltaPT1, - deltaPT0, - informationRates, - futilityBounds, - optimizationCriterion, - typeBetaSpending, - gammaA, - gammaB, - bindingFutility, - userAlphaSpending, - userBetaSpending, - twoSidedPower, - constantBoundsHP, - betaAdjustment = TRUE, - delayedInformation = NA_real_) { - informationRatesTemp <- informationRates - if (any(is.na(informationRatesTemp))) { - informationRatesTemp <- .getInformationRatesDefault(kMax) - } - futilityBoundsTemp <- futilityBounds[1:(kMax - 1)] - if (any(is.na(futilityBoundsTemp))) { - futilityBoundsTemp <- rep(C_FUTILITY_BOUNDS_DEFAULT, kMax - 1) - } - - if (!identical(kMax, self$kMax)) { - return(self$.pasteComparisonResult("kMax", kMax, self$kMax)) - } - if (!identical(alpha, self$alpha)) { - return(self$.pasteComparisonResult("alpha", alpha, self$alpha)) - } - if (!identical(beta, self$beta)) { - return(self$.pasteComparisonResult("beta", beta, self$beta)) - } - if (!identical(sided, self$sided)) { - return(self$.pasteComparisonResult("sided", sided, self$sided)) - } - if (!identical(twoSidedPower, self$twoSidedPower)) { - return(self$.pasteComparisonResult("twoSidedPower", twoSidedPower, self$twoSidedPower)) - } - if (kMax == 1) { - return(FALSE) - } - - if (!identical(betaAdjustment, self$betaAdjustment)) { - return(self$.pasteComparisonResult("betaAdjustment", betaAdjustment, self$betaAdjustment)) - } - if (!identical(delayedInformation, self$delayedInformation)) { - return(self$.pasteComparisonResult("delayedInformation", delayedInformation, self$delayedInformation)) - } - if (!identical(typeOfDesign, self$typeOfDesign)) { - return(self$.pasteComparisonResult("typeOfDesign", typeOfDesign, self$typeOfDesign)) - } - if (typeOfDesign == C_TYPE_OF_DESIGN_WT) { - if (!identical(deltaWT, self$deltaWT)) { - return(self$.pasteComparisonResult("deltaWT", deltaWT, self$deltaWT)) - } - } - if (typeOfDesign == C_TYPE_OF_DESIGN_PT) { - if (!identical(deltaPT1, self$deltaPT1)) { - return(self$.pasteComparisonResult("deltaPT1", deltaPT1, self$deltaPT1)) - } - if (!identical(deltaPT0, self$deltaPT0)) { - return(self$.pasteComparisonResult("deltaPT0", deltaPT0, self$deltaPT0)) - } - } - if (!identical(informationRatesTemp, self$informationRates)) { - return(self$.pasteComparisonResult("informationRates", informationRatesTemp, self$informationRates)) - } - if (self$.getParameterType("futilityBounds") != C_PARAM_GENERATED && - (!grepl("^as.*", typeOfDesign) || typeBetaSpending == C_TYPE_OF_DESIGN_BS_NONE) && - !identical(futilityBoundsTemp, self$futilityBounds)) { - return(self$.pasteComparisonResult("futilityBounds", futilityBoundsTemp, self$futilityBounds)) - } - if (!identical(optimizationCriterion, self$optimizationCriterion)) { - return(self$.pasteComparisonResult("optimizationCriterion", optimizationCriterion, self$optimizationCriterion)) - } - if (!identical(typeBetaSpending, self$typeBetaSpending)) { - return(self$.pasteComparisonResult("typeBetaSpending", typeBetaSpending, self$typeBetaSpending)) - } - if (!identical(gammaA, self$gammaA)) { - return(self$.pasteComparisonResult("gammaA", gammaA, self$gammaA)) - } - if (!identical(gammaB, self$gammaB)) {#TODO - return(self$.pasteComparisonResult("gammaB", gammaB, self$gammaB)) - } - if ((typeOfDesign == C_TYPE_OF_DESIGN_PT && !identical(bindingFutility, self$bindingFutility)) || - (!identical(bindingFutility, self$bindingFutility) && - self$.getParameterType("futilityBounds") != C_PARAM_NOT_APPLICABLE && - (sided == 1 || !grepl("^as.*", typeOfDesign) || typeBetaSpending == C_TYPE_OF_DESIGN_BS_NONE) && - (any(na.omit(futilityBounds) > -6) || any(na.omit(self$futilityBounds) > -6)) - )) { - return(self$.pasteComparisonResult("bindingFutility", bindingFutility, self$bindingFutility)) - } - if (!identical(userAlphaSpending, self$userAlphaSpending)) { - return(self$.pasteComparisonResult("userAlphaSpending", userAlphaSpending, self$userAlphaSpending)) - } - if (!identical(userBetaSpending, self$userBetaSpending)) { - return(self$.pasteComparisonResult("userBetaSpending", userBetaSpending, self$userBetaSpending)) - } - if (!identical(twoSidedPower, self$twoSidedPower)) { - return(self$.pasteComparisonResult("twoSidedPower", twoSidedPower, self$twoSidedPower)) - } - if (typeOfDesign == C_TYPE_OF_DESIGN_HP) { - if (!identical(constantBoundsHP, self$constantBoundsHP)) { - return(self$.pasteComparisonResult("constantBoundsHP", constantBoundsHP, self$constantBoundsHP)) - } - } - return(FALSE) - }, - - # Defines the order of the parameter output - .getParametersToShow = function() { - return(c( - "typeOfDesign", - "kMax", - "stages", - "informationRates", - "alpha", - "beta", - "power", - "twoSidedPower", - "deltaWT", - "deltaPT1", - "deltaPT0", - "futilityBounds", - "bindingFutility", - "constantBoundsHP", - "gammaA", - "gammaB", - "optimizationCriterion", - "sided", - "betaAdjustment", - "delayedInformation", - "tolerance", - "alphaSpent", - "userAlphaSpending", - "betaSpent", - "typeBetaSpending", - "userBetaSpending", - "criticalValues", - "stageLevels", - "decisionCriticalValues", - "reversalProbabilities" - )) - } - ) + if (!identical(kMax, self$kMax)) { + return(self$.pasteComparisonResult("kMax", kMax, self$kMax)) + } + if (!identical(alpha, self$alpha)) { + return(self$.pasteComparisonResult("alpha", alpha, self$alpha)) + } + if (!identical(beta, self$beta)) { + return(self$.pasteComparisonResult("beta", beta, self$beta)) + } + if (!identical(sided, self$sided)) { + return(self$.pasteComparisonResult("sided", sided, self$sided)) + } + if (!identical(twoSidedPower, self$twoSidedPower)) { + return(self$.pasteComparisonResult("twoSidedPower", twoSidedPower, self$twoSidedPower)) + } + if (kMax == 1) { + return(FALSE) + } + + if (!identical(betaAdjustment, self$betaAdjustment)) { + return(self$.pasteComparisonResult("betaAdjustment", betaAdjustment, self$betaAdjustment)) + } + if (!identical(delayedInformation, self$delayedInformation)) { + return(self$.pasteComparisonResult("delayedInformation", delayedInformation, self$delayedInformation)) + } + if (!identical(typeOfDesign, self$typeOfDesign)) { + return(self$.pasteComparisonResult("typeOfDesign", typeOfDesign, self$typeOfDesign)) + } + if (typeOfDesign == C_TYPE_OF_DESIGN_WT) { + if (!identical(deltaWT, self$deltaWT)) { + return(self$.pasteComparisonResult("deltaWT", deltaWT, self$deltaWT)) + } + } + if (typeOfDesign == C_TYPE_OF_DESIGN_PT) { + if (!identical(deltaPT1, self$deltaPT1)) { + return(self$.pasteComparisonResult("deltaPT1", deltaPT1, self$deltaPT1)) + } + if (!identical(deltaPT0, self$deltaPT0)) { + return(self$.pasteComparisonResult("deltaPT0", deltaPT0, self$deltaPT0)) + } + } + if (!identical(informationRatesTemp, self$informationRates)) { + return(self$.pasteComparisonResult("informationRates", informationRatesTemp, self$informationRates)) + } + if (self$.getParameterType("futilityBounds") != C_PARAM_GENERATED && + (!grepl("^as.*", typeOfDesign) || typeBetaSpending == C_TYPE_OF_DESIGN_BS_NONE) && + !identical(futilityBoundsTemp, self$futilityBounds)) { + return(self$.pasteComparisonResult("futilityBounds", futilityBoundsTemp, self$futilityBounds)) + } + if (!identical(optimizationCriterion, self$optimizationCriterion)) { + return(self$.pasteComparisonResult("optimizationCriterion", optimizationCriterion, self$optimizationCriterion)) + } + if (!identical(typeBetaSpending, self$typeBetaSpending)) { + return(self$.pasteComparisonResult("typeBetaSpending", typeBetaSpending, self$typeBetaSpending)) + } + if (!identical(gammaA, self$gammaA)) { + return(self$.pasteComparisonResult("gammaA", gammaA, self$gammaA)) + } + if (!identical(gammaB, self$gammaB)) { # TODO + return(self$.pasteComparisonResult("gammaB", gammaB, self$gammaB)) + } + if ((typeOfDesign == C_TYPE_OF_DESIGN_PT && !identical(bindingFutility, self$bindingFutility)) || + (!identical(bindingFutility, self$bindingFutility) && + self$.getParameterType("futilityBounds") != C_PARAM_NOT_APPLICABLE && + (sided == 1 || !grepl("^as.*", typeOfDesign) || typeBetaSpending == C_TYPE_OF_DESIGN_BS_NONE) && + (any(na.omit(futilityBounds) > -6) || any(na.omit(self$futilityBounds) > -6)) + )) { + return(self$.pasteComparisonResult("bindingFutility", bindingFutility, self$bindingFutility)) + } + if (!identical(userAlphaSpending, self$userAlphaSpending)) { + return(self$.pasteComparisonResult("userAlphaSpending", userAlphaSpending, self$userAlphaSpending)) + } + if (!identical(userBetaSpending, self$userBetaSpending)) { + return(self$.pasteComparisonResult("userBetaSpending", userBetaSpending, self$userBetaSpending)) + } + if (!identical(twoSidedPower, self$twoSidedPower)) { + return(self$.pasteComparisonResult("twoSidedPower", twoSidedPower, self$twoSidedPower)) + } + if (typeOfDesign == C_TYPE_OF_DESIGN_HP) { + if (!identical(constantBoundsHP, self$constantBoundsHP)) { + return(self$.pasteComparisonResult("constantBoundsHP", constantBoundsHP, self$constantBoundsHP)) + } + } + return(FALSE) + }, + + # Defines the order of the parameter output + .getParametersToShow = function() { + return(c( + "typeOfDesign", + "kMax", + "stages", + "informationRates", + "alpha", + "beta", + "power", + "twoSidedPower", + "deltaWT", + "deltaPT1", + "deltaPT0", + "futilityBounds", + "bindingFutility", + "constantBoundsHP", + "gammaA", + "gammaB", + "optimizationCriterion", + "sided", + "betaAdjustment", + "delayedInformation", + "tolerance", + "alphaSpent", + "userAlphaSpending", + "betaSpent", + "typeBetaSpending", + "userBetaSpending", + "criticalValues", + "stageLevels", + "decisionCriticalValues", + "reversalProbabilities" + )) + } + ) ) #' @@ -830,17 +824,17 @@ TrialDesignInverseNormal <- R6::R6Class("TrialDesignInverseNormal", #' @importFrom methods new #' TrialDesignGroupSequential <- R6::R6Class("TrialDesignGroupSequential", - inherit = TrialDesignInverseNormal, - public = list( - initialize = function(...) { - super$initialize(...) - self$.initStages() - }, - show = function(showType = 1, digits = NA_integer_) { - "Method for automatically printing trial design objects" - super$show(showType = showType, digits = digits) - } - ) + inherit = TrialDesignInverseNormal, + public = list( + initialize = function(...) { + super$initialize(...) + self$.initStages() + }, + show = function(showType = 1, digits = NA_integer_) { + "Method for automatically printing trial design objects" + super$show(showType = showType, digits = digits) + } + ) ) #' @@ -881,49 +875,49 @@ TrialDesignGroupSequential <- R6::R6Class("TrialDesignGroupSequential", #' @seealso \code{\link{getDesignConditionalDunnett}} for creating a conditional Dunnett test design. #' TrialDesignConditionalDunnett <- R6::R6Class("TrialDesignConditionalDunnett", - inherit = TrialDesign, - public = list( - informationAtInterim = NULL, - secondStageConditioning = NULL, - sided = NULL, - initialize = function(...,informationAtInterim = NULL, secondStageConditioning = NULL) { - super$initialize(...) - self$informationAtInterim <- informationAtInterim - self$secondStageConditioning <- secondStageConditioning - notApplicableParameters <- c( - "kMax", - "stages", - "informationRates", - "userAlphaSpending", - "criticalValues", - "stageLevels", - "alphaSpent", - "bindingFutility", - "tolerance" - ) - for (notApplicableParameter in notApplicableParameters) { - self$.setParameterType(notApplicableParameter, C_PARAM_NOT_APPLICABLE) - } - self$.setParameterType("alpha", ifelse( - identical(self$alpha, C_ALPHA_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - self$.setParameterType("informationAtInterim", ifelse( - identical(self$informationAtInterim, 0.5), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - self$.setParameterType("secondStageConditioning", ifelse( - identical(self$secondStageConditioning, TRUE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED - )) - - self$kMax <- 2L - self$sided <- 1L - - self$.initStages() - }, - show = function(showType = 1, digits = NA_integer_) { - "Method for automatically printing trial design objects" - super$show(showType = showType, digits = digits) - } - ) + inherit = TrialDesign, + public = list( + informationAtInterim = NULL, + secondStageConditioning = NULL, + sided = NULL, + initialize = function(..., informationAtInterim = NULL, secondStageConditioning = NULL) { + super$initialize(...) + self$informationAtInterim <- informationAtInterim + self$secondStageConditioning <- secondStageConditioning + notApplicableParameters <- c( + "kMax", + "stages", + "informationRates", + "userAlphaSpending", + "criticalValues", + "stageLevels", + "alphaSpent", + "bindingFutility", + "tolerance" + ) + for (notApplicableParameter in notApplicableParameters) { + self$.setParameterType(notApplicableParameter, C_PARAM_NOT_APPLICABLE) + } + self$.setParameterType("alpha", ifelse( + identical(self$alpha, C_ALPHA_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + self$.setParameterType("informationAtInterim", ifelse( + identical(self$informationAtInterim, 0.5), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + self$.setParameterType("secondStageConditioning", ifelse( + identical(self$secondStageConditioning, TRUE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) + + self$kMax <- 2L + self$sided <- 1L + + self$.initStages() + }, + show = function(showType = 1, digits = NA_integer_) { + "Method for automatically printing trial design objects" + super$show(showType = showType, digits = digits) + } + ) ) #' @@ -956,15 +950,15 @@ TrialDesignConditionalDunnett <- R6::R6Class("TrialDesignConditionalDunnett", #' @export #' getDesignConditionalDunnett <- function(alpha = 0.025, # C_ALPHA_DEFAULT - informationAtInterim = 0.5, secondStageConditioning = TRUE) { - .assertIsValidAlpha(alpha) - .assertIsSingleNumber(informationAtInterim, "informationAtInterim") - .assertIsInOpenInterval(informationAtInterim, "informationAtInterim", 0, 1) - return(TrialDesignConditionalDunnett$new( - alpha = alpha, - informationAtInterim = informationAtInterim, - secondStageConditioning = secondStageConditioning - )) + informationAtInterim = 0.5, secondStageConditioning = TRUE) { + .assertIsValidAlpha(alpha) + .assertIsSingleNumber(informationAtInterim, "informationAtInterim") + .assertIsInOpenInterval(informationAtInterim, "informationAtInterim", 0, 1) + return(TrialDesignConditionalDunnett$new( + alpha = alpha, + informationAtInterim = informationAtInterim, + secondStageConditioning = secondStageConditioning + )) } #' @@ -1038,108 +1032,108 @@ getDesignConditionalDunnett <- function(alpha = 0.025, # C_ALPHA_DEFAULT #' @export #' plot.TrialDesign <- function(x, y, ..., main = NA_character_, - xlab = NA_character_, ylab = NA_character_, type = 1L, palette = "Set1", - theta = seq(-1, 1, 0.01), nMax = NA_integer_, plotPointsEnabled = NA, - legendPosition = NA_integer_, showSource = FALSE, - grid = 1, plotSettings = NULL) { - fCall <- match.call(expand.dots = FALSE) - designName <- deparse(fCall$x) - .assertGgplotIsInstalled() - .assertIsSingleInteger(grid, "grid", validateType = FALSE) - typeNumbers <- .getPlotTypeNumber(type, x) - if (is.null(plotSettings)) { - plotSettings <- .getGridPlotSettings(x, typeNumbers, grid) - } - p <- NULL - plotList <- list() - for (typeNumber in typeNumbers) { - p <- .plotTrialDesign( - x = x, y = y, main = main, - xlab = xlab, ylab = ylab, type = typeNumber, palette = palette, - theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, - legendPosition = .getGridLegendPosition(legendPosition, typeNumbers, grid), - showSource = showSource, designName = designName, - plotSettings = plotSettings, ... - ) - .printPlotShowSourceSeparator(showSource, typeNumber, typeNumbers) - if (length(typeNumbers) > 1) { - caption <- .getPlotCaption(x, typeNumber, stopIfNotFound = TRUE) - plotList[[caption]] <- p + xlab = NA_character_, ylab = NA_character_, type = 1L, palette = "Set1", + theta = seq(-1, 1, 0.01), nMax = NA_integer_, plotPointsEnabled = NA, + legendPosition = NA_integer_, showSource = FALSE, + grid = 1, plotSettings = NULL) { + fCall <- match.call(expand.dots = FALSE) + designName <- deparse(fCall$x) + .assertGgplotIsInstalled() + .assertIsSingleInteger(grid, "grid", validateType = FALSE) + typeNumbers <- .getPlotTypeNumber(type, x) + if (is.null(plotSettings)) { + plotSettings <- .getGridPlotSettings(x, typeNumbers, grid) + } + p <- NULL + plotList <- list() + for (typeNumber in typeNumbers) { + p <- .plotTrialDesign( + x = x, y = y, main = main, + xlab = xlab, ylab = ylab, type = typeNumber, palette = palette, + theta = theta, nMax = nMax, plotPointsEnabled = plotPointsEnabled, + legendPosition = .getGridLegendPosition(legendPosition, typeNumbers, grid), + showSource = showSource, designName = designName, + plotSettings = plotSettings, ... + ) + .printPlotShowSourceSeparator(showSource, typeNumber, typeNumbers) + if (length(typeNumbers) > 1) { + caption <- .getPlotCaption(x, typeNumber, stopIfNotFound = TRUE) + plotList[[caption]] <- p + } } - } - if (length(typeNumbers) == 1) { + if (length(typeNumbers) == 1) { + if (.isSpecialPlotShowSourceArgument(showSource)) { + return(invisible(p)) + } + + return(p) + } + if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(p)) + return(invisible(plotList)) } - - return(p) - } - - if (.isSpecialPlotShowSourceArgument(showSource)) { - return(invisible(plotList)) - } - - return(.createPlotResultObject(plotList, grid)) + + return(.createPlotResultObject(plotList, grid)) } #' @rdname plot.TrialDesign #' @export plot.TrialDesignCharacteristics <- function(x, y, ...) { - plot(x = x$.design, y = y, ...) + plot(x = x$.design, y = y, ...) } .plotTrialDesign <- function(..., x, y, main, - xlab, ylab, type, palette, - theta, nMax, plotPointsEnabled, + xlab, ylab, type, palette, + theta, nMax, plotPointsEnabled, legendPosition, showSource, designName, plotSettings = NULL) { - .assertGgplotIsInstalled() - - .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) - if (any(.isTrialDesignFisher(x)) && !(type %in% c(1, 3, 4))) { - stop( - C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'type' (", type, ") is not allowed for Fisher designs; must be 1, 3 or 4" - ) - } - - .warnInCaseOfUnknownArguments( - functionName = "plot", - ignore = c("xlim", "ylim", "companyAnnotationEnabled", "variedParameters"), ... - ) - - if ((type < 5 || type > 9) && !identical(theta, seq(-1, 1, 0.01))) { - warning("'theta' (", .reconstructSequenceCommand(theta), ") will be ignored for plot type ", type, call. = FALSE) - } - - if (!missing(y) && !is.null(y) && length(y) == 1 && inherits(y, "TrialDesign")) { - args <- list(...) - variedParameters <- args[["variedParameters"]] - if (is.null(variedParameters)) { - if (.isTrialDesignInverseNormalOrGroupSequential(x) && - .isTrialDesignInverseNormalOrGroupSequential(y) && - x$typeOfDesign != y$typeOfDesign) { - variedParameters <- "typeOfDesign" - } else { + .assertGgplotIsInstalled() + + .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) + if (any(.isTrialDesignFisher(x)) && !(type %in% c(1, 3, 4))) { stop( - C_EXCEPTION_TYPE_MISSING_ARGUMENT, - "'variedParameters' needs to be specified, e.g., variedParameters = \"typeOfDesign\"" + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'type' (", type, ") is not allowed for Fisher designs; must be 1, 3 or 4" ) - } } - designSet <- getDesignSet(designs = c(x, y), variedParameters = variedParameters) - } else { - designSet <- TrialDesignSet$new(design = x, singleDesign = TRUE) - if (!is.null(plotSettings)) { - designSet$.plotSettings <- plotSettings + + .warnInCaseOfUnknownArguments( + functionName = "plot", + ignore = c("xlim", "ylim", "companyAnnotationEnabled", "variedParameters"), ... + ) + + if ((type < 5 || type > 9) && !identical(theta, seq(-1, 1, 0.01))) { + warning("'theta' (", .reconstructSequenceCommand(theta), ") will be ignored for plot type ", type, call. = FALSE) } - } - - .plotTrialDesignSet( - x = designSet, y = y, main = main, xlab = xlab, ylab = ylab, type = type, - palette = palette, theta = theta, nMax = nMax, - plotPointsEnabled = plotPointsEnabled, legendPosition = legendPosition, - showSource = showSource, designSetName = designName, ... - ) + + if (!missing(y) && !is.null(y) && length(y) == 1 && inherits(y, "TrialDesign")) { + args <- list(...) + variedParameters <- args[["variedParameters"]] + if (is.null(variedParameters)) { + if (.isTrialDesignInverseNormalOrGroupSequential(x) && + .isTrialDesignInverseNormalOrGroupSequential(y) && + x$typeOfDesign != y$typeOfDesign) { + variedParameters <- "typeOfDesign" + } else { + stop( + C_EXCEPTION_TYPE_MISSING_ARGUMENT, + "'variedParameters' needs to be specified, e.g., variedParameters = \"typeOfDesign\"" + ) + } + } + designSet <- getDesignSet(designs = c(x, y), variedParameters = variedParameters) + } else { + designSet <- TrialDesignSet$new(design = x, singleDesign = TRUE) + if (!is.null(plotSettings)) { + designSet$.plotSettings <- plotSettings + } + } + + .plotTrialDesignSet( + x = designSet, y = y, main = main, xlab = xlab, ylab = ylab, type = type, + palette = palette, theta = theta, nMax = nMax, + plotPointsEnabled = plotPointsEnabled, legendPosition = legendPosition, + showSource = showSource, designSetName = designName, ... + ) } #' diff --git a/R/class_design_plan.R b/R/class_design_plan.R index 936bca8c..7606a022 100644 --- a/R/class_design_plan.R +++ b/R/class_design_plan.R @@ -108,8 +108,8 @@ TrialDesignPlan <- R6::R6Class("TrialDesignPlan", .objectType = NULL, # "sampleSize" or "power" initialize = function(design, ...) { self$.design <- design - - super$initialize(...)#TODO + + super$initialize(...) # TODO self$.plotSettings <- PlotSettings$new() @@ -197,7 +197,7 @@ TrialDesignPlan <- R6::R6Class("TrialDesignPlan", self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - if (inherits(self, "TrialDesignPlanSurvival") || self$groups == 2 || self$.design$kMax > 1) {#TODO Groups???? + if (inherits(self, "TrialDesignPlanSurvival") || self$groups == 2 || self$.design$kMax > 1) { # TODO Groups???? self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled @@ -243,7 +243,7 @@ TrialDesignPlan <- R6::R6Class("TrialDesignPlan", } else { s <- paste0("unknown data class '", .getClassName(self), "'") } - return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) #TODO correct closure of s? + return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) # TODO correct closure of s? } ) ) @@ -390,8 +390,7 @@ TrialDesignPlanMeans <- R6::R6Class("TrialDesignPlanMeans", stDev = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS[["stDev"]], groups = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS[["groups"]], allocationRatioPlanned = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS[["allocationRatioPlanned"]]) { - - super$initialize(...)#TODO + super$initialize(...) # TODO self$normalApproximation <- normalApproximation self$meanRatio <- meanRatio @@ -400,7 +399,7 @@ TrialDesignPlanMeans <- R6::R6Class("TrialDesignPlanMeans", self$stDev <- stDev self$groups <- groups self$allocationRatioPlanned <- allocationRatioPlanned - + self$optimumAllocationRatio <- FALSE visibleFieldNames <- self$.getVisibleFieldNames() startIndex <- which(visibleFieldNames == "directionUpper") @@ -539,7 +538,7 @@ TrialDesignPlanRates <- R6::R6Class("TrialDesignPlanRates", pi2 = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["pi2"]], groups = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["groups"]], allocationRatioPlanned = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["allocationRatioPlanned"]]) { - super$initialize(...) #TODO + super$initialize(...) # TODO self$normalApproximation <- normalApproximation self$riskRatio <- riskRatio self$thetaH0 <- thetaH0 @@ -650,7 +649,7 @@ TrialDesignPlanRates <- R6::R6Class("TrialDesignPlanRates", #' @template field_futilityBoundsEffectScaleLower #' @template field_futilityBoundsEffectScaleUpper #' @template field_futilityBoundsPValueScale -#' +#' #' @details #' This object cannot be created directly; use \code{\link[=getSampleSizeSurvival]{getSampleSizeSurvival()}} #' with suitable arguments to create a design plan for a dataset of survival data. @@ -734,22 +733,20 @@ TrialDesignPlanSurvival <- R6::R6Class("TrialDesignPlanSurvival", futilityBoundsEffectScaleLower = NULL, futilityBoundsEffectScaleUpper = NULL, futilityBoundsPValueScale = NULL, - initialize = function(...,typeOfComputation = NULL, - thetaH0 = NULL, - allocationRatioPlanned = NULL, - accountForObservationTimes = NULL, - eventTime = NULL, - accrualTime = NULL, - accrualIntensity = NULL, - kappa = NULL, - followUpTime = NULL, - maxNumberOfSubjects = NULL, - dropoutRate1 = NULL, - dropoutRate2 = NULL, - dropoutTime = NULL, - hazardRatio = NULL) { - - + initialize = function(..., typeOfComputation = NULL, + thetaH0 = NULL, + allocationRatioPlanned = NULL, + accountForObservationTimes = NULL, + eventTime = NULL, + accrualTime = NULL, + accrualIntensity = NULL, + kappa = NULL, + followUpTime = NULL, + maxNumberOfSubjects = NULL, + dropoutRate1 = NULL, + dropoutRate2 = NULL, + dropoutTime = NULL, + hazardRatio = NULL) { self$typeOfComputation <- typeOfComputation self$thetaH0 <- thetaH0 self$allocationRatioPlanned <- allocationRatioPlanned @@ -764,7 +761,7 @@ TrialDesignPlanSurvival <- R6::R6Class("TrialDesignPlanSurvival", self$dropoutRate2 <- dropoutRate2 self$dropoutTime <- dropoutTime self$hazardRatio <- hazardRatio - + super$initialize(...) self$optimumAllocationRatio <- FALSE diff --git a/R/class_design_power_and_asn.R b/R/class_design_power_and_asn.R index f8837b21..bf52baa1 100644 --- a/R/class_design_power_and_asn.R +++ b/R/class_design_power_and_asn.R @@ -66,11 +66,11 @@ PowerAndAverageSampleNumberResult <- R6::R6Class("PowerAndAverageSampleNumberRes futilityPerStage = NULL, initialize = function(design, theta = seq(-1, 1, 0.05), nMax = 100L, ...) { super$initialize(...) - + self$.design <- design self$theta <- theta self$nMax <- nMax - + self$theta <- .assertIsValidThetaRange(thetaRange = theta, thetaAutoSeqEnabled = FALSE) self$.initPowerAndAverageSampleNumber() }, diff --git a/R/class_design_set.R b/R/class_design_set.R index 6295becc..9a038c50 100644 --- a/R/class_design_set.R +++ b/R/class_design_set.R @@ -599,11 +599,13 @@ length.TrialDesignSet <- function(x) { colNames1 <- colnames(df1) colNames2 <- colnames(df2) if (length(colNames1) != length(colNames2)) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, "cannot harmonize column names of two data frames if number of columns is unequal (", - length(colNames1), " != ", length(colNames2), ")") + length(colNames1), " != ", length(colNames2), ")" + ) } - + colNames <- character() for (i in 1:length(colNames1)) { colName1 <- colNames1[i] @@ -624,12 +626,10 @@ length.TrialDesignSet <- function(x) { if (at == 1) { colNames <- c(colName, colNames) df <- cbind(naCol, df) - } - else if (at <= length(colNames)) { + } else if (at <= length(colNames)) { colNames <- c(colNames[1:(at - 1)], colName, colNames[at:length(colNames)]) df <- cbind(df[, 1:(at - 1)], naCol, df[, at:ncol(df)]) - } - else { + } else { colNames <- c(colNames, colName) df <- cbind(df, naCol) } @@ -641,7 +641,7 @@ length.TrialDesignSet <- function(x) { if (ncol(df1) == ncol(df2)) { return(list(df1 = df1, df2 = df2)) } - + colNames1 <- colnames(df1) colNames2 <- colnames(df2) difference <- c(colNames1[!(colNames1 %in% colNames2)], colNames2[!(colNames2 %in% colNames1)]) @@ -688,13 +688,13 @@ length.TrialDesignSet <- function(x) { #' #' @keywords internal #' -as.data.frame.TrialDesignSet <- function(x, +as.data.frame.TrialDesignSet <- function(x, row.names = NULL, - optional = FALSE, - niceColumnNamesEnabled = FALSE, + optional = FALSE, + niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, - addPowerAndAverageSampleNumber = FALSE, - theta = seq(-1, 1, 0.02), + addPowerAndAverageSampleNumber = FALSE, + theta = seq(-1, 1, 0.02), nMax = NA_integer_, ...) { .assertIsTrialDesignSet(x) if (x$isEmpty()) { @@ -725,7 +725,7 @@ as.data.frame.TrialDesignSet <- function(x, niceColumnNamesEnabled = niceColumnNamesEnabled, includeAllParameters = includeAllParameters )) - + if (.isTrialDesignWithValidFutilityBounds(design)) { futilityBoundsName <- "futilityBounds" if (niceColumnNamesEnabled) { @@ -744,16 +744,16 @@ as.data.frame.TrialDesignSet <- function(x, kMax <- design$kMax df[[alpha0VecName]][kMax] <- design$criticalValues[kMax] } - + if (addPowerAndAverageSampleNumber) { results <- PowerAndAverageSampleNumberResult$new(design, theta = theta, nMax = nMax) suppressWarnings(df2 <- as.data.frame(results, niceColumnNamesEnabled = niceColumnNamesEnabled, - includeAllParameters = FALSE #includeAllParameters + includeAllParameters = FALSE # includeAllParameters )) df <- merge(df, df2, all.y = TRUE) } - + if (is.null(dataFrame)) { if (niceColumnNamesEnabled) { dataFrame <- cbind("Design number" = rep(1, nrow(df)), df) @@ -766,15 +766,15 @@ as.data.frame.TrialDesignSet <- function(x, } else { df <- cbind(designNumber = rep(max(dataFrame$designNumber) + 1, nrow(df)), df) } - + result <- .getHarmonizedDataFrames(dataFrame, df) dataFrame <- result$df1 df <- result$df2 - + colNames <- .getHarmonizedColumnNames(dataFrame, df) colnames(dataFrame) <- colNames colnames(df) <- colNames - + dataFrame <- rbind(dataFrame, df) } } @@ -882,7 +882,7 @@ plot.TrialDesignSet <- function(x, y, ..., type = 1L, main = NA_character_, legendPosition = NA_integer_, showSource = FALSE, designSetName = NA_character_, plotSettings = NULL) { .assertGgplotIsInstalled() - if (!is.call(main) && !isS4(main) && !R6::is.R6(main)) { #TODO is.R6 added + if (!is.call(main) && !isS4(main) && !R6::is.R6(main)) { # TODO is.R6 added .assertIsSingleCharacter(main, "main", naAllowed = TRUE) } .assertIsSingleCharacter(xlab, "xlab", naAllowed = TRUE) diff --git a/R/class_dictionary.R b/R/class_dictionary.R index f5ff8485..eed9d022 100644 --- a/R/class_dictionary.R +++ b/R/class_dictionary.R @@ -43,13 +43,13 @@ createDictionary <- function(name, keyValuePairList = NULL) { } } -#' -#' @examples +#' +#' @examples #' x <- createDictionary("x", list(a = 1, b = 2, c = 3)) #' getDictionaryKeyByValue(x, 2) -#' -#' @noRd -#' +#' +#' @noRd +#' getDictionaryKeyByValue <- function(x, value) { .assertIsDictionary(x) keys <- names(x) @@ -57,13 +57,13 @@ getDictionaryKeyByValue <- function(x, value) { return(unique(keys[values == value])) } -#' -#' @examples +#' +#' @examples #' x <- createDictionary("x", list(a = 1, b = 2, c = 3)) #' getDictionarySubset(x, c("b", "c")) -#' -#' @noRd -#' +#' +#' @noRd +#' getDictionarySubset <- function(x, subsetNames) { .assertIsDictionary(x) result <- createDictionary(attr(x, "name")) @@ -85,8 +85,8 @@ cloneDictionary <- function(x) { } #' -#' @export -#' @noRd +#' @export +#' @noRd #' as.vector.Dictionary <- function(x, ...) { .assertIsDictionary(x) @@ -98,8 +98,8 @@ as.vector.Dictionary <- function(x, ...) { } #' -#' @export -#' @noRd +#' @export +#' @noRd #' as.list.Dictionary <- function(x, ...) { .assertIsDictionary(x) @@ -111,8 +111,8 @@ as.list.Dictionary <- function(x, ...) { } #' -#' @export -#' @noRd +#' @export +#' @noRd #' print.Dictionary <- function(x, ...) { .assertIsDictionary(x) @@ -133,7 +133,7 @@ initDictionary <- function(x, keyValuePairList) { if (any(names(keyValuePairList) == "")) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'keyValuePairList' must be a named list") } - + for (key in names(keyValuePairList)) { value <- keyValuePairList[[key]] addValueToDictionary(x, key, value) diff --git a/R/class_event_probabilities.R b/R/class_event_probabilities.R index 96710727..174ffa41 100644 --- a/R/class_event_probabilities.R +++ b/R/class_event_probabilities.R @@ -80,20 +80,20 @@ EventProbabilities <- R6::R6Class("EventProbabilities", eventProbabilities1 = NULL, eventProbabilities2 = NULL, initialize = function(..., .piecewiseSurvivalTime = NULL, - .accrualTime = NULL, - time = NULL, - accrualTime = NULL, - accrualIntensity = NULL, - kappa = NULL, - piecewiseSurvivalTime = NULL, - lambda1 = NULL, - lambda2 = NULL, - allocationRatioPlanned = NULL, - hazardRatio = NULL, - dropoutRate1 = NULL, - dropoutRate2 = NULL, - dropoutTime = NULL, - maxNumberOfSubjects = NULL) { + .accrualTime = NULL, + time = NULL, + accrualTime = NULL, + accrualIntensity = NULL, + kappa = NULL, + piecewiseSurvivalTime = NULL, + lambda1 = NULL, + lambda2 = NULL, + allocationRatioPlanned = NULL, + hazardRatio = NULL, + dropoutRate1 = NULL, + dropoutRate2 = NULL, + dropoutTime = NULL, + maxNumberOfSubjects = NULL) { self$.piecewiseSurvivalTime <- .piecewiseSurvivalTime self$.accrualTime <- .accrualTime self$time <- time @@ -109,9 +109,9 @@ EventProbabilities <- R6::R6Class("EventProbabilities", self$dropoutRate2 <- dropoutRate2 self$dropoutTime <- dropoutTime self$maxNumberOfSubjects <- maxNumberOfSubjects - + super$initialize() - + self$.plotSettings <- PlotSettings$new() self$.setParameterType("overallEventProbabilities", C_PARAM_NOT_APPLICABLE) # deprecated }, @@ -190,20 +190,20 @@ NumberOfSubjects <- R6::R6Class("NumberOfSubjects", maxNumberOfSubjects = NULL, numberOfSubjects = NULL, initialize = function(..., accrualSetup = NULL, - time = NULL, - accrualTime = NULL, - accrualIntensity = NULL, - maxNumberOfSubjects = NULL, - numberOfSubjects = NULL) { + time = NULL, + accrualTime = NULL, + accrualIntensity = NULL, + maxNumberOfSubjects = NULL, + numberOfSubjects = NULL) { self$.accrualTime <- accrualSetup self$time <- time self$accrualTime <- accrualTime self$accrualIntensity <- accrualIntensity self$maxNumberOfSubjects <- maxNumberOfSubjects self$numberOfSubjects <- numberOfSubjects - + super$initialize() - + self$.plotSettings <- PlotSettings$new() }, getPlotSettings = function() { diff --git a/R/class_simulation_results.R b/R/class_simulation_results.R index 1aa970b2..70f9cb02 100644 --- a/R/class_simulation_results.R +++ b/R/class_simulation_results.R @@ -563,14 +563,14 @@ SimulationResults <- R6::R6Class("SimulationResults", SimulationResultsBaseMeans <- R6::R6Class("SimulationResultsBaseMeans", inherit = SimulationResults, public = list( - stDev =NULL, - plannedSubjects =NULL, - minNumberOfSubjectsPerStage =NULL, - maxNumberOfSubjectsPerStage =NULL, - thetaH1 =NULL, - stDevH1 =NULL, - calcSubjectsFunction =NULL, - expectedNumberOfSubjects =NULL, + stDev = NULL, + plannedSubjects = NULL, + minNumberOfSubjectsPerStage = NULL, + maxNumberOfSubjectsPerStage = NULL, + thetaH1 = NULL, + stDevH1 = NULL, + calcSubjectsFunction = NULL, + expectedNumberOfSubjects = NULL, initialize = function(design, ...) { super$initialize(design = design, ...) generatedParams <- c( @@ -653,18 +653,18 @@ SimulationResultsBaseMeans <- R6::R6Class("SimulationResultsBaseMeans", SimulationResultsMeans <- R6::R6Class("SimulationResultsMeans", inherit = SimulationResultsBaseMeans, public = list( - meanRatio =NULL, - thetaH0 =NULL, - normalApproximation =NULL, - alternative =NULL, - groups =NULL, - directionUpper =NULL, - effect =NULL, - earlyStop =NULL, - sampleSizes =NULL, - overallReject =NULL, # = rejectedArmsPerStage in multi-arm - rejectPerStage =NULL, - conditionalPowerAchieved =NULL, + meanRatio = NULL, + thetaH0 = NULL, + normalApproximation = NULL, + alternative = NULL, + groups = NULL, + directionUpper = NULL, + effect = NULL, + earlyStop = NULL, + sampleSizes = NULL, + overallReject = NULL, # = rejectedArmsPerStage in multi-arm + rejectPerStage = NULL, + conditionalPowerAchieved = NULL, initialize = function(design, ...) { super$initialize(design = design, ...) } @@ -873,7 +873,7 @@ SimulationResultsRates <- R6::R6Class("SimulationResultsRates", pi1 = NULL, pi2 = NULL, groups = NULL, - #directionUpper = NULL, + # directionUpper = NULL, pi1H1 = NULL, pi2H1 = NULL, effect = NULL, @@ -1026,7 +1026,7 @@ SimulationResultsBaseSurvival <- R6::R6Class("SimulationResultsBaseSurvival", thetaH1 = NULL, calcEventsFunction = NULL, expectedNumberOfEvents = NULL, - #conditionalPowerAchieved = matrix(), #TODO remove? + # conditionalPowerAchieved = matrix(), #TODO remove? initialize = function(design, ...) { super$initialize(design = design, ...) generatedParams <- c( @@ -1181,8 +1181,10 @@ SimulationResultsSurvival <- R6::R6Class("SimulationResultsSurvival", "allocationRatioPlanned" ) if (inherits(self, "SimulationResultsMultiArmSurvival")) { - generatedParams <- c(generatedParams, - "cumulativeEventsPerStage", "singleEventsPerArmAndStage") + generatedParams <- c( + generatedParams, + "cumulativeEventsPerStage", "singleEventsPerArmAndStage" + ) } else { generatedParams <- c(generatedParams, "singleEventsPerSubsetAndStage") } @@ -1290,7 +1292,7 @@ SimulationResultsMultiArmSurvival <- R6::R6Class("SimulationResultsMultiArmSurvi successPerStage = NULL, eventsPerStage = NULL, singleEventsPerStage = NULL, - cumulativeEventsPerStage = NULL, + cumulativeEventsPerStage = NULL, singleEventsPerArmAndStage = NULL, singleNumberOfEventsPerStage = NULL, conditionalPowerAchieved = matrix(), diff --git a/R/class_summary.R b/R/class_summary.R index 1dfbc950..a3353c83 100644 --- a/R/class_summary.R +++ b/R/class_summary.R @@ -31,7 +31,7 @@ SummaryItem <- R6::R6Class("SummaryItem", initialize = function(title = NA_character_, values = NA_character_, ...) { self$title <- title self$values <- values - #callSuper(...) TODO LEGENDENTRyy + # callSuper(...) TODO LEGENDENTRyy if (!is.null(self$legendEntry) && length(self$legendEntry) > 0) { if (is.null(names(self$legendEntry))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("legendEntry"), " must be a named list") @@ -188,7 +188,7 @@ SummaryFactory <- R6::R6Class("SummaryFactory", justify = NULL, output = NULL, initialize = function(..., intervalFormat = "[%s; %s]", output = "all") { - #callSuper(...) TODO + # callSuper(...) TODO self$intervalFormat <- intervalFormat self$output <- output self$summaryItems <- list() @@ -629,7 +629,7 @@ SummaryFactory <- R6::R6Class("SummaryFactory", } if (is.null(variedParameter) || length(variedParameter) == 0 || variedParameter == "") { if (.getLogicalEnvironmentVariable("RPACT_DEVELOPMENT_MODE")) { - warning( + warning( "Failed to get varied parameter from ", .getClassName(parameterSet), " (", length(parameterNames), " parameter names; numberOfVariants: ", numberOfVariants, ")" ) @@ -638,7 +638,9 @@ SummaryFactory <- R6::R6Class("SummaryFactory", } variedParameterCaption <- parameterSet$.getDataFrameColumnCaption( - variedParameter, niceColumnNamesEnabled = TRUE) + variedParameter, + niceColumnNamesEnabled = TRUE + ) variedParameterCaption <- tolower(variedParameterCaption) if (variedParameterCaption == "alternative" || variedParameterCaption == ".alternative") { @@ -770,7 +772,7 @@ SummaryFactory <- R6::R6Class("SummaryFactory", if (length(values) == 0 || nrow(values) == 0 || ncol(values) == 0) { return("") } - + if (nrow(values) == 1 && ncol(values) == 1) { colValues <- values[1, 1] } else if (ncol(values) == 1) { @@ -3171,7 +3173,7 @@ SummaryFactory <- R6::R6Class("SummaryFactory", parameterName <- "singleEventsPerSubsetAndStage" parameterCaption <- "Single number of events" } else { - parameterName <- "cumulativeEventsPerStage" + parameterName <- "cumulativeEventsPerStage" parameterCaption <- "Cumulative number of events" } } else { @@ -3324,8 +3326,8 @@ SummaryFactory <- R6::R6Class("SummaryFactory", ) } - if (countDataEnabled && design$kMax > 1 && - !is.null(designPlan[["maxNumberOfSubjects"]]) && + if (countDataEnabled && design$kMax > 1 && + !is.null(designPlan[["maxNumberOfSubjects"]]) && designPlan$.getParameterType("maxNumberOfSubjects") == C_PARAM_GENERATED) { summaryFactory$addParameter(designPlan, parameterName = "maxNumberOfSubjects", diff --git a/R/class_time.R b/R/class_time.R index eb3162d7..8c76d40d 100644 --- a/R/class_time.R +++ b/R/class_time.R @@ -632,8 +632,8 @@ PiecewiseSurvivalTime <- R6::R6Class("PiecewiseSurvivalTime", colnames(data) <- c( "Start time", .getParameterCaption("lambda1", tableOutputEnabled = TRUE), - .getParameterCaption("lambda2", tableOutputEnabled = TRUE) - ) + .getParameterCaption("lambda2", tableOutputEnabled = TRUE) + ) return(data) }, .isPiBased = function() { @@ -1107,7 +1107,7 @@ PiecewiseSurvivalTime <- R6::R6Class("PiecewiseSurvivalTime", } } else { if (length(self$lambda1) > 0 && !all(is.na(self$lambda1)) && self$.getParameterType("median1") != C_PARAM_USER_DEFINED) { - self$median1 <- getMedianByLambda(self$lambda1, kappa =self$kappa) + self$median1 <- getMedianByLambda(self$lambda1, kappa = self$kappa) self$.setParameterType("median1", C_PARAM_GENERATED) } if (length(self$lambda2) == 1 && !is.na(self$lambda2) && self$.getParameterType("median2") != C_PARAM_USER_DEFINED) { @@ -1409,7 +1409,7 @@ AccrualTime <- R6::R6Class("AccrualTime", self$.initAccrualIntensityAbsolute() self$.validateFormula() - self$.showWarningIfCaseIsNotAllowed()#TODO wrong naming upstream! + self$.showWarningIfCaseIsNotAllowed() # TODO wrong naming upstream! }, .asDataFrame = function() { accrualIntensityTemp <- self$accrualIntensity diff --git a/R/f_analysis_base.R b/R/f_analysis_base.R index 985bee00..3eca7fdd 100644 --- a/R/f_analysis_base.R +++ b/R/f_analysis_base.R @@ -50,7 +50,7 @@ NULL return(list( design = design, - dataInput = dataInput$clone(deep=TRUE)#TODO was $copy shallow + dataInput = dataInput$clone(deep = TRUE) # TODO was $copy shallow )) } diff --git a/R/f_analysis_base_rates.R b/R/f_analysis_base_rates.R index 7c244d31..225b2c5f 100644 --- a/R/f_analysis_base_rates.R +++ b/R/f_analysis_base_rates.R @@ -76,7 +76,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsInverseNormal$new(design = design, dataInput = dataInput)#R6$new + results <- AnalysisResultsInverseNormal$new(design = design, dataInput = dataInput) # R6$new .getAnalysisResultsRatesAll( results = results, design = design, dataInput = dataInput, @@ -105,7 +105,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsGroupSequential$new(design = design, dataInput = dataInput)#R6$new + results <- AnalysisResultsGroupSequential$new(design = design, dataInput = dataInput) # R6$new .getAnalysisResultsRatesAll( results = results, design = design, dataInput = dataInput, @@ -136,7 +136,7 @@ NULL ), "stage"), ... ) - results <- AnalysisResultsFisher$new(design = design, dataInput = dataInput)#R6$new + results <- AnalysisResultsFisher$new(design = design, dataInput = dataInput) # R6$new .setValueAndParameterType(results, "iterations", as.integer(iterations), C_ITERATIONS_DEFAULT) .setValueAndParameterType(results, "seed", seed, NA_real_) @@ -570,7 +570,7 @@ NULL direction <- ifelse(directionUpper, C_DIRECTION_UPPER, C_DIRECTION_LOWER) - stageResults <- StageResultsRates$new(#R6$new + stageResults <- StageResultsRates$new( # R6$new design = design, dataInput = dataInput, stage = as.integer(stage), @@ -1102,7 +1102,7 @@ NULL pi2 <- .assertIsValidPi2(pi2, stageResults, stage) } - results <- ConditionalPowerResultsRates$new(#R6$new + results <- ConditionalPowerResultsRates$new( # R6$new .stageResults = stageResults, .design = stageResults$.design, nPlanned = nPlanned, allocationRatioPlanned = allocationRatioPlanned, pi1 = pi1, pi2 = pi2 diff --git a/R/f_analysis_multiarm.R b/R/f_analysis_multiarm.R index 401cdca2..3769bdd0 100644 --- a/R/f_analysis_multiarm.R +++ b/R/f_analysis_multiarm.R @@ -30,8 +30,7 @@ NULL #' #' @noRd #' -.getAnalysisResultsMultiArm <- function( - design, dataInput, ..., +.getAnalysisResultsMultiArm <- function(design, dataInput, ..., intersectionTest = C_INTERSECTION_TEST_MULTIARMED_DEFAULT, directionUpper = C_DIRECTION_UPPER_DEFAULT, thetaH0 = NA_real_, @@ -156,8 +155,7 @@ NULL #' #' @noRd #' -.getConditionalPowerMultiArm <- function( - ..., stageResults, nPlanned, +.getConditionalPowerMultiArm <- function(..., stageResults, nPlanned, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT) { .assertIsStageResults(stageResults) @@ -212,8 +210,7 @@ NULL } -.performClosedCombinationTest <- function( - ..., stageResults, design = stageResults$.design, +.performClosedCombinationTest <- function(..., stageResults, design = stageResults$.design, intersectionTest = stageResults$intersectionTest) { dataInput <- stageResults$.dataInput stage <- stageResults$stage @@ -696,8 +693,7 @@ getClosedConditionalDunnettTestResults <- function(stageResults, ..., stage = st )) } -.getClosedConditionalDunnettTestResults <- function( - ..., +.getClosedConditionalDunnettTestResults <- function(..., stageResults, design = stageResults$.design, stage = stageResults$stage) { @@ -758,73 +754,77 @@ getClosedConditionalDunnettTestResults <- function(stageResults, ..., stage = st } for (i in 1:(2^gMax - 1)) { - tryCatch({ - - zeta <- sqrt(frac1[indices[i, ] == 1]) - sigma <- zeta %*% t(zeta) - diag(sigma) <- 1 - crit <- .getMultivariateDistribution( - type = "quantile", - upper = NA_real_, sigma = sigma, alpha = alpha - ) - - integrandFunction <- function(x) { - innerProduct <- 1 - for (g in (1:gMax)) { - if (indices[i, g] == 1) { - innerProduct <- innerProduct * stats::pnorm(((crit - - sqrt(informationAtInterim) * signedTestStatistics[g, 1] + - sqrt(1 - informationAtInterim) * sqrt(frac1[g]) * x)) / - sqrt((1 - informationAtInterim) * (1 - frac1[g]))) + tryCatch( + { + zeta <- sqrt(frac1[indices[i, ] == 1]) + sigma <- zeta %*% t(zeta) + diag(sigma) <- 1 + crit <- .getMultivariateDistribution( + type = "quantile", + upper = NA_real_, sigma = sigma, alpha = alpha + ) + + integrandFunction <- function(x) { + innerProduct <- 1 + for (g in (1:gMax)) { + if (indices[i, g] == 1) { + innerProduct <- innerProduct * stats::pnorm(((crit - + sqrt(informationAtInterim) * signedTestStatistics[g, 1] + + sqrt(1 - informationAtInterim) * sqrt(frac1[g]) * x)) / + sqrt((1 - informationAtInterim) * (1 - frac1[g]))) + } } + return(innerProduct * dnorm(x)) } - return(innerProduct * dnorm(x)) + conditionalErrorRate[i, 1] <- 1 - stats::integrate(integrandFunction, lower = -Inf, upper = Inf)$value + }, + error = function(e) { + warning("Failed to calculate conditionalErrorRate[", i, ", 1]: ", e$message) } - conditionalErrorRate[i, 1] <- 1 - stats::integrate(integrandFunction, lower = -Inf, upper = Inf)$value - - }, error = function(e) { - warning("Failed to calculate conditionalErrorRate[", i, ", 1]: ", e$message) - }) - - tryCatch({ - if (stage == 2) { - if (!all(is.na(stageResults$separatePValues[indices[i, ] == 1, 2]))) { - if (secondStageConditioning) { - maxOverallTestStatistic <- max( - signedOverallTestStatistics[indices[i, ] == 1, 2], - na.rm = TRUE - ) - integrandFunctionStage2 <- function(x) { - innerProduct <- 1 - for (g in (1:gMax)) { - if ((indices[i, g] == 1) && !is.na(stageResults$overallTestStatistics[g, 2])) { - innerProduct <- innerProduct * stats::pnorm(((maxOverallTestStatistic - - sqrt(informationAtInterim) * signedTestStatistics[g, 1] + - sqrt(1 - informationAtInterim) * sqrt(frac2[g]) * x)) / - sqrt((1 - informationAtInterim) * (1 - frac2[g]))) + ) + + tryCatch( + { + if (stage == 2) { + if (!all(is.na(stageResults$separatePValues[indices[i, ] == 1, 2]))) { + if (secondStageConditioning) { + maxOverallTestStatistic <- max( + signedOverallTestStatistics[indices[i, ] == 1, 2], + na.rm = TRUE + ) + integrandFunctionStage2 <- function(x) { + innerProduct <- 1 + for (g in (1:gMax)) { + if ((indices[i, g] == 1) && !is.na(stageResults$overallTestStatistics[g, 2])) { + innerProduct <- innerProduct * stats::pnorm(((maxOverallTestStatistic - + sqrt(informationAtInterim) * signedTestStatistics[g, 1] + + sqrt(1 - informationAtInterim) * sqrt(frac2[g]) * x)) / + sqrt((1 - informationAtInterim) * (1 - frac2[g]))) + } } + return(innerProduct * dnorm(x)) } - return(innerProduct * dnorm(x)) - } - } else { - maxTestStatistic <- max(signedTestStatistics[indices[i, ] == 1, 2], na.rm = TRUE) - integrandFunctionStage2 <- function(x) { - innerProduct <- 1 - for (g in (1:gMax)) { - if ((indices[i, g] == 1) && !is.na(stageResults$separatePValues[g, 2])) { - innerProduct <- innerProduct * - stats::pnorm(((maxTestStatistic + sqrt(frac2[g]) * x)) / sqrt(1 - frac2[g])) + } else { + maxTestStatistic <- max(signedTestStatistics[indices[i, ] == 1, 2], na.rm = TRUE) + integrandFunctionStage2 <- function(x) { + innerProduct <- 1 + for (g in (1:gMax)) { + if ((indices[i, g] == 1) && !is.na(stageResults$separatePValues[g, 2])) { + innerProduct <- innerProduct * + stats::pnorm(((maxTestStatistic + sqrt(frac2[g]) * x)) / sqrt(1 - frac2[g])) + } } + return(innerProduct * dnorm(x)) } - return(innerProduct * dnorm(x)) } + secondStagePValues[i, 2] <- 1 - stats::integrate(integrandFunctionStage2, lower = -Inf, upper = Inf)$value } - secondStagePValues[i, 2] <- 1 - stats::integrate(integrandFunctionStage2, lower = -Inf, upper = Inf)$value } + }, + error = function(e) { + warning("Failed to calculate secondStagePValues[", i, ", 2]: ", e$message) } - }, error = function(e) { - warning("Failed to calculate secondStagePValues[", i, ", 2]: ", e$message) - }) + ) } if (stage == 2) { @@ -948,8 +948,7 @@ getClosedConditionalDunnettTestResults <- function(stageResults, ..., stage = st #' #' @noRd #' -.getConditionalRejectionProbabilitiesMultiArm <- function( - stageResults, ..., +.getConditionalRejectionProbabilitiesMultiArm <- function(stageResults, ..., stage = stageResults$stage, iterations = C_ITERATIONS_DEFAULT, seed = NA_real_) { .assertIsValidStage(stage, stageResults$.design$kMax) gMax <- stageResults$getGMax() @@ -1152,8 +1151,7 @@ getClosedConditionalDunnettTestResults <- function(stageResults, ..., stage = st #' #' @noRd #' -.getConditionalPowerPlotMultiArm <- function( - stageResults, ..., +.getConditionalPowerPlotMultiArm <- function(stageResults, ..., nPlanned, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, thetaRange = NA_real_, assumedStDevs = NA_real_, piTreatmentRange = NA_real_, piControl = NA_real_, diff --git a/R/f_analysis_utilities.R b/R/f_analysis_utilities.R index 2ad07268..c47aae38 100644 --- a/R/f_analysis_utilities.R +++ b/R/f_analysis_utilities.R @@ -1240,4 +1240,3 @@ getObservedInformationRates <- function(dataInput, ..., return(invisible(results)) } - diff --git a/R/f_as251.R b/R/f_as251.R index 410684b9..3f868ae5 100644 --- a/R/f_as251.R +++ b/R/f_as251.R @@ -103,8 +103,7 @@ mvnprd <- function(..., A, B, BPD, EPS = 1e-06, INF, IERC = 1, HINC = 0) { #' #' @export #' -as251Normal <- function( - lower, upper, sigma, ..., +as251Normal <- function(lower, upper, sigma, ..., eps = 1e-06, errorControl = c("strict", "halvingIntervals"), intervalSimpsonsRule = 0) { @@ -224,8 +223,7 @@ mvstud <- function(..., NDF, A, B, BPD, D, EPS = 1e-06, INF, IERC = 1, HINC = 0) #' #' @export #' -as251StudentT <- function( - lower, upper, sigma, ..., +as251StudentT <- function(lower, upper, sigma, ..., df, eps = 1e-06, errorControl = c("strict", "halvingIntervals"), diff --git a/R/f_core_assertions.R b/R/f_core_assertions.R index 04539dd4..0816d8f4 100644 --- a/R/f_core_assertions.R +++ b/R/f_core_assertions.R @@ -780,29 +780,28 @@ NULL } .showParameterOutOfValidatedBoundsMessage <- function( - parameterValue, - parameterName, ..., - lowerBound = NA_real_, - upperBound = NA_real_, - spendingFunctionName = NA_character_, - closedLowerBound = TRUE, - closedUpperBound = TRUE, - suffix = NA_character_) { - + parameterValue, + parameterName, ..., + lowerBound = NA_real_, + upperBound = NA_real_, + spendingFunctionName = NA_character_, + closedLowerBound = TRUE, + closedUpperBound = TRUE, + suffix = NA_character_) { .assertIsSingleNumber(lowerBound, "lowerBound", naAllowed = TRUE) .assertIsSingleNumber(upperBound, "upperBound", naAllowed = TRUE) if (is.na(lowerBound) && is.na(upperBound)) { stop(C_EXCEPTION_TYPE_MISSING_ARGUMENT, "'lowerBound' or 'upperBound' must be defined") } - + if (is.na(lowerBound)) { lowerBound <- -Inf } - + if (is.na(upperBound)) { upperBound <- Inf } - + if (closedLowerBound) { bracketLowerBound <- "[" conditionLowerBound <- parameterValue < lowerBound @@ -817,43 +816,46 @@ NULL bracketUpperBound <- ")" conditionUpperBound <- parameterValue >= upperBound } - + if (conditionLowerBound || conditionUpperBound) { if (!is.null(spendingFunctionName) && !is.na(spendingFunctionName)) { spendingFunctionName <- paste0("for ", spendingFunctionName, " function ") } else { spendingFunctionName <- "" } - + if (is.na(suffix)) { suffix <- "" } else { suffix <- paste0(" ", trimws(suffix)) } - + type <- getOption("rpact.out.of.validated.bounds.message.type", "warning") if (identical(type, "warning")) { - warning("The parameter ", sQuote(parameterName), " (", parameterValue, ") ", - spendingFunctionName, "is out of validated bounds ", - bracketLowerBound, lowerBound, "; ", upperBound, bracketUpperBound, suffix, call. = FALSE) - } - else if (identical(type, "message")) { - message("Note that parameter ", sQuote(parameterName), " (", parameterValue, ") ", - spendingFunctionName, "is out of validated bounds ", - bracketLowerBound, lowerBound, "; ", upperBound, bracketUpperBound, suffix) - } + warning("The parameter ", sQuote(parameterName), " (", parameterValue, ") ", + spendingFunctionName, "is out of validated bounds ", + bracketLowerBound, lowerBound, "; ", upperBound, bracketUpperBound, suffix, + call. = FALSE + ) + } else if (identical(type, "message")) { + message( + "Note that parameter ", sQuote(parameterName), " (", parameterValue, ") ", + spendingFunctionName, "is out of validated bounds ", + bracketLowerBound, lowerBound, "; ", upperBound, bracketUpperBound, suffix + ) + } } } .assertIsValidAlpha <- function(alpha) { .assertIsSingleNumber(alpha, "alpha") - .assertIsInOpenInterval(alpha, "alpha", lower = 0, upper = NULL) + .assertIsInOpenInterval(alpha, "alpha", lower = 0, upper = NULL) .showParameterOutOfValidatedBoundsMessage(alpha, "alpha", lowerBound = 1e-06, upperBound = 0.5, closedUpperBound = FALSE) } .assertIsValidKappa <- function(kappa) { .assertIsSingleNumber(kappa, "kappa") - .assertIsInOpenInterval(kappa, "kappa", lower = 0, upper = NULL) + .assertIsInOpenInterval(kappa, "kappa", lower = 0, upper = NULL) } .assertIsValidLambda <- function(lambda, lambdaNumber = 0) { @@ -922,10 +924,12 @@ NULL .assertIsValidBeta <- function(beta, alpha) { .assertIsSingleNumber(beta, "beta") .assertIsSingleNumber(alpha, "alpha") - .assertIsInOpenInterval(beta, "beta", lower = 0, upper = NULL) - .showParameterOutOfValidatedBoundsMessage(beta, "beta", lowerBound = 1e-04, - upperBound = 1 - alpha, closedUpperBound = FALSE, - suffix = "condition: 1e-06 <= alpha < 1 - beta <= 1 - 1e-04") + .assertIsInOpenInterval(beta, "beta", lower = 0, upper = NULL) + .showParameterOutOfValidatedBoundsMessage(beta, "beta", + lowerBound = 1e-04, + upperBound = 1 - alpha, closedUpperBound = FALSE, + suffix = "condition: 1e-06 <= alpha < 1 - beta <= 1 - 1e-04" + ) } .assertIsValidAlphaAndBeta <- function(alpha, beta) { diff --git a/R/f_core_constants.R b/R/f_core_constants.R index b26e1585..c6b9a889 100644 --- a/R/f_core_constants.R +++ b/R/f_core_constants.R @@ -913,7 +913,7 @@ C_TABLE_COLUMN_NAMES <- createDictionary("C_TABLE_COLUMN_NAMES", list( piecewiseSurvivalEnabled = "Piecewise exponential survival enabled", median1 = "median(1)", median2 = "median(2)", - eventsPerStage = "Events per stage", + eventsPerStage = "Events per stage", cumulativeEventsPerStage = "Cumulative events", expectedNumberOfEvents = "Expected events", expectedNumberOfSubjects = "Expected subjects", @@ -1071,7 +1071,7 @@ C_PARAMETER_NAMES_PLOT_SETTINGS <- createDictionary("C_PARAMETER_NAMES_PLOT_SETT } if (identical(parameterName, "eventsPerStage") && - (inherits(obj, "TrialDesignPlanSurvival") || + (inherits(obj, "TrialDesignPlanSurvival") || inherits(obj, "SimulationResultsMultiArmSurvival"))) { return(ifelse(tableOutputEnabled, "Cumulative events", "Cumulative events per stage")) } @@ -1136,7 +1136,7 @@ C_PARAMETER_NAMES_PLOT_SETTINGS <- createDictionary("C_PARAMETER_NAMES_PLOT_SETT if (identical(parameterName, "overallStDevs") && ((inherits(obj, "StageResults") && obj$isOneSampleDataset()) || - inherits(obj, "DatasetMeans"))) { + inherits(obj, "DatasetMeans"))) { return(paste0("Cumulative standard deviation", ifelse(tableOutputEnabled, "", "s"))) } diff --git a/R/f_core_output_formats.R b/R/f_core_output_formats.R index 126436d8..61808760 100644 --- a/R/f_core_output_formats.R +++ b/R/f_core_output_formats.R @@ -1205,11 +1205,11 @@ getOutputFormat <- function(parameterName = NA_character_, ..., if (is.null(fieldName) || length(fieldName) != 1 || is.na(fieldName)) { return(NULL) } - + if (!(fieldName %in% names(C_PARAMETER_FORMAT_FUNCTIONS))) { return(NULL) } - + functionName <- C_PARAMETER_FORMAT_FUNCTIONS[[fieldName]] if (is.null(functionName)) { return(NULL) diff --git a/R/f_core_plot.R b/R/f_core_plot.R index ffce1d72..0a633de2 100644 --- a/R/f_core_plot.R +++ b/R/f_core_plot.R @@ -533,7 +533,7 @@ getAvailablePlotTypes <- function(obj, output = c("numeric", "caption", "numcap" if (length(variedParameter) != 2) { return("") } - + return(paste0( "Note: interim values between ", round(variedParameter[1], 4), " and ", round(variedParameter[2], 4), " were calculated to get smoother lines; use, e.g., '", @@ -736,7 +736,7 @@ getAvailablePlotTypes <- function(obj, output = c("numeric", "caption", "numcap" niceColumnNamesEnabled = FALSE, includeAllParameters = TRUE, addPowerAndAverageSampleNumber = addPowerAndAverageSampleNumber, - theta = theta, + theta = theta, nMax = nMax )) } else { @@ -850,8 +850,8 @@ getAvailablePlotTypes <- function(obj, output = c("numeric", "caption", "numcap" "overallEarlyStop", "calculatedPower" ))] fieldNames <- c( - names(parameterSet),#TODO - names(designMaster)#TODO + names(parameterSet), # TODO + names(designMaster) # TODO ) if (simulationEnrichmentEnmabled) { fieldNames <- c(fieldNames, gsub("s$", "", names(parameterSet$effectList)), "situation") @@ -907,7 +907,7 @@ getAvailablePlotTypes <- function(obj, output = c("numeric", "caption", "numcap" yParameterNames = yParameterNames ) data <- df$data - + variedParameters <- df$variedParameters variedParameters <- na.omit(variedParameters) variedParameters <- variedParameters[variedParameters != "NA"] @@ -984,7 +984,7 @@ getAvailablePlotTypes <- function(obj, output = c("numeric", "caption", "numcap" "Lower and", yAxisLabel1, fixed = TRUE ) - + if (!("xValues" %in% colnames(data)) || !("yValues" %in% colnames(data))) { if (!(xParameterName %in% colnames(data))) { stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, sQuote(xParameterName), " is not available in dataset") @@ -1031,7 +1031,7 @@ getAvailablePlotTypes <- function(obj, output = c("numeric", "caption", "numcap" data$categories <- rep(NA_character_, nrow(data)) } } - + if (!is.na(nMax) && is.null(yParameterName3) && xParameterName == "informationRates") { xAxisLabel <- "Sample Size" data$xValues <- data$xValues * nMax @@ -1106,7 +1106,7 @@ getAvailablePlotTypes <- function(obj, output = c("numeric", "caption", "numcap" legendTitle <- paste(legendTitle, "Type of error", sep = sep) } } - + if (is.na(legendPosition)) { legendPosition <- .getLegendPosition( plotSettings, designMaster, data, yParameterName1, @@ -1287,7 +1287,7 @@ getAvailablePlotTypes <- function(obj, output = c("numeric", "caption", "numcap" data$yValues[!is.na(data$yValues) & is.infinite(data$yValues)] <- NA_real_ data <- data[!is.na(data$yValues), ] - + if (categoryEnabled && groupEnabled) { p <- ggplot2::ggplot(data, ggplot2::aes( x = .data[["xValues"]], y = .data[["yValues"]], diff --git a/R/f_core_utilities.R b/R/f_core_utilities.R index b55b9594..52c1588c 100644 --- a/R/f_core_utilities.R +++ b/R/f_core_utilities.R @@ -541,7 +541,7 @@ NULL if (is.na(direction)) { return(NA_real_) } - + return(.getOneDimensionalRootBisectionMethod( fun = fun, lower = lower, upper = upper, tolerance = tolerance, @@ -764,7 +764,7 @@ NULL stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'parameterSet' must be not null") } - if (!ifelse(R6::is.R6(parameterSet), parameterName %in% names(parameterSet), parameterName %in% names(getClass(class(parameterSet))@fieldClasses))) { #TODO + if (!ifelse(R6::is.R6(parameterSet), parameterName %in% names(parameterSet), parameterName %in% names(getClass(class(parameterSet))@fieldClasses))) { # TODO stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", .getClassName(parameterSet), "' does not contain a field with name '", parameterName, "'" @@ -1045,7 +1045,7 @@ getParameterCaption <- function(obj, parameterName) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'obj' (", .getClassName(obj), ") must be an rpact result object") } .assertIsSingleCharacter(parameterName, "parameterName", naAllowed = FALSE) - + return(.getParameterCaption(parameterName, obj)) } @@ -1078,23 +1078,23 @@ getParameterName <- function(obj, parameterCaption) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'obj' (", .getClassName(obj), ") must be an rpact result object") } .assertIsSingleCharacter(parameterCaption, "parameterCaption", naAllowed = FALSE) - + parameterName <- getDictionaryKeyByValue(C_PARAMETER_NAMES, parameterCaption) if (!is.null(parameterName)) { return(parameterName) } - + parameterName <- getDictionaryKeyByValue(C_PARAMETER_NAMES_PLOT_SETTINGS, parameterCaption) if (!is.null(parameterName)) { return(parameterName) } - + fieldNames <- obj$.getVisibleFieldNames() for (parameterName in fieldNames) { if (identical(.getParameterCaption(parameterName, obj), parameterCaption)) { return(parameterName) } - + if (identical(.getParameterCaption(parameterName, obj, tableOutputEnabled = TRUE), parameterCaption)) { return(parameterName) } @@ -1483,4 +1483,3 @@ getParameterName <- function(obj, parameterCaption) { parameterSet$.setParameterType(fieldName, C_PARAM_NOT_APPLICABLE) parameterSet$.deprecatedFieldNames <- unique(c(parameterSet$.deprecatedFieldNames, fieldName)) } - diff --git a/R/f_design_fisher_combination_test.R b/R/f_design_fisher_combination_test.R index c2281ec3..e30a3232 100644 --- a/R/f_design_fisher_combination_test.R +++ b/R/f_design_fisher_combination_test.R @@ -255,7 +255,7 @@ getDesignFisher <- function(..., cases <- .getFisherCombinationCases(kMax = design$kMax, tVec = design$scale) result <- .getDesignFisherInner( design$kMax, design$alpha, design$tolerance, - design$criticalValues, design$scale, alpha0Vec, + design$criticalValues, design$scale, alpha0Vec, design$userAlphaSpending, design$method ) design$criticalValues <- result$criticalValues diff --git a/R/f_design_group_sequential.R b/R/f_design_group_sequential.R index acb880aa..9784ee03 100644 --- a/R/f_design_group_sequential.R +++ b/R/f_design_group_sequential.R @@ -137,13 +137,15 @@ getGroupSequentialProbabilities <- function(decisionMatrix, informationRates) { .assertIsSingleNumber(design$gammaA, "gammaA", naAllowed = FALSE) .showParameterOutOfValidatedBoundsMessage(design$gammaA, "gammaA", lowerBound = 0.4, upperBound = 8, - spendingFunctionName = "Kim & DeMets alpha spending") + spendingFunctionName = "Kim & DeMets alpha spending" + ) } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_AS_HSD) { .assertDesignParameterExists(design, "gammaA", NA_real_) .assertIsSingleNumber(design$gammaA, "gammaA", naAllowed = FALSE) .showParameterOutOfValidatedBoundsMessage(design$gammaA, "gammaA", lowerBound = -10, upperBound = 5, - spendingFunctionName = "Hwang, Shih & DeCani alpha spending") + spendingFunctionName = "Hwang, Shih & DeCani alpha spending" + ) } else if (design$typeOfDesign == C_TYPE_OF_DESIGN_AS_USER) { .validateUserAlphaSpending(design) design$.setParameterType("userAlphaSpending", C_PARAM_USER_DEFINED) @@ -182,7 +184,8 @@ getGroupSequentialProbabilities <- function(decisionMatrix, informationRates) { .assertIsSingleNumber(design$gammaB, "gammaB", naAllowed = FALSE) .showParameterOutOfValidatedBoundsMessage(design$gammaB, "gammaB", lowerBound = 0.4, upperBound = 8, - spendingFunctionName = "Kim & DeMets beta spending", c(-0.4, 8)) + spendingFunctionName = "Kim & DeMets beta spending", c(-0.4, 8) + ) } if (design$typeBetaSpending == C_TYPE_OF_DESIGN_BS_HSD) { @@ -190,7 +193,8 @@ getGroupSequentialProbabilities <- function(decisionMatrix, informationRates) { .assertIsSingleNumber(design$gammaB, "gammaB", naAllowed = FALSE) .showParameterOutOfValidatedBoundsMessage(design$gammaB, "gammaB", lowerBound = -10, upperBound = 5, - spendingFunctionName = "Hwang, Shih & DeCani beta spending") + spendingFunctionName = "Hwang, Shih & DeCani beta spending" + ) } if (design$typeBetaSpending == C_TYPE_OF_DESIGN_BS_USER) { @@ -1330,7 +1334,8 @@ getDesignInverseNormal <- function(..., if (!is.na(design$informationRates)) { warning("Information rate", ifelse(length(design$informationRates) != 1, "s", ""), " ", .arrayToString(design$informationRates, vectorLookAndFeelEnabled = TRUE), - " will be ignored", call. = FALSE + " will be ignored", + call. = FALSE ) } design$informationRates <- 1 @@ -1850,7 +1855,7 @@ getDesignCharacteristics <- function(design = NULL, ...) { designCharacteristics$rejectionProbabilities <- rejectionProbabilities designCharacteristics$futilityProbabilities <- futilityProbabilities - } else if ((design$typeOfDesign == C_TYPE_OF_DESIGN_PT || + } else if ((design$typeOfDesign == C_TYPE_OF_DESIGN_PT || .isBetaSpendingDesignType(design$typeBetaSpending)) && design$sided == 2) { design$futilityBounds[is.na(design$futilityBounds)] <- 0 @@ -2142,18 +2147,18 @@ getPowerAndAverageSampleNumber <- function(design, theta = seq(-1, 1, 0.02), nMa #' -#' @title +#' @title #' Simulated Rejections Delayed Response -#' -#' @description +#' +#' @description #' Simulates the rejection probability of a delayed response group sequential design with specified parameters. -#' +#' #' @inheritParams param_design #' @param delta The delay value. #' @param iterations The number of simulation iterations. #' @inheritParams param_seed -#' -#' @details +#' +#' @details #' By default, delta = 0, i.e., the Type error rate is simulated. #' #' @return Returns a list summarizing the rejection probabilities. diff --git a/R/f_design_plan_count_data.R b/R/f_design_plan_count_data.R index 09ccca9d..eb4ec4df 100644 --- a/R/f_design_plan_count_data.R +++ b/R/f_design_plan_count_data.R @@ -18,8 +18,7 @@ ## | Last changed by: $Author: pahlke $ ## | -.getCalendarTime <- function( - n1, +.getCalendarTime <- function(n1, n2, information, shift, @@ -194,8 +193,10 @@ .setValueAndParameterType(designPlan, "accrualTime", accrualTime, NA_real_, notApplicableIfNA = TRUE) .setValueAndParameterType(designPlan, "accrualIntensity", accrualIntensity, NA_real_, notApplicableIfNA = TRUE) .setValueAndParameterType(designPlan, "followUpTime", followUpTime, NA_real_, notApplicableIfNA = TRUE) - .setValueAndParameterType(designPlan, "maxNumberOfSubjects", - as.integer(maxNumberOfSubjects), NA_integer_, notApplicableIfNA = TRUE) + .setValueAndParameterType(designPlan, "maxNumberOfSubjects", + as.integer(maxNumberOfSubjects), NA_integer_, + notApplicableIfNA = TRUE + ) .setValueAndParameterType( designPlan, "allocationRatioPlanned", allocationRatioPlanned, C_ALLOCATION_RATIO_DEFAULT @@ -358,7 +359,7 @@ getSampleSizeCounts <- function(design = NULL, ..., if (length(accrualTime) > 1) { accrualTime <- accrualTime[-1] } - + if (design$kMax > 1) { designPlan$rejectPerStage <- matrix(designCharacteristics$rejectionProbabilities, ncol = 1) designPlan$.setParameterType("rejectPerStage", C_PARAM_GENERATED) @@ -382,9 +383,9 @@ getSampleSizeCounts <- function(design = NULL, ..., ) designPlan$earlyStop <- sum(c( - designCharacteristics$rejectionProbabilities[1:(design$kMax - 1)], designPlan$futilityStop)) + designCharacteristics$rejectionProbabilities[1:(design$kMax - 1)], designPlan$futilityStop + )) designPlan$.setParameterType("earlyStop", C_PARAM_GENERATED) - } else { designPlan$.setParameterType("nFixed", C_PARAM_GENERATED) } @@ -644,22 +645,21 @@ getSampleSizeCounts <- function(design = NULL, ..., C_PARAM_GENERATED, C_PARAM_NOT_APPLICABLE ) ) - + if (!is.na(maxNumberOfSubjects)) { designPlan$.setParameterType("maxNumberOfSubjects", C_PARAM_USER_DEFINED) } else { designPlan$maxNumberOfSubjects <- n1 + n2 designPlan$.setParameterType("maxNumberOfSubjects", C_PARAM_GENERATED) } - + designPlan$maxNumberOfSubjects1 <- n1 designPlan$.setParameterType("maxNumberOfSubjects1", C_PARAM_GENERATED) - + designPlan$maxNumberOfSubjects2 <- n2 designPlan$.setParameterType("maxNumberOfSubjects2", C_PARAM_GENERATED) - - if (design$kMax > 1) { + if (design$kMax > 1) { designPlan$informationOverStages <- informationOverStages designPlan$.setParameterType("informationOverStages", C_PARAM_GENERATED) @@ -766,8 +766,7 @@ getSampleSizeCounts <- function(design = NULL, ..., #' #' @export #' -getPowerCounts <- function( - design = NULL, ..., +getPowerCounts <- function(design = NULL, ..., directionUpper = NA, maxNumberOfSubjects = NA_real_, lambda1 = NA_real_, diff --git a/R/f_design_plan_means.R b/R/f_design_plan_means.R index 22e688af..8ff4e080 100644 --- a/R/f_design_plan_means.R +++ b/R/f_design_plan_means.R @@ -141,12 +141,11 @@ NULL )) } -.getSampleSizeFixedMeans <- function( - ..., alpha = 0.025, beta = 0.2, sided = 1, +.getSampleSizeFixedMeans <- function(..., alpha = 0.025, beta = 0.2, sided = 1, twoSidedPower = C_TWO_SIDED_POWER_DEFAULT, normalApproximation = FALSE, meanRatio = FALSE, thetaH0 = 0, alternative = C_ALTERNATIVE_DEFAULT, - stDev = C_STDEV_DEFAULT, groups = 2, + stDev = C_STDEV_DEFAULT, groups = 2, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT) { nFixed <- rep(NA_real_, length(alternative)) @@ -482,12 +481,11 @@ NULL # Note that 'directionUpper' and 'maxNumberOfSubjects' are only applicable # for 'objectType' = "power" -.createDesignPlanMeans <- function( - ..., objectType = c("sampleSize", "power"), +.createDesignPlanMeans <- function(..., objectType = c("sampleSize", "power"), design, normalApproximation = FALSE, meanRatio = FALSE, thetaH0 = ifelse(meanRatio, 1, 0), alternative = NA_real_, stDev = C_STDEV_DEFAULT, directionUpper = NA, - maxNumberOfSubjects = NA_real_, groups = 2, + maxNumberOfSubjects = NA_real_, groups = 2, allocationRatioPlanned = NA_real_) { objectType <- match.arg(objectType) @@ -637,7 +635,7 @@ NULL #' #' @details #' At given design the function calculates the stage-wise and maximum sample size for testing means. -#' In a two treatment groups design, additionally, an allocation ratio = \code{n1 / n2} +#' In a two treatment groups design, additionally, an allocation ratio = \code{n1 / n2} #' can be specified where \code{n1} and \code{n2} are the number of subjects in the two treatment groups. #' A null hypothesis value thetaH0 != 0 for testing the difference of two means or #' thetaH0 != 1 for testing the ratio of two means can be specified. @@ -653,8 +651,7 @@ NULL #' #' @export #' -getSampleSizeMeans <- function( - design = NULL, ..., +getSampleSizeMeans <- function(design = NULL, ..., groups = 2L, normalApproximation = FALSE, meanRatio = FALSE, @@ -728,8 +725,7 @@ getSampleSizeMeans <- function( #' #' @export #' -getPowerMeans <- function( - design = NULL, ..., +getPowerMeans <- function(design = NULL, ..., groups = 2L, normalApproximation = FALSE, meanRatio = FALSE, diff --git a/R/f_design_plan_plot.R b/R/f_design_plan_plot.R index 65045411..b19e055b 100644 --- a/R/f_design_plan_plot.R +++ b/R/f_design_plan_plot.R @@ -44,8 +44,9 @@ if (designPlan$groups == 1) { if (type %in% c(2, (5:9))) { items$add("H0: mu", designPlan$thetaH0) - items$add("allocation ratio", round(designPlan$allocationRatioPlanned, 2), - condition = (designPlan$allocationRatioPlanned != 1)) + items$add("allocation ratio", round(designPlan$allocationRatioPlanned, 2), + condition = (designPlan$allocationRatioPlanned != 1) + ) } } else { if (type %in% c(2, (5:9))) { @@ -54,8 +55,9 @@ } else { items$add("H0: mean difference", designPlan$thetaH0) } - items$add("allocation ratio", round(designPlan$allocationRatioPlanned, 2), - condition = (designPlan$allocationRatioPlanned != 1)) + items$add("allocation ratio", round(designPlan$allocationRatioPlanned, 2), + condition = (designPlan$allocationRatioPlanned != 1) + ) } } } else if (.isTrialDesignPlanRates(designPlan)) { @@ -85,8 +87,9 @@ } else { items$add("H0: risk difference", designPlan$thetaH0) } - items$add("allocation ratio", round(designPlan$allocationRatioPlanned, 2), - condition = (designPlan$allocationRatioPlanned != 1)) + items$add("allocation ratio", round(designPlan$allocationRatioPlanned, 2), + condition = (designPlan$allocationRatioPlanned != 1) + ) } } } else if (.isTrialDesignPlanSurvival(designPlan)) { @@ -98,8 +101,9 @@ } if (type %in% c(2, (5:12))) { items$add("H0: hazard ratio", designPlan$thetaH0) - items$add("allocation ratio", round(designPlan$allocationRatioPlanned, 2), - condition = (designPlan$allocationRatioPlanned != 1)) + items$add("allocation ratio", round(designPlan$allocationRatioPlanned, 2), + condition = (designPlan$allocationRatioPlanned != 1) + ) } } else if (.isTrialDesignPlanCountData(designPlan)) { if (type %in% c(2, (5:9))) { @@ -107,8 +111,9 @@ if (length(designPlan$theta) == 1) { items$add("H1: effect", designPlan$theta) } - items$add("allocation ratio", round(designPlan$allocationRatioPlanned, 2), - condition = (designPlan$allocationRatioPlanned != 1)) + items$add("allocation ratio", round(designPlan$allocationRatioPlanned, 2), + condition = (designPlan$allocationRatioPlanned != 1) + ) } } } @@ -141,67 +146,66 @@ } } -.getTrialDesignPlanTheta <- function(designPlan, theta) { +.getTrialDesignPlanTheta <- function(designPlan, theta) { thetaName <- NA_character_ - if (.isTrialDesignPlanMeans(designPlan) && + if (.isTrialDesignPlanMeans(designPlan) && designPlan$.getParameterType("alternative") %in% c(C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE)) { thetaName <- "alternative" } else if ((.isTrialDesignPlanRates(designPlan) || .isTrialDesignPlanSurvival(designPlan)) && designPlan$.getParameterType("pi1") %in% c(C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE)) { thetaName <- "pi1" - } else if (.isTrialDesignPlanCountData(designPlan) && + } else if (.isTrialDesignPlanCountData(designPlan) && designPlan$.getParameterType("theta") %in% c(C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE)) { thetaName <- "theta" - } else if (.isTrialDesignPlanCountData(designPlan) && + } else if (.isTrialDesignPlanCountData(designPlan) && designPlan$.getParameterType("lambda1") %in% c(C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE)) { thetaName <- "lambda1" - } else if (.isTrialDesignPlanSurvival(designPlan) && + } else if (.isTrialDesignPlanSurvival(designPlan) && designPlan$.getParameterType("hazardRatio") %in% c(C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE)) { thetaName <- "hazardRatio" } if (is.na(thetaName)) { return(list(theta = NA_real_, thetaName = thetaName)) } - + if (!is.null(theta) && length(theta) > 1 && !all(is.na(theta))) { return(list(theta = theta, thetaName = thetaName)) } - + return(list(theta = designPlan[[thetaName]], thetaName = thetaName)) } -.plotTrialDesignPlan <- function( - designPlan, - type = 1L, +.plotTrialDesignPlan <- function(designPlan, + type = 1L, main = NA_character_, - xlab = NA_character_, - ylab = NA_character_, + xlab = NA_character_, + ylab = NA_character_, palette = "Set1", - theta = NA_real_, + theta = NA_real_, plotPointsEnabled = NA, - legendPosition = NA_integer_, + legendPosition = NA_integer_, showSource = FALSE, - designPlanName = NA_character_, + designPlanName = NA_character_, plotSettings = NULL, ...) { .assertGgplotIsInstalled() .assertIsTrialDesignPlan(designPlan) .assertIsValidLegendPosition(legendPosition) .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) - + availablePlotTypes <- getAvailablePlotTypes(designPlan, output = "numeric", numberInCaptionEnabled = FALSE) if (!(type %in% availablePlotTypes)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'type' (", type, - ") is not available; 'type' can ", ifelse(length(availablePlotTypes) == 1, "only ", ""), + ") is not available; 'type' can ", ifelse(length(availablePlotTypes) == 1, "only ", ""), "be ", .arrayToString(availablePlotTypes, mode = "or") ) } survivalDesignPlanEnabled <- .isTrialDesignPlanSurvival(designPlan) - nMax = NA_integer_ + nMax <- NA_integer_ if (!.isTrialDesignPlanCountData(designPlan)) { - nMax <- ifelse(survivalDesignPlanEnabled, + nMax <- ifelse(survivalDesignPlanEnabled, designPlan$maxNumberOfEvents[1], designPlan$maxNumberOfSubjects[1] ) # use first value for plotting @@ -210,7 +214,7 @@ if (is.null(plotSettings)) { plotSettings <- designPlan$.plotSettings } - + designMaster <- designPlan$.design if (is.na(plotPointsEnabled)) { @@ -226,7 +230,7 @@ showSourceHint <- "" if (type %in% c(5:12)) { result <- .getTrialDesignPlanTheta(designPlan, theta) - if (!all(is.na(result$theta)) && !is.na(result$thetaName) && + if (!all(is.na(result$theta)) && !is.na(result$thetaName) && (length(result$theta) == 2 || !identical(result$theta, designPlan[[result$thetaName]]))) { if (!is.logical(showSource) || isTRUE(showSource)) { showSourceHint <- .getVariedParameterHint(result$theta, result$thetaName) @@ -618,7 +622,7 @@ parameterSet = designPlan, designMaster = designMaster, xParameterName = xParameterName, yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, - palette = palette, theta = .plotTheta(theta), + palette = palette, theta = .plotTheta(theta), nMax = nMax, plotPointsEnabled = plotPointsEnabled, legendPosition = legendPosition, variedParameters = variedParameters, qnormAlphaLineEnabled = FALSE, yAxisScalingEnabled = FALSE, @@ -665,7 +669,7 @@ parameterSet = designPlan, designMaster = designMaster, xParameterName = xParameterName, yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, - palette = palette, theta = .plotTheta(theta), + palette = palette, theta = .plotTheta(theta), nMax = nMax, plotPointsEnabled = plotPointsEnabled, legendPosition = legendPosition, variedParameters = variedParameters, qnormAlphaLineEnabled = FALSE, yAxisScalingEnabled = FALSE, @@ -676,7 +680,7 @@ parameterSet = designPlan, designMaster = designMaster, xParameterName = xParameterName, yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, - palette = palette, theta = .plotTheta(theta), + palette = palette, theta = .plotTheta(theta), nMax = nMax, plotPointsEnabled = plotPointsEnabled, legendPosition = legendPosition, variedParameters = variedParameters, qnormAlphaLineEnabled = FALSE, yAxisScalingEnabled = FALSE, @@ -688,9 +692,9 @@ .assertIsValidVariedParameterVectorForPlotting(designPlan, type) if (is.na(main)) { - if (.isTrialDesignPlanCountData(designPlan) && - (length(designPlan$expectedNumberOfSubjectsH1) == 0 || - all(is.na(designPlan$expectedNumberOfSubjectsH1)))) { + if (.isTrialDesignPlanCountData(designPlan) && + (length(designPlan$expectedNumberOfSubjectsH1) == 0 || + all(is.na(designPlan$expectedNumberOfSubjectsH1)))) { main <- PlotSubTitleItems$new(title = "Power / Early Stop") } else { titlePart <- ifelse(survivalDesignPlanEnabled, "Number of Events", "Sample Size") @@ -715,14 +719,15 @@ yParameterNames <- character() if (!.isTrialDesignPlanCountData(designPlan)) { yParameterNames <- c(yParameterNames, "expectedNumberOfSubjects") - } else if (length(designPlan$expectedNumberOfSubjectsH1) > 0 && + } else if (length(designPlan$expectedNumberOfSubjectsH1) > 0 && all(is.na(designPlan$expectedNumberOfSubjectsH1))) { yParameterNames <- c(yParameterNames, "expectedNumberOfSubjectsH1") } yParameterNames <- c( - yParameterNames, - "overallReject", # overallReject = power - "earlyStop") + yParameterNames, + "overallReject", # overallReject = power + "earlyStop" + ) } srcCmd <- .showPlotSourceInformation( objectName = designPlanName, @@ -805,11 +810,11 @@ legendPosition <- C_POSITION_RIGHT_CENTER } } - } else if(.isTrialDesignPlanCountData(designPlan)) { + } else if (.isTrialDesignPlanCountData(designPlan)) { if (designPlan$.getParameterType("expectedNumberOfSubjectsH1") != C_PARAM_GENERATED) { stop("Plot type 9 is only available for count data endpoint if 'expectedNumberOfSubjectsH1' was not calculated") } - + xParameterName <- "theta" yParameterNames <- "expectedNumberOfSubjectsH1" } else { @@ -930,7 +935,7 @@ parameterSet = designPlan, designMaster = designMaster, xParameterName = xParameterName, yParameterNames = yParameterNames, mainTitle = main, xlab = xlab, ylab = ylab, - palette = palette, theta = .plotTheta(theta), + palette = palette, theta = .plotTheta(theta), nMax = nMax, plotPointsEnabled = plotPointsEnabled, legendPosition = legendPosition, variedParameters = variedParameters, qnormAlphaLineEnabled = (type != 2), ratioEnabled = ratioEnabled, @@ -943,8 +948,7 @@ return(p) } -.getSurvivalFunctionPlotCommand <- function( - functionType = c("pwExpDist", "lambdaStep"), timeValues, lambda, +.getSurvivalFunctionPlotCommand <- function(functionType = c("pwExpDist", "lambdaStep"), timeValues, lambda, designPlan, type, piecewiseSurvivalEnabled, multiplyByHazardRatio = FALSE) { functionType <- match.arg(functionType) signPrefix <- ifelse(type == 13, "", "-") @@ -975,8 +979,7 @@ } # Cumulative Distribution Function / Survival function -.plotSurvivalFunction <- function( - designPlan, ..., designMaster, type = c(13, 14), main = NA_character_, +.plotSurvivalFunction <- function(designPlan, ..., designMaster, type = c(13, 14), main = NA_character_, xlab = NA_character_, ylab = NA_character_, palette = "Set1", legendPosition = NA_integer_, showSource = FALSE, designPlanName = NA_character_, plotSettings = NULL) { @@ -1370,17 +1373,16 @@ #' #' @export #' -plot.TrialDesignPlan <- function( - x, y, ..., +plot.TrialDesignPlan <- function(x, y, ..., main = NA_character_, - xlab = NA_character_, + xlab = NA_character_, ylab = NA_character_, - type = NA_integer_, + type = NA_integer_, palette = "Set1", theta = NA_real_, plotPointsEnabled = NA, - legendPosition = NA_integer_, + legendPosition = NA_integer_, showSource = FALSE, - grid = 1, + grid = 1, plotSettings = NULL) { fCall <- match.call(expand.dots = FALSE) designPlanName <- deparse(fCall$x) @@ -1394,7 +1396,7 @@ plot.TrialDesignPlan <- function( ") will be ignored because it will be taken from design plan" ) } - + if (all(is.na(type))) { type <- 1L availablePlotTypes <- getAvailablePlotTypes(x) diff --git a/R/f_design_plan_rates.R b/R/f_design_plan_rates.R index 20c3db62..c7d20f47 100644 --- a/R/f_design_plan_rates.R +++ b/R/f_design_plan_rates.R @@ -790,7 +790,7 @@ NULL #' At given design the function calculates the power, stopping probabilities, and expected sample size #' for testing rates at given maximum sample size. #' The sample sizes over the stages are calculated according to the specified information rate in the design. -#' In a two treatment groups design, additionally, an allocation ratio = \code{n1 / n2} can be specified +#' In a two treatment groups design, additionally, an allocation ratio = \code{n1 / n2} can be specified #' where \code{n1} and \code{n2} are the number of subjects in the two treatment groups. #' If a null hypothesis value thetaH0 != 0 for testing the difference of two rates #' or \code{thetaH0 != 1} for testing the risk ratio is specified, the @@ -943,7 +943,7 @@ getPowerRates <- function(design = NULL, ..., #' #' @details #' At given design the function calculates the stage-wise and maximum sample size for testing rates. -#' In a two treatment groups design, additionally, an allocation ratio = \code{n1 / n2} can be specified +#' In a two treatment groups design, additionally, an allocation ratio = \code{n1 / n2} can be specified #' where \code{n1} and \code{n2} are the number of subjects in the two treatment groups. #' If a null hypothesis value thetaH0 != 0 for testing the difference of two rates or #' thetaH0 != 1 for testing the risk ratio is specified, the sample size @@ -962,8 +962,7 @@ getPowerRates <- function(design = NULL, ..., #' #' @export #' -getSampleSizeRates <- function( - design = NULL, ..., +getSampleSizeRates <- function(design = NULL, ..., groups = 2L, normalApproximation = TRUE, riskRatio = FALSE, diff --git a/R/f_design_plan_survival.R b/R/f_design_plan_survival.R index 7fa7aecd..f8b9218a 100644 --- a/R/f_design_plan_survival.R +++ b/R/f_design_plan_survival.R @@ -165,8 +165,7 @@ NULL return(result) } -.getEventProbabilitiesGroupwise <- function( - ..., time, accrualTimeVector, accrualIntensity, lambda2, +.getEventProbabilitiesGroupwise <- function(..., time, accrualTimeVector, accrualIntensity, lambda2, lambda1, piecewiseSurvivalTime, phi, kappa, allocationRatioPlanned, hazardRatio) { .assertIsSingleNumber(time, "time") @@ -479,7 +478,7 @@ NULL designPlan$.getParameterType("accrualIntensity") ) } - + accrualIntensityAbsolute <- numeric() for (maxNumberOfSubjects in designPlan[[paramName]]) { accrualSetup <- getAccrualTime( @@ -492,7 +491,7 @@ NULL } designPlan$accrualIntensity <- accrualIntensityAbsolute designPlan$.setParameterType("accrualIntensity", C_PARAM_GENERATED) - + if (numberOfDefinedAccrualIntensities > 1) { paramName <- NULL if (designPlan$.getParameterType("pi1") == C_PARAM_USER_DEFINED || @@ -2054,7 +2053,7 @@ getSampleSizeSurvival <- function(design = NULL, ..., accrualTime = accrualTime, accrualIntensity = accrualIntensity, accrualIntensityType = accrualIntensityType, - maxNumberOfSubjects = maxNumberOfSubjects, + maxNumberOfSubjects = maxNumberOfSubjects, showWarnings = FALSE ) accrualSetup$.validate() diff --git a/R/f_design_plan_utilities.R b/R/f_design_plan_utilities.R index 1234050c..b3088d32 100644 --- a/R/f_design_plan_utilities.R +++ b/R/f_design_plan_utilities.R @@ -118,7 +118,7 @@ NULL designPlan$optimumAllocationRatio <- TRUE designPlan$.setParameterType("optimumAllocationRatio", C_PARAM_USER_DEFINED) } - + if (.isTrialDesignPlanMeans(designPlan)) { sampleSizeFixed <- .getSampleSizeFixedMeans( alpha = designPlan$getAlpha(), @@ -147,7 +147,7 @@ NULL allocationRatioPlanned = designPlan$allocationRatioPlanned ) } - + # Fixed designPlan$nFixed <- sampleSizeFixed$nFixed designPlan$.setParameterType("nFixed", C_PARAM_GENERATED) @@ -160,16 +160,16 @@ NULL designPlan$numberOfSubjects2 <- matrix(designPlan$nFixed2, nrow = 1) } designPlan$numberOfSubjects <- matrix(designPlan$nFixed, nrow = 1) - + if (!is.null(sampleSizeFixed$allocationRatioPlanned) && - (length(designPlan$allocationRatioPlanned) != - length(sampleSizeFixed$allocationRatioPlanned) || - sum(designPlan$allocationRatioPlanned == sampleSizeFixed$allocationRatioPlanned) != - length(designPlan$allocationRatioPlanned))) { + (length(designPlan$allocationRatioPlanned) != + length(sampleSizeFixed$allocationRatioPlanned) || + sum(designPlan$allocationRatioPlanned == sampleSizeFixed$allocationRatioPlanned) != + length(designPlan$allocationRatioPlanned))) { designPlan$allocationRatioPlanned <- sampleSizeFixed$allocationRatioPlanned designPlan$.setParameterType("allocationRatioPlanned", C_PARAM_GENERATED) } - + # Sequential if (designPlan$.design$kMax > 1) { designCharacteristics <- getDesignCharacteristics(designPlan$.design) @@ -182,15 +182,15 @@ NULL sampleSizeFixed, designCharacteristics ) } - + designPlan$informationRates <- sampleSizeSequential$informationRates if (ncol(designPlan$informationRates) == 1 && - identical(designPlan$informationRates[, 1], designPlan$.design$informationRates)) { + identical(designPlan$informationRates[, 1], designPlan$.design$informationRates)) { designPlan$.setParameterType("informationRates", C_PARAM_NOT_APPLICABLE) } else { designPlan$.setParameterType("informationRates", C_PARAM_GENERATED) } - + designPlan$maxNumberOfSubjects <- sampleSizeSequential$maxNumberOfSubjects designPlan$.setParameterType("maxNumberOfSubjects", C_PARAM_GENERATED) if (designPlan$groups == 2) { @@ -203,59 +203,59 @@ NULL designPlan$.setParameterType("maxNumberOfSubjects1", C_PARAM_GENERATED) designPlan$.setParameterType("maxNumberOfSubjects2", C_PARAM_GENERATED) } - + designPlan$numberOfSubjects <- sampleSizeSequential$numberOfSubjects designPlan$.setParameterType("numberOfSubjects", C_PARAM_GENERATED) - + if (designPlan$groups == 2) { designPlan$numberOfSubjects1 <- sampleSizeSequential$numberOfSubjects1 designPlan$numberOfSubjects2 <- sampleSizeSequential$numberOfSubjects2 designPlan$.setParameterType("numberOfSubjects1", C_PARAM_GENERATED) designPlan$.setParameterType("numberOfSubjects2", C_PARAM_GENERATED) } - + designPlan$expectedNumberOfSubjectsH0 <- sampleSizeSequential$expectedNumberOfSubjectsH0 designPlan$expectedNumberOfSubjectsH01 <- sampleSizeSequential$expectedNumberOfSubjectsH01 designPlan$expectedNumberOfSubjectsH1 <- sampleSizeSequential$expectedNumberOfSubjectsH1 designPlan$.setParameterType("expectedNumberOfSubjectsH0", C_PARAM_GENERATED) designPlan$.setParameterType("expectedNumberOfSubjectsH01", C_PARAM_GENERATED) designPlan$.setParameterType("expectedNumberOfSubjectsH1", C_PARAM_GENERATED) - + designPlan$.setParameterType("eventsFixed", C_PARAM_NOT_APPLICABLE) designPlan$.setParameterType("nFixed1", C_PARAM_NOT_APPLICABLE) designPlan$.setParameterType("nFixed2", C_PARAM_NOT_APPLICABLE) designPlan$.setParameterType("nFixed", C_PARAM_NOT_APPLICABLE) - + if (all(designPlan$allocationRatioPlanned == 1)) { designPlan$.setParameterType("numberOfSubjects1", C_PARAM_NOT_APPLICABLE) designPlan$.setParameterType("numberOfSubjects2", C_PARAM_NOT_APPLICABLE) } - + if (!is.null(sampleSizeSequential$rejectPerStage)) { designPlan$rejectPerStage <- matrix(sampleSizeSequential$rejectPerStage, nrow = designPlan$.design$kMax ) designPlan$.setParameterType("rejectPerStage", C_PARAM_GENERATED) - + designPlan$earlyStop <- sum(designPlan$rejectPerStage[1:(designPlan$.design$kMax - 1), ]) designPlan$.setParameterType("earlyStop", C_PARAM_GENERATED) } if (!is.null(sampleSizeSequential$futilityPerStage) && - any(designPlan$.design$futilityBounds != C_FUTILITY_BOUNDS_DEFAULT)) { + any(designPlan$.design$futilityBounds != C_FUTILITY_BOUNDS_DEFAULT)) { designPlan$futilityPerStage <- matrix(sampleSizeSequential$futilityPerStage, nrow = designPlan$.design$kMax - 1 ) designPlan$.setParameterType("futilityPerStage", C_PARAM_GENERATED) - + designPlan$futilityStop <- sum(designPlan$futilityPerStage) designPlan$.setParameterType("futilityStop", C_PARAM_GENERATED) - + designPlan$earlyStop <- designPlan$earlyStop + sum(designPlan$futilityPerStage) } } - + .addEffectScaleBoundaryDataToDesignPlan(designPlan) - + return(designPlan) } diff --git a/R/f_object_r_code.R b/R/f_object_r_code.R index 23f9ea11..2efb969a 100644 --- a/R/f_object_r_code.R +++ b/R/f_object_r_code.R @@ -129,128 +129,130 @@ NULL if (obj$.isSampleSizeObject()) { return("getSampleSizeMeans") } - + return("getPowerMeans") } - + if ("TrialDesignPlanRates" == .getClassName(obj)) { if (obj$.isSampleSizeObject()) { return("getSampleSizeRates") - } - + } + return("getPowerRates") - } - + } + if ("TrialDesignPlanSurvival" == .getClassName(obj)) { if (obj$.isSampleSizeObject()) { return("getSampleSizeSurvival") - } - + } + return("getPowerSurvival") - } - + } + if ("TrialDesignPlanCountData" == .getClassName(obj)) { if (obj$.isSampleSizeObject()) { return("getSampleSizeCounts") - } - + } + return("getPowerCounts") - } - + } + if (inherits(obj, "TrialDesign")) { return(paste0("get", sub("^Trial", "", .getClassName(obj)))) - } - + } + if (inherits(obj, "Dataset")) { return("getDataset") - } - + } + if (inherits(obj, "AnalysisResults")) { return("getAnalysisResults") - } - + } + if ("TrialDesignSet" == .getClassName(obj)) { return("getDesignSet") - } - + } + if ("TrialDesignCharacteristics" == .getClassName(obj)) { return("getDesignCharacteristics") - } - + } + if (inherits(obj, "SimulationResultsMeans")) { return("getSimulationMeans") - } - + } + if (inherits(obj, "SimulationResultsRates")) { return("getSimulationRates") - } - + } + if (inherits(obj, "SimulationResultsSurvival")) { return("getSimulationSurvival") - } - + } + if (inherits(obj, "SimulationResultsMultiArmMeans")) { return("getSimulationMultiArmMeans") - } - + } + if (inherits(obj, "SimulationResultsMultiArmRates")) { return("getSimulationMultiArmRates") - } - + } + if (inherits(obj, "SimulationResultsMultiArmSurvival")) { return("getSimulationMultiArmSurvival") - } - + } + if (inherits(obj, "SimulationResultsEnrichmentMeans")) { return("getSimulationEnrichmentMeans") - } - + } + if (inherits(obj, "SimulationResultsEnrichmentRates")) { return("getSimulationEnrichmentRates") - } - + } + if (inherits(obj, "SimulationResultsEnrichmentSurvival")) { return("getSimulationEnrichmentSurvival") - } - + } + if (inherits(obj, "PiecewiseSurvivalTime")) { return("getPiecewiseSurvivalTime") - } - + } + if (inherits(obj, "AccrualTime")) { return("getAccrualTime") - } - + } + if (inherits(obj, "StageResults")) { return("getStageResults") - } - + } + if (inherits(obj, "ConditionalPowerResults")) { return("getConditionalPower") - } - + } + if (inherits(obj, "PowerAndAverageSampleNumberResult")) { return("getPowerAndAverageSampleNumber") - } - + } + if (inherits(obj, "EventProbabilities")) { return("getEventProbabilities") - } - + } + if (inherits(obj, "NumberOfSubjects")) { return("getNumberOfSubjects") - } - + } + if (inherits(obj, "PerformanceScore")) { return("gePerformanceScore") - } - + } + if (inherits(obj, "SummaryFactory") || "SummaryFactory" == .getClassName(obj)) { return(.getGeneratorFunctionName(obj$object)) - } - - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, - "function '.getGeneratorFunctionName' is not implemented for class ", .getClassName(obj)) + } + + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, + "function '.getGeneratorFunctionName' is not implemented for class ", .getClassName(obj) + ) } #' @rdname getObjectRCode @@ -323,7 +325,7 @@ getObjectRCode <- function(obj, ..., explicitPrint = FALSE) { functionName <- deparse(substitute(obj)) functionName <- sub("\\(.*\\)$", "", functionName) - + output <- match.arg(output) .assertIsSingleLogical(includeDefaultParameters, "includeDefaultParameters") @@ -538,9 +540,9 @@ getObjectRCode <- function(obj, ..., precondition <- c(precond, precondition) } } - + precondition <- unique(precondition) - + if (inherits(obj, "SummaryFactory") || "SummaryFactory" == .getClassName(obj)) { return(getObjectRCode(obj$object, prefix = ifelse(pipeOperator == "none", "summary(", ""), diff --git a/R/f_parameter_set_utilities.R b/R/f_parameter_set_utilities.R index d4cc0280..35078542 100644 --- a/R/f_parameter_set_utilities.R +++ b/R/f_parameter_set_utilities.R @@ -52,7 +52,7 @@ NULL type = "matrix" )) } - + if (!is.matrix(paramValueFormatted) && enforceListOuput) { paramValueFormatted <- matrix(paramValueFormatted, nrow = 1) } @@ -143,7 +143,7 @@ NULL paramValueFormatted <- C_TYPE_OF_DESIGN_BS_LIST[[paramValue]] } } else { - formatFunctionName <- .getParameterFormatFunction(parameterName, obj) + formatFunctionName <- .getParameterFormatFunction(parameterName, obj) if (!is.null(formatFunctionName)) { paramValueFormatted <- eval(call(formatFunctionName, paramValueFormatted)) if (.isArray(paramValue) && length(dim(paramValue)) == 2) { diff --git a/R/f_quality_assurance.R b/R/f_quality_assurance.R index 36a2ac41..becc9ccd 100644 --- a/R/f_quality_assurance.R +++ b/R/f_quality_assurance.R @@ -37,8 +37,10 @@ NULL .skipTestIfPipeOperatorNotAvailable <- function() { if (!.isPipeOperatorAvailable()) { - testthat::skip(paste0("The test is disabled because it works only for ", - "R version >= 4.1.0 (pipe operator is available)")) + testthat::skip(paste0( + "The test is disabled because it works only for ", + "R version >= 4.1.0 (pipe operator is available)" + )) } } @@ -196,8 +198,10 @@ NULL for (testFile in testFiles) { file.copy(file.path(testthatTempSubDirectory, testFile), file.path(testFileTargetDirectory, testFile)) } - message(length(testFiles), " extracted from ", sQuote(packageSource), - " and copied to ", sQuote(testFileTargetDirectory)) + message( + length(testFiles), " extracted from ", sQuote(packageSource), + " and copied to ", sQuote(testFileTargetDirectory) + ) }, finally = { if (!is.null(testthatTempDirectory)) { @@ -400,8 +404,10 @@ NULL "mode", "cacheEnabled", "extra", "cleanOldFiles", "connectionType" )) { if (is.null(connection) || !is.list(connection)) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'connection' must be a list (is ", .getClassName(connection), ")") + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'connection' must be a list (is ", .getClassName(connection), ")" + ) } name <- match.arg(name) diff --git a/R/f_simulation_base_rates.R b/R/f_simulation_base_rates.R index 851435c2..1a6f1af0 100644 --- a/R/f_simulation_base_rates.R +++ b/R/f_simulation_base_rates.R @@ -18,8 +18,7 @@ ## | Last changed by: $Author: pahlke $ ## | -.getSimulationRatesStageSubjects <- function( - ..., +.getSimulationRatesStageSubjects <- function(..., stage, riskRatio, thetaH0, diff --git a/R/f_simulation_enrichment_rates.R b/R/f_simulation_enrichment_rates.R index 72e2e2f9..bb141780 100644 --- a/R/f_simulation_enrichment_rates.R +++ b/R/f_simulation_enrichment_rates.R @@ -707,7 +707,7 @@ NULL thetaStandardized <- (2 * directionUpper - 1) * thetaStandardized - if (any(!is.na(thetaStandardized))){ + if (any(!is.na(thetaStandardized))) { thetaStandardized <- min(thetaStandardized, na.rm = TRUE) conditionalPowerPerStage[k] <- 1 - stats::pnorm(conditionalCriticalValue[k] - thetaStandardized * sqrt(plannedSubjects[k + 1] - plannedSubjects[k])) diff --git a/R/f_simulation_enrichment_survival.R b/R/f_simulation_enrichment_survival.R index 631afd02..4219e269 100644 --- a/R/f_simulation_enrichment_survival.R +++ b/R/f_simulation_enrichment_survival.R @@ -581,7 +581,7 @@ getSimulationEnrichmentSurvival <- function(design = NULL, ..., closedTest <- .performClosedCombinationTestForSimulationEnrichment( stageResults = stageResults, design = design, indices = indices, - intersectionTest = intersectionTest, + intersectionTest = intersectionTest, successCriterion = successCriterion ) diff --git a/R/f_simulation_multiarm_survival.R b/R/f_simulation_multiarm_survival.R index c4af1ae2..c17e2227 100644 --- a/R/f_simulation_multiarm_survival.R +++ b/R/f_simulation_multiarm_survival.R @@ -705,7 +705,7 @@ getSimulationMultiArmSurvival <- function(design = NULL, ..., } simulationResults$cumulativeEventsPerStage <- .removeLastEntryFromArray(simulationResults$cumulativeEventsPerStage) .addDeprecatedFieldValues(simulationResults, "eventsPerStage", simulationResults$cumulativeEventsPerStage) - + simulationResults$singleEventsPerStage <- simulatedSingleEventsPerStage for (g in 1:gMax) { simulationResults$singleEventsPerStage[, , g] <- simulationResults$singleEventsPerStage[, , g] + diff --git a/R/f_simulation_performance_score.R b/R/f_simulation_performance_score.R index 8b03703d..dcd8db55 100644 --- a/R/f_simulation_performance_score.R +++ b/R/f_simulation_performance_score.R @@ -23,9 +23,9 @@ #' Get Performance Score #' #' @description -#' Calculates the conditional performance score, its sub-scores and components according to -#' [Herrmann et al. (2020)](https://doi.org/10.1002/sim.8534) and -#' [Bokelmann et al. (2024)](https://doi.org/10.1186/s12874-024-02150-4) for a given +#' Calculates the conditional performance score, its sub-scores and components according to +#' [Herrmann et al. (2020)](https://doi.org/10.1002/sim.8534) and +#' [Bokelmann et al. (2024)](https://doi.org/10.1186/s12874-024-02150-4) for a given #' simulation result from a two-stage design with continuous or binary endpoint. #' Larger (sub-)score and component values refer to a better performance. #' @@ -39,9 +39,9 @@ #' The term conditional refers to an evaluation perspective where the interim results #' suggest a trial continuation with a second stage. #' The score can take values between 0 and 1. More details on the performance score -#' can be found in [Herrmann et al. (2020)](https://doi.org/10.1002/sim.8534) and +#' can be found in [Herrmann et al. (2020)](https://doi.org/10.1002/sim.8534) and #' [Bokelmann et al. (2024)](https://doi.org/10.1186/s12874-024-02150-4). -#' +#' #' @template examples_get_performance_score #' #' @author Stephen Schueuerhuis @@ -53,7 +53,7 @@ getPerformanceScore <- function(simulationResult) { design <- simulationResult$.design - if (!inherits(simulationResult, "SimulationResultsMeans") && !inherits(simulationResult, "SimulationResultsRates")) { + if (!inherits(simulationResult, "SimulationResultsMeans") && !inherits(simulationResult, "SimulationResultsRates")) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "performance score so far implemented only for single comparisons with continuous and binary endpoints" @@ -92,7 +92,7 @@ getPerformanceScore <- function(simulationResult) { normalApproximation = TRUE, groups = simulationResult$groups ) - + alternativeParamName <- NA_character_ referenceValue <- NA_real_ diff --git a/R/f_simulation_plot.R b/R/f_simulation_plot.R index 090e609b..b0fb23c8 100644 --- a/R/f_simulation_plot.R +++ b/R/f_simulation_plot.R @@ -58,8 +58,7 @@ NULL } } -.getSimulationPlotXAxisParameterName <- function( - simulationResults, +.getSimulationPlotXAxisParameterName <- function(simulationResults, showSource = FALSE, simulationResultsName = NA_character_) { if (grepl("SimulationResultsEnrichment", .getClassName(simulationResults))) { effectDataList <- .getSimulationEnrichmentEffectData(simulationResults) @@ -180,8 +179,7 @@ NULL )) } -.plotSimulationResults <- function( - simulationResults, designMaster, type = 5L, main = NA_character_, +.plotSimulationResults <- function(simulationResults, designMaster, type = 5L, main = NA_character_, xlab = NA_character_, ylab = NA_character_, palette = "Set1", theta = seq(-1, 1, 0.02), plotPointsEnabled = NA, legendPosition = NA_integer_, showSource = FALSE, @@ -963,8 +961,7 @@ NULL #' #' @export #' -plot.SimulationResults <- function( - x, y, ..., main = NA_character_, +plot.SimulationResults <- function(x, y, ..., main = NA_character_, xlab = NA_character_, ylab = NA_character_, type = 1L, palette = "Set1", theta = seq(-1, 1, 0.01), plotPointsEnabled = NA, legendPosition = NA_integer_, showSource = FALSE, diff --git a/R/f_simulation_utilities.R b/R/f_simulation_utilities.R index cc80848e..252d8033 100644 --- a/R/f_simulation_utilities.R +++ b/R/f_simulation_utilities.R @@ -710,7 +710,7 @@ getData <- function(x) { "'x' must be a 'SimulationResults' object; for example, use getSimulationMeans() to create one" ) } - + return(x$.data) } @@ -732,10 +732,10 @@ getData.SimulationResults <- function(x) { } else { subData <- rawData[rawData$iterationNumber == iterationNumber, ] } - + eventsPerStage1 <- sum(subData$event[subData$treatmentGroup == 1]) eventsPerStage2 <- sum(subData$event[subData$treatmentGroup == 2]) - + result <- data.frame( iterationNumber = iterationNumber, pi1 = pi1, @@ -746,11 +746,11 @@ getData.SimulationResults <- function(x) { eventsPerStage2 = eventsPerStage2, eventsPerStage = eventsPerStage1 + eventsPerStage2 ) - + if (is.na(pi1)) { result <- result[, colnames(result) != "pi1"] } - + return(result) } @@ -760,7 +760,7 @@ getData.SimulationResults <- function(x) { if (!is.null(pi1Vec)) { pi1Vec <- sort(unique(na.omit(rawData$pi1))) } - + data <- NULL if (!is.null(pi1Vec) && length(pi1Vec) > 0) { for (iterationNumber in iterationNumbers) { @@ -806,7 +806,7 @@ getData.SimulationResults <- function(x) { #' \code{maxNumberOfRawDatasetsPerStage} > 0 (default is \code{0}). #' #' This function can be used to get the simulated raw data from a simulation results -#' object obtained by \code{\link[=getSimulationSurvival]{getSimulationSurvival()}}. +#' object obtained by \code{\link[=getSimulationSurvival]{getSimulationSurvival()}}. #' Note that \code{\link[=getSimulationSurvival]{getSimulationSurvival()}} #' must called before with \code{maxNumberOfRawDatasetsPerStage} > 0. #' The data frame contains the following columns: @@ -856,7 +856,7 @@ getRawData <- function(x, aggregate = FALSE) { "'x' must be a 'SimulationResultsSurvival' object; use getSimulationSurvival() to create one" ) } - + rawData <- x$.rawData if (is.null(rawData) || ncol(rawData) == 0 || nrow(rawData) == 0) { stop( @@ -866,10 +866,10 @@ getRawData <- function(x, aggregate = FALSE) { "getSimulationSurvival(..., maxNumberOfRawDatasetsPerStage = 1)" ) } - + if (!aggregate) { return(rawData) } - + return(.getAggregatedData(rawData)) } diff --git a/R/parameter_descriptions.R b/R/parameter_descriptions.R index 1e36638e..6af89ef3 100644 --- a/R/parameter_descriptions.R +++ b/R/parameter_descriptions.R @@ -283,41 +283,41 @@ NULL #' Parameter Description: lambda for Counts #' @param lambda A numeric value or vector that represents the assumed rate of a homogeneous Poisson process in -#' the pooled treatment groups, there is no default. +#' the pooled treatment groups, there is no default. #' @name param_lambda_counts #' @keywords internal NULL #' Parameter Description: theta for Counts -#' @param theta A numeric value or vector that represents the assumed mean ratios lambda1/lambda2 of a homogeneous -#' Poisson process, there is no default. +#' @param theta A numeric value or vector that represents the assumed mean ratios lambda1/lambda2 of a homogeneous +#' Poisson process, there is no default. #' @name param_theta_counts #' @keywords internal NULL #' Parameter Description: lambda (1) for Counts #' @param lambda1 A numeric value or vector that represents the assumed rate of a homogeneous Poisson process in -#' the active treatment group, there is no default. +#' the active treatment group, there is no default. #' @name param_lambda1_counts #' @keywords internal NULL #' Parameter Description: lambda (2) for Counts #' @param lambda2 A numeric value that represents the assumed rate of a homogeneous Poisson process in -#' the control group, there is no default. +#' the control group, there is no default. #' @name param_lambda2_counts #' @keywords internal NULL #' Parameter Description: overdispersion for Counts -#' @param overdispersion A numeric value that represents the assumed overdispersion of the negative binomial distribution, -#' default is \code{0}. +#' @param overdispersion A numeric value that represents the assumed overdispersion of the negative binomial distribution, +#' default is \code{0}. #' @name param_overdispersion_counts #' @keywords internal NULL #' Parameter Description: fixedExposureTime for Counts -#' @param fixedExposureTime If specified, the fixed time of exposure per subject for count data, there is no default. +#' @param fixedExposureTime If specified, the fixed time of exposure per subject for count data, there is no default. #' @name param_fixedExposureTime_counts #' @keywords internal NULL diff --git a/man/AccrualTime.Rd b/man/AccrualTime.Rd index ee0ea99e..0401b420 100644 --- a/man/AccrualTime.Rd +++ b/man/AccrualTime.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_time.R -\docType{class} \name{AccrualTime} \alias{AccrualTime} \title{Accrual Time} @@ -36,5 +35,4 @@ Class for the definition of accrual time and accrual intensity. \item{\code{piecewiseAccrualEnabled}}{Indicates whether piecewise accrual is selected. Is a logical vector of length 1.} }} - \keyword{internal} diff --git a/man/AnalysisResults.Rd b/man/AnalysisResults.Rd index d67d0197..8fe6c1b1 100644 --- a/man/AnalysisResults.Rd +++ b/man/AnalysisResults.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R -\docType{class} \name{AnalysisResults} \alias{AnalysisResults} \title{Basic Class for Analysis Results} @@ -20,5 +19,4 @@ A basic class for analysis results. \item \code{\link{AnalysisResultsEnrichmentInverseNormal}}. } } - \keyword{internal} diff --git a/man/AnalysisResultsConditionalDunnett.Rd b/man/AnalysisResultsConditionalDunnett.Rd index c9242ba4..e9354f00 100644 --- a/man/AnalysisResultsConditionalDunnett.Rd +++ b/man/AnalysisResultsConditionalDunnett.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R -\docType{class} \name{AnalysisResultsConditionalDunnett} \alias{AnalysisResultsConditionalDunnett} \title{Analysis Results Multi-Arm Conditional Dunnett} @@ -51,5 +50,4 @@ with suitable arguments to create the multi-arm analysis results of a conditiona \item{\code{piControl}}{The assumed probability in the control arm for simulation and under which the sample size recalculation is performed. Is a numeric vector of length 1 containing a value between 0 and 1.} }} - \keyword{internal} diff --git a/man/AnalysisResultsEnrichment.Rd b/man/AnalysisResultsEnrichment.Rd index feb1922c..5ce94d23 100644 --- a/man/AnalysisResultsEnrichment.Rd +++ b/man/AnalysisResultsEnrichment.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R -\docType{class} \name{AnalysisResultsEnrichment} \alias{AnalysisResultsEnrichment} \title{Basic Class for Analysis Results Enrichment} @@ -14,5 +13,4 @@ A basic class for enrichment analysis results. \item \code{\link{AnalysisResultsEnrichmentInverseNormal}}. } } - \keyword{internal} diff --git a/man/AnalysisResultsEnrichmentFisher.Rd b/man/AnalysisResultsEnrichmentFisher.Rd index a912cb06..5c679c40 100644 --- a/man/AnalysisResultsEnrichmentFisher.Rd +++ b/man/AnalysisResultsEnrichmentFisher.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R -\docType{class} \name{AnalysisResultsEnrichmentFisher} \alias{AnalysisResultsEnrichmentFisher} \title{Analysis Results Enrichment Fisher} @@ -55,5 +54,4 @@ with suitable arguments to create the multi-arm analysis results of a Fisher com \item{\code{stratifiedAnalysis}}{For enrichment designs, typically a stratified analysis should be chosen. When testing means and rates, a non-stratified analysis can be performed on overall data. For survival data, only a stratified analysis is possible. Is a logical vector of length 1.} }} - \keyword{internal} diff --git a/man/AnalysisResultsEnrichmentInverseNormal.Rd b/man/AnalysisResultsEnrichmentInverseNormal.Rd index db7d53c7..bb19a0e4 100644 --- a/man/AnalysisResultsEnrichmentInverseNormal.Rd +++ b/man/AnalysisResultsEnrichmentInverseNormal.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R -\docType{class} \name{AnalysisResultsEnrichmentInverseNormal} \alias{AnalysisResultsEnrichmentInverseNormal} \title{Analysis Results Enrichment Inverse Normal} @@ -53,5 +52,4 @@ with suitable arguments to create the enrichment analysis results of an inverse \item{\code{stratifiedAnalysis}}{For enrichment designs, typically a stratified analysis should be chosen. When testing means and rates, a non-stratified analysis can be performed on overall data. For survival data, only a stratified analysis is possible. Is a logical vector of length 1.} }} - \keyword{internal} diff --git a/man/AnalysisResultsFisher.Rd b/man/AnalysisResultsFisher.Rd index 892419af..d417df34 100644 --- a/man/AnalysisResultsFisher.Rd +++ b/man/AnalysisResultsFisher.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R -\docType{class} \name{AnalysisResultsFisher} \alias{AnalysisResultsFisher} \title{Analysis Results Fisher} @@ -63,5 +62,4 @@ with suitable arguments to create the analysis results of a Fisher combination t \item{\code{seed}}{The seed used for random number generation. Is a numeric vector of length 1.} }} - \keyword{internal} diff --git a/man/AnalysisResultsGroupSequential.Rd b/man/AnalysisResultsGroupSequential.Rd index 069cf571..10a8ac37 100644 --- a/man/AnalysisResultsGroupSequential.Rd +++ b/man/AnalysisResultsGroupSequential.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R -\docType{class} \name{AnalysisResultsGroupSequential} \alias{AnalysisResultsGroupSequential} \title{Analysis Results Group Sequential} @@ -61,5 +60,4 @@ with suitable arguments to create the analysis results of a group sequential des \item{\code{informationEpsilon}}{The absolute information epsilon, which defines the maximum distance from the observed information to the maximum information that causes the final analysis. Updates at the final analysis if the observed information at the final analysis is smaller ("under-running") than the planned maximum information. Is either a positive integer value specifying the absolute information epsilon or a floating point number >0 and <1 to define a relative information epsilon.} }} - \keyword{internal} diff --git a/man/AnalysisResultsInverseNormal.Rd b/man/AnalysisResultsInverseNormal.Rd index bbf9333a..f0f75cf2 100644 --- a/man/AnalysisResultsInverseNormal.Rd +++ b/man/AnalysisResultsInverseNormal.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R -\docType{class} \name{AnalysisResultsInverseNormal} \alias{AnalysisResultsInverseNormal} \title{Analysis Results Inverse Normal} @@ -57,5 +56,4 @@ with suitable arguments to create the analysis results of a inverse normal desig \item{\code{medianUnbiasedEstimates}}{The calculated median unbiased estimates that are based on the stage-wise ordering. Is a numeric vector of length \code{kMax}.} }} - \keyword{internal} diff --git a/man/AnalysisResultsMultiArm.Rd b/man/AnalysisResultsMultiArm.Rd index 7719af7f..cd32d3da 100644 --- a/man/AnalysisResultsMultiArm.Rd +++ b/man/AnalysisResultsMultiArm.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R -\docType{class} \name{AnalysisResultsMultiArm} \alias{AnalysisResultsMultiArm} \title{Basic Class for Analysis Results Multi-Arm} @@ -15,5 +14,4 @@ A basic class for multi-arm analysis results. \item \code{\link{AnalysisResultsConditionalDunnett}}. } } - \keyword{internal} diff --git a/man/AnalysisResultsMultiArmFisher-class.Rd b/man/AnalysisResultsMultiArmFisher.Rd similarity index 97% rename from man/AnalysisResultsMultiArmFisher-class.Rd rename to man/AnalysisResultsMultiArmFisher.Rd index ce2c63ec..37da8982 100644 --- a/man/AnalysisResultsMultiArmFisher-class.Rd +++ b/man/AnalysisResultsMultiArmFisher.Rd @@ -1,8 +1,6 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R -\docType{class} -\name{AnalysisResultsMultiArmFisher-class} -\alias{AnalysisResultsMultiArmFisher-class} +\name{AnalysisResultsMultiArmFisher} \alias{AnalysisResultsMultiArmFisher} \title{Analysis Results Multi-Arm Fisher} \description{ @@ -58,5 +56,4 @@ with suitable arguments to create the multi-arm analysis results of a Fisher com \item{\code{seed}}{The seed used for random number generation. Is a numeric vector of length 1.} }} - \keyword{internal} diff --git a/man/AnalysisResultsMultiArmInverseNormal.Rd b/man/AnalysisResultsMultiArmInverseNormal.Rd index 84be8996..3c84e85a 100644 --- a/man/AnalysisResultsMultiArmInverseNormal.Rd +++ b/man/AnalysisResultsMultiArmInverseNormal.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R -\docType{class} \name{AnalysisResultsMultiArmInverseNormal} \alias{AnalysisResultsMultiArmInverseNormal} \title{Analysis Results Multi-Arm Inverse Normal} @@ -51,5 +50,4 @@ with suitable arguments to create the multi-arm analysis results of an inverse n \item{\code{piControl}}{The assumed probability in the control arm for simulation and under which the sample size recalculation is performed. Is a numeric vector of length 1 containing a value between 0 and 1.} }} - \keyword{internal} diff --git a/man/AnalysisResultsMultiHypotheses.Rd b/man/AnalysisResultsMultiHypotheses.Rd index e521a933..56864df6 100644 --- a/man/AnalysisResultsMultiHypotheses.Rd +++ b/man/AnalysisResultsMultiHypotheses.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R -\docType{class} \name{AnalysisResultsMultiHypotheses} \alias{AnalysisResultsMultiHypotheses} \title{Basic Class for Analysis Results Multi-Hypotheses} @@ -14,5 +13,4 @@ A basic class for multi-hypotheses analysis results. \item \code{\link{AnalysisResultsEnrichment}}. } } - \keyword{internal} diff --git a/man/ClosedCombinationTestResults.Rd b/man/ClosedCombinationTestResults.Rd index 3e457354..fded19ea 100644 --- a/man/ClosedCombinationTestResults.Rd +++ b/man/ClosedCombinationTestResults.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R -\docType{class} \name{ClosedCombinationTestResults} \alias{ClosedCombinationTestResults} \title{Analysis Results Closed Combination Test} @@ -33,5 +32,4 @@ with suitable arguments to create the multi-arm analysis results of a closed com \item{\code{rejectedIntersections}}{The simulated number of rejected arms in the closed testing procedure.. Is a logical matrix.} }} - \keyword{internal} diff --git a/man/ConditionalPowerResults.Rd b/man/ConditionalPowerResults.Rd index 3a920396..966819e9 100644 --- a/man/ConditionalPowerResults.Rd +++ b/man/ConditionalPowerResults.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R -\docType{class} \name{ConditionalPowerResults} \alias{ConditionalPowerResults} \title{Conditional Power Results} @@ -31,5 +30,4 @@ with suitable arguments to create the results of a group sequential or a combina \item{\code{assumedStDev}}{The assumed standard deviation(s) for means analysis. Is a numeric vector.} }} - \keyword{internal} diff --git a/man/ConditionalPowerResultsEnrichmentMeans.Rd b/man/ConditionalPowerResultsEnrichmentMeans.Rd index 6f6b3c0e..a3ba7b0d 100644 --- a/man/ConditionalPowerResultsEnrichmentMeans.Rd +++ b/man/ConditionalPowerResultsEnrichmentMeans.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R -\docType{class} \name{ConditionalPowerResultsEnrichmentMeans} \alias{ConditionalPowerResultsEnrichmentMeans} \title{Conditional Power Results Enrichment Means} @@ -31,5 +30,4 @@ with suitable arguments to create the results of a group sequential or a combina \item{\code{assumedStDevs}}{Assumed standard deviations to calculate conditional power in multi-arm trials or enrichment designs. Is a numeric vector.} }} - \keyword{internal} diff --git a/man/ConditionalPowerResultsEnrichmentRates.Rd b/man/ConditionalPowerResultsEnrichmentRates.Rd index 08d88514..04bb13e2 100644 --- a/man/ConditionalPowerResultsEnrichmentRates.Rd +++ b/man/ConditionalPowerResultsEnrichmentRates.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R -\docType{class} \name{ConditionalPowerResultsEnrichmentRates} \alias{ConditionalPowerResultsEnrichmentRates} \title{Conditional Power Results Enrichment Rates} @@ -31,5 +30,4 @@ with suitable arguments to create the results of a group sequential or a combina \item{\code{piControls}}{The assumed rates in the control group for enrichment designs, i.e., designs with multiple subsets.} }} - \keyword{internal} diff --git a/man/ConditionalPowerResultsMeans.Rd b/man/ConditionalPowerResultsMeans.Rd index 2b0dcb98..eaffb760 100644 --- a/man/ConditionalPowerResultsMeans.Rd +++ b/man/ConditionalPowerResultsMeans.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R -\docType{class} \name{ConditionalPowerResultsMeans} \alias{ConditionalPowerResultsMeans} \title{Conditional Power Results Means} @@ -31,5 +30,4 @@ with suitable arguments to create the results of a group sequential or a combina \item{\code{assumedStDev}}{The assumed standard deviation(s) for means analysis. Is a numeric vector.} }} - \keyword{internal} diff --git a/man/ConditionalPowerResultsRates.Rd b/man/ConditionalPowerResultsRates.Rd index 0cf596a3..59526e11 100644 --- a/man/ConditionalPowerResultsRates.Rd +++ b/man/ConditionalPowerResultsRates.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R -\docType{class} \name{ConditionalPowerResultsRates} \alias{ConditionalPowerResultsRates} \title{Conditional Power Results Rates} @@ -31,5 +30,4 @@ with suitable arguments to create the results of a group sequential or a combina \item{\code{pi2}}{The assumed probability in the reference group for two-group designs. Is a numeric vector of length 1 containing a value between 0 and 1.} }} - \keyword{internal} diff --git a/man/ConditionalPowerResultsSurvival.Rd b/man/ConditionalPowerResultsSurvival.Rd index cbedeb4c..f9a6a996 100644 --- a/man/ConditionalPowerResultsSurvival.Rd +++ b/man/ConditionalPowerResultsSurvival.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_results.R -\docType{class} \name{ConditionalPowerResultsSurvival} \alias{ConditionalPowerResultsSurvival} \title{Conditional Power Results Survival} @@ -29,5 +28,4 @@ with suitable arguments to create the results of a group sequential or a combina \item{\code{thetaH1}}{The assumed effect under the alternative hypothesis. For survival designs, refers to the hazard ratio. Is a numeric vector.} }} - \keyword{internal} diff --git a/man/Dataset.Rd b/man/Dataset.Rd index 0e7a234c..2b92509e 100644 --- a/man/Dataset.Rd +++ b/man/Dataset.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_dataset.R -\docType{class} \name{Dataset} \alias{Dataset} \title{Dataset} @@ -26,5 +25,4 @@ functions. \item{\code{groups}}{The group numbers. Is a numeric vector.} }} - \keyword{internal} diff --git a/man/DatasetMeans.Rd b/man/DatasetMeans.Rd index 4ff7917b..e6eccced 100644 --- a/man/DatasetMeans.Rd +++ b/man/DatasetMeans.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_dataset.R -\docType{class} \name{DatasetMeans} \alias{DatasetMeans} \title{Dataset of Means} @@ -31,5 +30,4 @@ with suitable arguments to create a dataset of means. \item{\code{overallStDevs}}{The overall, i.e., cumulative standard deviations. Is a numeric vector of length number of stages times number of groups.} }} - \keyword{internal} diff --git a/man/DatasetRates.Rd b/man/DatasetRates.Rd index 029eef03..67e2f3d6 100644 --- a/man/DatasetRates.Rd +++ b/man/DatasetRates.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_dataset.R -\docType{class} \name{DatasetRates} \alias{DatasetRates} \title{Dataset of Rates} @@ -27,5 +26,4 @@ with suitable arguments to create a dataset of rates. \item{\code{overallEvents}}{The overall, i.e., cumulative events. Is a numeric vector of length number of stages times number of groups containing whole numbers.} }} - \keyword{internal} diff --git a/man/DatasetSurvival.Rd b/man/DatasetSurvival.Rd index 25f41210..19275e8c 100644 --- a/man/DatasetSurvival.Rd +++ b/man/DatasetSurvival.Rd @@ -1,9 +1,7 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_dataset.R -\docType{class} \name{DatasetSurvival} \alias{DatasetSurvival} -\alias{DatasetEnrichmentSurvival-class} \alias{DatasetEnrichmentSurvival} \title{Dataset of Survival Data} \description{ @@ -33,5 +31,4 @@ with suitable arguments to create a dataset of survival data. \item{\code{overallLogRanks}}{The overall, i.e., cumulative logrank test statistics. Is a numeric vector of length number of stages times number of groups.} }} - \keyword{internal} diff --git a/man/EventProbabilities.Rd b/man/EventProbabilities.Rd index d7c77037..411c2348 100644 --- a/man/EventProbabilities.Rd +++ b/man/EventProbabilities.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_event_probabilities.R -\docType{class} \name{EventProbabilities} \alias{EventProbabilities} \title{Event Probabilities} @@ -48,5 +47,4 @@ Class for the definition of event probabilities. \item{\code{eventProbabilities2}}{The event probabilities in treatment group 2. Is a numeric vector.} }} - \keyword{internal} diff --git a/man/FieldSet.Rd b/man/FieldSet.Rd index c9bb34a8..5b1e6469 100644 --- a/man/FieldSet.Rd +++ b/man/FieldSet.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_core_parameter_set.R -\docType{class} \name{FieldSet} \alias{FieldSet} \title{Field Set} @@ -10,5 +9,4 @@ Basic class for field sets. \details{ The field set implements basic functions for a set of fields. } - \keyword{internal} diff --git a/man/NumberOfSubjects.Rd b/man/NumberOfSubjects.Rd index 2c852895..59b43947 100644 --- a/man/NumberOfSubjects.Rd +++ b/man/NumberOfSubjects.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_event_probabilities.R -\docType{class} \name{NumberOfSubjects} \alias{NumberOfSubjects} \title{Number Of Subjects} @@ -24,5 +23,4 @@ Class for the definition of number of subjects results. \item{\code{numberOfSubjects}}{In simulation results data set: The number of subjects under consideration when the interim analysis takes place.} }} - \keyword{internal} diff --git a/man/ParameterSet.Rd b/man/ParameterSet.Rd index 08d278bd..28c7819c 100644 --- a/man/ParameterSet.Rd +++ b/man/ParameterSet.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_core_parameter_set.R -\docType{class} \name{ParameterSet} \alias{ParameterSet} \title{Parameter Set} @@ -10,5 +9,4 @@ Basic class for parameter sets. \details{ The parameter set implements basic functions for a set of parameters. } - \keyword{internal} diff --git a/man/PerformanceScore.Rd b/man/PerformanceScore.Rd index 9b6c970a..4d40cfbd 100644 --- a/man/PerformanceScore.Rd +++ b/man/PerformanceScore.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_performance_score.R -\docType{class} \name{PerformanceScore} \alias{PerformanceScore} \title{Performance Score} @@ -11,5 +10,4 @@ Herrmann et al. (2020) for a given simulation result. \details{ Use \link{getPerformanceScore} to calculate the performance score. } - \keyword{internal} diff --git a/man/PiecewiseSurvivalTime.Rd b/man/PiecewiseSurvivalTime.Rd index f065b548..9253cfff 100644 --- a/man/PiecewiseSurvivalTime.Rd +++ b/man/PiecewiseSurvivalTime.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_time.R -\docType{class} \name{PiecewiseSurvivalTime} \alias{PiecewiseSurvivalTime} \title{Piecewise Exponential Survival Time} @@ -40,5 +39,4 @@ Class for the definition of piecewise survival times. \item{\code{delayedResponseEnabled}}{If \code{TRUE}, delayed response is enabled, if \code{FALSE} delayed response is not enabled.} }} - \keyword{internal} diff --git a/man/PlotSettings.Rd b/man/PlotSettings.Rd index 75ac1e4e..a9910887 100644 --- a/man/PlotSettings.Rd +++ b/man/PlotSettings.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_core_plot_settings.R -\docType{class} \name{PlotSettings} \alias{PlotSettings} \title{Plot Settings} @@ -28,31 +27,4 @@ Collects typical plot settings in an object. \item{\code{scalingFactor}}{The scaling factor.} }} -\section{Methods}{ - -\describe{ -\item{\code{adjustLegendFontSize(adjustingValue)}}{Adjusts the legend font size, e.g., run \cr -\code{adjustLegendFontSize(-2)} # makes the font size 2 points smaller} - -\item{\code{enlargeAxisTicks(p)}}{Enlarges the axis ticks} - -\item{\code{expandAxesRange(p, x = NA_real_, y = NA_real_)}}{Expands the axes range} - -\item{\code{hideGridLines(p)}}{Hides the grid lines} - -\item{\code{setAxesAppearance(p)}}{Sets the font size and face of the axes titles and texts} - -\item{\code{setColorPalette(p, palette, mode = c("colour", "fill", "all"))}}{Sets the color palette} - -\item{\code{setLegendBorder(p)}}{Sets the legend border} - -\item{\code{setMainTitle(p, mainTitle, subtitle = NA_character_)}}{Sets the main title} - -\item{\code{setMarginAroundPlot(p, margin = 0.2)}}{Sets the margin around the plot, e.g., run \cr -\code{setMarginAroundPlot(p, .2)} or \cr -\code{setMarginAroundPlot(p, c(.1, .2, .1, .2)}} - -\item{\code{setTheme(p)}}{Sets the theme} -}} - \keyword{internal} diff --git a/man/PowerAndAverageSampleNumberResult.Rd b/man/PowerAndAverageSampleNumberResult.Rd index e46f83b2..f7fda159 100644 --- a/man/PowerAndAverageSampleNumberResult.Rd +++ b/man/PowerAndAverageSampleNumberResult.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design_power_and_asn.R -\docType{class} \name{PowerAndAverageSampleNumberResult} \alias{PowerAndAverageSampleNumberResult} \title{Power and Average Sample Number Result} @@ -35,5 +34,4 @@ with suitable arguments to create it. \item{\code{futilityPerStage}}{The per-stage probabilities of stopping the trial for futility. Is a numeric matrix.} }} - \keyword{internal} diff --git a/man/SimulationResults.Rd b/man/SimulationResults.Rd index b83839ec..c7120a41 100644 --- a/man/SimulationResults.Rd +++ b/man/SimulationResults.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_simulation_results.R -\docType{class} \name{SimulationResults} \alias{SimulationResults} \title{Class for Simulation Results} @@ -29,5 +28,4 @@ A class for simulation results. \item{\code{iterations}}{The number of iterations used for simulations. Is a numeric vector of length 1 containing a whole number.} }} - \keyword{internal} diff --git a/man/SimulationResultsEnrichmentMeans.Rd b/man/SimulationResultsEnrichmentMeans.Rd index 3cdc6242..d32880ea 100644 --- a/man/SimulationResultsEnrichmentMeans.Rd +++ b/man/SimulationResultsEnrichmentMeans.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_simulation_results.R -\docType{class} \name{SimulationResultsEnrichmentMeans} \alias{SimulationResultsEnrichmentMeans} \title{Class for Simulation Results Enrichment Means} @@ -84,5 +83,4 @@ Use \code{\link[=getSimulationEnrichmentMeans]{getSimulationEnrichmentMeans()}} \item{\code{conditionalPowerAchieved}}{The calculated conditional power, under the assumption of observed or assumed effect sizes. Is a numeric matrix.} }} - \keyword{internal} diff --git a/man/SimulationResultsEnrichmentRates.Rd b/man/SimulationResultsEnrichmentRates.Rd index b595c50b..a7104790 100644 --- a/man/SimulationResultsEnrichmentRates.Rd +++ b/man/SimulationResultsEnrichmentRates.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_simulation_results.R -\docType{class} \name{SimulationResultsEnrichmentRates} \alias{SimulationResultsEnrichmentRates} \title{Class for Simulation Results Enrichment Rates} @@ -84,5 +83,4 @@ Use \code{\link[=getSimulationEnrichmentRates]{getSimulationEnrichmentRates()}} \item{\code{conditionalPowerAchieved}}{The calculated conditional power, under the assumption of observed or assumed effect sizes. Is a numeric matrix.} }} - \keyword{internal} diff --git a/man/SimulationResultsEnrichmentSurvival.Rd b/man/SimulationResultsEnrichmentSurvival.Rd index 1acbd877..42c1e816 100644 --- a/man/SimulationResultsEnrichmentSurvival.Rd +++ b/man/SimulationResultsEnrichmentSurvival.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_simulation_results.R -\docType{class} \name{SimulationResultsEnrichmentSurvival} \alias{SimulationResultsEnrichmentSurvival} \title{Class for Simulation Results Enrichment Survival} @@ -88,5 +87,4 @@ Use \code{\link[=getSimulationEnrichmentSurvival]{getSimulationEnrichmentSurviva \item{\code{conditionalPowerAchieved}}{The calculated conditional power, under the assumption of observed or assumed effect sizes. Is a numeric matrix.} }} - \keyword{internal} diff --git a/man/SimulationResultsMeans.Rd b/man/SimulationResultsMeans.Rd index f2e6419b..8e80d90d 100644 --- a/man/SimulationResultsMeans.Rd +++ b/man/SimulationResultsMeans.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_simulation_results.R -\docType{class} \name{SimulationResultsMeans} \alias{SimulationResultsMeans} \title{Class for Simulation Results Means} @@ -75,5 +74,4 @@ Use \code{\link[=getSimulationMeans]{getSimulationMeans()}} to create an object \item{\code{conditionalPowerAchieved}}{The calculated conditional power, under the assumption of observed or assumed effect sizes. Is a numeric matrix.} }} - \keyword{internal} diff --git a/man/SimulationResultsMultiArmMeans.Rd b/man/SimulationResultsMultiArmMeans.Rd index 9713c195..fe9e81a2 100644 --- a/man/SimulationResultsMultiArmMeans.Rd +++ b/man/SimulationResultsMultiArmMeans.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_simulation_results.R -\docType{class} \name{SimulationResultsMultiArmMeans} \alias{SimulationResultsMultiArmMeans} \title{Class for Simulation Results Multi-Arm Means} @@ -90,5 +89,4 @@ Use \code{\link[=getSimulationMultiArmMeans]{getSimulationMultiArmMeans()}} to c \item{\code{conditionalPowerAchieved}}{The calculated conditional power, under the assumption of observed or assumed effect sizes. Is a numeric matrix.} }} - \keyword{internal} diff --git a/man/SimulationResultsMultiArmRates.Rd b/man/SimulationResultsMultiArmRates.Rd index d8273d9c..6809efad 100644 --- a/man/SimulationResultsMultiArmRates.Rd +++ b/man/SimulationResultsMultiArmRates.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_simulation_results.R -\docType{class} \name{SimulationResultsMultiArmRates} \alias{SimulationResultsMultiArmRates} \title{Class for Simulation Results Multi-Arm Rates} @@ -90,5 +89,4 @@ Use \code{\link[=getSimulationMultiArmRates]{getSimulationMultiArmRates()}} to c \item{\code{conditionalPowerAchieved}}{The calculated conditional power, under the assumption of observed or assumed effect sizes. Is a numeric matrix.} }} - \keyword{internal} diff --git a/man/SimulationResultsMultiArmSurvival.Rd b/man/SimulationResultsMultiArmSurvival.Rd index 8d4742c4..4107dd30 100644 --- a/man/SimulationResultsMultiArmSurvival.Rd +++ b/man/SimulationResultsMultiArmSurvival.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_simulation_results.R -\docType{class} \name{SimulationResultsMultiArmSurvival} \alias{SimulationResultsMultiArmSurvival} \title{Class for Simulation Results Multi-Arm Survival} @@ -88,5 +87,4 @@ Use \code{\link[=getSimulationMultiArmSurvival]{getSimulationMultiArmSurvival()} \item{\code{conditionalPowerAchieved}}{The calculated conditional power, under the assumption of observed or assumed effect sizes. Is a numeric matrix.} }} - \keyword{internal} diff --git a/man/SimulationResultsRates.Rd b/man/SimulationResultsRates.Rd index 8f0118ed..0ae7b674 100644 --- a/man/SimulationResultsRates.Rd +++ b/man/SimulationResultsRates.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_simulation_results.R -\docType{class} \name{SimulationResultsRates} \alias{SimulationResultsRates} \title{Class for Simulation Results Rates} @@ -73,5 +72,4 @@ Use \code{\link[=getSimulationRates]{getSimulationRates()}} to create an object \item{\code{conditionalPowerAchieved}}{The calculated conditional power, under the assumption of observed or assumed effect sizes. Is a numeric matrix.} }} - \keyword{internal} diff --git a/man/SimulationResultsSurvival.Rd b/man/SimulationResultsSurvival.Rd index b771010f..d89f1ca4 100644 --- a/man/SimulationResultsSurvival.Rd +++ b/man/SimulationResultsSurvival.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_simulation_results.R -\docType{class} \name{SimulationResultsSurvival} \alias{SimulationResultsSurvival} \title{Class for Simulation Results Survival} @@ -111,5 +110,4 @@ Use \code{\link[=getSimulationSurvival]{getSimulationSurvival()}} to create an o \item{\code{conditionalPowerAchieved}}{The calculated conditional power, under the assumption of observed or assumed effect sizes. Is a numeric matrix.} }} - \keyword{internal} diff --git a/man/StageResults.Rd b/man/StageResults.Rd index c24c3345..7e9c589e 100644 --- a/man/StageResults.Rd +++ b/man/StageResults.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_stage_results.R -\docType{class} \name{StageResults} \alias{StageResults} \title{Basic Stage Results} @@ -43,5 +42,4 @@ Basic class for stage results. \item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} }} - \keyword{internal} diff --git a/man/StageResultsEnrichmentMeans.Rd b/man/StageResultsEnrichmentMeans.Rd index ef96ffa3..106ee944 100644 --- a/man/StageResultsEnrichmentMeans.Rd +++ b/man/StageResultsEnrichmentMeans.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_stage_results.R -\docType{class} \name{StageResultsEnrichmentMeans} \alias{StageResultsEnrichmentMeans} \title{Stage Results Enrichment Means} @@ -57,5 +56,4 @@ with suitable arguments to create the stage results of a dataset of enrichment m \item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} }} - \keyword{internal} diff --git a/man/StageResultsEnrichmentRates.Rd b/man/StageResultsEnrichmentRates.Rd index e15d30ef..b838721b 100644 --- a/man/StageResultsEnrichmentRates.Rd +++ b/man/StageResultsEnrichmentRates.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_stage_results.R -\docType{class} \name{StageResultsEnrichmentRates} \alias{StageResultsEnrichmentRates} \title{Stage Results Enrichment Rates} @@ -33,5 +32,4 @@ with suitable arguments to create the stage results of a dataset of enrichment r \item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} }} - \keyword{internal} diff --git a/man/StageResultsEnrichmentSurvival.Rd b/man/StageResultsEnrichmentSurvival.Rd index 091fa8be..fb21a2df 100644 --- a/man/StageResultsEnrichmentSurvival.Rd +++ b/man/StageResultsEnrichmentSurvival.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_stage_results.R -\docType{class} \name{StageResultsEnrichmentSurvival} \alias{StageResultsEnrichmentSurvival} \title{Stage Results Enrichment Survival} @@ -33,5 +32,4 @@ with suitable arguments to create the stage results of a dataset of enrichment s \item{\code{weightsInverseNormal}}{The weights for the inverse normal statistic. Is a numeric vector of length \code{kMax}.} }} - \keyword{internal} diff --git a/man/StageResultsMeans.Rd b/man/StageResultsMeans.Rd index c6f7bcec..c4cc5bfc 100644 --- a/man/StageResultsMeans.Rd +++ b/man/StageResultsMeans.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_stage_results.R -\docType{class} \name{StageResultsMeans} \alias{StageResultsMeans} \title{Stage Results of Means} @@ -45,5 +44,4 @@ with suitable arguments to create the stage results of a dataset of means. \item{\code{...}}{Names of \code{dataInput}.} }} - \keyword{internal} diff --git a/man/StageResultsMultiArmMeans.Rd b/man/StageResultsMultiArmMeans.Rd index bb86eedd..8cdeab13 100644 --- a/man/StageResultsMultiArmMeans.Rd +++ b/man/StageResultsMultiArmMeans.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_stage_results.R -\docType{class} \name{StageResultsMultiArmMeans} \alias{StageResultsMultiArmMeans} \title{Stage Results Multi Arm Means} @@ -61,5 +60,4 @@ with suitable arguments to create the stage results of a dataset of multi arm me \item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} }} - \keyword{internal} diff --git a/man/StageResultsMultiArmRates.Rd b/man/StageResultsMultiArmRates.Rd index ed93dd91..3b64ca5a 100644 --- a/man/StageResultsMultiArmRates.Rd +++ b/man/StageResultsMultiArmRates.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_stage_results.R -\docType{class} \name{StageResultsMultiArmRates} \alias{StageResultsMultiArmRates} \title{Stage Results Multi Arm Rates} @@ -55,5 +54,4 @@ with suitable arguments to create the stage results of a dataset of multi arm ra \item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} }} - \keyword{internal} diff --git a/man/StageResultsMultiArmSurvival.Rd b/man/StageResultsMultiArmSurvival.Rd index 446c4dab..bb4ad494 100644 --- a/man/StageResultsMultiArmSurvival.Rd +++ b/man/StageResultsMultiArmSurvival.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_stage_results.R -\docType{class} \name{StageResultsMultiArmSurvival} \alias{StageResultsMultiArmSurvival} \title{Stage Results Multi Arm Survival} @@ -53,5 +52,4 @@ with suitable arguments to create the stage results of a dataset of multi arm su \item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} }} - \keyword{internal} diff --git a/man/StageResultsRates.Rd b/man/StageResultsRates.Rd index f327a9dc..8e68ecea 100644 --- a/man/StageResultsRates.Rd +++ b/man/StageResultsRates.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_stage_results.R -\docType{class} \name{StageResultsRates} \alias{StageResultsRates} \title{Stage Results of Rates} @@ -45,5 +44,4 @@ with suitable arguments to create the stage results of a dataset of rates. \item{\code{...}}{Names of \code{dataInput}.} }} - \keyword{internal} diff --git a/man/StageResultsSurvival.Rd b/man/StageResultsSurvival.Rd index 7c5b29ab..ef54b0f7 100644 --- a/man/StageResultsSurvival.Rd +++ b/man/StageResultsSurvival.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_analysis_stage_results.R -\docType{class} \name{StageResultsSurvival} \alias{StageResultsSurvival} \title{Stage Results of Survival Data} @@ -51,5 +50,4 @@ with suitable arguments to create the stage results of a dataset of survival dat \item{\code{...}}{Names of \code{dataInput}.} }} - \keyword{internal} diff --git a/man/SummaryFactory.Rd b/man/SummaryFactory.Rd index b32bdcd9..47497021 100644 --- a/man/SummaryFactory.Rd +++ b/man/SummaryFactory.Rd @@ -1,11 +1,9 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_summary.R -\docType{class} \name{SummaryFactory} \alias{SummaryFactory} \title{Summary Factory} \description{ Basic class for summaries } - \keyword{internal} diff --git a/man/TrialDesign.Rd b/man/TrialDesign.Rd index 12d59b90..e145047b 100644 --- a/man/TrialDesign.Rd +++ b/man/TrialDesign.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design.R -\docType{class} \name{TrialDesign} \alias{TrialDesign} \title{Basic Trial Design} @@ -40,5 +39,4 @@ Basic class for trial designs. \item{\code{tolerance}}{The numerical tolerance, default is \code{1e-06}. Is a numeric vector of length 1.} }} - \keyword{internal} diff --git a/man/TrialDesignCharacteristics.Rd b/man/TrialDesignCharacteristics.Rd index be76f3c5..d549f32e 100644 --- a/man/TrialDesignCharacteristics.Rd +++ b/man/TrialDesignCharacteristics.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design.R -\docType{class} \name{TrialDesignCharacteristics} \alias{TrialDesignCharacteristics} \title{Trial Design Characteristics} @@ -38,7 +37,6 @@ with suitable arguments to create it. \item{\code{averageSampleNumber0}}{The expected sample size under H0. Is a positive numeric vector of length 1.} }} - \seealso{ \code{\link{getDesignCharacteristics}} for getting the design characteristics. } diff --git a/man/TrialDesignConditionalDunnett.Rd b/man/TrialDesignConditionalDunnett.Rd index 478b0e0b..e6ca16cf 100644 --- a/man/TrialDesignConditionalDunnett.Rd +++ b/man/TrialDesignConditionalDunnett.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design.R -\docType{class} \name{TrialDesignConditionalDunnett} \alias{TrialDesignConditionalDunnett} \title{Conditional Dunnett Design} @@ -41,7 +40,6 @@ with suitable arguments to create a conditional Dunnett test design. \item{\code{sided}}{Describes if the alternative is one-sided (\code{1}) or two-sided (\code{2}). Is a numeric vector of length 1 containing a whole number.} }} - \seealso{ \code{\link{getDesignConditionalDunnett}} for creating a conditional Dunnett test design. } diff --git a/man/TrialDesignFisher.Rd b/man/TrialDesignFisher.Rd index 1b6d5420..8a506adf 100644 --- a/man/TrialDesignFisher.Rd +++ b/man/TrialDesignFisher.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design.R -\docType{class} \name{TrialDesignFisher} \alias{TrialDesignFisher} \title{Fisher Design} @@ -51,7 +50,6 @@ with suitable arguments to create a Fisher combination test design. \item{\code{seed}}{The seed used for random number generation. Is a numeric vector of length 1.} }} - \seealso{ \code{\link{getDesignFisher}} for creating a Fisher combination test design. } diff --git a/man/TrialDesignGroupSequential.Rd b/man/TrialDesignGroupSequential.Rd index b19c76b5..d0604935 100644 --- a/man/TrialDesignGroupSequential.Rd +++ b/man/TrialDesignGroupSequential.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design.R -\docType{class} \name{TrialDesignGroupSequential} \alias{TrialDesignGroupSequential} \title{Group Sequential Design} @@ -75,7 +74,6 @@ with suitable arguments to create a group sequential design. \item{\code{reversalProbabilities}}{The probability to switch from stopping the trial for success (or futility) and reaching non-rejection (or rejection) in a delayed response design. Is a numeric vector of length \code{kMax} minus 1 containing values between 0 and 1.} }} - \seealso{ \code{\link[=getDesignGroupSequential]{getDesignGroupSequential()}} for creating a group sequential design. } diff --git a/man/TrialDesignInverseNormal.Rd b/man/TrialDesignInverseNormal.Rd index c059e7ec..bee5ad00 100644 --- a/man/TrialDesignInverseNormal.Rd +++ b/man/TrialDesignInverseNormal.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design.R -\docType{class} \name{TrialDesignInverseNormal} \alias{TrialDesignInverseNormal} \title{Inverse Normal Design} @@ -75,7 +74,6 @@ with suitable arguments to create a inverse normal design. \item{\code{reversalProbabilities}}{The probability to switch from stopping the trial for success (or futility) and reaching non-rejection (or rejection) in a delayed response design. Is a numeric vector of length \code{kMax} minus 1 containing values between 0 and 1.} }} - \seealso{ \code{\link[=getDesignInverseNormal]{getDesignInverseNormal()}} for creating a inverse normal design. } diff --git a/man/TrialDesignPlan.Rd b/man/TrialDesignPlan.Rd index 6a930ad8..e5574529 100644 --- a/man/TrialDesignPlan.Rd +++ b/man/TrialDesignPlan.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design_plan.R -\docType{class} \name{TrialDesignPlan} \alias{TrialDesignPlan} \title{Basic Trial Design Plan} @@ -15,5 +14,4 @@ Basic class for trial design plans. \item \code{\link{TrialDesignPlanSurvival}}. } } - \keyword{internal} diff --git a/man/TrialDesignPlanCountData.Rd b/man/TrialDesignPlanCountData.Rd index 31a92994..41b292a4 100644 --- a/man/TrialDesignPlanCountData.Rd +++ b/man/TrialDesignPlanCountData.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design_plan.R -\docType{class} \name{TrialDesignPlanCountData} \alias{TrialDesignPlanCountData} \title{Trial Design Plan Count Data} @@ -87,5 +86,4 @@ with suitable arguments to create a design plan for a dataset of rates. \item{\code{futilityBoundsPValueScale}}{The futility bounds for each stage of the trial on the p-value scale. Is a numeric matrix.} }} - \keyword{internal} diff --git a/man/TrialDesignPlanMeans.Rd b/man/TrialDesignPlanMeans.Rd index 7715c3be..fd84e4ed 100644 --- a/man/TrialDesignPlanMeans.Rd +++ b/man/TrialDesignPlanMeans.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design_plan.R -\docType{class} \name{TrialDesignPlanMeans} \alias{TrialDesignPlanMeans} \title{Trial Design Plan Means} @@ -89,5 +88,4 @@ with suitable arguments to create a design plan for a dataset of means. \item{\code{futilityBoundsPValueScale}}{The futility bounds for each stage of the trial on the p-value scale. Is a numeric matrix.} }} - \keyword{internal} diff --git a/man/TrialDesignPlanRates.Rd b/man/TrialDesignPlanRates.Rd index 89d0f69e..1f20129e 100644 --- a/man/TrialDesignPlanRates.Rd +++ b/man/TrialDesignPlanRates.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design_plan.R -\docType{class} \name{TrialDesignPlanRates} \alias{TrialDesignPlanRates} \title{Trial Design Plan Rates} @@ -89,5 +88,4 @@ with suitable arguments to create a design plan for a dataset of rates. \item{\code{futilityBoundsPValueScale}}{The futility bounds for each stage of the trial on the p-value scale. Is a numeric matrix.} }} - \keyword{internal} diff --git a/man/TrialDesignPlanSurvival.Rd b/man/TrialDesignPlanSurvival.Rd index 2a5468c8..14b67e05 100644 --- a/man/TrialDesignPlanSurvival.Rd +++ b/man/TrialDesignPlanSurvival.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design_plan.R -\docType{class} \name{TrialDesignPlanSurvival} \alias{TrialDesignPlanSurvival} \title{Trial Design Plan Survival} @@ -141,5 +140,4 @@ with suitable arguments to create a design plan for a dataset of survival data. \item{\code{futilityBoundsPValueScale}}{The futility bounds for each stage of the trial on the p-value scale. Is a numeric matrix.} }} - \keyword{internal} diff --git a/man/TrialDesignSet.Rd b/man/TrialDesignSet.Rd index 6b41f222..0680b05e 100644 --- a/man/TrialDesignSet.Rd +++ b/man/TrialDesignSet.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_design_set.R -\docType{class} \name{TrialDesignSet} \alias{TrialDesignSet} \title{Class for trial design sets.} @@ -21,12 +20,6 @@ with suitable arguments to create a set of designs. \item{\code{variedParameters}}{A character vector containing the names of the parameters that vary between designs.} }} -\section{Methods}{ - -\describe{ -\item{\code{add(...)}}{Adds 'designs' OR a 'design' and/or a design parameter, e.g., deltaWT = c(0.1, 0.3, 0.4)} -}} - \seealso{ \code{\link[=getDesignSet]{getDesignSet()}} } From 97b846b48de990347e1e56c6d7cc160d52261da6 Mon Sep 17 00:00:00 2001 From: Friedrich Pahlke Date: Fri, 15 Mar 2024 08:23:50 +0100 Subject: [PATCH 20/28] DESCRIPTION updated --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index a48047d4..75f3c128 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: rpact Title: Confirmatory Adaptive Clinical Trial Design and Analysis -Version: 3.5.2.9233 -Date: 2024-03-12 +Version: 4.0.0.9234 +Date: 2024-03-15 Authors@R: c( person( given = "Gernot", From 782d9093bd7a8c5137cc61657fd2b274bc5aed1b Mon Sep 17 00:00:00 2001 From: Friedrich Pahlke Date: Fri, 15 Mar 2024 09:23:36 +0100 Subject: [PATCH 21/28] Issue in FieldSet fixed --- R/class_core_parameter_set.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/class_core_parameter_set.R b/R/class_core_parameter_set.R index eb73a726..9ac60cc1 100644 --- a/R/class_core_parameter_set.R +++ b/R/class_core_parameter_set.R @@ -150,10 +150,10 @@ FieldSet <- R6::R6Class("FieldSet", } } } - if (length(.catLines) == 0) { - .catLines <<- line + if (length(self$.catLines) == 0) { + self$.catLines <<- line } else { - .catLines <<- c(.catLines, line) + self$.catLines <<- c(.catLines, line) } return(invisible()) }, From 63676abe8acc1a258330a669cd2b92de928379fe Mon Sep 17 00:00:00 2001 From: Till Jensen Date: Wed, 20 Mar 2024 14:36:28 +0100 Subject: [PATCH 22/28] fixed SummaryItem --- R/class_analysis_results.R | 3 ++- R/class_simulation_results.R | 2 +- R/class_summary.R | 13 ++++++++----- R/f_analysis_multiarm_means.R | 2 +- 4 files changed, 12 insertions(+), 8 deletions(-) diff --git a/R/class_analysis_results.R b/R/class_analysis_results.R index 51daf369..8255bef1 100644 --- a/R/class_analysis_results.R +++ b/R/class_analysis_results.R @@ -731,13 +731,14 @@ AnalysisResults <- R6::R6Class("AnalysisResults", pi2 = NULL, nPlanned = NULL, allocationRatioPlanned = NULL, - initialize = function(design, dataInput, ..., .stageResults = NULL, .conditionalPowerResults = NULL, directionUpper = NULL, thetaH0 = NULL) { + initialize = function(design, dataInput, ..., .stageResults = NULL, .conditionalPowerResults = NULL, directionUpper = NULL, thetaH0 = NULL, nPlanned = NULL) { self$.design <- design self$.dataInput <- dataInput self$.stageResults <- .stageResults self$.conditionalPowerResults <- .conditionalPowerResults self$directionUpper <- directionUpper self$thetaH0 <- thetaH0 + self$nPlanned <- nPlanned super$initialize(...) diff --git a/R/class_simulation_results.R b/R/class_simulation_results.R index 1aa970b2..74ac43c8 100644 --- a/R/class_simulation_results.R +++ b/R/class_simulation_results.R @@ -96,7 +96,7 @@ SimulationResults <- R6::R6Class("SimulationResults", .showStatistics = NULL, maxNumberOfIterations = NULL, seed = NULL, - allocationRatioPlanned = NULL, + allocationRatioPlanned = numeric(), conditionalPower = NULL, iterations = NULL, futilityPerStage = NULL, diff --git a/R/class_summary.R b/R/class_summary.R index 1dfbc950..51e0bb24 100644 --- a/R/class_summary.R +++ b/R/class_summary.R @@ -28,10 +28,11 @@ SummaryItem <- R6::R6Class("SummaryItem", title = NULL, values = NULL, legendEntry = NULL, - initialize = function(title = NA_character_, values = NA_character_, ...) { + initialize = function(title = NA_character_, values = NA_character_, legendEntry = NULL, ...) { self$title <- title self$values <- values - #callSuper(...) TODO LEGENDENTRyy + self$legendEntry <- legendEntry + if (!is.null(self$legendEntry) && length(self$legendEntry) > 0) { if (is.null(names(self$legendEntry))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("legendEntry"), " must be a named list") @@ -187,8 +188,9 @@ SummaryFactory <- R6::R6Class("SummaryFactory", intervalFormat = NULL, justify = NULL, output = NULL, - initialize = function(..., intervalFormat = "[%s; %s]", output = "all") { - #callSuper(...) TODO + initialize = function(..., object = NULL, intervalFormat = "[%s; %s]", output = "all") { + super$initialize(...) + self$object <- object self$intervalFormat <- intervalFormat self$output <- output self$summaryItems <- list() @@ -228,6 +230,7 @@ SummaryFactory <- R6::R6Class("SummaryFactory", legendEntries <- c() legendEntriesUnique <- c() summaryItemNames <- c() + for (summaryItem in self$summaryItems) { if (!is.null(summaryItem$title) && length(summaryItem$title) == 1 && !is.na(summaryItem$title)) { summaryItemNames <- c(summaryItemNames, summaryItem$title) @@ -3603,7 +3606,7 @@ SummaryFactory <- R6::R6Class("SummaryFactory", } if (!is.null(performanceScore)) { - print(performanceScore) + print(performanceScore)#TODO? summaryFactory$addParameter(performanceScore, parameterName = "performanceScore", parameterCaption = "Performance score", diff --git a/R/f_analysis_multiarm_means.R b/R/f_analysis_multiarm_means.R index d995c239..cb4b7a5e 100644 --- a/R/f_analysis_multiarm_means.R +++ b/R/f_analysis_multiarm_means.R @@ -60,7 +60,7 @@ NULL ) results <- AnalysisResultsMultiArmInverseNormal$new(design = design, dataInput = dataInput) - + results <- .getAnalysisResultsMeansMultiArmAll( results = results, design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, directionUpper = directionUpper, From c17286f8b3b27c75faf1eab94fe901365a1ea77a Mon Sep 17 00:00:00 2001 From: Friedrich Pahlke Date: Fri, 22 Mar 2024 09:31:45 +0100 Subject: [PATCH 23/28] Outdated man pages removed --- DESCRIPTION | 4 ++-- R/RcppExports.R | 1 + R/class_core_parameter_set.R | 4 ++-- R/class_design_set.R | 2 ++ R/class_summary.R | 5 ----- R/f_analysis_multiarm_means.R | 2 +- inst/doc/rpact_getting_started.html | 4 ++-- man/sub-TrialDesignSet-method.Rd | 22 ---------------------- man/t-FieldSet-method.Rd | 18 ------------------ 9 files changed, 10 insertions(+), 52 deletions(-) delete mode 100644 man/sub-TrialDesignSet-method.Rd delete mode 100644 man/t-FieldSet-method.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 75f3c128..5e2c6ed5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: rpact Title: Confirmatory Adaptive Clinical Trial Design and Analysis -Version: 4.0.0.9234 -Date: 2024-03-15 +Version: 4.0.0.9235 +Date: 2024-03-22 Authors@R: c( person( given = "Gernot", diff --git a/R/RcppExports.R b/R/RcppExports.R index f298ad3a..b10466c9 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -92,3 +92,4 @@ getCipheredValue <- function(x) { getFraction <- function(x, epsilon = 1.0e-6, maxNumberOfSearchSteps = 30L) { .Call(`_rpact_getFraction`, x, epsilon, maxNumberOfSearchSteps) } + diff --git a/R/class_core_parameter_set.R b/R/class_core_parameter_set.R index 9ac60cc1..581c0dd3 100644 --- a/R/class_core_parameter_set.R +++ b/R/class_core_parameter_set.R @@ -151,9 +151,9 @@ FieldSet <- R6::R6Class("FieldSet", } } if (length(self$.catLines) == 0) { - self$.catLines <<- line + self$.catLines <- line } else { - self$.catLines <<- c(.catLines, line) + self$.catLines <- c(.catLines, line) } return(invisible()) }, diff --git a/R/class_design_set.R b/R/class_design_set.R index 9a038c50..29bcfeb2 100644 --- a/R/class_design_set.R +++ b/R/class_design_set.R @@ -1058,3 +1058,5 @@ plot.TrialDesignSet <- function(x, y, ..., type = 1L, main = NA_character_, try(suppressWarnings(suppressMessages(p <- p + ggplot2::scale_color_manual(values = c("#4daf4a", "#377eb8", "#e41a1c"))))) return(p) } + + diff --git a/R/class_summary.R b/R/class_summary.R index d7562e81..f15a009b 100644 --- a/R/class_summary.R +++ b/R/class_summary.R @@ -22,7 +22,6 @@ #' @include f_core_assertions.R NULL - SummaryItem <- R6::R6Class("SummaryItem", public = list( title = NULL, @@ -81,10 +80,6 @@ plot.SummaryFactory <- function(x, y, ..., showSummary = FALSE) { markdown <- .isMarkdownEnabled() } if (markdown) { - if (.isQuartoEnabled()) { - # cat("#| results: 'asis'\n\n") - } - x$.catMarkdownText() } else { x$show() diff --git a/R/f_analysis_multiarm_means.R b/R/f_analysis_multiarm_means.R index cb4b7a5e..d995c239 100644 --- a/R/f_analysis_multiarm_means.R +++ b/R/f_analysis_multiarm_means.R @@ -60,7 +60,7 @@ NULL ) results <- AnalysisResultsMultiArmInverseNormal$new(design = design, dataInput = dataInput) - + results <- .getAnalysisResultsMeansMultiArmAll( results = results, design = design, dataInput = dataInput, intersectionTest = intersectionTest, stage = stage, directionUpper = directionUpper, diff --git a/inst/doc/rpact_getting_started.html b/inst/doc/rpact_getting_started.html index 28c35dce..b5f20ea2 100644 --- a/inst/doc/rpact_getting_started.html +++ b/inst/doc/rpact_getting_started.html @@ -12,7 +12,7 @@ - + Getting started with rpact @@ -239,7 +239,7 @@

Getting started with rpact

Friedrich Pahlke and Gernot Wassmer

-

2024-03-07

+

2024-03-22

diff --git a/man/sub-TrialDesignSet-method.Rd b/man/sub-TrialDesignSet-method.Rd deleted file mode 100644 index ce35c473..00000000 --- a/man/sub-TrialDesignSet-method.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_design_set.R -\name{[,TrialDesignSet-method} -\alias{[,TrialDesignSet-method} -\title{Access Trial Design by Index} -\usage{ -\S4method{[}{TrialDesignSet}(x, i, j, ..., drop = TRUE) -} -\description{ -Function to the \code{TrialDesign} at position \code{i} in a \code{TrialDesignSet} object. -} -\details{ -Can be used to iterate over all designs in a design set. -} -\examples{ -designSet <- getDesignSet(design = getDesignFisher(), alpha = c(0.01, 0.05)) -for (i in 1:length(designSet)) { - print(designSet[i]$alpha) -} - -} -\keyword{internal} diff --git a/man/t-FieldSet-method.Rd b/man/t-FieldSet-method.Rd deleted file mode 100644 index 98654749..00000000 --- a/man/t-FieldSet-method.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_core_parameter_set.R -\name{t,FieldSet-method} -\alias{t,FieldSet-method} -\title{Field Set Transpose} -\usage{ -\S4method{t}{FieldSet}(x) -} -\arguments{ -\item{x}{A \code{FieldSet}.} -} -\description{ -Given a \code{FieldSet} \code{x}, t returns the transpose of \code{x}. -} -\details{ -Implementation of the base R generic function \code{\link[base]{t}} -} -\keyword{internal} From 4bc26425de9e94ae2f4b2a922e9bcd76e903642b Mon Sep 17 00:00:00 2001 From: Friedrich Pahlke Date: Fri, 22 Mar 2024 09:36:09 +0100 Subject: [PATCH 24/28] Summary heading default base number set to -2L --- R/class_core_parameter_set.R | 11 ++++++----- R/f_core_constants.R | 2 ++ 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/R/class_core_parameter_set.R b/R/class_core_parameter_set.R index 581c0dd3..4155be11 100644 --- a/R/class_core_parameter_set.R +++ b/R/class_core_parameter_set.R @@ -100,21 +100,22 @@ FieldSet <- R6::R6Class("FieldSet", line <- paste0(args, collapse = sep) listItemEnabled <- grepl("^ ", line) - headingBaseNumber <- as.integer(getOption("rpact.print.heading.base.number", 0L)) + headingBaseNumber <- as.integer(getOption("rpact.print.heading.base.number", + C_HEADING_BASE_NUMBER_DEFAULT)) if (is.na(headingBaseNumber)) { - headingBaseNumber <- 0L + headingBaseNumber <- C_HEADING_BASE_NUMBER_DEFAULT } if (headingBaseNumber < -2) { warning( "Illegal option ", sQuote("rpact.print.heading.base.number"), - " (", headingBaseNumber, ") was set to 0" + " (", headingBaseNumber, ") was set to ", C_HEADING_BASE_NUMBER_DEFAULT ) - headingBaseNumber <- 0L + headingBaseNumber <- C_HEADING_BASE_NUMBER_DEFAULT } if (headingBaseNumber > 4) { warning( "Illgeal option ", sQuote("rpact.print.heading.base.number"), - " (", headingBaseNumber, ") was set to 4 becasue it was too large" + " (", headingBaseNumber, ") was set to 4 because it was too large" ) headingBaseNumber <- 4L } diff --git a/R/f_core_constants.R b/R/f_core_constants.R index c6b9a889..1321a5b3 100644 --- a/R/f_core_constants.R +++ b/R/f_core_constants.R @@ -79,6 +79,8 @@ C_ACCEPT_DEVIATION_INFORMATIONRATES <- 0.05 C_THETA_RANGE_SEQUENCE_LENGTH_DEFAULT <- 50 C_VARIED_PARAMETER_SEQUENCE_LENGTH_DEFAULT <- 30 +C_HEADING_BASE_NUMBER_DEFAULT <- -2L + C_CLASS_NAME_TRIAL_DESIGN_GROUP_SEQUENTIAL <- "TrialDesignGroupSequential" C_CLASS_NAME_TRIAL_DESIGN_INVERSE_NORMAL <- "TrialDesignInverseNormal" C_CLASS_NAME_TRIAL_DESIGN_FISHER <- "TrialDesignFisher" From 282fd543fa397e3e55b838ce725ff72cd2e57624 Mon Sep 17 00:00:00 2001 From: Friedrich Pahlke Date: Fri, 22 Mar 2024 13:46:55 +0100 Subject: [PATCH 25/28] Several issues fixed --- DESCRIPTION | 2 + NAMESPACE | 1 + NEWS.md | 4 +- R/class_analysis_dataset.R | 6 +- R/class_analysis_results.R | 4 +- R/class_analysis_stage_results.R | 18 +- R/class_core_parameter_set.R | 15 +- R/class_core_plot_settings.R | 4 +- R/class_design.R | 8 +- R/class_design_plan.R | 220 ++++++- R/class_design_power_and_asn.R | 4 +- R/class_design_set.R | 22 +- R/class_dictionary.R | 4 +- R/class_event_probabilities.R | 4 +- R/class_performance_score.R | 4 +- R/class_simulation_results.R | 79 ++- R/class_summary.R | 4 +- R/class_time.R | 6 +- R/f_analysis_base.R | 4 +- R/f_analysis_base_means.R | 4 +- R/f_analysis_base_rates.R | 4 +- R/f_analysis_base_survival.R | 4 +- R/f_analysis_enrichment_means.R | 4 +- R/f_analysis_enrichment_rates.R | 4 +- R/f_analysis_enrichment_survival.R | 6 +- R/f_analysis_multiarm.R | 4 +- R/f_analysis_multiarm_means.R | 11 +- R/f_analysis_multiarm_rates.R | 7 +- R/f_analysis_multiarm_survival.R | 7 +- R/f_analysis_utilities.R | 4 +- R/f_as251.R | 4 +- R/f_core_assertions.R | 16 +- R/f_core_constants.R | 4 +- R/f_core_output_formats.R | 4 +- R/f_core_plot.R | 8 +- R/f_core_utilities.R | 14 +- R/f_design_fisher_combination_test.R | 6 +- R/f_design_general_utilities.R | 4 +- R/f_design_group_sequential.R | 4 +- R/f_design_plan_count_data.R | 4 +- R/f_design_plan_means.R | 4 +- R/f_design_plan_plot.R | 6 +- R/f_design_plan_rates.R | 4 +- R/f_design_plan_survival.R | 6 +- R/f_design_plan_utilities.R | 4 +- R/f_object_r_code.R | 6 +- R/f_parameter_set_utilities.R | 6 +- R/f_quality_assurance.R | 6 +- R/f_simulation_base_count_data.R | 556 ++++++++++++++++++ R/f_simulation_base_means.R | 4 +- R/f_simulation_base_rates.R | 4 +- R/f_simulation_base_survival.R | 6 +- R/f_simulation_enrichment.R | 4 +- R/f_simulation_enrichment_rates.R | 6 +- R/f_simulation_enrichment_survival.R | 4 +- R/f_simulation_multiarm.R | 4 +- R/f_simulation_multiarm_survival.R | 4 +- R/f_simulation_performance_score.R | 4 +- R/f_simulation_plot.R | 4 +- R/f_simulation_utilities.R | 4 +- R/parameter_descriptions.R | 16 +- cran-comments.md | 2 +- .../examples_get_simulation_count_data.R | 220 +++++++ man/SimulationResultsBaseCountData.Rd | 46 ++ man/getSimulationCounts.Rd | 190 ++++++ man/param_plannedMaxSubjects.Rd | 12 + man/param_plannedMaxSubjectsPerStage.Rd | 12 + tests/testthat/helper-f_core_assertions.R | 4 +- .../testthat/test-class_core_plot_settings.R | 4 +- tests/testthat/test-class_design_plan.R | 4 +- tests/testthat/test-class_design_set.R | 4 +- .../test-f_analysis_input_validation.R | 6 +- ...test-f_simulation_calc_subjects_function.R | 4 +- .../test-f_simulation_performance_score.R | 4 +- 74 files changed, 1525 insertions(+), 189 deletions(-) create mode 100644 R/f_simulation_base_count_data.R create mode 100644 man-roxygen/examples_get_simulation_count_data.R create mode 100644 man/SimulationResultsBaseCountData.Rd create mode 100644 man/getSimulationCounts.Rd create mode 100644 man/param_plannedMaxSubjects.Rd create mode 100644 man/param_plannedMaxSubjectsPerStage.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 5e2c6ed5..d99746d5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -55,6 +55,7 @@ Imports: graphics, tools, rlang, + R6 (>= 2.5.1), knitr (>= 1.19), Rcpp (>= 1.0.3) LinkingTo: Rcpp @@ -92,6 +93,7 @@ Collate: 'class_design_plan.R' 'class_design_power_and_asn.R' 'class_event_probabilities.R' + 'f_simulation_base_count_data.R' 'f_simulation_utilities.R' 'f_simulation_base_survival.R' 'class_simulation_results.R' diff --git a/NAMESPACE b/NAMESPACE index ea80189c..ca869811 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -99,6 +99,7 @@ export(getSampleSizeCounts) export(getSampleSizeMeans) export(getSampleSizeRates) export(getSampleSizeSurvival) +export(getSimulationCounts) export(getSimulationEnrichmentMeans) export(getSimulationEnrichmentRates) export(getSimulationEnrichmentSurvival) diff --git a/NEWS.md b/NEWS.md index 0e9f1842..734ca698 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,12 +1,14 @@ -# rpact 3.5.2 +# rpact 4.0.0 ## New features * Extension of the function `getPerformanceScore()` for sample size recalculation rules to the setting of binary endpoints according to [Bokelmann et al. (2024)](https://doi.org/10.1186/s12874-024-02150-4) +* The new functions `getSimulationCounts()` can be used to perform power simulations and the assessment of test characteristics for clinical trials with negative binomial distributed count data. ## Improvements, issues, and changes +* All reference classes were replaced by [R6](https://cran.r-project.org/package=R6) classes due to better performance * Issue [#25](https://github.com/rpact-com/rpact/issues/25) fixed diff --git a/R/class_analysis_dataset.R b/R/class_analysis_dataset.R index 7c57fa4c..bd20bdcd 100644 --- a/R/class_analysis_dataset.R +++ b/R/class_analysis_dataset.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7645 $ -## | Last changed: $Date: 2024-02-16 16:12:34 +0100 (Fr, 16 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -909,7 +909,7 @@ getDataSet <- function(..., floatingPointNumbersEnabled = FALSE) { emptySubsetNames <- validSubsetNames[!(validSubsetNames %in% subsetNames)] for (subsetName in subsetNames) { subset <- args[[subsetName]] - if (is.null(subset) || (!R6::is.R6(subset) && is.na(subset))) { + if (is.null(subset) || (!.isResultObjectBaseClass(subset) && is.na(subset))) { emptySubsetNames <- c(emptySubsetNames, subsetName) } else { if (!.isDataset(subset)) { diff --git a/R/class_analysis_results.R b/R/class_analysis_results.R index 7838a869..4a375022 100644 --- a/R/class_analysis_results.R +++ b/R/class_analysis_results.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7620 $ -## | Last changed: $Date: 2024-02-09 12:57:37 +0100 (Fr, 09 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/class_analysis_stage_results.R b/R/class_analysis_stage_results.R index 8c159439..f45e7858 100644 --- a/R/class_analysis_stage_results.R +++ b/R/class_analysis_stage_results.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7645 $ -## | Last changed: $Date: 2024-02-16 16:12:34 +0100 (Fr, 16 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -324,7 +324,7 @@ StageResultsMeans <- R6::R6Class("StageResultsMeans", overallSampleSizes1 = NULL, overallSampleSizes2 = NULL, equalVariances = TRUE, normalApproximation = FALSE) { - super$initialize(.design = design, .dataInput = dataInput, ...) # TODO + super$initialize(.design = design, .dataInput = dataInput, ...) self$combInverseNormal <- combInverseNormal self$combFisher <- combFisher @@ -656,7 +656,7 @@ StageResultsRates <- R6::R6Class("StageResultsRates", overallSampleSizes1 = NULL, overallSampleSizes2 = NULL, normalApproximation = TRUE) { - super$initialize(.design = design, .dataInput = dataInput, ...) # TODO + super$initialize(.design = design, .dataInput = dataInput, ...) self$combInverseNormal <- combInverseNormal self$combFisher <- combFisher @@ -826,7 +826,7 @@ StageResultsMultiArmRates <- R6::R6Class("StageResultsMultiArmRates", intersectionTest = NULL, normalApproximation = FALSE, directionUpper = NULL) { - super$initialize(.design = design, .dataInput = dataInput, ...) # TODO + super$initialize(.design = design, .dataInput = dataInput, ...) self$overallPiTreatments <- overallPiTreatments self$overallPiControl <- overallPiControl @@ -966,7 +966,7 @@ StageResultsSurvival <- R6::R6Class("StageResultsSurvival", events = NULL, allocationRatios = NULL, testStatistics = NULL) { - super$initialize(.design = design, .dataInput = dataInput, ...) # TODO + super$initialize(.design = design, .dataInput = dataInput, ...) self$combInverseNormal <- combInverseNormal self$combFisher <- combFisher @@ -1099,7 +1099,7 @@ StageResultsMultiArmSurvival <- R6::R6Class("StageResultsMultiArmSurvival", singleStepAdjustedPValues = NULL, intersectionTest = NULL, directionUpper = NULL) { - super$initialize(.design = design, .dataInput = dataInput, ...) # TODO + super$initialize(.design = design, .dataInput = dataInput, ...) self$combInverseNormal <- combInverseNormal self$combFisher <- combFisher @@ -1211,7 +1211,7 @@ StageResultsEnrichmentMeans <- R6::R6Class("StageResultsEnrichmentMeans", .overallSampleSizes1 = NULL, .overallSampleSizes2 = NULL, stratifiedAnalysis = NULL, - .getParametersToShow = function() { # TODO init + .getParametersToShow = function() { return(c(super$.getParametersToShow(), "stratifiedAnalysis")) } ) @@ -1733,7 +1733,7 @@ plot.StageResults <- function(x, y, ..., type = 1L, p <- plotSettings$hideGridLines(p) # set main title - mainTitle <- ifelse(!is.call(main) && !isS4(main) && !R6::is.R6(main) && is.na(main), plotData$main, main) + mainTitle <- ifelse(!is.call(main) && !.isResultObjectBaseClass(main) && is.na(main), plotData$main, main) p <- plotSettings$setMainTitle(p, mainTitle, subtitle = plotData$sub) # set legend diff --git a/R/class_core_parameter_set.R b/R/class_core_parameter_set.R index 4155be11..49409471 100644 --- 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: 7656 $ -## | Last changed: $Date: 2024-02-22 10:55:00 +0100 (Do, 22 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -154,7 +154,7 @@ FieldSet <- R6::R6Class("FieldSet", if (length(self$.catLines) == 0) { self$.catLines <- line } else { - self$.catLines <- c(.catLines, line) + self$.catLines <- c(self$.catLines, line) } return(invisible()) }, @@ -292,8 +292,13 @@ ParameterSet <- R6::R6Class("ParameterSet", if (self$isUserDefinedParameter(parameterName) || self$isDefaultParameter(parameterName)) { return(self[[parameterName]]) } - - parameterType <- self$getRefClass()$fields()[[parameterName]] + + tryCatch({ + parameterType <- .getClassName(self[[parameterName]]) + }, error = function(e) { + parameterType <- "unknown" + }) + if (parameterType == "numeric") { return(NA_real_) } diff --git a/R/class_core_plot_settings.R b/R/class_core_plot_settings.R index 6cb0d925..b23843b1 100644 --- a/R/class_core_plot_settings.R +++ b/R/class_core_plot_settings.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7645 $ -## | Last changed: $Date: 2024-02-16 16:12:34 +0100 (Fr, 16 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/class_design.R b/R/class_design.R index ed19bef0..226819a8 100644 --- a/R/class_design.R +++ b/R/class_design.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7620 $ -## | Last changed: $Date: 2024-02-09 12:57:37 +0100 (Fr, 09 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -402,7 +402,7 @@ TrialDesignFisher <- R6::R6Class("TrialDesignFisher", self$nonStochasticCurtailment <- nonStochasticCurtailment self$sided <- sided self$simAlpha <- simAlpha - super$initialize(...) # TODO dont move to first line of constructor + super$initialize(...) # important: don't move to first line of constructor self$iterations <- iterations self$seed <- seed self$tolerance <- tolerance @@ -703,7 +703,7 @@ TrialDesignInverseNormal <- R6::R6Class("TrialDesignInverseNormal", if (!identical(gammaA, self$gammaA)) { return(self$.pasteComparisonResult("gammaA", gammaA, self$gammaA)) } - if (!identical(gammaB, self$gammaB)) { # TODO + if (!identical(gammaB, self$gammaB)) { return(self$.pasteComparisonResult("gammaB", gammaB, self$gammaB)) } if ((typeOfDesign == C_TYPE_OF_DESIGN_PT && !identical(bindingFutility, self$bindingFutility)) || diff --git a/R/class_design_plan.R b/R/class_design_plan.R index 7606a022..004c5013 100644 --- 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: 7651 $ -## | Last changed: $Date: 2024-02-20 15:45:44 +0100 (Di, 20 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -109,7 +109,7 @@ TrialDesignPlan <- R6::R6Class("TrialDesignPlan", initialize = function(design, ...) { self$.design <- design - super$initialize(...) # TODO + super$initialize(...) self$.plotSettings <- PlotSettings$new() @@ -197,12 +197,15 @@ TrialDesignPlan <- R6::R6Class("TrialDesignPlan", self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) - if (inherits(self, "TrialDesignPlanSurvival") || self$groups == 2 || self$.design$kMax > 1) { # TODO Groups???? + if (inherits(self, "TrialDesignPlanSurvival") || + (!is.null(self$groups) && self$groups == 2) || + self$.design$kMax > 1) { self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled ) - if (inherits(self, "TrialDesignPlanSurvival") || self$groups == 2) { + if (inherits(self, "TrialDesignPlanSurvival") || + (!is.null(self$groups) && self$groups == 2)) { self$.cat(" (i): values of treatment arm i\n", consoleOutputEnabled = consoleOutputEnabled ) @@ -235,15 +238,15 @@ TrialDesignPlan <- R6::R6Class("TrialDesignPlan", }, .toString = function(startWithUpperCase = FALSE) { if (.isTrialDesignPlanMeans(self)) { - s <- "means" + result <- "means" } else if (.isTrialDesignPlanRates(self)) { - s <- "rates" + result <- "rates" } else if (.isTrialDesignPlanSurvival(self)) { - s <- "survival data" + result <- "survival data" } else { - s <- paste0("unknown data class '", .getClassName(self), "'") + result <- paste0("unknown data class '", .getClassName(self), "'") } - return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) # TODO correct closure of s? + return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(result), result)) } ) ) @@ -390,7 +393,7 @@ TrialDesignPlanMeans <- R6::R6Class("TrialDesignPlanMeans", stDev = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS[["stDev"]], groups = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS[["groups"]], allocationRatioPlanned = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS[["allocationRatioPlanned"]]) { - super$initialize(...) # TODO + super$initialize(...) self$normalApproximation <- normalApproximation self$meanRatio <- meanRatio @@ -426,6 +429,39 @@ TrialDesignPlanMeans <- R6::R6Class("TrialDesignPlanMeans", show = function(showType = 1, digits = NA_integer_) { "Method for automatically printing trial plan objects" super$show(showType = showType, digits = digits) + }, + recreate = function(alternative = NA_real_) { + alternativeTemp <- alternative + if (any(is.na(alternative))) { + alternativeTemp <- self$alternative + } + if (self$.objectType == "sampleSize") { + result <- getSampleSizeMeans( + design = self$.design, + normalApproximation = self$.getParameterValueIfUserDefinedOrDefault("normalApproximation"), + meanRatio = self$meanRatio, + thetaH0 = self$.getParameterValueIfUserDefinedOrDefault("thetaH0"), + alternative = alternativeTemp, + stDev = self$.getParameterValueIfUserDefinedOrDefault("stDev"), + groups = self$.getParameterValueIfUserDefinedOrDefault("groups"), + allocationRatioPlanned = self$.getParameterValueIfUserDefinedOrDefault("allocationRatioPlanned") + ) + } else { + result <- getPowerMeans( + design = self$.design, + normalApproximation = self$.getParameterValueIfUserDefinedOrDefault("normalApproximation"), + meanRatio = self$meanRatio, + thetaH0 = self$.getParameterValueIfUserDefinedOrDefault("thetaH0"), + alternative = alternativeTemp, + stDev = self$.getParameterValueIfUserDefinedOrDefault("stDev"), + directionUpper = self$.getParameterValueIfUserDefinedOrDefault("directionUpper"), + maxNumberOfSubjects = self$.getParameterValueIfUserDefinedOrDefault("maxNumberOfSubjects"), + groups = self$.getParameterValueIfUserDefinedOrDefault("groups"), + allocationRatioPlanned = self$.getParameterValueIfUserDefinedOrDefault("allocationRatioPlanned") + ) + } + result$.plotSettings <- self$.plotSettings + return(result) } ) ) @@ -538,7 +574,7 @@ TrialDesignPlanRates <- R6::R6Class("TrialDesignPlanRates", pi2 = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["pi2"]], groups = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["groups"]], allocationRatioPlanned = C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_RATES[["allocationRatioPlanned"]]) { - super$initialize(...) # TODO + super$initialize(...) self$normalApproximation <- normalApproximation self$riskRatio <- riskRatio self$thetaH0 <- thetaH0 @@ -573,6 +609,36 @@ TrialDesignPlanRates <- R6::R6Class("TrialDesignPlanRates", show = function(showType = 1, digits = NA_integer_) { "Method for automatically printing trial plan objects" super$show(showType = showType, digits = digits) + }, + recreate = function(pi1 = NA_real_) { + pi1Temp <- pi1 + if (any(is.na(pi1))) { + pi1Temp <- self$pi1 + } + if (self$.objectType == "sampleSize") { + return(getSampleSizeRates( + design = self$.design, + normalApproximation = self$.getParameterValueIfUserDefinedOrDefault("normalApproximation"), + riskRatio = self$riskRatio, + thetaH0 = self$.getParameterValueIfUserDefinedOrDefault("thetaH0"), + pi1 = pi1Temp, + pi2 = self$.getParameterValueIfUserDefinedOrDefault("pi2"), + groups = self$.getParameterValueIfUserDefinedOrDefault("groups"), + allocationRatioPlanned = self$.getParameterValueIfUserDefinedOrDefault("allocationRatioPlanned") + )) + } else { + return(getPowerRates( + design = self$.design, + riskRatio = self$riskRatio, + thetaH0 = self$.getParameterValueIfUserDefinedOrDefault("thetaH0"), + pi1 = pi1Temp, + pi2 = self$.getParameterValueIfUserDefinedOrDefault("pi2"), + directionUpper = self$.getParameterValueIfUserDefinedOrDefault("directionUpper"), + maxNumberOfSubjects = self$.getParameterValueIfUserDefinedOrDefault("maxNumberOfSubjects"), + groups = self$.getParameterValueIfUserDefinedOrDefault("groups"), + allocationRatioPlanned = self$.getParameterValueIfUserDefinedOrDefault("allocationRatioPlanned") + )) + } } ) ) @@ -817,6 +883,82 @@ TrialDesignPlanSurvival <- R6::R6Class("TrialDesignPlanSurvival", argumentName, .arrayToString(argument) ), call. = FALSE) } + }, + recreate = function(hazardRatio = NA_real_, pi1 = NA_real_) { + hr <- NA_real_ + if (.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) { + pi1Temp <- pi1 + if (any(is.na(pi1))) { + pi1Temp <- self$pi1 + } + } + accrualTimeTemp <- self$.getParameterValueIfUserDefinedOrDefault("accrualTime") + if (!is.null(accrualTimeTemp) && length(accrualTimeTemp) > 0 && + !all(is.na(accrualTimeTemp)) && accrualTimeTemp[1] != 0) { + accrualTimeTemp <- c(0, accrualTimeTemp) + } + accrualIntensityTemp <- self$.getParameterValueIfUserDefinedOrDefault("accrualIntensity") + if (all(is.na(accrualIntensityTemp))) { + accrualIntensityTemp <- C_ACCRUAL_INTENSITY_DEFAULT + } + if (self$.objectType == "sampleSize") { + return(getSampleSizeSurvival( + design = self$.design, + typeOfComputation = self$.getParameterValueIfUserDefinedOrDefault("typeOfComputation"), + thetaH0 = self$.getParameterValueIfUserDefinedOrDefault("thetaH0"), + pi1 = pi1Temp, + pi2 = self$.getParameterValueIfUserDefinedOrDefault("pi2"), + allocationRatioPlanned = self$allocationRatioPlanned, + accountForObservationTimes = self$.getParameterValueIfUserDefinedOrDefault("accountForObservationTimes"), + eventTime = self$eventTime, + accrualTime = accrualTimeTemp, + accrualIntensity = accrualIntensityTemp, + kappa = self$kappa, + piecewiseSurvivalTime = self$.getParameterValueIfUserDefinedOrDefault("piecewiseSurvivalTime"), + lambda2 = self$.getParameterValueIfUserDefinedOrDefault("lambda2"), + lambda1 = self$.getParameterValueIfUserDefinedOrDefault("lambda1"), + followUpTime = self$.getParameterValueIfUserDefinedOrDefault("followUpTime"), + maxNumberOfSubjects = self$.getParameterValueIfUserDefinedOrDefault("maxNumberOfSubjects"), + dropoutRate1 = self$dropoutRate1, + dropoutRate2 = self$dropoutRate2, + dropoutTime = self$dropoutTime, + hazardRatio = hr + )) + } else { + directionUpperTemp <- directionUpper + if (length(directionUpperTemp) > 1) { + directionUpperTemp <- directionUpperTemp[1] + } + return(getPowerSurvival( + design = self$.design, + typeOfComputation = self$.getParameterValueIfUserDefinedOrDefault("typeOfComputation"), + thetaH0 = self$.getParameterValueIfUserDefinedOrDefault("thetaH0"), + pi1 = pi1Temp, + pi2 = self$.getParameterValueIfUserDefinedOrDefault("pi2"), + directionUpper = directionUpperTemp, + allocationRatioPlanned = self$allocationRatioPlanned, + eventTime = self$eventTime, + accrualTime = accrualTimeTemp, + accrualIntensity = accrualIntensityTemp, + kappa = self$kappa, + piecewiseSurvivalTime = self$.getParameterValueIfUserDefinedOrDefault("piecewiseSurvivalTime"), + lambda2 = self$.getParameterValueIfUserDefinedOrDefault("lambda2"), + lambda1 = self$.getParameterValueIfUserDefinedOrDefault("lambda1"), + hazardRatio = hr, + maxNumberOfSubjects = self$.getParameterValueIfUserDefinedOrDefault("maxNumberOfSubjects"), + maxNumberOfEvents = self$.getParameterValueIfUserDefinedOrDefault("maxNumberOfEvents"), + dropoutRate1 = self$dropoutRate1, + dropoutRate2 = self$dropoutRate2, + dropoutTime = self$dropoutTime + )) + } } ) ) @@ -956,6 +1098,60 @@ TrialDesignPlanCountData <- R6::R6Class("TrialDesignPlanCountData", .toString = function(startWithUpperCase = FALSE) { s <- "count data" return(ifelse(startWithUpperCase, .firstCharacterToUpperCase(s), s)) + }, + recreate = function(..., lambda1 = NA_real_, theta = NA_real_) { + if (all(is.na(lambda1))) { + lambda1Temp <- self$.getParameterValueIfUserDefinedOrDefault("lambda1") + } else { + lambda1Temp <- lambda1 + if (any(is.na(lambda1))) { + lambda1Temp <- self$lambda1 + } + } + if (all(is.na(theta))) { + thetaTemp <- self$.getParameterValueIfUserDefinedOrDefault("theta") + } else { + thetaTemp <- theta + if (any(is.na(theta))) { + thetaTemp <- self$theta + } + } + if (self$.objectType == "sampleSize") { + result <- getSampleSizeCounts( + design = self$.design, + lambda1 = lambda1Temp, + lambda2 = self$.getParameterValueIfUserDefinedOrDefault("lambda2"), + lambda = self$.getParameterValueIfUserDefinedOrDefault("lambda"), + theta = thetaTemp, + thetaH0 = self$.getParameterValueIfUserDefinedOrDefault("thetaH0"), + overdispersion = self$.getParameterValueIfUserDefinedOrDefault("overdispersion"), + fixedExposureTime = self$.getParameterValueIfUserDefinedOrDefault("fixedExposureTime"), + accrualTime = self$.getParameterValueIfUserDefinedOrDefault("accrualTime"), + accrualIntensity = self$.getParameterValueIfUserDefinedOrDefault("accrualIntensity"), + followUpTime = self$.getParameterValueIfUserDefinedOrDefault("followUpTime"), + maxNumberOfSubjects = self$.getParameterValueIfUserDefinedOrDefault("maxNumberOfSubjects"), + allocationRatioPlanned = self$.getParameterValueIfUserDefinedOrDefault("allocationRatioPlanned") + ) + } else { + result <- getPowerCounts( + design = self$.design, + directionUpper = self$.getParameterValueIfUserDefinedOrDefault("directionUpper"), + maxNumberOfSubjects = self$.getParameterValueIfUserDefinedOrDefault("maxNumberOfSubjects"), + lambda1 = lambda1Temp, + lambda2 = self$.getParameterValueIfUserDefinedOrDefault("lambda2"), + lambda = self$.getParameterValueIfUserDefinedOrDefault("lambda"), + theta = thetaTemp, + thetaH0 = self$.getParameterValueIfUserDefinedOrDefault("thetaH0"), + overdispersion = self$.getParameterValueIfUserDefinedOrDefault("overdispersion"), + fixedExposureTime = self$.getParameterValueIfUserDefinedOrDefault("fixedExposureTime"), + accrualTime = self$.getParameterValueIfUserDefinedOrDefault("accrualTime"), + accrualIntensity = self$.getParameterValueIfUserDefinedOrDefault("accrualIntensity"), + followUpTime = self$.getParameterValueIfUserDefinedOrDefault("followUpTime"), + allocationRatioPlanned = self$.getParameterValueIfUserDefinedOrDefault("allocationRatioPlanned") + ) + } + result$.plotSettings <- self$.plotSettings + return(result) } ) ) diff --git a/R/class_design_power_and_asn.R b/R/class_design_power_and_asn.R index bf52baa1..afe6f936 100644 --- a/R/class_design_power_and_asn.R +++ b/R/class_design_power_and_asn.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7620 $ -## | Last changed: $Date: 2024-02-09 12:57:37 +0100 (Fr, 09 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/class_design_set.R b/R/class_design_set.R index 29bcfeb2..e7b28118 100644 --- a/R/class_design_set.R +++ b/R/class_design_set.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7645 $ -## | Last changed: $Date: 2024-02-16 16:12:34 +0100 (Fr, 16 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -882,7 +882,7 @@ plot.TrialDesignSet <- function(x, y, ..., type = 1L, main = NA_character_, legendPosition = NA_integer_, showSource = FALSE, designSetName = NA_character_, plotSettings = NULL) { .assertGgplotIsInstalled() - if (!is.call(main) && !isS4(main) && !R6::is.R6(main)) { # TODO is.R6 added + if (!is.call(main) && !.isResultObjectBaseClass(main)) { .assertIsSingleCharacter(main, "main", naAllowed = TRUE) } .assertIsSingleCharacter(xlab, "xlab", naAllowed = TRUE) @@ -900,7 +900,7 @@ plot.TrialDesignSet <- function(x, y, ..., type = 1L, main = NA_character_, .assertIsTrialDesign(designMaster) if (type == 1) { - main <- if (!is.call(main) && !isS4(main) && !R6::is.R6(main) && is.na(main)) "Boundaries" else main + main <- if (!is.call(main) && !.isResultObjectBaseClass(main) && is.na(main)) "Boundaries" else main xParameterName <- "informationRates" yParameterNames <- "criticalValues" @@ -916,11 +916,11 @@ plot.TrialDesignSet <- function(x, y, ..., type = 1L, main = NA_character_, } else if (type == 2) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "designs with undefined endpoint do not support plot type 2") } else if (type == 3) { - main <- if (!is.call(main) && !isS4(main) && !R6::is.R6(main) && is.na(main)) "Stage Levels" else main + main <- if (!is.call(main) && !.isResultObjectBaseClass(main) && is.na(main)) "Stage Levels" else main xParameterName <- "informationRates" yParameterNames <- "stageLevels" } else if (type == 4) { - main <- if (!is.call(main) && !isS4(main) && !R6::is.R6(main) && is.na(main)) "Error Spending" else main + main <- if (!is.call(main) && !.isResultObjectBaseClass(main) && is.na(main)) "Error Spending" else main xParameterName <- "informationRates" yParameterNames <- c("alphaSpent") if (!.isTrialDesignFisher(designMaster) && @@ -930,35 +930,35 @@ plot.TrialDesignSet <- function(x, y, ..., type = 1L, main = NA_character_, } plotPointsEnabled <- ifelse(is.na(plotPointsEnabled), FALSE, plotPointsEnabled) } else if (type == 5) { - if (!is.call(main) && !isS4(main) && !R6::is.R6(main) && is.na(main)) { + if (!is.call(main) && !.isResultObjectBaseClass(main) && is.na(main)) { main <- PlotSubTitleItems$new(title = "Power and Early Stopping") main$add("N", nMax, "max") } xParameterName <- "theta" yParameterNames <- c("overallEarlyStop", "calculatedPower") } else if (type == 6) { - if (!is.call(main) && !isS4(main) && !R6::is.R6(main) && is.na(main)) { + if (!is.call(main) && !.isResultObjectBaseClass(main) && is.na(main)) { main <- PlotSubTitleItems$new(title = "Average Sample Size and Power / Early Stop") main$add("N", nMax, "max") } xParameterName <- "theta" yParameterNames <- c("averageSampleNumber", "overallEarlyStop", "calculatedPower") } else if (type == 7) { - if (!is.call(main) && !isS4(main) && !R6::is.R6(main) && is.na(main)) { + if (!is.call(main) && !.isResultObjectBaseClass(main) && is.na(main)) { main <- PlotSubTitleItems$new(title = "Power") main$add("N", nMax, "max") } xParameterName <- "theta" yParameterNames <- "calculatedPower" } else if (type == 8) { - if (!is.call(main) && !isS4(main) && !R6::is.R6(main) && is.na(main)) { + if (!is.call(main) && !.isResultObjectBaseClass(main) && is.na(main)) { main <- PlotSubTitleItems$new(title = "Early Stopping") main$add("N", nMax, "max") } xParameterName <- "theta" yParameterNames <- "overallEarlyStop" } else if (type == 9) { - if (!is.call(main) && !isS4(main) && !R6::is.R6(main) && is.na(main)) { + if (!is.call(main) && !.isResultObjectBaseClass(main) && is.na(main)) { main <- PlotSubTitleItems$new(title = "Average Sample Size") main$add("N", nMax, "max") } diff --git a/R/class_dictionary.R b/R/class_dictionary.R index eed9d022..3503f14d 100644 --- a/R/class_dictionary.R +++ b/R/class_dictionary.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7476 $ -## | Last changed: $Date: 2023-12-07 11:57:03 +0100 (Do, 07 Dez 2023) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/class_event_probabilities.R b/R/class_event_probabilities.R index 174ffa41..d1d90c7b 100644 --- a/R/class_event_probabilities.R +++ b/R/class_event_probabilities.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7620 $ -## | Last changed: $Date: 2024-02-09 12:57:37 +0100 (Fr, 09 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/class_performance_score.R b/R/class_performance_score.R index 1bbfbfea..f4ac54c7 100644 --- a/R/class_performance_score.R +++ b/R/class_performance_score.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7620 $ -## | Last changed: $Date: 2024-02-09 12:57:37 +0100 (Fr, 09 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/class_simulation_results.R b/R/class_simulation_results.R index 56b518ba..c1efc115 100644 --- 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: 7665 $ -## | Last changed: $Date: 2024-02-23 17:33:46 +0100 (Fr, 23 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -1026,7 +1026,6 @@ SimulationResultsBaseSurvival <- R6::R6Class("SimulationResultsBaseSurvival", thetaH1 = NULL, calcEventsFunction = NULL, expectedNumberOfEvents = NULL, - # conditionalPowerAchieved = matrix(), #TODO remove? initialize = function(design, ...) { super$initialize(design = design, ...) generatedParams <- c( @@ -1616,6 +1615,80 @@ SimulationResultsEnrichmentSurvival <- R6::R6Class("SimulationResultsEnrichmentS ) ) +#' +#' @name SimulationResultsBaseCountData +#' +#' @title +#' Class for Simulation Results Count Data +#' +#' @description +#' A class for simulation results count data. +#' +#' @template field_maxNumberOfIterations +#' @template field_seed +#' @template field_allocationRatioPlanned +#' @template field_conditionalPower +#' @template field_iterations +#' @template field_futilityPerStage +#' @template field_thetaH0 +#' @template field_accrualTime +#' @template field_accrualIntensity +#' @template field_groups +#' @template field_directionUpper +#' @template field_earlyStop +#' @template field_sampleSizes +#' @template field_overallReject +#' @template field_rejectPerStage +#' +#' @details +#' Use \code{\link[=getSimulationCounts]{getSimulationCounts()}} to create an object of this type. +#' +#' @include class_core_parameter_set.R +#' @include class_core_plot_settings.R +#' @include class_design.R +#' @include f_core_constants.R +#' @include f_simulation_base_count_data.R +#' +#' @keywords internal +#' +#' @importFrom methods new +#' +SimulationResultsBaseCountData <- R6::R6Class("SimulationResultsBaseCountData", + inherit = SimulationResults, + public = list( + plannedMaxSubjects = NULL, + plannedCalendarTime = NULL, + directionUpper = NULL, + lambda1 = NULL, + lambda2 = NULL, + lambda = NULL, + theta = NULL, + thetaH0 = NULL, + overdispersion = NULL, + fixedExposureTime = NULL, + accrualTime = NULL, + accrualIntensity = NULL, + followUpTime = NULL, + groups = NULL, + numberOfSubjects = NULL, + numberOfSubjects1 = NULL, + numberOfSubjects2 = NULL, + iterations = NULL, + futilityStop = NULL, + futilityPerStage = NULL, + rejectPerStage = NULL, + earlyStop = NULL, + overallReject = NULL, + calcSubjectsFunction = NULL, + initialize = function(design, ...) { + super$initialize(design = design, ...) + self$groups <- 2L + self$.setParameterType("conditionalPower", C_PARAM_NOT_APPLICABLE) + self$.setParameterType("futilityStop", C_PARAM_NOT_APPLICABLE) + } + ) +) + #' #' @title #' Print Simulation Results diff --git a/R/class_summary.R b/R/class_summary.R index f15a009b..f4e5949c 100644 --- 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: 7668 $ -## | Last changed: $Date: 2024-02-26 10:47:27 +0100 (Mo, 26 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/class_time.R b/R/class_time.R index 8c76d40d..8226ba10 100644 --- a/R/class_time.R +++ b/R/class_time.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7659 $ -## | Last changed: $Date: 2024-02-23 10:42:33 +0100 (Fr, 23 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -1409,7 +1409,7 @@ AccrualTime <- R6::R6Class("AccrualTime", self$.initAccrualIntensityAbsolute() self$.validateFormula() - self$.showWarningIfCaseIsNotAllowed() # TODO wrong naming upstream! + self$.showWarningIfCaseIsNotAllowed() }, .asDataFrame = function() { accrualIntensityTemp <- self$accrualIntensity diff --git a/R/f_analysis_base.R b/R/f_analysis_base.R index 3eca7fdd..a28c6bb8 100644 --- 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: 7526 $ -## | Last changed: $Date: 2023-12-21 13:38:20 +0100 (Do, 21 Dez 2023) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/f_analysis_base_means.R b/R/f_analysis_base_means.R index d347617d..6aba593d 100644 --- a/R/f_analysis_base_means.R +++ b/R/f_analysis_base_means.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7147 $ -## | Last changed: $Date: 2023-07-03 08:10:31 +0200 (Mo, 03 Jul 2023) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/f_analysis_base_rates.R b/R/f_analysis_base_rates.R index 225b2c5f..697ca339 100644 --- a/R/f_analysis_base_rates.R +++ b/R/f_analysis_base_rates.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7126 $ -## | Last changed: $Date: 2023-06-23 14:26:39 +0200 (Fr, 23 Jun 2023) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/f_analysis_base_survival.R b/R/f_analysis_base_survival.R index 06d9aca0..9b7d0e67 100644 --- a/R/f_analysis_base_survival.R +++ b/R/f_analysis_base_survival.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7535 $ -## | Last changed: $Date: 2024-01-08 09:39:31 +0100 (Mo, 08 Jan 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/f_analysis_enrichment_means.R b/R/f_analysis_enrichment_means.R index 4052763e..d2ff7cd1 100644 --- a/R/f_analysis_enrichment_means.R +++ b/R/f_analysis_enrichment_means.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7126 $ -## | Last changed: $Date: 2023-06-23 14:26:39 +0200 (Fr, 23 Jun 2023) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/f_analysis_enrichment_rates.R b/R/f_analysis_enrichment_rates.R index 0e3df259..da8979b7 100644 --- a/R/f_analysis_enrichment_rates.R +++ b/R/f_analysis_enrichment_rates.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7126 $ -## | Last changed: $Date: 2023-06-23 14:26:39 +0200 (Fr, 23 Jun 2023) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/f_analysis_enrichment_survival.R b/R/f_analysis_enrichment_survival.R index f9913aa5..9b30874c 100644 --- a/R/f_analysis_enrichment_survival.R +++ b/R/f_analysis_enrichment_survival.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7126 $ -## | Last changed: $Date: 2023-06-23 14:26:39 +0200 (Fr, 23 Jun 2023) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | ## | @@ -1058,7 +1058,7 @@ NULL stdErr <- 2 / sqrt(stageResults$.overallEvents[, stage]) - results <- ConditionalPowerResultsEnrichmentSurvival( + results <- ConditionalPowerResultsEnrichmentSurvival$new( .design = design, .stageResults = stageResults, nPlanned = nPlanned, diff --git a/R/f_analysis_multiarm.R b/R/f_analysis_multiarm.R index 3769bdd0..97f8f546 100644 --- a/R/f_analysis_multiarm.R +++ b/R/f_analysis_multiarm.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7379 $ -## | Last changed: $Date: 2023-10-30 16:19:12 +0100 (Mo, 30 Okt 2023) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/f_analysis_multiarm_means.R b/R/f_analysis_multiarm_means.R index d995c239..cbd14df3 100644 --- a/R/f_analysis_multiarm_means.R +++ b/R/f_analysis_multiarm_means.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7206 $ -## | Last changed: $Date: 2023-07-25 14:55:05 +0200 (Tue, 25 Jul 2023) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -85,7 +85,8 @@ NULL allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, calculateSingleStepAdjusted = FALSE, tolerance = C_ANALYSIS_TOLERANCE_DEFAULT, - iterations = C_ITERATIONS_DEFAULT, seed = NA_real_) { + iterations = C_ITERATIONS_DEFAULT, + seed = NA_real_) { .assertIsTrialDesignFisher(design) .assertIsValidIterationsAndSeed(iterations, seed, zeroIterationsAllowed = FALSE) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) @@ -122,7 +123,9 @@ NULL nPlanned = NA_real_, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, calculateSingleStepAdjusted = FALSE, - tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { + tolerance = C_ANALYSIS_TOLERANCE_DEFAULT, + iterations = C_ITERATIONS_DEFAULT, + seed = NA_real_) { .assertIsTrialDesignConditionalDunnett(design) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .warnInCaseOfUnknownArguments( diff --git a/R/f_analysis_multiarm_rates.R b/R/f_analysis_multiarm_rates.R index 3cd7cff1..6950ccb0 100644 --- a/R/f_analysis_multiarm_rates.R +++ b/R/f_analysis_multiarm_rates.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7126 $ -## | Last changed: $Date: 2023-06-23 14:26:39 +0200 (Fr, 23 Jun 2023) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -136,7 +136,8 @@ NULL normalApproximation = C_NORMAL_APPROXIMATION_RATES_DEFAULT, thetaH0 = C_THETA_H0_RATES_DEFAULT, piTreatments = NA_real_, piControl = NA_real_, nPlanned = NA_real_, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, - tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { + tolerance = C_ANALYSIS_TOLERANCE_DEFAULT, + iterations = C_ITERATIONS_DEFAULT, seed = NA_real_) { .assertIsTrialDesignConditionalDunnett(design) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .warnInCaseOfUnknownArguments( diff --git a/R/f_analysis_multiarm_survival.R b/R/f_analysis_multiarm_survival.R index 2d895294..18e1393e 100644 --- a/R/f_analysis_multiarm_survival.R +++ b/R/f_analysis_multiarm_survival.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7126 $ -## | Last changed: $Date: 2023-06-23 14:26:39 +0200 (Fr, 23 Jun 2023) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -134,7 +134,8 @@ NULL thetaH1 = NA_real_, nPlanned = NA_real_, allocationRatioPlanned = C_ALLOCATION_RATIO_DEFAULT, - tolerance = C_ANALYSIS_TOLERANCE_DEFAULT) { + tolerance = C_ANALYSIS_TOLERANCE_DEFAULT, + iterations = C_ITERATIONS_DEFAULT, seed = NA_real_) { .assertIsTrialDesignConditionalDunnett(design) stage <- .getStageFromOptionalArguments(..., dataInput = dataInput, design = design) .warnInCaseOfUnknownArguments( diff --git a/R/f_analysis_utilities.R b/R/f_analysis_utilities.R index c47aae38..bed2a330 100644 --- a/R/f_analysis_utilities.R +++ b/R/f_analysis_utilities.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7645 $ -## | Last changed: $Date: 2024-02-16 16:12:34 +0100 (Fr, 16 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/f_as251.R b/R/f_as251.R index 3f868ae5..73aa4ad4 100644 --- a/R/f_as251.R +++ b/R/f_as251.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7547 $ -## | Last changed: $Date: 2024-01-10 08:13:40 +0100 (Mi, 10 Jan 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/f_core_assertions.R b/R/f_core_assertions.R index 0816d8f4..d8dafe2f 100644 --- a/R/f_core_assertions.R +++ b/R/f_core_assertions.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7712 $ -## | Last changed: $Date: 2024-03-12 08:24:58 +0100 (Di, 12 Mrz 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -37,7 +37,7 @@ NULL } .isParameterSet <- function(x) { - return(R6::is.R6(x) && inherits(x, "ParameterSet")) + return(.isResultObjectBaseClass(x) && inherits(x, "ParameterSet")) } .assertIsParameterSetClass <- function(x, objectName = "x") { @@ -559,7 +559,7 @@ NULL if ((!naAllowed && is.na(x)) || !is.logical(x)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' (", - ifelse(isS4(x) || R6::is.R6(x), .getClassName(x), x), ") must be a single logical value", + ifelse(.isResultObjectBaseClass(x), .getClassName(x), x), ") must be a single logical value", call. = call. ) } @@ -586,7 +586,7 @@ NULL if ((!naAllowed && is.na(x)) || !is.numeric(x)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", argumentName, "' (", - ifelse(isS4(x) || R6::is.R6(x), .getClassName(x), x), ") must be a valid numeric value", + ifelse(.isResultObjectBaseClass(x), .getClassName(x), x), ") must be a valid numeric value", call. = call. ) } @@ -629,7 +629,7 @@ NULL (!validateType && !is.na(x) && !is.infinite(x) && as.integer(x) != x)) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'", argumentName, "' (", ifelse(isS4(x) || R6::is.R6(x), .getClassName(x), x), ") must be a ", prefix, "integer value", + "'", argumentName, "' (", ifelse(.isResultObjectBaseClass(x), .getClassName(x), x), ") must be a ", prefix, "integer value", call. = call. ) } @@ -637,7 +637,7 @@ NULL if (mustBePositive && !is.na(x) && !is.infinite(x) && x <= 0) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'", argumentName, "' (", ifelse(isS4(x) || R6::is.R6(x), .getClassName(x), x), ") must be a ", prefix, "integer value", + "'", argumentName, "' (", ifelse(.isResultObjectBaseClass(x), .getClassName(x), x), ") must be a ", prefix, "integer value", call. = call. ) } @@ -1410,7 +1410,7 @@ NULL argNames[i] ) if (!(argName %in% ignore) && !grepl("^\\.", argName)) { - if (isS4(arg) || is.environment(arg) || R6::is.R6(arg)) { + if (.isResultObjectBaseClass(arg) || is.environment(arg)) { arg <- .getClassName(arg) } if (is.function(arg)) { diff --git a/R/f_core_constants.R b/R/f_core_constants.R index 1321a5b3..a4f8ba02 100644 --- a/R/f_core_constants.R +++ b/R/f_core_constants.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7656 $ -## | Last changed: $Date: 2024-02-22 10:55:00 +0100 (Do, 22 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/f_core_output_formats.R b/R/f_core_output_formats.R index 61808760..8844b17a 100644 --- a/R/f_core_output_formats.R +++ b/R/f_core_output_formats.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7383 $ -## | Last changed: $Date: 2023-11-02 15:18:21 +0100 (Do, 02 Nov 2023) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/f_core_plot.R b/R/f_core_plot.R index 0a633de2..ad5fc0dd 100644 --- 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: 7645 $ -## | Last changed: $Date: 2024-02-16 16:12:34 +0100 (Fr, 16 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -850,8 +850,8 @@ getAvailablePlotTypes <- function(obj, output = c("numeric", "caption", "numcap" "overallEarlyStop", "calculatedPower" ))] fieldNames <- c( - names(parameterSet), # TODO - names(designMaster) # TODO + names(parameterSet), + names(designMaster) ) if (simulationEnrichmentEnmabled) { fieldNames <- c(fieldNames, gsub("s$", "", names(parameterSet$effectList)), "situation") diff --git a/R/f_core_utilities.R b/R/f_core_utilities.R index 52c1588c..b63e8048 100644 --- 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: 7645 $ -## | Last changed: $Date: 2024-02-16 16:12:34 +0100 (Fr, 16 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -764,7 +764,7 @@ NULL stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'parameterSet' must be not null") } - if (!ifelse(R6::is.R6(parameterSet), parameterName %in% names(parameterSet), parameterName %in% names(getClass(class(parameterSet))@fieldClasses))) { # TODO + if (!(parameterName %in% names(parameterSet))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'", .getClassName(parameterSet), "' does not contain a field with name '", parameterName, "'" @@ -1017,6 +1017,10 @@ printCitation <- function(inclusiveR = TRUE, language = "en") { return(decimalPlaces) } +.isResultObjectBaseClass <- function(x) { + return(R6::is.R6(x)) +} + #' #' @title #' Get Parameter Caption @@ -1041,7 +1045,7 @@ printCitation <- function(inclusiveR = TRUE, language = "en") { #' @export #' getParameterCaption <- function(obj, parameterName) { - if (is.null(obj) || length(obj) != 1 || !isS4(obj) || !R6::is.R6(obj) || !inherits(obj, "FieldSet")) { + if (is.null(obj) || !.isResultObjectBaseClass(obj) || !inherits(obj, "FieldSet")) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'obj' (", .getClassName(obj), ") must be an rpact result object") } .assertIsSingleCharacter(parameterName, "parameterName", naAllowed = FALSE) @@ -1074,7 +1078,7 @@ getParameterCaption <- function(obj, parameterName) { #' @export #' getParameterName <- function(obj, parameterCaption) { - if (is.null(obj) || length(obj) != 1 || !isS4(obj) || !R6::is.R6(obj) || !inherits(obj, "FieldSet")) { + if (is.null(obj) || !.isResultObjectBaseClass(obj) || !inherits(obj, "FieldSet")) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'obj' (", .getClassName(obj), ") must be an rpact result object") } .assertIsSingleCharacter(parameterCaption, "parameterCaption", naAllowed = FALSE) diff --git a/R/f_design_fisher_combination_test.R b/R/f_design_fisher_combination_test.R index e30a3232..0cf2af60 100644 --- a/R/f_design_fisher_combination_test.R +++ b/R/f_design_fisher_combination_test.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7644 $ -## | Last changed: $Date: 2024-02-16 10:36:28 +0100 (Fr, 16 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -322,7 +322,7 @@ getDesignFisher <- function(..., if (length(diff) > 0 && any(diff > 1e-12)) { .logDebug( "Stop creation of Fisher design because critical values are ", - .arrayToString(criticalValues, vectorLookAndFeelEnabled = TRUE), ", ", + .arrayToString(design$criticalValues, vectorLookAndFeelEnabled = TRUE), ", ", "i.e., differences are ", .arrayToString(diff, vectorLookAndFeelEnabled = TRUE) ) stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "no calculation possible") diff --git a/R/f_design_general_utilities.R b/R/f_design_general_utilities.R index 938d7250..b8033378 100644 --- 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: 7461 $ -## | Last changed: $Date: 2023-12-01 10:24:25 +0100 (Fr, 01 Dez 2023) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/f_design_group_sequential.R b/R/f_design_group_sequential.R index 9784ee03..c7ca127a 100644 --- a/R/f_design_group_sequential.R +++ b/R/f_design_group_sequential.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7703 $ -## | Last changed: $Date: 2024-03-07 13:38:48 +0100 (Do, 07 Mrz 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/f_design_plan_count_data.R b/R/f_design_plan_count_data.R index eb4ec4df..a5f2d590 100644 --- a/R/f_design_plan_count_data.R +++ b/R/f_design_plan_count_data.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7620 $ -## | Last changed: $Date: 2024-02-09 12:57:37 +0100 (Fr, 09 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/f_design_plan_means.R b/R/f_design_plan_means.R index 8ff4e080..843c1411 100644 --- a/R/f_design_plan_means.R +++ b/R/f_design_plan_means.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7652 $ -## | Last changed: $Date: 2024-02-21 16:23:54 +0100 (Mi, 21 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/f_design_plan_plot.R b/R/f_design_plan_plot.R index b19e055b..0ffe92a3 100644 --- a/R/f_design_plan_plot.R +++ b/R/f_design_plan_plot.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7701 $ -## | Last changed: $Date: 2024-03-07 11:44:08 +0100 (Do, 07 Mrz 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -237,7 +237,7 @@ } parameterList <- list() parameterList[[result$thetaName]] <- .getVariedParameterVector(result$theta, result$thetaName) - designPlan <- do.call(designPlan$clone, parameterList) + designPlan <- do.call(designPlan$recreate, parameterList) } } diff --git a/R/f_design_plan_rates.R b/R/f_design_plan_rates.R index c7d20f47..00ceb7cb 100644 --- a/R/f_design_plan_rates.R +++ b/R/f_design_plan_rates.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7652 $ -## | Last changed: $Date: 2024-02-21 16:23:54 +0100 (Mi, 21 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/f_design_plan_survival.R b/R/f_design_plan_survival.R index f8b9218a..4542d985 100644 --- a/R/f_design_plan_survival.R +++ b/R/f_design_plan_survival.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7662 $ -## | Last changed: $Date: 2024-02-23 12:42:26 +0100 (Fr, 23 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -533,7 +533,7 @@ NULL } } else { warning("Follow-up time could not be calculated for hazardRatio = ", - .arrayToString(designPlan$hazardRatio[indices]), + .arrayToString(designPlan$hazardRatio), call. = FALSE ) } diff --git a/R/f_design_plan_utilities.R b/R/f_design_plan_utilities.R index b3088d32..e63df07a 100644 --- a/R/f_design_plan_utilities.R +++ b/R/f_design_plan_utilities.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7652 $ -## | Last changed: $Date: 2024-02-21 16:23:54 +0100 (Mi, 21 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/f_object_r_code.R b/R/f_object_r_code.R index 2efb969a..3e3f84a3 100644 --- a/R/f_object_r_code.R +++ b/R/f_object_r_code.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7659 $ -## | Last changed: $Date: 2024-02-23 10:42:33 +0100 (Fr, 23 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -59,7 +59,7 @@ NULL } } - if (is.function(x) || isS4(x) || R6::is.R6(x)) { + if (is.function(x) || .isResultObjectBaseClass(x)) { return("NULL") } diff --git a/R/f_parameter_set_utilities.R b/R/f_parameter_set_utilities.R index 35078542..e52001d8 100644 --- a/R/f_parameter_set_utilities.R +++ b/R/f_parameter_set_utilities.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7620 $ -## | Last changed: $Date: 2024-02-09 12:57:37 +0100 (Fr, 09 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -91,7 +91,7 @@ NULL parameterName <- result$parameterName paramValue <- result$paramValue - if (isS4(paramValue) || R6::is.R6(paramValue)) { + if (.isResultObjectBaseClass(paramValue)) { return(NULL) } diff --git a/R/f_quality_assurance.R b/R/f_quality_assurance.R index becc9ccd..ce8df6b5 100644 --- a/R/f_quality_assurance.R +++ b/R/f_quality_assurance.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7620 $ -## | Last changed: $Date: 2024-02-09 12:57:37 +0100 (Fr, 09 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -504,7 +504,7 @@ testPackage <- function(outDir = ".", ..., if (completeUnitTestSetEnabled && fullTestEnabled) { cat("Run all tests. Please wait...\n") - cat("Have a break - it takes about 30 minutes.\n") + cat("Have a break - it takes about 20 minutes.\n") cat("Exceution of all available unit tests startet at ", format(startTime, "%H:%M (%d-%B-%Y)"), "\n", sep = "" diff --git a/R/f_simulation_base_count_data.R b/R/f_simulation_base_count_data.R new file mode 100644 index 00000000..9b63fe7e --- /dev/null +++ b/R/f_simulation_base_count_data.R @@ -0,0 +1,556 @@ +## | +## | *Simulation of count data* +## | +## | This file is part of the R package rpact: +## | Confirmatory Adaptive Clinical Trial Design and Analysis +## | +## | Author: Gernot Wassmer, PhD, Tobias Muetze, PhD, and Friedrich Pahlke, PhD +## | Licensed under "GNU Lesser General Public License" version 3 +## | License text can be found here: https://www.r-project.org/Licenses/LGPL-3 +## | +## | RPACT company website: https://www.rpact.com +## | rpact package website: https://www.rpact.org +## | +## | 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) $ +## | Last changed by: $Author: pahlke $ +## | + +.getInformationCountData <- function(lambda1, + lambda2, + overdispersion, + recruit1, + recruit2) { + sumLambda1 <- sum(recruit1 * lambda1 / + (1 + overdispersion * recruit1 * lambda1)) + sumLambda2 <- sum(recruit2 * lambda2 / + (1 + overdispersion * recruit2 * lambda2)) + return(1 / (1 / sumLambda1 + 1 / sumLambda2)) +} + +.getGeneratedEventTimesCountData <- function(recruit1, recruit2, accrualTime, followUpTime, + lambda1, lambda2, overdispersion, fixedFollowUp = FALSE) { + n1 <- length(recruit1) + n2 <- length(recruit2) + totalRecruitment <- c(recruit1, recruit2) + + if (fixedFollowUp) { + followUp <- rep(followUpTime, times = n1 + n2) + } else { + followUp <- accrualTime + followUpTime - totalRecruitment + } + + # generate number of events by subject + nEvents <- rnbinom( + n = n1 + n2, + mu = c(lambda1 * followUp[1:n1], lambda2 * followUp[(n1 + 1):(n1 + n2)]), + size = 1 / overdispersion + ) + + # generate event times through a homogeneous Poisson process + output <- matrix(NA, nrow = sum(nEvents) + n1 + n2, ncol = 8) + colnames(output) <- c( + "id", "recruitTime", "startEvent", "stopEvent", + "startCalendar", "stopCalendar", "status", "group" + ) + index <- 1 + for (i in 1:(n1 + n2)) { + if (nEvents[i] == 0) { + output[index, c("id", "recruitTime", "startEvent", "stopEvent")] <- + c(i, totalRecruitment[i], 0, followUp[i]) + output[index, "status"] <- c(0) + output[index, "group"] <- if (i <= n1) 1 else 2 + index <- index + 1 + } else if (nEvents[i] != 0) { + eventTime <- sort(runif(nEvents[i], min = 0, max = followUp[i])) + indices <- index:(index + nEvents[i]) + output[indices, "id"] <- i + output[indices, "recruitTime"] <- totalRecruitment[i] + output[indices, "startEvent"] <- c(0, eventTime) + output[indices, "stopEvent"] <- c(eventTime, followUp[i]) + output[indices, "status"] <- c(rep(1, times = nEvents[i]), 0) + output[indices, "group"] <- if (i <= n1) 1 else 2 + index <- index + nEvents[i] + 1 + } + } + + # calculate the calendar times + output[, "startCalendar"] <- output[, "recruitTime"] + output[, "startEvent"] + output[, "stopCalendar"] <- output[, "recruitTime"] + output[, "stopEvent"] + + return(list(output = output, nEvents = nEvents)) +} + +#' @title +#' Get Simulation Counts +#' +#' @description +#' Returns the simulated power, stopping probabilities, conditional power, and expected sample size for +#' testing means rates for negative binomial distributed event numbers in the two treatment groups testing situation. +#' +#' @inheritParams param_design_with_default +#' @inheritParams param_thetaH0 +#' @inheritParams param_lambda_counts +#' @inheritParams param_lambda1_counts +#' @inheritParams param_lambda2_counts +#' @inheritParams param_theta_counts +#' @inheritParams param_fixedExposureTime_counts +#' @inheritParams param_accrualTime_counts +#' @inheritParams param_accrualIntensity_counts +#' @inheritParams param_followUpTime_counts +#' @inheritParams param_plannedMaxSubjects +#' @inheritParams param_overdispersion_counts +#' @inheritParams param_directionUpper +#' @inheritParams param_allocationRatioPlanned +#' @inheritParams param_plannedSubjects +#' @inheritParams param_minNumberOfSubjectsPerStage +#' @inheritParams param_plannedMaxSubjectsPerStage +#' @inheritParams param_conditionalPowerSimulation +#' @param lambda1H1 If specified, the assumed probability in the active treatment group if two treatment groups +#' are considered, or the assumed probability for a one treatment group design, for which the conditional +#' power was calculated. +#' @param lambda2H1 If specified, the assumed probability in the reference group if two treatment groups +#' are considered, for which the conditional power was calculated. +#' @inheritParams param_maxNumberOfIterations +#' @inheritParams param_calcSubjectsFunction +#' @inheritParams param_seed +#' @inheritParams param_three_dots +#' @inheritParams param_showStatistics +#' +#' +#' @details +#' At given design the function simulates the power, stopping probabilities, conditional power, and expected +#' sample size at given number of subjects and parameter configuration. +#' Additionally, an allocation ratio = n1/n2 and a null hypothesis value thetaH0 can be specified. +#' +#' The definition of \code{lambda1H1} and/or \code{lambda2H1} makes only sense if \code{kMax} > 1 +#' and if \code{conditionalPower}, \code{minNumberOfSubjectsPerStage}, and +#' \code{plannedMaxSubjectsPerStage} (or \code{calcSubjectsFunction}) are defined. +#' +#' @section Simulation Data: +#' The summary statistics "Simulated data" contains the following parameters: median [range]; mean +/-sd\cr +#' +#' \code{$show(showStatistics = FALSE)} or \code{$setShowStatistics(FALSE)} can be used to disable +#' the output of the aggregated simulated data.\cr +#' +#' Example 1: \cr +#' \code{simulationResults <- getSimulationRates(plannedSubjects = 40)} \cr +#' \code{simulationResults$show(showStatistics = FALSE)}\cr +#' +#' Example 2: \cr +#' \code{simulationResults <- getSimulationRates(plannedSubjects = 40)} \cr +#' \code{simulationResults$setShowStatistics(FALSE)}\cr +#' \code{simulationResults}\cr +#' +#' \code{\link[=getData]{getData()}} can be used to get the aggregated simulated data from the +#' object as \code{\link[base]{data.frame}}. The data frame contains the following columns: +#' \enumerate{ +#' \item \code{iterationNumber}: The number of the simulation iteration. +#' \item \code{stageNumber}: The stage. +#' \item \code{lambda1}: The assumed or derived event rate in the treatment group (if available). +#' \item \code{lambda2}: The assumed or derived event rate in the control group (if available). +#' \item \code{numberOfSubjects}: The number of subjects under consideration when the +#' (interim) analysis takes place. +#' \item \code{rejectPerStage}: 1 if null hypothesis can be rejected, 0 otherwise. +#' \item \code{futilityPerStage}: 1 if study should be stopped for futility, 0 otherwise. +#' \item \code{testStatistic}: The test statistic that is used for the test decision, +#' depends on which design was chosen (group sequential, inverse normal, +#' or Fisher combination test)' +#' \item \code{testStatisticsPerStage}: The test statistic for each stage if only data from +#' the considered stage is taken into account. +#' \item \code{overallLambda1}: The cumulative rate in treatment group 1. +#' \item \code{overallLambda2}: The cumulative rate in treatment group 2. +#' \item \code{stagewiseLambda1}: The stage-wise rate in treatment group 1. +#' \item \code{stagewiseLambda2}: The stage-wise rate in treatment group 2. +#' \item \code{sampleSizesPerStage1}: The stage-wise sample size in treatment group 1. +#' \item \code{sampleSizesPerStage2}: The stage-wise sample size in treatment group 2. +#' \item \code{trialStop}: \code{TRUE} if study should be stopped for efficacy or futility or final stage, \code{FALSE} otherwise. +#' \item \code{conditionalPowerAchieved}: The conditional power for the subsequent stage of the trial for +#' selected sample size and effect. The effect is either estimated from the data or can be +#' user defined with \code{lambda1H1} and \code{lambda2H1}. +#' } +#' +#' @template return_object_simulation_results +#' @template how_to_get_help_for_generics +#' +#' @template examples_get_simulation_count_data +#' +#' @export +#' +getSimulationCounts <- function(design = NULL, + ..., + plannedCalendarTime, + plannedMaxSubjects = NA_real_, + lambda1 = NA_real_, + lambda2 = NA_real_, + lambda = NA_real_, + theta = NA_real_, + directionUpper = TRUE, # C_DIRECTION_UPPER_DEFAULT + thetaH0 = 1, + overdispersion = 0, + fixedExposureTime = NA_real_, + accrualTime = NA_real_, + accrualIntensity = NA_real_, + followUpTime = NA_real_, + allocationRatioPlanned = NA_real_, + maxNumberOfIterations = 1000L, # C_MAX_SIMULATION_ITERATIONS_DEFAULT + seed = NA_real_, + calcSubjectsFunction = NULL, + showStatistics = FALSE) { + if (is.na(directionUpper)) { + directionUpper <- TRUE + } + if (is.null(design)) { + design <- .getDefaultDesign(..., type = "simulation") + .warnInCaseOfUnknownArguments( + functionName = "getSimulationCounts", + ignore = .getDesignArgumentsToIgnoreAtUnknownArgumentCheck( + design, + powerCalculationEnabled = TRUE + ) + ) + } else { + .assertIsTrialDesign(design) + .warnInCaseOfUnknownArguments( + functionName = "getSimulationCounts", + ignore = c("showStatistics"), ... + ) + .warnInCaseOfTwoSidedPowerArgument(...) + .warnInCaseOfTwoSidedPowerIsDisabled(design) + } + if (!any(is.na(theta))) { + totalCases <- length(theta) + lambda1 <- rep(NA_real_, totalCases) + } else if (!any(is.na(lambda1))) { + totalCases <- length(lambda1) + } else { + totalCases <- 1 + } + + kMax <- design$kMax + alpha <- design$alpha + sided <- design$sided + sampleSizeEnabled <- FALSE + + allocationRatioPlanned <- .assertIsValidAllocationRatioPlannedSampleSize(allocationRatioPlanned, plannedMaxSubjects) + .assertIsValidEffectCountData( + sampleSizeEnabled, sided, lambda1, lambda2, lambda, theta, + thetaH0, overdispersion + ) + if (!is.na(lambda2) && !any(is.na(theta))) { + lambda1 <- lambda2 * theta + } else if (!any(is.na(lambda1)) && !any(is.na(theta))) { + lambda2 <- lambda1 / theta + } + .assertIsValidParametersCountData( + sampleSizeEnabled = sampleSizeEnabled, + simulationEnabled = TRUE, + fixedExposureTime = fixedExposureTime, + followUpTime = followUpTime, + accrualTime = accrualTime, + accrualIntensity = accrualIntensity, + maxNumberOfSubjects = plannedMaxSubjects + ) + .assertAreValidCalendarTimes(plannedCalendarTime, kMax) + if (any(is.na(accrualTime))) { + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "'accrualTime' needs to be specified for simulating count data" + ) + } + + simulationResults <- SimulationResultsBaseCountData$new(design = design) + + if ((length(accrualTime) > 1) && (accrualTime[1] == 0)) { + accrualTime <- accrualTime[-1] + } + + .assertIsSinglePositiveInteger(maxNumberOfIterations, "maxNumberOfIterations", validateType = FALSE) + .assertIsSingleNumber(seed, "seed", naAllowed = TRUE) + .assertIsSingleLogical(showStatistics, "showStatistics", naAllowed = FALSE) + if (!is.null(calcSubjectsFunction) && design$kMax == 1) { + warning("'calcSubjectsFunction' will be ignored for fixed sample design", call. = FALSE) + } + + .setValueAndParameterType(simulationResults, "plannedCalendarTime", plannedCalendarTime, NA_real_) + .setValueAndParameterType(simulationResults, "plannedMaxSubjects", plannedMaxSubjects, 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) + .setValueAndParameterType(simulationResults, "theta", theta, NA_real_, notApplicableIfNA = TRUE) + .setValueAndParameterType(simulationResults, "thetaH0", thetaH0, 1, notApplicableIfNA = TRUE) + .setValueAndParameterType(simulationResults, "directionUpper", directionUpper, C_DIRECTION_UPPER_DEFAULT) + .setValueAndParameterType(simulationResults, "overdispersion", overdispersion, 0) + .setValueAndParameterType(simulationResults, "fixedExposureTime", fixedExposureTime, NA_real_, notApplicableIfNA = TRUE) + .setValueAndParameterType(simulationResults, "accrualTime", accrualTime, NA_real_, notApplicableIfNA = TRUE) + .setValueAndParameterType(simulationResults, "accrualIntensity", accrualIntensity, NA_real_, notApplicableIfNA = TRUE) + .setValueAndParameterType(simulationResults, "followUpTime", followUpTime, NA_real_, notApplicableIfNA = TRUE) + .setValueAndParameterType(simulationResults, "maxNumberOfIterations", as.integer(maxNumberOfIterations), C_MAX_SIMULATION_ITERATIONS_DEFAULT) + .setValueAndParameterType(simulationResults, "allocationRatioPlanned", allocationRatioPlanned, C_ALLOCATION_RATIO_DEFAULT) + simulationResults$.setParameterType( + "calcSubjectsFunction", + ifelse(design$kMax == 1, C_PARAM_NOT_APPLICABLE, + ifelse(!is.null(calcSubjectsFunction) && design$kMax > 1, + C_PARAM_USER_DEFINED, C_PARAM_DEFAULT_VALUE + ) + ) + ) + simulationResults$.setParameterType("seed", ifelse(is.na(seed), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED)) + simulationResults$seed <- .setSeed(seed) + + if (!is.na(lambda2) && !any(is.na(theta))) { + lambda1 <- lambda2 * theta + simulationResults$lambda1 <- lambda1 + simulationResults$.setParameterType("lambda1", C_PARAM_GENERATED) + } else if (!any(is.na(lambda1)) && !any(is.na(theta))) { + lambda2 <- lambda1 / theta + simulationResults$lambda2 <- lambda2 + simulationResults$.setParameterType("lambda2", C_PARAM_GENERATED) + } else if (!is.na(lambda) && !any(is.na(theta))) { + simulationResults$.setParameterType("lambda1", C_PARAM_GENERATED) + simulationResults$.setParameterType("lambda2", C_PARAM_GENERATED) + } + + if (kMax == 1) { + futilityPerStage <- NULL + rejectPerStage <- NULL + earlyStop <- NULL + } else { + futilityPerStage <- matrix(NA_real_, kMax - 1, totalCases) + rejectPerStage <- matrix(NA_real_, kMax, totalCases) + earlyStop <- matrix(NA_real_, 1, totalCases) + } + overallReject <- rep(NA_real_, totalCases) + iterations <- matrix(0, kMax, totalCases) + + for (iCase in 1:totalCases) { + if (!(is.na(lambda)) && !any(is.na(theta))) { + lambda2 <- (1 + allocationRatioPlanned) * lambda / (1 + allocationRatioPlanned * theta[iCase]) + lambda1[iCase] <- lambda2 * theta[iCase] + } + if (!any(is.na(accrualIntensity))) { + const <- allocationRatioPlanned / (1 + allocationRatioPlanned) + if (length(unique(accrualIntensity)) == 1) { + recruit1 <- seq(0, accrualTime[length(accrualIntensity)], + length.out = accrualTime[length(accrualIntensity)] * accrualIntensity[1] * const + ) + recruit2 <- seq(0, accrualTime[length(accrualIntensity)], + length.out = accrualTime[length(accrualIntensity)] * accrualIntensity[1] * (1 - const) + ) + } else { + recruit1 <- seq(0, accrualTime[1], length.out = accrualTime[1] * accrualIntensity[1] * const) + recruit2 <- seq(0, accrualTime[1], length.out = accrualTime[1] * accrualIntensity[1] * (1 - const)) + for (i in 2:length(accrualIntensity)) { + recruit1 <- c(recruit1, seq(accrualTime[i - 1] + 1 / accrualIntensity[i], + accrualTime[i], + length.out = (accrualTime[i] - accrualTime[i - 1]) * + accrualIntensity[i] * const + )) + recruit2 <- c(recruit2, seq(accrualTime[i - 1] + 1 / accrualIntensity[i], + accrualTime[i], + length.out = (accrualTime[i] - accrualTime[i - 1]) * + accrualIntensity[i] * (1 - const) + )) + } + } + n1 <- length(recruit1) + n2 <- length(recruit2) + nTotal <- n1 + n2 + } else { + n2 <- plannedMaxSubjects / (1 + allocationRatioPlanned) + n1 <- allocationRatioPlanned * n2 + nTotal <- n1 + n2 + recruit1 <- seq(0, accrualTime, length.out = n1) + recruit2 <- seq(0, accrualTime, length.out = n2) + } + + reject <- rep(0, kMax) + futility <- rep(0, kMax - 1) + if (!is.na(fixedExposureTime)) { + followUpTime <- fixedExposureTime + } + for (i in 1:maxNumberOfIterations) { + if (kMax == 1) { + recruit1 <- seq(0, accrualTime, length.out = n1) + recruit2 <- seq(0, accrualTime, length.out = n2) + if (is.na(fixedExposureTime)) { + timeUnderObservation1 <- pmax(accrualTime + followUpTime - recruit1, 0) + timeUnderObservation2 <- pmax(accrualTime + followUpTime - recruit2, 0) + } else { + timeUnderObservation1 <- pmax(pmin( + accrualTime + followUpTime - recruit1, + fixedExposureTime + ), 0) + timeUnderObservation2 <- pmax(pmin( + accrualTime + followUpTime - recruit2, + fixedExposureTime + ), 0) + } + counts1 <- rnbinom( + n = n1, mu = lambda1[iCase] * timeUnderObservation1, + size = 1 / overdispersion + ) + counts2 <- rnbinom( + n = n2, mu = lambda2 * timeUnderObservation2, + size = 1 / overdispersion + ) + nb <- .getNegativeBinomialEstimates( + counts1 = counts1, counts2 = counts2, + t1 = timeUnderObservation1, t2 = timeUnderObservation2 + ) + info_Analysis <- .getInformationCountData( + lambda1 = nb[1], + lambda2 = nb[2], + overdispersion = nb[3], + recruit1 = timeUnderObservation1, + recruit2 = timeUnderObservation2 + ) + z <- (2 * directionUpper - 1) * (log(nb[1]) - log(nb[2]) - log(thetaH0)) * sqrt(info_Analysis) + if (!is.na(z) && z > design$criticalValues[1]) { + reject[1] <- reject[1] + 1 + } + iterations[1, iCase] <- iterations[1, iCase] + 1 + } else { + counts <- rep(0, length(recruit1) + length(recruit2)) + dfStartStop <- .getGeneratedEventTimesCountData( + recruit1 = recruit1, + recruit2 = recruit2, + accrualTime = accrualTime, + followUpTime = followUpTime, + lambda1 = lambda1[iCase], + lambda2 = lambda2, + overdispersion = overdispersion, + fixedFollowUp = !is.na(fixedExposureTime) + ) + for (k in 1:kMax) { + if (is.na(fixedExposureTime)) { + timeUnderObservation1 <- (plannedCalendarTime[k] - + recruit1)[plannedCalendarTime[k] - recruit1 >= 0] + timeUnderObservation2 <- (plannedCalendarTime[k] - + recruit2)[plannedCalendarTime[k] - recruit2 >= 0] + } else { + timeUnderObservation1 <- pmin( + plannedCalendarTime[k] - recruit1, + fixedExposureTime + )[plannedCalendarTime[k] - recruit1 >= 0] + timeUnderObservation2 <- pmin( + plannedCalendarTime[k] - recruit2, + fixedExposureTime + )[plannedCalendarTime[k] - recruit2 >= 0] + } + if (k < kMax) { + kthStageWithEvents <- dfStartStop$output[ + dfStartStop$output[, "status"] == 1 & + dfStartStop$output[, "recruitTime"] <= plannedCalendarTime[k] & + dfStartStop$output[, "stopCalendar"] <= plannedCalendarTime[k], + ] + if (length(kthStageWithEvents) > 0 && nrow(kthStageWithEvents) > 0) { + tab <- table(kthStageWithEvents[, "id"]) + idx <- as.integer(names(tab)) + counts[idx] <- as.vector(tab) + } + counts1 <- counts[1:length(timeUnderObservation1)] + counts2 <- counts[(length(recruit1) + 1):(length(recruit1) + length(timeUnderObservation2))] + } else { + counts1 <- dfStartStop$nEvents[1:n1] + counts2 <- dfStartStop$nEvents[(n1 + 1):(n1 + n2)] + } + nb <- .getNegativeBinomialEstimates( + counts1 = counts1, counts2 = counts2, + t1 = timeUnderObservation1, t2 = timeUnderObservation2 + ) + info_Analysis <- .getInformationCountData( + lambda1 = nb[1], + lambda2 = nb[2], + overdispersion = nb[3], + recruit1 = timeUnderObservation1, + recruit2 = timeUnderObservation2 + ) + z <- (2 * directionUpper - 1) * (log(nb[1]) - log(nb[2]) - log(thetaH0)) * sqrt(info_Analysis) + iterations[k, iCase] <- iterations[k, iCase] + 1 + if (!is.na(z)) { + if (z > design$criticalValues[k]) { + reject[k] <- reject[k] + 1 + break + } + if (z < design$futilityBounds[k] && k < kMax) { + futility[k] <- futility[k] + 1 + break + } + } + } + } + } + if (kMax > 1) { + futilityPerStage[, iCase] <- futility / i + rejectPerStage[, iCase] <- reject / i + earlyStop[1, iCase] <- sum(reject[1:(kMax - 1)] + futility) / i + } + overallReject[iCase] <- cumsum(reject / i)[kMax] + } + + if (design$kMax > 1) { + simulationResults$futilityPerStage <- futilityPerStage + simulationResults$.setParameterType( + "futilityPerStage", + ifelse(!all(is.na(futilityPerStage)) && + any(futilityPerStage > 1e-06, na.rm = TRUE), + C_PARAM_GENERATED, C_PARAM_NOT_APPLICABLE + ) + ) + + simulationResults$futilityStop <- base::colSums(futilityPerStage, na.rm = TRUE) + simulationResults$.setParameterType( + "futilityStop", + ifelse(!all(is.na(simulationResults$futilityStop)) && + any(simulationResults$futilityStop > 1e-06, na.rm = TRUE), + C_PARAM_GENERATED, C_PARAM_NOT_APPLICABLE + ) + ) + + simulationResults$rejectPerStage <- rejectPerStage + simulationResults$.setParameterType("rejectPerStage", C_PARAM_GENERATED) + + simulationResults$earlyStop <- earlyStop + simulationResults$.setParameterType( + "earlyStop", ifelse(!all(is.na(earlyStop)), C_PARAM_GENERATED, C_PARAM_NOT_APPLICABLE) + ) + } + + simulationResults$iterations <- iterations + simulationResults$.setParameterType("iterations", C_PARAM_GENERATED) + + simulationResults$numberOfSubjects <- n1 + n2 + simulationResults$.setParameterType( + "numberOfSubjects", + ifelse(any(is.na(accrualIntensity)), C_PARAM_USER_DEFINED, C_PARAM_GENERATED) + ) + + simulationResults$numberOfSubjects1 <- n1 + simulationResults$.setParameterType( + "numberOfSubjects1", + ifelse(allocationRatioPlanned == 1, C_PARAM_NOT_APPLICABLE, C_PARAM_GENERATED) + ) + simulationResults$numberOfSubjects2 <- n2 + simulationResults$.setParameterType( + "numberOfSubjects2", + ifelse(allocationRatioPlanned == 1, C_PARAM_NOT_APPLICABLE, C_PARAM_GENERATED) + ) + + simulationResults$overallReject <- overallReject + simulationResults$.setParameterType("overallReject", C_PARAM_GENERATED) + + if (all(is.na(theta))) { + simulationResults$theta <- lambda1 / lambda2 + simulationResults$.setParameterType("theta", C_PARAM_GENERATED) + } + + warning("The simulation count data feature is experimental and ", + "hence not fully validated (see www.rpact.com/experimental)", + call. = FALSE + ) + + return(simulationResults) +} diff --git a/R/f_simulation_base_means.R b/R/f_simulation_base_means.R index e0c348d1..eadc4bbe 100644 --- a/R/f_simulation_base_means.R +++ b/R/f_simulation_base_means.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7408 $ -## | Last changed: $Date: 2023-11-09 10:36:19 +0100 (Do, 09 Nov 2023) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/f_simulation_base_rates.R b/R/f_simulation_base_rates.R index 1a6f1af0..eb07b671 100644 --- a/R/f_simulation_base_rates.R +++ b/R/f_simulation_base_rates.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7408 $ -## | Last changed: $Date: 2023-11-09 10:36:19 +0100 (Do, 09 Nov 2023) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/f_simulation_base_survival.R b/R/f_simulation_base_survival.R index 84ce6ccf..f20a6570 100644 --- a/R/f_simulation_base_survival.R +++ b/R/f_simulation_base_survival.R @@ -13,9 +13,9 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7671 $ -## | Last changed: $Date: 2024-02-26 16:27:43 +0100 (Mo, 26 Feb 2024) $ -## | Last changed by: $Author: wassmer $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ +## | Last changed by: $Author: pahlke $ ## | #' @include class_simulation_results.R diff --git a/R/f_simulation_enrichment.R b/R/f_simulation_enrichment.R index 84e42f65..8598f91f 100644 --- a/R/f_simulation_enrichment.R +++ b/R/f_simulation_enrichment.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7645 $ -## | Last changed: $Date: 2024-02-16 16:12:34 +0100 (Fr, 16 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/f_simulation_enrichment_rates.R b/R/f_simulation_enrichment_rates.R index bb141780..967dd97a 100644 --- a/R/f_simulation_enrichment_rates.R +++ b/R/f_simulation_enrichment_rates.R @@ -13,9 +13,9 @@ ## | ## | 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 by: $Author: wassmer $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ +## | Last changed by: $Author: pahlke $ ## | #' @include f_simulation_enrichment.R diff --git a/R/f_simulation_enrichment_survival.R b/R/f_simulation_enrichment_survival.R index 4219e269..657cba7d 100644 --- a/R/f_simulation_enrichment_survival.R +++ b/R/f_simulation_enrichment_survival.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7656 $ -## | Last changed: $Date: 2024-02-22 10:55:00 +0100 (Do, 22 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/f_simulation_multiarm.R b/R/f_simulation_multiarm.R index 3af4278e..6a47e898 100644 --- a/R/f_simulation_multiarm.R +++ b/R/f_simulation_multiarm.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7645 $ -## | Last changed: $Date: 2024-02-16 16:12:34 +0100 (Fr, 16 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/f_simulation_multiarm_survival.R b/R/f_simulation_multiarm_survival.R index c17e2227..08a32ef2 100644 --- a/R/f_simulation_multiarm_survival.R +++ b/R/f_simulation_multiarm_survival.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7650 $ -## | Last changed: $Date: 2024-02-20 14:37:26 +0100 (Di, 20 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/f_simulation_performance_score.R b/R/f_simulation_performance_score.R index dcd8db55..0c5072d6 100644 --- a/R/f_simulation_performance_score.R +++ b/R/f_simulation_performance_score.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7688 $ -## | Last changed: $Date: 2024-03-05 14:56:47 +0100 (Tue, 05 Mar 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/f_simulation_plot.R b/R/f_simulation_plot.R index b0fb23c8..0f8f0a30 100644 --- a/R/f_simulation_plot.R +++ b/R/f_simulation_plot.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7620 $ -## | Last changed: $Date: 2024-02-09 12:57:37 +0100 (Fr, 09 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/f_simulation_utilities.R b/R/f_simulation_utilities.R index 252d8033..308a894f 100644 --- a/R/f_simulation_utilities.R +++ b/R/f_simulation_utilities.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7645 $ -## | Last changed: $Date: 2024-02-16 16:12:34 +0100 (Fr, 16 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/R/parameter_descriptions.R b/R/parameter_descriptions.R index 6af89ef3..da382f94 100644 --- a/R/parameter_descriptions.R +++ b/R/parameter_descriptions.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 7644 $ -## | Last changed: $Date: 2024-02-16 10:36:28 +0100 (Fr, 16 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -905,3 +905,15 @@ NULL #' @name param_plotSettings #' @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 diff --git a/cran-comments.md b/cran-comments.md index dcc78f55..8a98c9ed 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,7 +1,7 @@ ## Test environments -* local OS X install, R 4.3.2 +* local OS X install, R 4.3.3 * win-builder (old release, devel, and release) ## R CMD check results diff --git a/man-roxygen/examples_get_simulation_count_data.R b/man-roxygen/examples_get_simulation_count_data.R new file mode 100644 index 00000000..9cdbc024 --- /dev/null +++ b/man-roxygen/examples_get_simulation_count_data.R @@ -0,0 +1,220 @@ +library(rpact) + +## Fixed sample size ### +alpha <- 0.025 +beta <- 0.15 +accrualTime <- 24/52 +lambda1 <- 0.55 +lambda2 <- 5.5 +overdispersion <- (7.3 + 14) / 2 +directionUpper <- (lambda1 > lambda2) + +design <- getDesignGroupSequential(typeOfDesign = "asHSD", gammaA = -4, futilityBounds = c(0, 0)) + +y <- getSampleSizeCounts(design = design, + accrualTime = accrualTime, + lambda1 = lambda1, + lambda2 = lambda2, + overdispersion = overdispersion, + fixedExposureTime = 24/52) +y$nFixed +y$calendarTime + +z <- getPowerCounts(alpha = alpha, + directionUpper = directionUpper, + maxNumberOfSubjects = 100, + lambda1 = lambda1, + lambda2 = lambda2, + overdispersion = overdispersion, + fixedExposureTime = 24/52) + +z$overallReject + +tictoc::tic() +s <- getSimulationCounts(design = design, + directionUpper = directionUpper, + plannedMaxSubjects = 100, + plannedCalendarTime = as.numeric(y$calendarTime), + lambda1 = lambda2, + lambda2 = lambda2, + overdispersion = overdispersion, + maxNumberOfIterations = 10000, + accrualTime = accrualTime, + fixedExposureTime = 24/52) +s$overallReject +tictoc::toc() + + +## Fixed sample size ### +alpha <- 0.025 +beta <- 0.1 +accrualTime <- 12 +lambda1 <- 0.6 +lambda2 <- 0.3 +overdispersion <- 2 +directionUpper <- (lambda1 > lambda2) + +# Case variable exposure +followUpTime <- 6 +y <- getSampleSizeCounts(alpha = alpha, beta = beta, + lambda1 = lambda1, lambda2 = lambda2, overdispersion = overdispersion, + accrualTime = accrualTime, followUpTime = followUpTime) + +y$calendarTime +y$nFixed + + +z <- getPowerCounts(alpha = alpha, + directionUpper = directionUpper, + maxNumberOfSubjects = y$nFixed, + lambda1 = c(lambda2, lambda1), + lambda2 = lambda2, + overdispersion = overdispersion, + accrualTime = accrualTime, + followUpTime = followUpTime) + +z$overallReject + +tictoc::tic() +s <- getSimulationCounts(alpha = alpha, + directionUpper = directionUpper, + plannedMaxSubjects = y$nFixed, + plannedCalendarTime = as.numeric(y$calendarTime), + lambda1 = c(lambda2, lambda1), + lambda2 = lambda2, + overdispersion = overdispersion, + maxNumberOfIterations = 500, + accrualTime = accrualTime, + followUpTime = followUpTime) +s$overallReject +tictoc::toc() + + +# Case fixed exposure +fixedExposureTime <- 1 +y <- getSampleSizeCounts(alpha = alpha, beta = beta, + lambda1 = lambda1, lambda2 = lambda2, overdispersion = overdispersion, + accrualTime = accrualTime, fixedExposureTime = fixedExposureTime) +y$calendarTime +y$nFixed + +z <- getPowerCounts(alpha = alpha, + directionUpper = directionUpper, + maxNumberOfSubjects = y$nFixed, + lambda1 = c(lambda2, lambda1), + lambda2 = lambda2, + overdispersion = overdispersion, + fixedExposureTime = fixedExposureTime, + accrualTime = accrualTime +) +z$overallReject + +tictoc::tic() +s <- getSimulationCounts(alpha = alpha, + directionUpper = directionUpper, + plannedMaxSubjects = y$nFixed, + plannedCalendarTime = y$calendarTime, + lambda1 = c(lambda2, lambda1), + lambda2 = lambda2, + overdispersion = overdispersion, + maxNumberOfIterations = 500, + fixedExposureTime = fixedExposureTime, + accrualTime = accrualTime) +s$overallReject +tictoc::toc() + + +################################################################# +################################################################# + +## Group sequential design +alpha <- 0.025 +beta <- 0.2 +accrualTime <- 12 +lambda1 <- 0.3 +lambda2 <- 0.7 +overdispersion <- 2 +directionUpper <- (lambda1 > lambda2) +informationRates <- c(0.3, 0.55, 1) + +design <- getDesignGroupSequential(informationRates = informationRates, alpha = alpha, beta = beta, + typeOfDesign = "asOF", typeBetaSpending = "bsOF", bindingFutility = TRUE) + +# Case variable exposure +y <- getSampleSizeCounts(design, + lambda1 = lambda1, lambda2 = lambda2, overdispersion = overdispersion, + accrualTime = accrualTime, followUpTime = followUpTime +) + +y$calendarTime +y$maxNumberOfSubjects + +z <- getPowerCounts(design = design, + directionUpper = directionUpper, + maxNumberOfSubjects = y$maxNumberOfSubjects, + lambda1 = c(lambda2, lambda1), + lambda2 = lambda2, + overdispersion = overdispersion, + accrualTime = accrualTime, + followUpTime = followUpTime) + +z$rejectPerStage +z$futilityPerStage +z$overallReject + +tictoc::tic() +s <- getSimulationCounts(design = design, + directionUpper = directionUpper, + plannedMaxSubjects = 400, + plannedCalendarTime = y$calendarTime, + lambda1 = c(lambda2), + lambda2 = lambda2, + overdispersion = overdispersion, + maxNumberOfIterations = 10000, + accrualTime = accrualTime, + followUpTime = followUpTime) + +s$rejectPerStage +s$futilityPerStage +s$overallReject +tictoc::toc() + +sqrt((1- 0.025)*0.025) / 100 + +# Case fixed exposure +fixedExposureTime <- 1 +y <- getSampleSizeCounts(design, + lambda1 = lambda1, lambda2 = lambda2, overdispersion = overdispersion, + accrualTime = accrualTime, fixedExposureTime = fixedExposureTime +) +y$calendarTime +y$maxNumberOfSubjects + +z <- getPowerCounts(design = design, + directionUpper = directionUpper, + maxNumberOfSubjects = y$maxNumberOfSubjects, + lambda1 = c(lambda2, lambda1), + lambda2 = lambda2, + overdispersion = overdispersion, + fixedExposureTime = fixedExposureTime) + +z$rejectPerStage +z$futilityPerStage +z$overallReject + +tictoc::tic() +s <- getSimulationCounts(design = design, + directionUpper = directionUpper, + plannedMaxSubjects = y$maxNumberOfSubjects, + plannedCalendarTime = y$calendarTime, + lambda1 = c(lambda2, lambda1), + lambda2 = lambda2, + overdispersion = overdispersion, + accrualTime = accrualTime, + fixedExposureTime = fixedExposureTime, + maxNumberOfIterations = 500 +) +s$rejectPerStage +s$futilityPerStage +s$overallReject +tictoc::toc() diff --git a/man/SimulationResultsBaseCountData.Rd b/man/SimulationResultsBaseCountData.Rd new file mode 100644 index 00000000..df063b57 --- /dev/null +++ b/man/SimulationResultsBaseCountData.Rd @@ -0,0 +1,46 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_simulation_results.R +\name{SimulationResultsBaseCountData} +\alias{SimulationResultsBaseCountData} +\title{Class for Simulation Results Count Data} +\description{ +A class for simulation results count data. +} +\details{ +Use \code{\link[=getSimulationCounts]{getSimulationCounts()}} to create an object of this type. +} +\section{Fields}{ + +\describe{ +\item{\code{maxNumberOfIterations}}{The number of simulation iterations. Is a numeric vector of length 1 containing a whole number.} + +\item{\code{seed}}{The seed used for random number generation. Is a numeric vector of length 1.} + +\item{\code{allocationRatioPlanned}}{The planned allocation ratio (\code{n1 / n2}) for the groups. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. Is a positive numeric vector of length 1.} + +\item{\code{conditionalPower}}{The conditional power at each stage of the trial. Is a numeric vector of length 1 containing a value between 0 and 1.} + +\item{\code{iterations}}{The number of iterations used for simulations. Is a numeric vector of length 1 containing a whole number.} + +\item{\code{futilityPerStage}}{The per-stage probabilities of stopping the trial for futility. Is a numeric matrix.} + +\item{\code{thetaH0}}{The difference or assumed effect under H0. Is a numeric vector of length 1.} + +\item{\code{accrualTime}}{The assumed accrual time intervals for the study. Is a numeric vector.} + +\item{\code{accrualIntensity}}{The absolute accrual intensities. Is a numeric vector of length \code{kMax}.} + +\item{\code{groups}}{The group numbers. Is a numeric vector.} + +\item{\code{directionUpper}}{Specifies the direction of the alternative, only applicable for one-sided testing. Default is \code{TRUE} which means that larger values of the test statistics yield smaller p-values. Is a logical vector of length 1.} + +\item{\code{earlyStop}}{The probability to stopping the trial either for efficacy or futility. Is a numeric vector.} + +\item{\code{sampleSizes}}{The sample sizes for each group and stage. Is a numeric vector of length number of stages times number of groups containing whole numbers.} + +\item{\code{overallReject}}{The overall rejection probability. Is a numeric vector.} + +\item{\code{rejectPerStage}}{The probability to reject a hypothesis per stage of the trial. Is a numeric matrix.} +}} + +\keyword{internal} diff --git a/man/getSimulationCounts.Rd b/man/getSimulationCounts.Rd new file mode 100644 index 00000000..8fb0efc6 --- /dev/null +++ b/man/getSimulationCounts.Rd @@ -0,0 +1,190 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/f_simulation_base_count_data.R +\name{getSimulationCounts} +\alias{getSimulationCounts} +\title{Get Simulation Counts} +\usage{ +getSimulationCounts( + design = NULL, + ..., + plannedCalendarTime, + plannedMaxSubjects = NA_real_, + lambda1 = NA_real_, + lambda2 = NA_real_, + lambda = NA_real_, + theta = NA_real_, + directionUpper = TRUE, + thetaH0 = 1, + overdispersion = 0, + fixedExposureTime = NA_real_, + accrualTime = NA_real_, + accrualIntensity = NA_real_, + followUpTime = NA_real_, + allocationRatioPlanned = NA_real_, + maxNumberOfIterations = 1000L, + seed = NA_real_, + calcSubjectsFunction = NULL, + showStatistics = FALSE +) +} +\arguments{ +\item{design}{The trial design. If no trial design is specified, a fixed sample size design is used. +In this case, Type I error rate \code{alpha}, Type II error rate \code{beta}, \code{twoSidedPower}, +and \code{sided} can be directly entered as argument where necessary.} + +\item{...}{Ensures that all arguments (starting from the "...") are to be named and +that a warning will be displayed if unknown arguments are passed.} + +\item{plannedMaxSubjects}{TODO @Gernot please describe} + +\item{lambda1}{A numeric value or vector that represents the assumed rate of a homogeneous Poisson process in +the active treatment group, there is no default.} + +\item{lambda2}{A numeric value that represents the assumed rate of a homogeneous Poisson process in +the control group, there is no default.} + +\item{lambda}{A numeric value or vector that represents the assumed rate of a homogeneous Poisson process in +the pooled treatment groups, there is no default.} + +\item{theta}{A numeric value or vector that represents the assumed mean ratios lambda1/lambda2 of a homogeneous +Poisson process, there is no default.} + +\item{directionUpper}{Logical. Specifies the direction of the alternative, +only applicable for one-sided testing; default is \code{TRUE} +which means that larger values of the test statistics yield smaller p-values.} + +\item{thetaH0}{The null hypothesis value, +default is \code{0} for the normal and the binary case (testing means and rates, respectively), +it is \code{1} for the survival case (testing the hazard ratio).\cr\cr +For non-inferiority designs, \code{thetaH0} is the non-inferiority bound. +That is, in case of (one-sided) testing of +\itemize{ +\item \emph{means}: a value \code{!= 0} +(or a value \code{!= 1} for testing the mean ratio) can be specified. +\item \emph{rates}: a value \code{!= 0} +(or a value \code{!= 1} for testing the risk ratio \code{pi1 / pi2}) can be specified. +\item \emph{survival data}: a bound for testing H0: \code{hazard ratio = thetaH0 != 1} can be specified. +\item \emph{count data}: a bound for testing H0: \code{lambda1 / lambda2 = thetaH0 != 1} can be specified. +} +For testing a rate in one sample, a value \code{thetaH0} in (0, 1) has to be specified for +defining the null hypothesis H0: \code{pi = thetaH0}.} + +\item{overdispersion}{A numeric value that represents the assumed overdispersion of the negative binomial distribution, +default is \code{0}.} + +\item{fixedExposureTime}{If specified, the fixed time of exposure per subject for count data, there is no default.} + +\item{accrualTime}{If specified, the assumed accrual time interval(s) for the study, there is no default.} + +\item{accrualIntensity}{If specified, the assumed accrual intensities for the study, there is no default.} + +\item{followUpTime}{If specified, the assumed (additional) follow-up time for the study, there is no default. +The total study duration is \code{accrualTime + followUpTime}.} + +\item{allocationRatioPlanned}{The planned allocation ratio \code{n1 / n2} for a two treatment groups +design, default is \code{1}. For multi-arm designs, it is the allocation ratio relating the active arm(s) to the control. +For simulating means and rates for a two treatment groups design, it can be a vector of length \code{kMax}, the number of stages. +It can be a vector of length kMax, too, for multi-arm and enrichment designs. +In these cases, a change of allocating subjects to treatment groups over the stages can be assessed. +Note that internally \code{allocationRatioPlanned} is treated as a vector of length \code{kMax}, not a scalar.} + +\item{maxNumberOfIterations}{The number of simulation iterations, default is \code{1000}. Must be a positive integer of length 1.} + +\item{seed}{The seed to reproduce the simulation, default is a random seed.} + +\item{calcSubjectsFunction}{Optionally, a function can be entered that defines the way of performing the sample size +recalculation. By default, sample size recalculation is performed with conditional power and specified +\code{minNumberOfSubjectsPerStage} and \code{maxNumberOfSubjectsPerStage} (see details and examples).} + +\item{showStatistics}{Logical. If \code{TRUE}, summary statistics of the simulated data +are displayed for the \code{print} command, otherwise the output is suppressed, default +is \code{FALSE}.} + +\item{lambda1H1}{If specified, the assumed probability in the active treatment group if two treatment groups +are considered, or the assumed probability for a one treatment group design, for which the conditional +power was calculated.} + +\item{lambda2H1}{If specified, the assumed probability in the reference group if two treatment groups +are considered, for which the conditional power was calculated.} +} +\value{ +Returns a \code{\link{SimulationResults}} object. +The following generics (R generic functions) are available for this object: +\itemize{ +\item \code{\link[=names.FieldSet]{names()}} to obtain the field names, +\item \code{\link[=print.FieldSet]{print()}} to print the object, +\item \code{\link[=summary.ParameterSet]{summary()}} to display a summary of the object, +\item \code{\link[=plot.SimulationResults]{plot()}} to plot the object, +\item \code{\link[=as.data.frame.ParameterSet]{as.data.frame()}} to coerce the object to a \code{\link[base]{data.frame}}, +\item \code{\link[=as.matrix.FieldSet]{as.matrix()}} to coerce the object to a \code{\link[base]{matrix}}. +} +} +\description{ +Returns the simulated power, stopping probabilities, conditional power, and expected sample size for +testing means rates for negative binomial distributed event numbers in the two treatment groups testing situation. +} +\details{ +At given design the function simulates the power, stopping probabilities, conditional power, and expected +sample size at given number of subjects and parameter configuration. +Additionally, an allocation ratio = n1/n2 and a null hypothesis value thetaH0 can be specified. + +The definition of \code{lambda1H1} and/or \code{lambda2H1} makes only sense if \code{kMax} > 1 +and if \code{conditionalPower}, \code{minNumberOfSubjectsPerStage}, and +\code{plannedMaxSubjectsPerStage} (or \code{calcSubjectsFunction}) are defined. +} +\section{Simulation Data}{ + +The summary statistics "Simulated data" contains the following parameters: median \link{range}; mean +/-sd\cr + +\code{$show(showStatistics = FALSE)} or \code{$setShowStatistics(FALSE)} can be used to disable +the output of the aggregated simulated data.\cr + +Example 1: \cr +\code{simulationResults <- getSimulationRates(plannedSubjects = 40)} \cr +\code{simulationResults$show(showStatistics = FALSE)}\cr + +Example 2: \cr +\code{simulationResults <- getSimulationRates(plannedSubjects = 40)} \cr +\code{simulationResults$setShowStatistics(FALSE)}\cr +\code{simulationResults}\cr + +\code{\link[=getData]{getData()}} can be used to get the aggregated simulated data from the +object as \code{\link[base]{data.frame}}. The data frame contains the following columns: +\enumerate{ +\item \code{iterationNumber}: The number of the simulation iteration. +\item \code{stageNumber}: The stage. +\item \code{lambda1}: The assumed or derived event rate in the treatment group (if available). +\item \code{lambda2}: The assumed or derived event rate in the control group (if available). +\item \code{numberOfSubjects}: The number of subjects under consideration when the +(interim) analysis takes place. +\item \code{rejectPerStage}: 1 if null hypothesis can be rejected, 0 otherwise. +\item \code{futilityPerStage}: 1 if study should be stopped for futility, 0 otherwise. +\item \code{testStatistic}: The test statistic that is used for the test decision, +depends on which design was chosen (group sequential, inverse normal, +or Fisher combination test)' +\item \code{testStatisticsPerStage}: The test statistic for each stage if only data from +the considered stage is taken into account. +\item \code{overallLambda1}: The cumulative rate in treatment group 1. +\item \code{overallLambda2}: The cumulative rate in treatment group 2. +\item \code{stagewiseLambda1}: The stage-wise rate in treatment group 1. +\item \code{stagewiseLambda2}: The stage-wise rate in treatment group 2. +\item \code{sampleSizesPerStage1}: The stage-wise sample size in treatment group 1. +\item \code{sampleSizesPerStage2}: The stage-wise sample size in treatment group 2. +\item \code{trialStop}: \code{TRUE} if study should be stopped for efficacy or futility or final stage, \code{FALSE} otherwise. +\item \code{conditionalPowerAchieved}: The conditional power for the subsequent stage of the trial for +selected sample size and effect. The effect is either estimated from the data or can be +user defined with \code{lambda1H1} and \code{lambda2H1}. +} +} + +\section{How to get help for generic functions}{ + +Click on the link of a generic in the list above to go directly to the help documentation of +the \code{rpact} specific implementation of the generic. +Note that you can use the R function \code{\link[utils]{methods}} to get all the methods of a generic and +to identify the object specific name of it, e.g., +use \code{methods("plot")} to get all the methods for the \code{plot} generic. +There you can find, e.g., \code{plot.AnalysisResults} and +obtain the specific help documentation linked above by typing \code{?plot.AnalysisResults}. +} + diff --git a/man/param_plannedMaxSubjects.Rd b/man/param_plannedMaxSubjects.Rd new file mode 100644 index 00000000..5004441b --- /dev/null +++ b/man/param_plannedMaxSubjects.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/parameter_descriptions.R +\name{param_plannedMaxSubjects} +\alias{param_plannedMaxSubjects} +\title{Parameter Description: Planned Max Subjects} +\arguments{ +\item{plannedMaxSubjects}{TODO @Gernot please describe} +} +\description{ +Parameter Description: Planned Max Subjects +} +\keyword{internal} diff --git a/man/param_plannedMaxSubjectsPerStage.Rd b/man/param_plannedMaxSubjectsPerStage.Rd new file mode 100644 index 00000000..91f5cbba --- /dev/null +++ b/man/param_plannedMaxSubjectsPerStage.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/parameter_descriptions.R +\name{param_plannedMaxSubjectsPerStage} +\alias{param_plannedMaxSubjectsPerStage} +\title{Parameter Description: Planned Max Subjects Per Stage} +\arguments{ +\item{plannedMaxSubjectsPerStage}{TODO @Gernot please describe} +} +\description{ +Parameter Description: Planned Max Subjects Per Stage +} +\keyword{internal} diff --git a/tests/testthat/helper-f_core_assertions.R b/tests/testthat/helper-f_core_assertions.R index fbff883f..56e57012 100644 --- a/tests/testthat/helper-f_core_assertions.R +++ b/tests/testthat/helper-f_core_assertions.R @@ -13,8 +13,8 @@ ## | ## | Contact us for information about our services: info@rpact.com ## | -## | File version: $Revision: 6117 $ -## | Last changed: $Date: 2022-05-04 15:55:23 +0200 (Mi, 04 Mai 2022) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/tests/testthat/test-class_core_plot_settings.R b/tests/testthat/test-class_core_plot_settings.R index 6779b2ef..2711160b 100644 --- a/tests/testthat/test-class_core_plot_settings.R +++ b/tests/testthat/test-class_core_plot_settings.R @@ -15,8 +15,8 @@ ## | ## | File name: test-class_analysis_dataset.R ## | Creation date: 06 February 2023, 12:04:06 -## | File version: $Revision: 7403 $ -## | Last changed: $Date: 2023-11-08 16:12:00 +0100 (Mi, 08 Nov 2023) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/tests/testthat/test-class_design_plan.R b/tests/testthat/test-class_design_plan.R index 1e61b196..32326d82 100644 --- a/tests/testthat/test-class_design_plan.R +++ b/tests/testthat/test-class_design_plan.R @@ -15,8 +15,8 @@ ## | ## | File name: test-class_design_plan.R ## | Creation date: 26 February 2024, 10:31:43 -## | File version: $Revision: 7667 $ -## | Last changed: $Date: 2024-02-26 10:35:51 +0100 (Mo, 26 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/tests/testthat/test-class_design_set.R b/tests/testthat/test-class_design_set.R index 0b8ee17f..8b75a755 100644 --- a/tests/testthat/test-class_design_set.R +++ b/tests/testthat/test-class_design_set.R @@ -15,8 +15,8 @@ ## | ## | File name: test-class_design_set.R ## | Creation date: 23 February 2024, 12:33:48 -## | File version: $Revision: 7662 $ -## | Last changed: $Date: 2024-02-23 12:42:26 +0100 (Fr, 23 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/tests/testthat/test-f_analysis_input_validation.R b/tests/testthat/test-f_analysis_input_validation.R index 0e874f94..4d4f30cd 100644 --- a/tests/testthat/test-f_analysis_input_validation.R +++ b/tests/testthat/test-f_analysis_input_validation.R @@ -15,8 +15,8 @@ ## | ## | File name: test-f_analysis_input_validation.R ## | Creation date: 08 November 2023, 08:56:03 -## | File version: $Revision: 7662 $ -## | Last changed: $Date: 2024-02-23 12:42:26 +0100 (Fr, 23 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -79,7 +79,7 @@ test_that("Errors and warnings for calculation of analysis results with dataset design = design1, dataInput = dataExample4, intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = 20 )) - expect_error(getAnalysisResults( + expect_warning(getAnalysisResults( design = design1, dataInput = dataExample4, intersectionTest = "Simes", varianceOption = "notPooled", nPlanned = c() )) diff --git a/tests/testthat/test-f_simulation_calc_subjects_function.R b/tests/testthat/test-f_simulation_calc_subjects_function.R index 2a337c62..1cb8dc64 100644 --- a/tests/testthat/test-f_simulation_calc_subjects_function.R +++ b/tests/testthat/test-f_simulation_calc_subjects_function.R @@ -15,8 +15,8 @@ ## | ## | File name: test-f_simulation_calc_subjects_function.R ## | Creation date: 23 February 2024, 12:20:41 -## | File version: $Revision: 7662 $ -## | Last changed: $Date: 2024-02-23 12:42:26 +0100 (Fr, 23 Feb 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | diff --git a/tests/testthat/test-f_simulation_performance_score.R b/tests/testthat/test-f_simulation_performance_score.R index a7a4c0b1..56ed2d40 100644 --- a/tests/testthat/test-f_simulation_performance_score.R +++ b/tests/testthat/test-f_simulation_performance_score.R @@ -15,8 +15,8 @@ ## | ## | File name: test-f_simulation_performance_score.R ## | Creation date: 06 February 2023, 12:14:51 -## | File version: $Revision: 7702 $ -## | Last changed: $Date: 2024-03-07 13:30:30 +0100 (Do, 07 Mrz 2024) $ +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | From 2edd3962f4aa3aa3d4318fcbc5bf5789c6f57921 Mon Sep 17 00:00:00 2001 From: Friedrich Pahlke Date: Fri, 22 Mar 2024 17:38:21 +0100 Subject: [PATCH 26/28] Man pages improved --- R/f_simulation_base_count_data.R | 15 +++------------ R/parameter_descriptions.R | 10 ++++++++-- man/getSimulationCounts.Rd | 13 ++----------- man/param_plannedCalendarTime.Rd | 12 ++++++++++++ 4 files changed, 25 insertions(+), 25 deletions(-) create mode 100644 man/param_plannedCalendarTime.Rd diff --git a/R/f_simulation_base_count_data.R b/R/f_simulation_base_count_data.R index 9b63fe7e..8de73848 100644 --- a/R/f_simulation_base_count_data.R +++ b/R/f_simulation_base_count_data.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: 7744 $ +## | Last changed: $Date: 2024-03-22 17:38:03 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -91,6 +91,7 @@ #' testing means rates for negative binomial distributed event numbers in the two treatment groups testing situation. #' #' @inheritParams param_design_with_default +#' @inheritParams param_plannedCalendarTime #' @inheritParams param_thetaH0 #' @inheritParams param_lambda_counts #' @inheritParams param_lambda1_counts @@ -108,27 +109,17 @@ #' @inheritParams param_minNumberOfSubjectsPerStage #' @inheritParams param_plannedMaxSubjectsPerStage #' @inheritParams param_conditionalPowerSimulation -#' @param lambda1H1 If specified, the assumed probability in the active treatment group if two treatment groups -#' are considered, or the assumed probability for a one treatment group design, for which the conditional -#' power was calculated. -#' @param lambda2H1 If specified, the assumed probability in the reference group if two treatment groups -#' are considered, for which the conditional power was calculated. #' @inheritParams param_maxNumberOfIterations #' @inheritParams param_calcSubjectsFunction #' @inheritParams param_seed #' @inheritParams param_three_dots #' @inheritParams param_showStatistics #' -#' #' @details #' At given design the function simulates the power, stopping probabilities, conditional power, and expected #' sample size at given number of subjects and parameter configuration. #' Additionally, an allocation ratio = n1/n2 and a null hypothesis value thetaH0 can be specified. #' -#' The definition of \code{lambda1H1} and/or \code{lambda2H1} makes only sense if \code{kMax} > 1 -#' and if \code{conditionalPower}, \code{minNumberOfSubjectsPerStage}, and -#' \code{plannedMaxSubjectsPerStage} (or \code{calcSubjectsFunction}) are defined. -#' #' @section Simulation Data: #' The summary statistics "Simulated data" contains the following parameters: median [range]; mean +/-sd\cr #' diff --git a/R/parameter_descriptions.R b/R/parameter_descriptions.R index da382f94..7f597996 100644 --- a/R/parameter_descriptions.R +++ b/R/parameter_descriptions.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: 7744 $ +## | Last changed: $Date: 2024-03-22 17:38:03 +0100 (Fr, 22 Mrz 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -917,3 +917,9 @@ NULL #' @name param_plannedMaxSubjects #' @keywords internal NULL + +#' Parameter Description: Planned Calendar Time +#' @param plannedCalendarTime TODO @Gernot please describe +#' @name param_plannedCalendarTime +#' @keywords internal +NULL diff --git a/man/getSimulationCounts.Rd b/man/getSimulationCounts.Rd index 8fb0efc6..b4cc17af 100644 --- a/man/getSimulationCounts.Rd +++ b/man/getSimulationCounts.Rd @@ -35,6 +35,8 @@ and \code{sided} can be directly entered as argument where necessary.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} +\item{plannedCalendarTime}{TODO @Gernot please describe} + \item{plannedMaxSubjects}{TODO @Gernot please describe} \item{lambda1}{A numeric value or vector that represents the assumed rate of a homogeneous Poisson process in @@ -99,13 +101,6 @@ recalculation. By default, sample size recalculation is performed with condition \item{showStatistics}{Logical. If \code{TRUE}, summary statistics of the simulated data are displayed for the \code{print} command, otherwise the output is suppressed, default is \code{FALSE}.} - -\item{lambda1H1}{If specified, the assumed probability in the active treatment group if two treatment groups -are considered, or the assumed probability for a one treatment group design, for which the conditional -power was calculated.} - -\item{lambda2H1}{If specified, the assumed probability in the reference group if two treatment groups -are considered, for which the conditional power was calculated.} } \value{ Returns a \code{\link{SimulationResults}} object. @@ -127,10 +122,6 @@ testing means rates for negative binomial distributed event numbers in the two t At given design the function simulates the power, stopping probabilities, conditional power, and expected sample size at given number of subjects and parameter configuration. Additionally, an allocation ratio = n1/n2 and a null hypothesis value thetaH0 can be specified. - -The definition of \code{lambda1H1} and/or \code{lambda2H1} makes only sense if \code{kMax} > 1 -and if \code{conditionalPower}, \code{minNumberOfSubjectsPerStage}, and -\code{plannedMaxSubjectsPerStage} (or \code{calcSubjectsFunction}) are defined. } \section{Simulation Data}{ diff --git a/man/param_plannedCalendarTime.Rd b/man/param_plannedCalendarTime.Rd new file mode 100644 index 00000000..8e10aa4b --- /dev/null +++ b/man/param_plannedCalendarTime.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/parameter_descriptions.R +\name{param_plannedCalendarTime} +\alias{param_plannedCalendarTime} +\title{Parameter Description: Planned Calendar Time} +\arguments{ +\item{plannedCalendarTime}{TODO @Gernot please describe} +} +\description{ +Parameter Description: Planned Calendar Time +} +\keyword{internal} From 65f7727d50c73a0f0f749994276cc32ddc75a713 Mon Sep 17 00:00:00 2001 From: Friedrich Pahlke Date: Tue, 26 Mar 2024 15:45:27 +0100 Subject: [PATCH 27/28] Issues in print outputs fixed --- DESCRIPTION | 4 +- R/class_core_parameter_set.R | 72 +++++++++++++++++------------ R/class_design_plan.R | 14 +++--- R/class_simulation_results.R | 6 +-- R/f_core_plot.R | 6 +-- R/f_core_utilities.R | 6 +-- R/f_simulation_base_count_data.R | 20 ++++---- R/parameter_descriptions.R | 25 +++------- README.md | 67 +++++++++++++-------------- inst/doc/rpact_getting_started.html | 4 +- 10 files changed, 113 insertions(+), 111 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index d99746d5..69939870 100644 --- 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 index 49409471..51e1f809 100644 --- 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 index 004c5013..cfd24134 100644 --- 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 index c1efc115..f6c2faa1 100644 --- 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 index ad5fc0dd..5e4b3173 100644 --- 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 index b63e8048..bd9b4cb6 100644 --- 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 index 8de73848..0e7a165a 100644 --- 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 index 7f597996..564fb012 100644 --- 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 diff --git a/README.md b/README.md index c9f7dafd..5150cf19 100644 --- a/README.md +++ b/README.md @@ -17,23 +17,22 @@ Confirmatory Adaptive Clinical Trial Design, Simulation, and Analysis. ## Functional Range -- Fixed sample design and designs with interim analysis stages -- Sample size and power calculation for - - means (continuous endpoint) - - rates (binary endpoint) - - survival trials with flexible recruitment and survival time - options - - count data -- Simulation tool for means, rates, and survival data - - Assessment of adaptive sample size/event number recalculations - based on conditional power - - Assessment of treatment selection strategies in multi-arm trials -- Adaptive analysis of means, rates, and survival data -- Adaptive designs and analysis for multi-arm trials -- Adaptive analysis and simulation tools for enrichment design testing - means, rates, and hazard ratios -- Automatic boundary recalculations during the trial for analysis with - alpha spending approach, including under- and over-running +- Fixed sample design and designs with interim analysis stages +- Sample size and power calculation for + - means (continuous endpoint) + - rates (binary endpoint) + - survival trials with flexible recruitment and survival time options + - count data +- Simulation tool for means, rates, and survival data + - Assessment of adaptive sample size/event number recalculations based + on conditional power + - Assessment of treatment selection strategies in multi-arm trials +- Adaptive analysis of means, rates, and survival data +- Adaptive designs and analysis for multi-arm trials +- Adaptive analysis and simulation tools for enrichment design testing + means, rates, and hazard ratios +- Automatic boundary recalculations during the trial for analysis with + alpha spending approach, including under- and over-running ## Installation @@ -86,27 +85,27 @@ with `testPackage()`. # About -- **rpact** is a comprehensive validated[^1] R package for clinical - research which - - enables the design and analysis of confirmatory adaptive group - sequential designs - - is a powerful sample size calculator - - is a free of charge open-source software licensed under - [LGPL-3](https://cran.r-project.org/web/licenses/LGPL-3) - - particularly, implements the methods described in the recent - monograph by [Wassmer and Brannath - (2016)](https://doi.org/10.1007%2F978-3-319-32562-0) +- **rpact** is a comprehensive validated[^1] R package for clinical + research which + - enables the design and analysis of confirmatory adaptive group + sequential designs + - is a powerful sample size calculator + - is a free of charge open-source software licensed under + [LGPL-3](https://cran.r-project.org/web/licenses/LGPL-3) + - particularly, implements the methods described in the recent + monograph by [Wassmer and Brannath + (2016)](https://doi.org/10.1007%2F978-3-319-32562-0) > For more information please visit > [www.rpact.org](https://www.rpact.org) -- **RPACT** is a company which offers - - enterprise R/Shiny software development services - - technical support for the - [rpact](https://cran.r-project.org/package=rpact) package - - consultancy and user training for scientists using R - - validated software solutions and R package development for - clinical research +- **RPACT** is a company which offers + - enterprise R/Shiny software development services + - technical support for the + [rpact](https://cran.r-project.org/package=rpact) package + - consultancy and user training for scientists using R + - validated software solutions and R package development for clinical + research > For more information please visit > [www.rpact.com](https://www.rpact.com) diff --git a/inst/doc/rpact_getting_started.html b/inst/doc/rpact_getting_started.html index b5f20ea2..596fa287 100644 --- a/inst/doc/rpact_getting_started.html +++ b/inst/doc/rpact_getting_started.html @@ -12,7 +12,7 @@ - + Getting started with rpact @@ -239,7 +239,7 @@

Getting started with rpact

Friedrich Pahlke and Gernot Wassmer

-

2024-03-22

+

2024-03-25

From f09af59cdd58127341709137262bb9501b45c79d Mon Sep 17 00:00:00 2001 From: Friedrich Pahlke Date: Tue, 26 Mar 2024 15:56:01 +0100 Subject: [PATCH 28/28] Man pages updated --- README.md | 67 ++++++++++++------------ inst/doc/rpact_getting_started.html | 4 +- man/getSimulationCounts.Rd | 8 +-- man/getSimulationEnrichmentMeans.Rd | 4 +- man/getSimulationEnrichmentRates.Rd | 4 +- man/getSimulationMeans.Rd | 4 +- man/getSimulationMultiArmMeans.Rd | 4 +- man/getSimulationMultiArmRates.Rd | 4 +- man/getSimulationRates.Rd | 4 +- man/param_maxNumberOfSubjectsPerStage.Rd | 2 +- man/param_minNumberOfSubjectsPerStage.Rd | 2 +- man/param_plannedCalendarTime.Rd | 3 +- man/param_plannedMaxSubjects.Rd | 12 ----- man/param_plannedMaxSubjectsPerStage.Rd | 12 ----- 14 files changed, 57 insertions(+), 77 deletions(-) delete mode 100644 man/param_plannedMaxSubjects.Rd delete mode 100644 man/param_plannedMaxSubjectsPerStage.Rd diff --git a/README.md b/README.md index 5150cf19..c9f7dafd 100644 --- a/README.md +++ b/README.md @@ -17,22 +17,23 @@ Confirmatory Adaptive Clinical Trial Design, Simulation, and Analysis. ## Functional Range -- Fixed sample design and designs with interim analysis stages -- Sample size and power calculation for - - means (continuous endpoint) - - rates (binary endpoint) - - survival trials with flexible recruitment and survival time options - - count data -- Simulation tool for means, rates, and survival data - - Assessment of adaptive sample size/event number recalculations based - on conditional power - - Assessment of treatment selection strategies in multi-arm trials -- Adaptive analysis of means, rates, and survival data -- Adaptive designs and analysis for multi-arm trials -- Adaptive analysis and simulation tools for enrichment design testing - means, rates, and hazard ratios -- Automatic boundary recalculations during the trial for analysis with - alpha spending approach, including under- and over-running +- Fixed sample design and designs with interim analysis stages +- Sample size and power calculation for + - means (continuous endpoint) + - rates (binary endpoint) + - survival trials with flexible recruitment and survival time + options + - count data +- Simulation tool for means, rates, and survival data + - Assessment of adaptive sample size/event number recalculations + based on conditional power + - Assessment of treatment selection strategies in multi-arm trials +- Adaptive analysis of means, rates, and survival data +- Adaptive designs and analysis for multi-arm trials +- Adaptive analysis and simulation tools for enrichment design testing + means, rates, and hazard ratios +- Automatic boundary recalculations during the trial for analysis with + alpha spending approach, including under- and over-running ## Installation @@ -85,27 +86,27 @@ with `testPackage()`. # About -- **rpact** is a comprehensive validated[^1] R package for clinical - research which - - enables the design and analysis of confirmatory adaptive group - sequential designs - - is a powerful sample size calculator - - is a free of charge open-source software licensed under - [LGPL-3](https://cran.r-project.org/web/licenses/LGPL-3) - - particularly, implements the methods described in the recent - monograph by [Wassmer and Brannath - (2016)](https://doi.org/10.1007%2F978-3-319-32562-0) +- **rpact** is a comprehensive validated[^1] R package for clinical + research which + - enables the design and analysis of confirmatory adaptive group + sequential designs + - is a powerful sample size calculator + - is a free of charge open-source software licensed under + [LGPL-3](https://cran.r-project.org/web/licenses/LGPL-3) + - particularly, implements the methods described in the recent + monograph by [Wassmer and Brannath + (2016)](https://doi.org/10.1007%2F978-3-319-32562-0) > For more information please visit > [www.rpact.org](https://www.rpact.org) -- **RPACT** is a company which offers - - enterprise R/Shiny software development services - - technical support for the - [rpact](https://cran.r-project.org/package=rpact) package - - consultancy and user training for scientists using R - - validated software solutions and R package development for clinical - research +- **RPACT** is a company which offers + - enterprise R/Shiny software development services + - technical support for the + [rpact](https://cran.r-project.org/package=rpact) package + - consultancy and user training for scientists using R + - validated software solutions and R package development for + clinical research > For more information please visit > [www.rpact.com](https://www.rpact.com) diff --git a/inst/doc/rpact_getting_started.html b/inst/doc/rpact_getting_started.html index 596fa287..7f2e5e68 100644 --- a/inst/doc/rpact_getting_started.html +++ b/inst/doc/rpact_getting_started.html @@ -12,7 +12,7 @@ - + Getting started with rpact @@ -239,7 +239,7 @@

Getting started with rpact

Friedrich Pahlke and Gernot Wassmer

-

2024-03-25

+

2024-03-26

diff --git a/man/getSimulationCounts.Rd b/man/getSimulationCounts.Rd index b4cc17af..e394c827 100644 --- a/man/getSimulationCounts.Rd +++ b/man/getSimulationCounts.Rd @@ -8,7 +8,7 @@ getSimulationCounts( design = NULL, ..., plannedCalendarTime, - plannedMaxSubjects = NA_real_, + maxNumberOfSubjects = NA_real_, lambda1 = NA_real_, lambda2 = NA_real_, lambda = NA_real_, @@ -35,9 +35,11 @@ and \code{sided} can be directly entered as argument where necessary.} \item{...}{Ensures that all arguments (starting from the "...") are to be named and that a warning will be displayed if unknown arguments are passed.} -\item{plannedCalendarTime}{TODO @Gernot please describe} +\item{plannedCalendarTime}{For simulating count data, the time points where an analysis is planned to be performed. +Should be a vector of length \code{kMax}} -\item{plannedMaxSubjects}{TODO @Gernot please describe} +\item{maxNumberOfSubjects}{\code{maxNumberOfSubjects > 0} needs to be specified for power calculations or calculation +of necessary follow-up (count data). For two treatment arms, it is the maximum number of subjects for both treatment arms.} \item{lambda1}{A numeric value or vector that represents the assumed rate of a homogeneous Poisson process in the active treatment group, there is no default.} diff --git a/man/getSimulationEnrichmentMeans.Rd b/man/getSimulationEnrichmentMeans.Rd index 189b8042..d510003b 100644 --- a/man/getSimulationEnrichmentMeans.Rd +++ b/man/getSimulationEnrichmentMeans.Rd @@ -97,14 +97,14 @@ In these cases, a change of allocating subjects to treatment groups over the sta Note that internally \code{allocationRatioPlanned} is treated as a vector of length \code{kMax}, not a scalar.} \item{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 to the minimum number of subjects per selected active arm.} \item{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 diff --git a/man/getSimulationEnrichmentRates.Rd b/man/getSimulationEnrichmentRates.Rd index 5ceba8d5..eda5c78c 100644 --- a/man/getSimulationEnrichmentRates.Rd +++ b/man/getSimulationEnrichmentRates.Rd @@ -102,14 +102,14 @@ In these cases, a change of allocating subjects to treatment groups over the sta Note that internally \code{allocationRatioPlanned} is treated as a vector of length \code{kMax}, not a scalar.} \item{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 to the minimum number of subjects per selected active arm.} \item{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 diff --git a/man/getSimulationMeans.Rd b/man/getSimulationMeans.Rd index e8d870f7..3c087efa 100644 --- a/man/getSimulationMeans.Rd +++ b/man/getSimulationMeans.Rd @@ -86,14 +86,14 @@ In these cases, a change of allocating subjects to treatment groups over the sta Note that internally \code{allocationRatioPlanned} is treated as a vector of length \code{kMax}, not a scalar.} \item{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 to the minimum number of subjects per selected active arm.} \item{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 diff --git a/man/getSimulationMultiArmMeans.Rd b/man/getSimulationMultiArmMeans.Rd index ffb68cb7..2a686b6a 100644 --- a/man/getSimulationMultiArmMeans.Rd +++ b/man/getSimulationMultiArmMeans.Rd @@ -124,14 +124,14 @@ In these cases, a change of allocating subjects to treatment groups over the sta Note that internally \code{allocationRatioPlanned} is treated as a vector of length \code{kMax}, not a scalar.} \item{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 to the minimum number of subjects per selected active arm.} \item{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 diff --git a/man/getSimulationMultiArmRates.Rd b/man/getSimulationMultiArmRates.Rd index be20cd2a..cb5fd819 100644 --- a/man/getSimulationMultiArmRates.Rd +++ b/man/getSimulationMultiArmRates.Rd @@ -128,14 +128,14 @@ In these cases, a change of allocating subjects to treatment groups over the sta Note that internally \code{allocationRatioPlanned} is treated as a vector of length \code{kMax}, not a scalar.} \item{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 to the minimum number of subjects per selected active arm.} \item{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 diff --git a/man/getSimulationRates.Rd b/man/getSimulationRates.Rd index c02d06a1..43c39b76 100644 --- a/man/getSimulationRates.Rd +++ b/man/getSimulationRates.Rd @@ -88,14 +88,14 @@ In these cases, a change of allocating subjects to treatment groups over the sta Note that internally \code{allocationRatioPlanned} is treated as a vector of length \code{kMax}, not a scalar.} \item{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 to the minimum number of subjects per selected active arm.} \item{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 diff --git a/man/param_maxNumberOfSubjectsPerStage.Rd b/man/param_maxNumberOfSubjectsPerStage.Rd index a02b4676..3d1a3aa0 100644 --- a/man/param_maxNumberOfSubjectsPerStage.Rd +++ b/man/param_maxNumberOfSubjectsPerStage.Rd @@ -5,7 +5,7 @@ \title{Parameter Description: Maximum Number Of Subjects Per Stage} \arguments{ \item{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 diff --git a/man/param_minNumberOfSubjectsPerStage.Rd b/man/param_minNumberOfSubjectsPerStage.Rd index 360bda57..849f8d23 100644 --- a/man/param_minNumberOfSubjectsPerStage.Rd +++ b/man/param_minNumberOfSubjectsPerStage.Rd @@ -5,7 +5,7 @@ \title{Parameter Description: Minimum Number Of Subjects Per Stage} \arguments{ \item{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 diff --git a/man/param_plannedCalendarTime.Rd b/man/param_plannedCalendarTime.Rd index 8e10aa4b..a5175920 100644 --- a/man/param_plannedCalendarTime.Rd +++ b/man/param_plannedCalendarTime.Rd @@ -4,7 +4,8 @@ \alias{param_plannedCalendarTime} \title{Parameter Description: Planned Calendar Time} \arguments{ -\item{plannedCalendarTime}{TODO @Gernot please describe} +\item{plannedCalendarTime}{For simulating count data, the time points where an analysis is planned to be performed. +Should be a vector of length \code{kMax}} } \description{ Parameter Description: Planned Calendar Time diff --git a/man/param_plannedMaxSubjects.Rd b/man/param_plannedMaxSubjects.Rd deleted file mode 100644 index 5004441b..00000000 --- a/man/param_plannedMaxSubjects.Rd +++ /dev/null @@ -1,12 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/parameter_descriptions.R -\name{param_plannedMaxSubjects} -\alias{param_plannedMaxSubjects} -\title{Parameter Description: Planned Max Subjects} -\arguments{ -\item{plannedMaxSubjects}{TODO @Gernot please describe} -} -\description{ -Parameter Description: Planned Max Subjects -} -\keyword{internal} diff --git a/man/param_plannedMaxSubjectsPerStage.Rd b/man/param_plannedMaxSubjectsPerStage.Rd deleted file mode 100644 index 91f5cbba..00000000 --- a/man/param_plannedMaxSubjectsPerStage.Rd +++ /dev/null @@ -1,12 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/parameter_descriptions.R -\name{param_plannedMaxSubjectsPerStage} -\alias{param_plannedMaxSubjectsPerStage} -\title{Parameter Description: Planned Max Subjects Per Stage} -\arguments{ -\item{plannedMaxSubjectsPerStage}{TODO @Gernot please describe} -} -\description{ -Parameter Description: Planned Max Subjects Per Stage -} -\keyword{internal}