From 94bae6aa128e67de3979bf4f693ce5d2f570f6e9 Mon Sep 17 00:00:00 2001 From: Friedrich Pahlke Date: Wed, 29 May 2024 15:59:14 +0200 Subject: [PATCH 1/3] Man pages improved --- DESCRIPTION | 4 +- R/class_design_plan.R | 13 ++++--- R/f_simulation_performance_score.R | 8 ++-- man/getPerformanceScore.Rd | 4 +- tests/testthat/test-f_core_plot.R | 9 ++--- tests/testthat/test-f_design_plan_plot.R | 49 ++++++++++++++++++++++-- 6 files changed, 66 insertions(+), 21 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 2492f3e1..247ae1d5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: rpact Title: Confirmatory Adaptive Clinical Trial Design and Analysis -Version: 4.0.0.9243 -Date: 2024-05-28 +Version: 4.0.0.9244 +Date: 2024-05-29 Authors@R: c( person( given = "Gernot", diff --git a/R/class_design_plan.R b/R/class_design_plan.R index fbe3df6b..0de280fd 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: 7940 $ -## | Last changed: $Date: 2024-05-27 15:47:41 +0200 (Mo, 27 Mai 2024) $ +## | File version: $Revision: 7953 $ +## | Last changed: $Date: 2024-05-29 10:36:52 +0200 (Mi, 29 Mai 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -892,13 +892,16 @@ TrialDesignPlanSurvival <- R6::R6Class("TrialDesignPlanSurvival", hr <- self$hazardRatio } } + + lambda2 <- self$.getParameterValueIfUserDefinedOrDefault("lambda2") + pi1Temp <- NA_real_ if (self$.getParameterType("pi1") == C_PARAM_USER_DEFINED) { pi1Temp <- pi1 if (any(is.na(pi1))) { pi1Temp <- self$pi1 } - } else { + } else if (all(is.na(lambda2))) { if (self$.objectType == "sampleSize") { pi1Temp <- C_PI_1_SAMPLE_SIZE_DEFAULT } else { @@ -929,7 +932,7 @@ TrialDesignPlanSurvival <- R6::R6Class("TrialDesignPlanSurvival", accrualIntensity = accrualIntensityTemp, kappa = self$kappa, piecewiseSurvivalTime = self$.getParameterValueIfUserDefinedOrDefault("piecewiseSurvivalTime"), - lambda2 = self$.getParameterValueIfUserDefinedOrDefault("lambda2"), + lambda2 = lambda2, lambda1 = self$.getParameterValueIfUserDefinedOrDefault("lambda1"), followUpTime = self$.getParameterValueIfUserDefinedOrDefault("followUpTime"), maxNumberOfSubjects = self$.getParameterValueIfUserDefinedOrDefault("maxNumberOfSubjects"), @@ -956,7 +959,7 @@ TrialDesignPlanSurvival <- R6::R6Class("TrialDesignPlanSurvival", accrualIntensity = accrualIntensityTemp, kappa = self$kappa, piecewiseSurvivalTime = self$.getParameterValueIfUserDefinedOrDefault("piecewiseSurvivalTime"), - lambda2 = self$.getParameterValueIfUserDefinedOrDefault("lambda2"), + lambda2 = lambda2, lambda1 = self$.getParameterValueIfUserDefinedOrDefault("lambda1"), hazardRatio = hr, maxNumberOfSubjects = self$.getParameterValueIfUserDefinedOrDefault("maxNumberOfSubjects"), diff --git a/R/f_simulation_performance_score.R b/R/f_simulation_performance_score.R index aac2aedb..4db7ea34 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: 7947 $ -## | Last changed: $Date: 2024-05-28 14:25:47 +0200 (Di, 28 Mai 2024) $ +## | File version: $Revision: 7954 $ +## | Last changed: $Date: 2024-05-29 12:02:48 +0200 (Mi, 29 Mai 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -39,8 +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)](https://doi.org/10.1002/sim.8534) and -#' [Bokelmann et al. (2024)](https://doi.org/10.1186/s12874-024-02150-4). +#' can be found in Herrmann et al. (2020), \doi{10.1002/sim.8534} and +#' Bokelmann et al. (2024) \doi{10.1186/s12874-024-02150-4}. #' #' @template examples_get_performance_score #' diff --git a/man/getPerformanceScore.Rd b/man/getPerformanceScore.Rd index 81e3ceb8..a4fd6d64 100644 --- a/man/getPerformanceScore.Rd +++ b/man/getPerformanceScore.Rd @@ -24,8 +24,8 @@ 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 \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)}. +can be found in Herrmann et al. (2020), \doi{10.1002/sim.8534} and +Bokelmann et al. (2024) \doi{10.1186/s12874-024-02150-4}. } \examples{ \dontrun{ diff --git a/tests/testthat/test-f_core_plot.R b/tests/testthat/test-f_core_plot.R index 63c6d980..6f485dd8 100644 --- a/tests/testthat/test-f_core_plot.R +++ b/tests/testthat/test-f_core_plot.R @@ -15,9 +15,9 @@ ## | ## | File name: test-f_core_plot.R ## | Creation date: 08 November 2023, 09:09:36 -## | File version: $Revision$ -## | Last changed: $Date$ -## | Last changed by: $Author$ +## | File version: $Revision: 7953 $ +## | Last changed: $Date: 2024-05-29 10:36:52 +0200 (Mi, 29 Mai 2024) $ +## | Last changed by: $Author: pahlke $ ## | test_plan_section("Testing .reconstructSequenceCommand") @@ -110,6 +110,5 @@ test_that("Internal core plot functions throw errors when arguments are missing expect_error(.getGridLegendPosition()) - expect_error(.formatSubTitleValue()) -}) + expect_error(.formatSubTitleValue()) }) diff --git a/tests/testthat/test-f_design_plan_plot.R b/tests/testthat/test-f_design_plan_plot.R index 47f98dbd..61a46b15 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: 7682 $ -## | Last changed: $Date: 2024-03-05 07:53:40 +0100 (Di, 05 Mrz 2024) $ +## | File version: $Revision: 7953 $ +## | Last changed: $Date: 2024-05-29 10:36:52 +0200 (Mi, 29 Mai 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -40,6 +40,7 @@ test_that(".addPlotSubTitleItems function works as expected", { # Test case for .assertIsValidVariedParameterVectorForPlotting function test_that(".assertIsValidVariedParameterVectorForPlotting function works as expected", { .skipTestIfDisabled() + designPlan <- getDesignInverseNormal( typeOfDesign = "OF", kMax = 2, alpha = 0.025, beta = 0.2, sided = 1, tolerance = 1e-08 @@ -53,6 +54,7 @@ test_that(".assertIsValidVariedParameterVectorForPlotting function works as expe # Test case for .getTrialDesignPlanTheta function test_that(".getTrialDesignPlanTheta function works as expected", { .skipTestIfDisabled() + survivalDesignPlanEnabled <- .isTrialDesignPlanSurvival(getDesignGroupSequential( informationRates = c(0.2, 0.5, 1), sided = 1, beta = 0.1, typeOfDesign = "WT", deltaWT = 0.3 @@ -176,16 +178,19 @@ test_that(".plotTrialDesignPlan function works as expected", { test_that(".getSurvivalFunctionPlotCommand works as intended", { .skipTestIfDisabled() + expect_error(.getSurvivalFunctionPlotCommand()) }) test_that(".plotSurvivalFunction works as intended", { .skipTestIfDisabled() + expect_error(.plotSurvivalFunction()) }) -test_that("warnings works as intended", { +test_that("The plot warning functions work as intended", { .skipTestIfDisabled() + expect_error(.warnInCaseOfUnusedValuesForPlottingMeans()) expect_error(.warnInCaseOfUnusedValuesForPlottingRates()) expect_error(.warnInCaseOfUnusedValuesForPlottingSurvival()) @@ -194,5 +199,43 @@ test_that("warnings works as intended", { test_that("plot.TrialDesignPlan works as intended", { .skipTestIfDisabled() + expect_error(plot.TrialDesignPlan()) }) + +test_that("The plot of a getPowerSurvival() result works as intended", { + .skipTestIfDisabled() + + design <- getDesignGroupSequential( + kMax = 3, typeOfDesign = "OF", + sided = 2, twoSidedPower = TRUE + ) + piecewiseSurvivalTime <- list( + "<5" = 0.04, + "5 - <10" = 0.02, + ">= 10" = 0.008 + ) + powerSurvival <- getPowerSurvival( + design = design, + typeOfComputation = "Schoenfeld", thetaH0 = 1, + allocationRatioPlanned = 1, kappa = 1, + piecewiseSurvivalTime = piecewiseSurvivalTime, + maxNumberOfSubjects = 2480, maxNumberOfEvents = 70, + hazardRatio = c(0.5, 2) + ) + expect_silent(plot(powerSurvival, type = 1)) + expect_silent(plot(powerSurvival, type = 2)) + expect_silent(plot(powerSurvival, type = 12)) + + powerSurvival2 <- getPowerSurvival( + design = design, + typeOfComputation = "Schoenfeld", thetaH0 = 1, + allocationRatioPlanned = 1, kappa = 1, + piecewiseSurvivalTime = piecewiseSurvivalTime, + maxNumberOfSubjects = 2480, maxNumberOfEvents = 70, + hazardRatio = 0.5 + ) + + expect_silent(plot(powerSurvival2, type = 13, legendPosition = 1)) + expect_silent(plot(powerSurvival2, type = 14, legendPosition = 5)) +}) From 406b432a2687965645e367a589bb2036fc86ee68 Mon Sep 17 00:00:00 2001 From: Friedrich Pahlke Date: Fri, 31 May 2024 13:45:01 +0200 Subject: [PATCH 2/3] Implemented fetch() and obtain() functions as alternatives to pull() to avoid conflicts with dplyr::pull() --- .gitignore | 1 + DESCRIPTION | 4 +- NAMESPACE | 4 + R/class_analysis_dataset.R | 6 +- R/class_analysis_results.R | 6 +- R/class_analysis_stage_results.R | 66 ++-- R/class_core_parameter_set.R | 143 +++++++-- R/class_core_plot_settings.R | 104 ++++-- R/class_design.R | 112 +++++-- R/class_design_plan.R | 48 ++- R/class_design_power_and_asn.R | 18 +- R/class_design_set.R | 23 +- R/class_event_probabilities.R | 27 +- R/class_simulation_results.R | 95 ++++-- R/class_summary.R | 303 +++++++++++++----- R/class_time.R | 284 +++++++++++----- R/f_design_plan_survival.R | 14 +- R/f_quality_assurance.R | 17 +- cran-comments.md | 4 +- inst/doc/rpact_getting_started.html | 4 +- .../examples_fetch_parameter_from_result.R | 6 + man/PowerAndAverageSampleNumberResult.Rd | 3 +- man/SimulationResultsBaseCountData.Rd | 3 +- man/SimulationResultsEnrichmentMeans.Rd | 3 +- man/SimulationResultsEnrichmentRates.Rd | 3 +- man/SimulationResultsEnrichmentSurvival.Rd | 3 +- man/SimulationResultsMultiArmRates.Rd | 3 +- man/SimulationResultsMultiArmSurvival.Rd | 3 +- man/SimulationResultsRates.Rd | 3 +- man/SimulationResultsSurvival.Rd | 3 +- man/TrialDesignCharacteristics.Rd | 3 +- man/TrialDesignGroupSequential.Rd | 3 +- man/as.data.frame.TrialDesign.Rd | 3 +- man/fetch.ParameterSet.Rd | 52 +++ man/getDesignSet.Rd | 6 +- man/knit_print.SummaryFactory.Rd | 18 +- man/names.SimulationResults.Rd | 3 +- man/plot.SummaryFactory.Rd | 6 +- man/print.SimulationResults.Rd | 6 +- man/print.SummaryFactory.Rd | 3 +- man/pull.ParameterSet.Rd | 26 -- .../testthat/test-class_core_parameter_set.R | 78 +++++ tests/testthat/test-f_design_plan_plot.R | 6 +- 43 files changed, 1115 insertions(+), 414 deletions(-) create mode 100644 man-roxygen/examples_fetch_parameter_from_result.R create mode 100644 man/fetch.ParameterSet.Rd delete mode 100644 man/pull.ParameterSet.Rd create mode 100644 tests/testthat/test-class_core_parameter_set.R diff --git a/.gitignore b/.gitignore index f8f170a7..5416484a 100644 --- a/.gitignore +++ b/.gitignore @@ -33,3 +33,4 @@ testthat-problems.rds /README.html /tests/testthat/Rplots.pdf /tests/testthat/index.txt +/rpact.Rproj diff --git a/DESCRIPTION b/DESCRIPTION index 247ae1d5..c01807e9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: rpact Title: Confirmatory Adaptive Clinical Trial Design and Analysis -Version: 4.0.0.9244 -Date: 2024-05-29 +Version: 4.0.0 +Date: 2024-05-30 Authors@R: c( person( given = "Gernot", diff --git a/NAMESPACE b/NAMESPACE index 0ec6664d..e1e1fbd3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -11,6 +11,7 @@ S3method(as.data.frame,TrialDesignSet) S3method(as.list,Dictionary) S3method(as.matrix,FieldSet) S3method(as.vector,Dictionary) +S3method(fetch,ParameterSet) S3method(kable,ParameterSet) S3method(knit_print,ParameterSet) S3method(knit_print,SummaryFactory) @@ -20,6 +21,7 @@ S3method(names,FieldSet) S3method(names,SimulationResults) S3method(names,StageResults) S3method(names,TrialDesignSet) +S3method(obtain,ParameterSet) S3method(plot,AnalysisResults) S3method(plot,Dataset) S3method(plot,EventProbabilities) @@ -46,6 +48,7 @@ S3method(summary,ParameterSet) S3method(summary,TrialDesignSet) export(as251Normal) export(as251StudentT) +export(fetch) export(getAccrualTime) export(getAnalysisResults) export(getAvailablePlotTypes) @@ -116,6 +119,7 @@ export(getWideFormat) export(kable) export(mvnprd) export(mvstud) +export(obtain) export(plotTypes) export(ppwexp) export(printCitation) diff --git a/R/class_analysis_dataset.R b/R/class_analysis_dataset.R index 72071e5e..2ead88a4 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: 7808 $ -## | Last changed: $Date: 2024-04-05 18:22:34 +0200 (Fr, 05 Apr 2024) $ +## | File version: $Revision: 7962 $ +## | Last changed: $Date: 2024-05-31 13:41:37 +0200 (Fr, 31 Mai 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -1193,7 +1193,7 @@ getDataSet <- function(..., floatingPointNumbersEnabled = FALSE) { 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)) { + if (!isTRUE(all.equal(1:kMax, subsetStages))) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, gettextf("subset %s has incomplete stages (%s)", s, .arrayToString(subsetStages)) diff --git a/R/class_analysis_results.R b/R/class_analysis_results.R index 4a375022..214c0e6c 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: 7742 $ -## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ +## | File version: $Revision: 7962 $ +## | Last changed: $Date: 2024-05-31 13:41:37 +0200 (Fr, 31 Mai 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -1911,7 +1911,7 @@ plot.AnalysisResults <- function(x, y, ..., type = 1L, } treatmentArmsToShowCmd <- "" - if (!is.null(treatmentArmsToShow) && !identical(sort(unique(treatmentArmsToShow)), 1:nrow(data))) { + if (!is.null(treatmentArmsToShow) && !isTRUE(all.equal(sort(unique(treatmentArmsToShow)), 1:nrow(data)))) { treatmentArmsToShowCmd <- paste0(", ", .arrayToString(treatmentArmsToShow, mode = "vector")) } dataCmd <- paste0("rpact:::.getConfidenceIntervalData(", analysisResultsName, treatmentArmsToShowCmd, ")") diff --git a/R/class_analysis_stage_results.R b/R/class_analysis_stage_results.R index f45e7858..56e70ddc 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: 7742 $ -## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ +## | File version: $Revision: 7962 $ +## | Last changed: $Date: 2024-05-31 13:41:37 +0200 (Fr, 31 Mai 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -75,7 +75,14 @@ StageResults <- R6::R6Class("StageResults", weightsInverseNormal = NULL, thetaH0 = NULL, direction = NULL, - initialize = function(..., 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 @@ -105,7 +112,7 @@ StageResults <- R6::R6Class("StageResults", 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 + isTRUE(all.equal(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 @@ -307,7 +314,9 @@ StageResultsMeans <- R6::R6Class("StageResultsMeans", overallSampleSizes2 = NULL, equalVariances = NULL, normalApproximation = NULL, - initialize = function(design, dataInput, ..., + initialize = function( + design, + dataInput, ..., combInverseNormal = NULL, combFisher = NULL, overallTestStatistics = NULL, @@ -323,7 +332,8 @@ StageResultsMeans <- R6::R6Class("StageResultsMeans", overallSampleSizes = NULL, overallSampleSizes1 = NULL, overallSampleSizes2 = NULL, - equalVariances = TRUE, normalApproximation = FALSE) { + equalVariances = TRUE, + normalApproximation = FALSE) { super$initialize(.design = design, .dataInput = dataInput, ...) self$combInverseNormal <- combInverseNormal @@ -491,7 +501,9 @@ StageResultsMultiArmMeans <- R6::R6Class("StageResultsMultiArmMeans", varianceOption = NULL, normalApproximation = NULL, directionUpper = NULL, - initialize = function(design, dataInput, ..., + initialize = function( + design, + dataInput, ..., combInverseNormal = NULL, combFisher = NULL, overallTestStatistics = NULL, @@ -502,8 +514,10 @@ StageResultsMultiArmMeans <- R6::R6Class("StageResultsMultiArmMeans", separatePValues = NULL, effectSizes = NULL, singleStepAdjustedPValues = NULL, - intersectionTest = NULL, varianceOption = C_VARIANCE_OPTION_MULTIARMED_DEFAULT, - normalApproximation = FALSE, directionUpper = NULL) { + intersectionTest = NULL, + varianceOption = C_VARIANCE_OPTION_MULTIARMED_DEFAULT, + normalApproximation = FALSE, + directionUpper = NULL) { super$initialize(...) self$combInverseNormal <- combInverseNormal self$combFisher <- combFisher @@ -539,13 +553,16 @@ StageResultsMultiArmMeans <- R6::R6Class("StageResultsMultiArmMeans", } self$.setParameterType("varianceOption", ifelse( - identical(self$varianceOption, C_VARIANCE_OPTION_MULTIARMED_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + 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 + 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 + identical(self$directionUpper, C_DIRECTION_UPPER_DEFAULT), + C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED )) }, .getParametersToShow = function() { @@ -693,7 +710,8 @@ StageResultsRates <- R6::R6Class("StageResultsRates", } self$.setParameterType("normalApproximation", ifelse( - identical(self$normalApproximation, TRUE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + identical(self$normalApproximation, TRUE), + C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED )) }, .getParametersToShow = function() { @@ -812,7 +830,9 @@ StageResultsMultiArmRates <- R6::R6Class("StageResultsMultiArmRates", intersectionTest = NULL, normalApproximation = NULL, directionUpper = NULL, - initialize = function(design, dataInput, ..., + initialize = function( + design, + dataInput, ..., overallPiTreatments = NULL, overallPiControl = NULL, combInverseNormal = NULL, @@ -861,10 +881,12 @@ StageResultsMultiArmRates <- R6::R6Class("StageResultsMultiArmRates", } self$.setParameterType("normalApproximation", ifelse( - identical(self$normalApproximation, FALSE), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + 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 + identical(self$directionUpper, C_DIRECTION_UPPER_DEFAULT), + C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED )) }, .getParametersToShow = function() { @@ -1131,7 +1153,8 @@ StageResultsMultiArmSurvival <- R6::R6Class("StageResultsMultiArmSurvival", } self$.setParameterType("directionUpper", ifelse( - identical(self$directionUpper, C_DIRECTION_UPPER_DEFAULT), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + identical(self$directionUpper, C_DIRECTION_UPPER_DEFAULT), + C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED )) }, .getParametersToShow = function() { @@ -1254,8 +1277,10 @@ StageResultsEnrichmentRates <- R6::R6Class("StageResultsEnrichmentRates", stratifiedAnalysis = NULL, .getParametersToShow = function() { parametersToShow <- super$.getParametersToShow() - parametersToShow <- parametersToShow[!(parametersToShow %in% c("overallPiTreatments", "overallPiControl"))] - return(c(parametersToShow, "stratifiedAnalysis", "overallPisTreatment", "overallPisControl")) + parametersToShow <- parametersToShow[ + !(parametersToShow %in% c("overallPiTreatments", "overallPiControl"))] + return(c(parametersToShow, "stratifiedAnalysis", + "overallPisTreatment", "overallPisControl")) } ) ) @@ -1547,7 +1572,8 @@ plot.StageResults <- function(x, y, ..., type = 1L, "condPow <- getConditionalPower(", stageResultsName, ", nPlanned = ", .arrayToString(nPlanned, vectorLookAndFeelEnabled = TRUE) ) - if (.isConditionalPowerEnabled(nPlanned) && allocationRatioPlanned != C_ALLOCATION_RATIO_DEFAULT) { + if (.isConditionalPowerEnabled(nPlanned) && + allocationRatioPlanned != C_ALLOCATION_RATIO_DEFAULT) { cmd <- paste0(cmd, ", allocationRatioPlanned = ", allocationRatioPlanned) } if (grepl("Means|Survival", .getClassName(x))) { diff --git a/R/class_core_parameter_set.R b/R/class_core_parameter_set.R index 8ab02821..2bd20790 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: 7809 $ -## | Last changed: $Date: 2024-04-05 18:37:05 +0200 (Fr, 05 Apr 2024) $ +## | File version: $Revision: 7962 $ +## | Last changed: $Date: 2024-05-31 13:41:37 +0200 (Fr, 31 Mai 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -1642,55 +1642,158 @@ print.ParameterSet <- function(x, ..., markdown = NA) { return(invisible(x)) } +.getParameterSetVar <- function(fCall, var) { + varName <- deparse(fCall$var) + if (identical(varName, "NULL")) { + return(var) + } + + varNameExists <- !is.null(varName) && exists(varName) + if (varNameExists) { + return(var) + } + + if (grepl("\"|'", varName)) { + varName <- gsub('"', "", varName) + varName <- gsub("'", "", varName) + return(varName) + } + + if (!varNameExists) { + var <- suppressWarnings(as.integer(varName)) + if (!is.na(var)) { + return(var) + } + + varName <- gsub('"', "", varName) + varName <- gsub("'", "", varName) + return(varName) + } + + return(var) +} + +#' +#' @rdname fetch.ParameterSet +#' +#' @export +#' +pull <- function(x, var, output) UseMethod("pull") + +#' +#' @rdname fetch.ParameterSet +#' +#' @export +#' +pull.ParameterSet <- function(x, var = -1, output = c("named", "value", "list")) { + fCall <- match.call(expand.dots = FALSE) + var <- .getParameterSetVar(fCall, var) + output <- match.arg(output) + return(fetch.ParameterSet(x, var = var, output = output)) +} + +#' +#' @rdname fetch.ParameterSet +#' +#' @export #' -#' @rdname pull.ParameterSet +obtain <- function(x, var, output) UseMethod("obtain") + +#' +#' @rdname fetch.ParameterSet +#' +#' @export +#' +obtain.ParameterSet <- function(x, var = -1, output = c("named", "value", "list")) { + fCall <- match.call(expand.dots = FALSE) + var <- .getParameterSetVar(fCall, var) + output <- match.arg(output) + return(fetch.ParameterSet(x, var = var, output = output)) +} + +#' +#' @rdname fetch.ParameterSet #' #' @export #' -pull <- function(x, var) UseMethod("pull") +fetch <- function(x, var, output) UseMethod("fetch") #' #' @title #' Extract a single parameter #' #' @description -#' Pull a parameter from a parameter set. +#' Fetch a parameter from a parameter set. #' -#' @param x The \code{\link{ParameterSet}} object to pull from. +#' @param x The \code{\link{ParameterSet}} object to fetch from. #' @param var A variable specified as: #' - a literal variable name #' - a positive integer, giving the position counting from the left #' - a negative integer, giving the position counting from the right. -#' The default returns the last column (on the assumption that's the column you've created most recently). +#' The default returns the last parameter. #' This argument is taken by expression and supports quasiquotation (you can unquote column names and column locations). +#' @param output A character defining the output type as follows: +#' - "named" (default) returns the named value if the value is a single value, the value inside a named list otherwise +#' - "value" returns only the value itself +#' - "list" returns the value inside a named list +#' +#' @template examples_fetch_parameter_from_result #' #' @export #' -pull.ParameterSet <- function(x, var = -1) { +fetch.ParameterSet <- function(x, var = -1, output = c("named", "value", "list")) { fCall <- match.call(expand.dots = FALSE) - varName <- deparse(fCall$var) - if (!exists(varName) || (!is.character(var) && !is.integer(var))) { - var <- gsub('"', "", varName) - var <- gsub("'", "", var) - } + var <- .getParameterSetVar(fCall, var) + output <- match.arg(output) + + .assertIsParameterSetClass(x, "x") if (is.character(var)) { if (!(var %in% names(x))) { stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "variable ", sQuote(var), " does not exist") } - return(x[[var]]) + value <- x[[var]] + + if (output == "value") { + return(value) + } + + if (output == "named" && is.vector(value) && length(value) <= 1) { + names(value) <- var + return(value) + } + + result <- list(value = value) + names(result) <- var + return(result) } - - .assertIsSingleInteger(x, "x", validateType = FALSE) - .assertIsInClosedInterval(x, "x", lower = -length(x), upper = length(x)) + + .assertIsSingleInteger(var, "var", validateType = FALSE) + varNames <- names(x) + .assertIsInClosedInterval(var, "var", lower = -length(varNames), upper = length(varNames)) if (var == 0) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'x' (", x, ") must != 0") + stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'var' (", var, ") must != 0") } if (var < 0) { - var <- length(x) + 1 - var + var <- length(varNames) + var + 1 } - return(x[[var]]) + + varName <- varNames[var] + value <- x[[varName]] + + if (output == "value") { + return(value) + } + + if (output == "named" && is.vector(value) && length(value) <= 1) { + names(value) <- names(x)[var] + return(value) + } + + result <- list(value = value) + names(result) <- names(x)[var] + return(result) } #' diff --git a/R/class_core_plot_settings.R b/R/class_core_plot_settings.R index 601903af..fb64d8b0 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: 7916 $ -## | Last changed: $Date: 2024-05-22 17:52:27 +0200 (Mi, 22 Mai 2024) $ +## | File version: $Revision: 7958 $ +## | Last changed: $Date: 2024-05-30 09:56:27 +0200 (Do, 30 Mai 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -165,52 +165,70 @@ PlotSubTitleItems <- R6::R6Class("PlotSubTitleItems", 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) * "")) + 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) * "")) + 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$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) * "")) + 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) * "")) + 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) * "")) + 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$subscript)] == .(item2$value) * + "," ~ .(item3$title) == .(item3$value) * "")) } - return(bquote(" " * .(item1$title) == .(item1$value) * "," ~ .(item2$title) == .(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) * "")) + 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) * "")) + 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$subscript)] == .(item2$value) * "")) } - return(bquote(" " * .(item1$title) == .(item1$value) * "," ~ .(item2$title) == .(item2$value) * "")) + return(bquote(" " * .(item1$title) == .(item1$value) * "," ~ + .(item2$title) == .(item2$value) * "")) } if (!is.null(item1)) { @@ -390,10 +408,18 @@ PlotSettings <- R6::R6Class("PlotSettings", }, 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))) + 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) }, @@ -476,22 +502,40 @@ PlotSettings <- R6::R6Class("PlotSettings", p <- p + ggplot2::theme(aspect.ratio = 1) }, "1" = { - p <- p + ggplot2::theme(legend.position = "inside", legend.position.inside = c(0.05, 1), legend.justification = c(0, 1)) + p <- p + ggplot2::theme( + legend.position = "inside", + legend.position.inside = c(0.05, 1), legend.justification = c(0, 1) + ) }, "2" = { - p <- p + ggplot2::theme(legend.position = "inside", legend.position.inside = c(0.05, 0.5), legend.justification = c(0, 0.5)) + p <- p + ggplot2::theme( + legend.position = "inside", + legend.position.inside = c(0.05, 0.5), legend.justification = c(0, 0.5) + ) }, "3" = { - p <- p + ggplot2::theme(legend.position = "inside", legend.position.inside = c(0.05, 0.05), legend.justification = c(0, 0)) + p <- p + ggplot2::theme( + legend.position = "inside", + legend.position.inside = c(0.05, 0.05), legend.justification = c(0, 0) + ) }, "4" = { - p <- p + ggplot2::theme(legend.position = "inside", legend.position.inside = c(0.95, 1), legend.justification = c(1, 1)) + p <- p + ggplot2::theme( + legend.position = "inside", + legend.position.inside = c(0.95, 1), legend.justification = c(1, 1) + ) }, "5" = { - p <- p + ggplot2::theme(legend.position = "inside", legend.position.inside = c(0.95, 0.5), legend.justification = c(1, 0.5)) + p <- p + ggplot2::theme( + legend.position = "inside", + legend.position.inside = c(0.95, 0.5), legend.justification = c(1, 0.5) + ) }, "6" = { - p <- p + ggplot2::theme(legend.position = "inside", legend.position.inside = c(0.95, 0.05), legend.justification = c(1, 0)) + p <- p + ggplot2::theme( + legend.position = "inside", + legend.position.inside = c(0.95, 0.05), legend.justification = c(1, 0) + ) } ) @@ -557,7 +601,9 @@ PlotSettings <- R6::R6Class("PlotSettings", } s <- items$toString() if (length(s) == 1 && !is.na(s) && nchar(s) > 0) { - plotLabsCaptionEnabled <- as.logical(getOption("rpact.plot.labs.caption.enabled", "true")) + plotLabsCaptionEnabled <- as.logical(getOption( + "rpact.plot.labs.caption.enabled", "true" + )) if (isTRUE(plotLabsCaptionEnabled)) { caption <- s } else { @@ -700,9 +746,13 @@ PlotSettings <- R6::R6Class("PlotSettings", 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)) + 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)) + p <- p + ggplot2::geom_line(ggplot2::aes(y = -yValues), + size = self$scaleSize(self$lineSize) + ) } } if (plotPointsEnabled) { diff --git a/R/class_design.R b/R/class_design.R index 226819a8..32869538 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: 7742 $ -## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ +## | File version: $Revision: 7962 $ +## | Last changed: $Date: 2024-05-31 13:41:37 +0200 (Fr, 31 Mai 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -87,7 +87,7 @@ TrialDesign <- R6::R6Class("TrialDesign", bindingFutility = NA, tolerance = 1e-06 # C_ANALYSIS_TOLERANCE_DEFAULT ) { - self$kMax <- kMax # NEW + self$kMax <- kMax self$alpha <- alpha self$informationRates <- informationRates self$userAlphaSpending <- userAlphaSpending @@ -192,7 +192,8 @@ TrialDesign <- R6::R6Class("TrialDesign", #' @template field_averageSampleNumber0 #' #' @details -#' \code{TrialDesignCharacteristics} contains all fields required to collect the characteristics of a design. +#' \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. #' @@ -233,13 +234,19 @@ TrialDesignCharacteristics <- R6::R6Class("TrialDesignCharacteristics", "Method for automatically printing trial design characteristics objects" self$.resetCat() if (showType == 2) { - super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + super$.show( + showType = showType, digits = digits, + consoleOutputEnabled = consoleOutputEnabled + ) } else { self$.showParametersOfOneGroup(self$.getGeneratedParameters(), title = self$.toString(startWithUpperCase = TRUE), - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + orderByParameterName = FALSE, + consoleOutputEnabled = consoleOutputEnabled + ) + self$.showUnknownParameters( + consoleOutputEnabled = consoleOutputEnabled ) - self$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) } }, .initStages = function() { @@ -422,13 +429,13 @@ TrialDesignFisher <- R6::R6Class("TrialDesignFisher", alpha0VecTemp <- rep(C_FUTILITY_BOUNDS_DEFAULT, kMax - 1) } - if (!identical(kMax, self$kMax)) { + if (!isTRUE(all.equal(kMax, self$kMax))) { return(TRUE) } if (!identical(alpha, self$alpha)) { return(TRUE) } - if (!identical(sided, self$sided)) { + if (!isTRUE(all.equal(sided, self$sided))) { return(TRUE) } if (!identical(method, self$method)) { @@ -569,7 +576,7 @@ TrialDesignInverseNormal <- R6::R6Class("TrialDesignInverseNormal", power = NA_real_, twoSidedPower = C_TWO_SIDED_POWER_DEFAULT, constantBoundsHP = NA_real_, - betaAdjustment = TRUE, # impl as constant + betaAdjustment = TRUE, delayedInformation = NA_real_) { self$beta <- beta self$betaSpent <- betaSpent @@ -645,7 +652,7 @@ TrialDesignInverseNormal <- R6::R6Class("TrialDesignInverseNormal", futilityBoundsTemp <- rep(C_FUTILITY_BOUNDS_DEFAULT, kMax - 1) } - if (!identical(kMax, self$kMax)) { + if (!isTRUE(all.equal(kMax, self$kMax))) { return(self$.pasteComparisonResult("kMax", kMax, self$kMax)) } if (!identical(alpha, self$alpha)) { @@ -654,7 +661,7 @@ TrialDesignInverseNormal <- R6::R6Class("TrialDesignInverseNormal", if (!identical(beta, self$beta)) { return(self$.pasteComparisonResult("beta", beta, self$beta)) } - if (!identical(sided, self$sided)) { + if (!isTRUE(all.equal(sided, self$sided))) { return(self$.pasteComparisonResult("sided", sided, self$sided)) } if (!identical(twoSidedPower, self$twoSidedPower)) { @@ -665,10 +672,16 @@ TrialDesignInverseNormal <- R6::R6Class("TrialDesignInverseNormal", } if (!identical(betaAdjustment, self$betaAdjustment)) { - return(self$.pasteComparisonResult("betaAdjustment", betaAdjustment, self$betaAdjustment)) + return(self$.pasteComparisonResult( + "betaAdjustment", + betaAdjustment, self$betaAdjustment + )) } if (!identical(delayedInformation, self$delayedInformation)) { - return(self$.pasteComparisonResult("delayedInformation", delayedInformation, self$delayedInformation)) + return(self$.pasteComparisonResult( + "delayedInformation", + delayedInformation, self$delayedInformation + )) } if (!identical(typeOfDesign, self$typeOfDesign)) { return(self$.pasteComparisonResult("typeOfDesign", typeOfDesign, self$typeOfDesign)) @@ -687,18 +700,30 @@ TrialDesignInverseNormal <- R6::R6Class("TrialDesignInverseNormal", } } if (!identical(informationRatesTemp, self$informationRates)) { - return(self$.pasteComparisonResult("informationRates", 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)) + return(self$.pasteComparisonResult( + "futilityBounds", + futilityBoundsTemp, self$futilityBounds + )) } if (!identical(optimizationCriterion, self$optimizationCriterion)) { - return(self$.pasteComparisonResult("optimizationCriterion", optimizationCriterion, self$optimizationCriterion)) + return(self$.pasteComparisonResult( + "optimizationCriterion", + optimizationCriterion, self$optimizationCriterion + )) } if (!identical(typeBetaSpending, self$typeBetaSpending)) { - return(self$.pasteComparisonResult("typeBetaSpending", typeBetaSpending, self$typeBetaSpending)) + return(self$.pasteComparisonResult( + "typeBetaSpending", + typeBetaSpending, self$typeBetaSpending + )) } if (!identical(gammaA, self$gammaA)) { return(self$.pasteComparisonResult("gammaA", gammaA, self$gammaA)) @@ -712,20 +737,35 @@ TrialDesignInverseNormal <- R6::R6Class("TrialDesignInverseNormal", (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)) + return(self$.pasteComparisonResult( + "bindingFutility", + bindingFutility, self$bindingFutility + )) } if (!identical(userAlphaSpending, self$userAlphaSpending)) { - return(self$.pasteComparisonResult("userAlphaSpending", userAlphaSpending, self$userAlphaSpending)) + return(self$.pasteComparisonResult( + "userAlphaSpending", + userAlphaSpending, self$userAlphaSpending + )) } if (!identical(userBetaSpending, self$userBetaSpending)) { - return(self$.pasteComparisonResult("userBetaSpending", userBetaSpending, self$userBetaSpending)) + return(self$.pasteComparisonResult( + "userBetaSpending", + userBetaSpending, self$userBetaSpending + )) } if (!identical(twoSidedPower, self$twoSidedPower)) { - return(self$.pasteComparisonResult("twoSidedPower", 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(self$.pasteComparisonResult( + "constantBoundsHP", + constantBoundsHP, self$constantBoundsHP + )) } } return(FALSE) @@ -810,7 +850,8 @@ TrialDesignInverseNormal <- R6::R6Class("TrialDesignInverseNormal", #' @template field_reversalProbabilities #' #' @details -#' This object should not be created directly; use \code{\link[=getDesignGroupSequential]{getDesignGroupSequential()}} +#' 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. @@ -899,13 +940,16 @@ TrialDesignConditionalDunnett <- R6::R6Class("TrialDesignConditionalDunnett", 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 + 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 + 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 + identical(self$secondStageConditioning, TRUE), + C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED )) self$kMax <- 2L @@ -1102,7 +1146,10 @@ plot.TrialDesignCharacteristics <- function(x, y, ...) { ) 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) + 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")) { @@ -1116,7 +1163,8 @@ plot.TrialDesignCharacteristics <- function(x, y, ...) { } else { stop( C_EXCEPTION_TYPE_MISSING_ARGUMENT, - "'variedParameters' needs to be specified, e.g., variedParameters = \"typeOfDesign\"" + "'variedParameters' needs to be specified, ", + "e.g., variedParameters = \"typeOfDesign\"" ) } } @@ -1149,7 +1197,8 @@ plot.TrialDesignCharacteristics <- function(x, y, ...) { #' @inheritParams param_three_dots #' #' @details -#' Each element of the \code{\link{TrialDesign}} is converted to a column in the data frame. +#' Each element of the \code{\link{TrialDesign}} is +#' converted to a column in the data frame. #' #' @template return_dataframe #' @@ -1161,7 +1210,8 @@ plot.TrialDesignCharacteristics <- function(x, y, ...) { #' @keywords internal #' as.data.frame.TrialDesign <- function(x, row.names = NULL, - optional = FALSE, niceColumnNamesEnabled = FALSE, includeAllParameters = FALSE, ...) { + optional = FALSE, niceColumnNamesEnabled = FALSE, + includeAllParameters = FALSE, ...) { .assertIsTrialDesign(x) if (includeAllParameters) { diff --git a/R/class_design_plan.R b/R/class_design_plan.R index 0de280fd..9189df21 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: 7953 $ -## | Last changed: $Date: 2024-05-29 10:36:52 +0200 (Mi, 29 Mai 2024) $ +## | File version: $Revision: 7958 $ +## | Last changed: $Date: 2024-05-30 09:56:27 +0200 (Do, 30 Mai 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -22,7 +22,10 @@ #' @include f_design_general_utilities.R NULL -C_VARIABLE_DESIGN_PLAN_PARAMETERS <- c("lambda1", "pi1", "median1", "alternative", "hazardRatio", "theta") +C_VARIABLE_DESIGN_PLAN_PARAMETERS <- c( + "lambda1", "pi1", "median1", + "alternative", "hazardRatio", "theta" +) C_TRIAL_DESIGN_PLAN_DEFAULT_VALUES_MEANS <- list( normalApproximation = FALSE, @@ -148,13 +151,19 @@ TrialDesignPlan <- R6::R6Class("TrialDesignPlan", }, .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'") + 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'") + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, + "'.objectType' must be specified as 'sampleSize' or 'power'" + ) } return(self$.objectType == "power") }, @@ -180,18 +189,23 @@ TrialDesignPlan <- R6::R6Class("TrialDesignPlan", consoleOutputEnabled = consoleOutputEnabled ) - self$.showParametersOfOneGroup(.getDesignParametersToShow(self), "Design parameters", + self$.showParametersOfOneGroup(.getDesignParametersToShow(self), + "Design parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled ) - self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), "User defined parameters", + self$.showParametersOfOneGroup(self$.getUserDefinedParameters(), + "User defined parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled ) - self$.showParametersOfOneGroup(self$.getDefaultParameters(), "Default parameters", + self$.showParametersOfOneGroup(self$.getDefaultParameters(), + "Default parameters", orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled ) self$.showParametersOfOneGroup(self$.getGeneratedParameters(), - ifelse(identical(self$.objectType, "sampleSize"), "Sample size and output", "Power and output"), + ifelse(identical(self$.objectType, "sampleSize"), + "Sample size and output", "Power and output" + ), orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled ) @@ -211,7 +225,9 @@ TrialDesignPlan <- R6::R6Class("TrialDesignPlan", ) } if (self$.design$kMax > 1) { - self$.cat(" [k]: values at stage k\n", consoleOutputEnabled = consoleOutputEnabled) + self$.cat(" [k]: values at stage k\n", + consoleOutputEnabled = consoleOutputEnabled + ) } } else { self$.cat("\n", consoleOutputEnabled = consoleOutputEnabled) @@ -619,7 +635,7 @@ TrialDesignPlanRates <- R6::R6Class("TrialDesignPlanRates", return(getSampleSizeRates( design = self$.design, normalApproximation = self$.getParameterValueIfUserDefinedOrDefault("normalApproximation"), - riskRatio = self$riskRatio, + riskRatio = self$riskRatio, thetaH0 = self$.getParameterValueIfUserDefinedOrDefault("thetaH0"), pi1 = pi1Temp, pi2 = self$.getParameterValueIfUserDefinedOrDefault("pi2"), @@ -629,7 +645,7 @@ TrialDesignPlanRates <- R6::R6Class("TrialDesignPlanRates", } else { return(getPowerRates( design = self$.design, - riskRatio = self$riskRatio, + riskRatio = self$riskRatio, thetaH0 = self$.getParameterValueIfUserDefinedOrDefault("thetaH0"), pi1 = pi1Temp, pi2 = self$.getParameterValueIfUserDefinedOrDefault("pi2"), @@ -892,9 +908,9 @@ TrialDesignPlanSurvival <- R6::R6Class("TrialDesignPlanSurvival", hr <- self$hazardRatio } } - + lambda2 <- self$.getParameterValueIfUserDefinedOrDefault("lambda2") - + pi1Temp <- NA_real_ if (self$.getParameterType("pi1") == C_PARAM_USER_DEFINED) { pi1Temp <- pi1 @@ -903,7 +919,7 @@ TrialDesignPlanSurvival <- R6::R6Class("TrialDesignPlanSurvival", } } else if (all(is.na(lambda2))) { if (self$.objectType == "sampleSize") { - pi1Temp <- C_PI_1_SAMPLE_SIZE_DEFAULT + pi1Temp <- C_PI_1_SAMPLE_SIZE_DEFAULT } else { pi1Temp <- C_PI_1_DEFAULT } @@ -917,7 +933,7 @@ TrialDesignPlanSurvival <- R6::R6Class("TrialDesignPlanSurvival", if (all(is.na(accrualIntensityTemp))) { accrualIntensityTemp <- C_ACCRUAL_INTENSITY_DEFAULT } - + if (self$.objectType == "sampleSize") { return(getSampleSizeSurvival( design = self$.design, diff --git a/R/class_design_power_and_asn.R b/R/class_design_power_and_asn.R index afe6f936..4bd22659 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: 7742 $ -## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ +## | File version: $Revision: 7958 $ +## | Last changed: $Date: 2024-05-30 09:56:27 +0200 (Do, 30 Mai 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -40,7 +40,8 @@ #' @template field_futilityPerStage #' #' @details -#' This object cannot be created directly; use \code{\link[=getPowerAndAverageSampleNumber]{getPowerAndAverageSampleNumber()}} +#' This object cannot be created directly; +#' use \code{\link[=getPowerAndAverageSampleNumber]{getPowerAndAverageSampleNumber()}} #' with suitable arguments to create it. #' #' @include class_core_parameter_set.R @@ -121,11 +122,15 @@ PowerAndAverageSampleNumberResult <- R6::R6Class("PowerAndAverageSampleNumberRes 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)) + 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)) + self$.setParameterType("theta", ifelse(thetaIsDefault, + C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED + )) kMax <- self$.design$kMax @@ -201,7 +206,8 @@ PowerAndAverageSampleNumberResult <- R6::R6Class("PowerAndAverageSampleNumberRes .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") { + 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), diff --git a/R/class_design_set.R b/R/class_design_set.R index e7b28118..e0def057 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: 7742 $ -## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ +## | File version: $Revision: 7958 $ +## | Last changed: $Date: 2024-05-30 09:56:27 +0200 (Do, 30 Mai 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -46,8 +46,10 @@ NULL #' \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}}. +#' \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 #' @@ -126,7 +128,10 @@ summary.TrialDesignSet <- function(object, ..., type = 1, digits = NA_integer_) .assertIsTrialDesignSet(object) if (object$isEmpty()) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "cannot create summary because the design set is empty") + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + "cannot create summary because the design set is empty" + ) } summaries <- list() @@ -171,9 +176,7 @@ TrialDesignSet <- R6::R6Class("TrialDesignSet", .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 <- PlotSettings$new() self$designs <- list() @@ -749,7 +752,7 @@ as.data.frame.TrialDesignSet <- function(x, results <- PowerAndAverageSampleNumberResult$new(design, theta = theta, nMax = nMax) suppressWarnings(df2 <- as.data.frame(results, niceColumnNamesEnabled = niceColumnNamesEnabled, - includeAllParameters = FALSE # includeAllParameters + includeAllParameters = FALSE )) df <- merge(df, df2, all.y = TRUE) } @@ -882,7 +885,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) && !.isResultObjectBaseClass(main)) { + if (!is.call(main) && !.isResultObjectBaseClass(main)) { .assertIsSingleCharacter(main, "main", naAllowed = TRUE) } .assertIsSingleCharacter(xlab, "xlab", naAllowed = TRUE) @@ -1058,5 +1061,3 @@ 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_event_probabilities.R b/R/class_event_probabilities.R index d1d90c7b..298f9458 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: 7742 $ -## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ +## | File version: $Revision: 7958 $ +## | Last changed: $Date: 2024-05-30 09:56:27 +0200 (Do, 30 Mai 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -286,7 +286,6 @@ plot.EventProbabilities <- function(x, y, ..., .assertGgplotIsInstalled() .assertIsValidLegendPosition(legendPosition) .assertIsValidAllocationRatioPlanned(allocationRatioPlanned, 2L) - # .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) numberOfSubjectsObject <- NULL if (!missing(y) && inherits(y, "NumberOfSubjects")) { @@ -305,8 +304,12 @@ plot.EventProbabilities <- function(x, y, ..., 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") + } 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)) { @@ -368,7 +371,10 @@ plot.EventProbabilities <- function(x, y, ..., srcCmd <- .showPlotSourceInformation( objectName = xObjectName, xParameterName = "time", - yParameterNames = c("cumulativeEventProbabilities", "eventProbabilities1", "eventProbabilities2"), + yParameterNames = c( + "cumulativeEventProbabilities", + "eventProbabilities1", "eventProbabilities2" + ), type = type, showSource = showSource ) @@ -458,12 +464,12 @@ plot.NumberOfSubjects <- function(x, y, ..., fCall <- match.call(expand.dots = FALSE) objectName <- deparse(fCall$x) - # .assertIsSingleInteger(type, "type", naAllowed = FALSE, validateType = FALSE) - if (!missing(y) && inherits(y, "EventProbabilities")) { return(plot.EventProbabilities( x = y, y = x, - allocationRatioPlanned = ifelse(is.na(allocationRatioPlanned), y$allocationRatioPlanned, allocationRatioPlanned), + allocationRatioPlanned = ifelse(is.na(allocationRatioPlanned), + y$allocationRatioPlanned, allocationRatioPlanned + ), main = main, xlab = xlab, ylab = ylab, type = type, legendTitle = legendTitle, palette = palette, plotPointsEnabled = plotPointsEnabled, legendPosition = legendPosition, @@ -473,7 +479,8 @@ plot.NumberOfSubjects <- function(x, y, ..., if (!is.na(allocationRatioPlanned)) { warning("'allocationRatioPlanned' (", allocationRatioPlanned, - ") will be ignored because 'y' is undefined (for more information see ?plot.NumberOfSubjects)", + ") will be ignored because 'y' is undefined ", + "(for more information see ?plot.NumberOfSubjects)", call. = FALSE ) } diff --git a/R/class_simulation_results.R b/R/class_simulation_results.R index f6c2faa1..1550d9ec 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: 7750 $ -## | Last changed: $Date: 2024-03-26 15:44:44 +0100 (Di, 26 Mrz 2024) $ +## | File version: $Revision: 7958 $ +## | Last changed: $Date: 2024-05-30 09:56:27 +0200 (Do, 30 Mai 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -28,7 +28,8 @@ NULL #' @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]}. +#' @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. @@ -321,36 +322,58 @@ SimulationResults <- R6::R6Class("SimulationResults", if (!is.null(performanceScore)) { performanceScore$.showParametersOfOneGroup( performanceScore$.getGeneratedParameters(), "Performance", - orderByParameterName = FALSE, consoleOutputEnabled = consoleOutputEnabled + orderByParameterName = FALSE, + consoleOutputEnabled = consoleOutputEnabled + ) + performanceScore$.showUnknownParameters( + consoleOutputEnabled = consoleOutputEnabled ) - performanceScore$.showUnknownParameters(consoleOutputEnabled = consoleOutputEnabled) } if (self$.design$kMax > 1 || twoGroupsEnabled || multiArmSurvivalEnabled) { - self$.cat("Legend:\n", heading = 2, consoleOutputEnabled = consoleOutputEnabled) + 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) + 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) + self$.cat(" (i): results of situation i\n", + consoleOutputEnabled = consoleOutputEnabled + ) } } else if (twoGroupsEnabled) { - self$.cat(" (i): values of treatment arm i\n", consoleOutputEnabled = consoleOutputEnabled) + 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(" [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(" S[i]: population i\n"), + consoleOutputEnabled = consoleOutputEnabled + ) } - self$.cat(paste0(" F: full 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) + self$.cat(paste0(" R: remaining population\n"), + consoleOutputEnabled = consoleOutputEnabled + ) } } @@ -372,7 +395,8 @@ SimulationResults <- R6::R6Class("SimulationResults", variedParameterName1 <- NA_character_ if (inherits(self, "SimulationResultsMeans")) { variedParameterName1 <- "alternative" - } else if (inherits(self, "SimulationResultsRates") || inherits(self, "SimulationResultsSurvival")) { + } else if (inherits(self, "SimulationResultsRates") || + inherits(self, "SimulationResultsSurvival")) { variedParameterName1 <- "pi1" } else if (grepl("MultiArm", .getClassName(self))) { if (inherits(self, "SimulationResultsMultiArmMeans")) { @@ -464,7 +488,8 @@ SimulationResults <- R6::R6Class("SimulationResults", 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) + "mean +/-sd: ", round(base::mean(paramValue), 3), + " +/-", round(stats::sd(paramValue), 3) ) } else { paramValueFormatted <- "median [range]: NA [NA - NA]; mean +/sd: NA +/-NA" @@ -478,11 +503,13 @@ SimulationResults <- R6::R6Class("SimulationResults", .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") } @@ -844,7 +871,8 @@ SimulationResultsBaseRates <- R6::R6Class("SimulationResultsBaseRates", #' #' #' @details -#' Use \code{\link[=getSimulationRates]{getSimulationRates()}} to create an object of this type. +#' Use \code{\link[=getSimulationRates]{getSimulationRates()}} +#' to create an object of this type. #' #' \code{SimulationResultsRates} is the basic class for #' \itemize{ @@ -958,7 +986,8 @@ SimulationResultsRates <- R6::R6Class("SimulationResultsRates", #' #' #' @details -#' Use \code{\link[=getSimulationMultiArmRates]{getSimulationMultiArmRates()}} to create an object of this type. +#' Use \code{\link[=getSimulationMultiArmRates]{getSimulationMultiArmRates()}} +#' to create an object of this type. #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R @@ -1103,7 +1132,8 @@ SimulationResultsBaseSurvival <- R6::R6Class("SimulationResultsBaseSurvival", #' @template field_conditionalPowerAchieved #' #' @details -#' Use \code{\link[=getSimulationSurvival]{getSimulationSurvival()}} to create an object of this type. +#' Use \code{\link[=getSimulationSurvival]{getSimulationSurvival()}} +#' to create an object of this type. #' #' \code{SimulationResultsSurvival} is the basic class for #' \itemize{ @@ -1251,7 +1281,8 @@ SimulationResultsSurvival <- R6::R6Class("SimulationResultsSurvival", #' @template field_conditionalPowerAchieved #' #' @details -#' Use \code{\link[=getSimulationMultiArmSurvival]{getSimulationMultiArmSurvival()}} to create an object of this type. +#' Use \code{\link[=getSimulationMultiArmSurvival]{getSimulationMultiArmSurvival()}} +#' to create an object of this type. #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R @@ -1357,7 +1388,8 @@ SimulationResultsMultiArmSurvival <- R6::R6Class("SimulationResultsMultiArmSurvi #' @template field_conditionalPowerAchieved #' #' @details -#' Use \code{\link[=getSimulationEnrichmentMeans]{getSimulationEnrichmentMeans()}} to create an object of this type. +#' Use \code{\link[=getSimulationEnrichmentMeans]{getSimulationEnrichmentMeans()}} +#' to create an object of this type. #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R @@ -1456,7 +1488,8 @@ SimulationResultsEnrichmentMeans <- R6::R6Class("SimulationResultsEnrichmentMean #' @template field_conditionalPowerAchieved #' #' @details -#' Use \code{\link[=getSimulationEnrichmentRates]{getSimulationEnrichmentRates()}} to create an object of this type. +#' Use \code{\link[=getSimulationEnrichmentRates]{getSimulationEnrichmentRates()}} +#' to create an object of this type. #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R @@ -1559,7 +1592,8 @@ SimulationResultsEnrichmentRates <- R6::R6Class("SimulationResultsEnrichmentRate #' @template field_conditionalPowerAchieved #' #' @details -#' Use \code{\link[=getSimulationEnrichmentSurvival]{getSimulationEnrichmentSurvival()}} to create an object of this type. +#' Use \code{\link[=getSimulationEnrichmentSurvival]{getSimulationEnrichmentSurvival()}} +#' to create an object of this type. #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R @@ -1641,7 +1675,8 @@ SimulationResultsEnrichmentSurvival <- R6::R6Class("SimulationResultsEnrichmentS #' @template field_rejectPerStage #' #' @details -#' Use \code{\link[=getSimulationCounts]{getSimulationCounts()}} to create an object of this type. +#' Use \code{\link[=getSimulationCounts]{getSimulationCounts()}} +#' to create an object of this type. #' #' @include class_core_parameter_set.R #' @include class_core_plot_settings.R @@ -1670,7 +1705,7 @@ SimulationResultsBaseCountData <- R6::R6Class("SimulationResultsBaseCountData", accrualIntensity = NULL, followUpTime = NULL, groups = NULL, - numberOfSubjects = NULL, + numberOfSubjects = NULL, numberOfSubjects1 = NULL, numberOfSubjects2 = NULL, iterations = NULL, @@ -1694,10 +1729,12 @@ SimulationResultsBaseCountData <- R6::R6Class("SimulationResultsBaseCountData", #' Print Simulation Results #' #' @description -#' \code{print} prints its \code{SimulationResults} argument and returns it invisibly (via \code{invisible(x)}). +#' \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; +#' @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 #' diff --git a/R/class_summary.R b/R/class_summary.R index 1f2de7bb..e09f6998 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: 7946 $ -## | Last changed: $Date: 2024-05-28 12:08:57 +0200 (Di, 28 Mai 2024) $ +## | File version: $Revision: 7958 $ +## | Last changed: $Date: 2024-05-30 09:56:27 +0200 (Do, 30 Mai 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -34,11 +34,17 @@ SummaryItem <- R6::R6Class("SummaryItem", 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") + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + sQuote("legendEntry"), " must be a named list" + ) } for (l in self$legendEntry) { if (length(l) == 0) { - stop(C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, sQuote("legendEntry"), " must be not empty") + stop( + C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, + sQuote("legendEntry"), " must be not empty" + ) } } } @@ -58,8 +64,10 @@ SummaryItem <- R6::R6Class("SummaryItem", #' 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}. +#' @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 @@ -93,9 +101,11 @@ plot.SummaryFactory <- function(x, y, ..., showSummary = FALSE) { #' 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 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`. +#' 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}. @@ -103,10 +113,14 @@ plot.SummaryFactory <- function(x, y, ..., showSummary = FALSE) { #' #' @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. +#' 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 #' @@ -137,7 +151,8 @@ knit_print.SummaryFactory <- function(x, ...) { #' Summary Factory Printing #' #' @param x The summary factory object. -#' @param markdown If \code{TRUE}, the object \code{x} will be printed using markdown syntax; +#' @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 @@ -190,7 +205,11 @@ SummaryFactory <- R6::R6Class("SummaryFactory", justify = NULL, output = NULL, markdown = NULL, - initialize = function(..., object = NULL, intervalFormat = "[%s; %s]", output = "all", markdown = FALSE) { + initialize = function(..., + object = NULL, + intervalFormat = "[%s; %s]", + output = "all", + markdown = FALSE) { super$initialize(...) self$object <- object self$intervalFormat <- intervalFormat @@ -318,7 +337,8 @@ SummaryFactory <- R6::R6Class("SummaryFactory", if (!inherits(summaryItem, "SummaryItem")) { stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, - "'summaryItem' must be an instance of class 'SummaryItem' (was '", .getClassName(summaryItem), "')" + "'summaryItem' must be an instance of class ", + "'SummaryItem' (was '", .getClassName(summaryItem), "')" ) } self$summaryItems <- c(self$summaryItems, summaryItem) @@ -361,7 +381,8 @@ SummaryFactory <- R6::R6Class("SummaryFactory", warning( "Failed to add parameter ", .arrayToString(parameterName), " (", .arrayToString(values), ") stored in ", - .getClassName(parameterSet), " because the parameter has type C_PARAM_NOT_APPLICABLE" + .getClassName(parameterSet), " because the ", + "parameter has type C_PARAM_NOT_APPLICABLE" ) } @@ -542,7 +563,8 @@ SummaryFactory <- R6::R6Class("SummaryFactory", if (userDefinedEffectMatrix) { legendEntry[["[j]"]] <- "effect matrix row j (situation to consider)" } - if (grepl("Survival", .getClassName(parameterSet)) && !grepl("Enrichment", .getClassName(parameterSet))) { + if (grepl("Survival", .getClassName(parameterSet)) && + !grepl("Enrichment", .getClassName(parameterSet))) { legendEntry[["(i)"]] <- "results of treatment arm i vs. control arm" } @@ -887,7 +909,10 @@ SummaryFactory <- R6::R6Class("SummaryFactory", 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")) { + } else if (parameterName %in% c( + "criticalValues", + "decisionCriticalValue", "overallAdjustedTestStatistics" + )) { design <- fieldSet if (!.isTrialDesign(design)) { design <- fieldSet[[".design"]] @@ -916,7 +941,10 @@ SummaryFactory <- R6::R6Class("SummaryFactory", } }, error = function(e) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "failed to show parameter '", parameterName, "': ", e$message) + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, + "failed to show parameter '", parameterName, "': ", e$message + ) } ) } @@ -1105,7 +1133,10 @@ SummaryFactory <- R6::R6Class("SummaryFactory", design <- object[[".design"]] if (is.null(design)) { - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "'.design' must be defined in specified ", .getClassName(object)) + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, + "'.design' must be defined in specified ", .getClassName(object) + ) } settings <- .getSummaryObjectSettings(object) @@ -1171,7 +1202,8 @@ SummaryFactory <- R6::R6Class("SummaryFactory", calcSep <- ifelse(settings$ratioEnabled, " / ", " - ") hypothesis <- "" - if (!settings$survivalEnabled && (settings$multiArmEnabled || settings$enrichmentEnabled || settings$groups == 2)) { + if (!settings$survivalEnabled && (settings$multiArmEnabled || + settings$enrichmentEnabled || settings$groups == 2)) { hypothesis <- paste0( hypothesis, "H0: ", value, treatmentArmIndex, calcSep, value, controlArmIndex, comparisonH0, thetaH0 @@ -1269,7 +1301,8 @@ SummaryFactory <- R6::R6Class("SummaryFactory", } .addAllocationRatioToHeader <- function(parameterSet, header, sep = ", ") { - if (!.isTrialDesignPlanSurvival(parameterSet) && !grepl("Simulation", .getClassName(parameterSet))) { + if (!.isTrialDesignPlanSurvival(parameterSet) && + !grepl("Simulation", .getClassName(parameterSet))) { numberOfGroups <- 1 if (inherits(parameterSet, "TrialDesignPlan")) { numberOfGroups <- parameterSet$groups @@ -1300,7 +1333,9 @@ SummaryFactory <- R6::R6Class("SummaryFactory", return(.concatenateSummaryText(header, paste0( prefix, "planned allocation ratio = ", - .arrayToString(allocationRatioPlanned, vectorLookAndFeelEnabled = length(allocationRatioPlanned) > 1) + .arrayToString(allocationRatioPlanned, + vectorLookAndFeelEnabled = length(allocationRatioPlanned) > 1 + ) ), sep = sep )) @@ -1358,7 +1393,10 @@ SummaryFactory <- R6::R6Class("SummaryFactory", } header <- .concatenateSummaryText(header, - paste0("(", ifelse(design$sided == 1, "one", "two"), "-sided, alpha = ", round(design$alpha, 4), ")"), + paste0( + "(", ifelse(design$sided == 1, "one", "two"), + "-sided, alpha = ", round(design$alpha, 4), ")" + ), sep = " " ) @@ -1386,8 +1424,6 @@ SummaryFactory <- R6::R6Class("SummaryFactory", } else { header <- .concatenateSummaryText(header, "exact test of Fisher") } - } else { - # header <- .concatenateSummaryText(header, "exact t test") } if (stageResults$isDatasetMeans() && multiHypothesesEnabled) { @@ -1873,7 +1909,9 @@ SummaryFactory <- R6::R6Class("SummaryFactory", .arrayToString(round(stDevs, 3), vectorLookAndFeelEnabled = TRUE) )) } else { - stDevCaption <- ifelse(.isRatioComparisonEnabled(designPlan), "coefficient of variation", "standard deviation") + stDevCaption <- ifelse(.isRatioComparisonEnabled(designPlan), + "coefficient of variation", "standard deviation" + ) header <- .concatenateSummaryText(header, paste0(stDevCaption, " = ", round(designPlan$stDev, 3))) } header <- .addAdditionalArgumentsToHeader(header, designPlan, settings) @@ -1967,7 +2005,10 @@ SummaryFactory <- R6::R6Class("SummaryFactory", } else if (userDefinedParam == "median1") { paramName <- "treatment median(1)" } else if (userDefinedParam == "hazardRatio") { - paramName <- ifelse(grepl("SimulationResultsMultiArm", .getClassName(designPlan)), "omega_max", "hazard ratio") + paramName <- ifelse(grepl( + "SimulationResultsMultiArm", + .getClassName(designPlan) + ), "omega_max", "hazard ratio") } } @@ -2013,8 +2054,12 @@ SummaryFactory <- R6::R6Class("SummaryFactory", 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) + "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)) @@ -2028,8 +2073,14 @@ SummaryFactory <- R6::R6Class("SummaryFactory", if (inherits(designPlan, "SimulationResults")) { - header <- .concatenateSummaryText(header, paste0("simulation runs = ", designPlan$maxNumberOfIterations)) - header <- .concatenateSummaryText(header, paste0("seed = ", designPlan$seed)) + header <- .concatenateSummaryText( + header, + paste0("simulation runs = ", designPlan$maxNumberOfIterations) + ) + header <- .concatenateSummaryText( + header, + paste0("seed = ", designPlan$seed) + ) } header <- paste0(header, ".") return(header) @@ -2237,7 +2288,8 @@ SummaryFactory <- R6::R6Class("SummaryFactory", userDefinedFunction <- !is.null(designPlan[[functionName]]) && designPlan$.getParameterType(functionName) == C_PARAM_USER_DEFINED - if (userDefinedFunction || (!is.null(designPlan[["conditionalPower"]]) && !is.na(designPlan$conditionalPower))) { + if (userDefinedFunction || (!is.null(designPlan[["conditionalPower"]]) && + !is.na(designPlan$conditionalPower))) { if (userDefinedFunction) { header <- .concatenateSummaryText( header, @@ -2258,9 +2310,15 @@ SummaryFactory <- R6::R6Class("SummaryFactory", } } - paramName1 <- ifelse(settings$survivalEnabled, "minNumberOfEventsPerStage", "minNumberOfSubjectsPerStage") - paramName2 <- ifelse(settings$survivalEnabled, "maxNumberOfEventsPerStage", "maxNumberOfSubjectsPerStage") - paramCaption <- ifelse(settings$survivalEnabled, "events", "subjects") + 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 = ", @@ -2332,8 +2390,12 @@ SummaryFactory <- R6::R6Class("SummaryFactory", } } - if (settings$survivalEnabled && !is.null(designPlan[["thetaH1"]]) && !is.na(designPlan$thetaH1)) { - header <- .concatenateSummaryText(header, paste0("thetaH1 = ", round(designPlan$thetaH1, 3))) + if (settings$survivalEnabled && !is.null(designPlan[["thetaH1"]]) && + !is.na(designPlan$thetaH1)) { + header <- .concatenateSummaryText( + header, + paste0("thetaH1 = ", round(designPlan$thetaH1, 3)) + ) } } @@ -2341,7 +2403,10 @@ SummaryFactory <- R6::R6Class("SummaryFactory", } .addShapeToHeader <- function(header, designPlan) { - header <- .concatenateSummaryText(header, paste0("effect shape = ", .formatCamelCase(designPlan$typeOfShape))) + 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)) @@ -2402,14 +2467,21 @@ SummaryFactory <- R6::R6Class("SummaryFactory", } if (inherits(object, "AnalysisResults")) { - return(.createSummaryAnalysisResults(object, digits = digits, output = output, markdown = markdown)) + return(.createSummaryAnalysisResults(object, + digits = digits, output = output, markdown = markdown + )) } if (inherits(object, "PerformanceScore")) { - return(.createSummaryPerformanceScore(object, digits = digits, output = output, markdown = markdown)) + return(.createSummaryPerformanceScore(object, + digits = digits, output = output, markdown = markdown + )) } - stop(C_EXCEPTION_TYPE_RUNTIME_ISSUE, "function 'summary' not implemented yet for class ", .getClassName(object)) + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, "function 'summary' not ", + "implemented yet for class ", .getClassName(object) + ) } .createSummaryPerformanceScore <- function(object, ..., @@ -2496,7 +2568,8 @@ SummaryFactory <- R6::R6Class("SummaryFactory", summaryFactory$addParameter(design, parameterName = "criticalValues", parameterCaption = .getSummaryParameterCaptionCriticalValues(design), - roundDigits = digitsProbabilities - ifelse(.isTrialDesignFisher(design) || digitsProbabilities <= 1, 0, 1), + roundDigits = digitsProbabilities - ifelse(.isTrialDesignFisher(design) || + digitsProbabilities <= 1, 0, 1), smoothedZeroFormat = !.isTrialDesignFisher(design) ) } @@ -2514,7 +2587,9 @@ SummaryFactory <- R6::R6Class("SummaryFactory", summaryFactory$addParameter(design, parameterName = "futilityBounds", parameterCaption = .getSummaryParameterCaptionFutilityBounds(design), - roundDigits = ifelse(digitsProbabilities > 1, digitsProbabilities - 1, digitsProbabilities), + roundDigits = ifelse(digitsProbabilities > 1, + digitsProbabilities - 1, digitsProbabilities + ), smoothedZeroFormat = TRUE ) } @@ -2538,8 +2613,9 @@ SummaryFactory <- R6::R6Class("SummaryFactory", summaryFactory$addParameter(stageResults, parameterName = "effectSizes", - parameterCaption = ifelse(stageResults$isDatasetRates() && dataInput$getNumberOfGroups() == 1, - "Cumulative treatment rate", "Cumulative effect size" + parameterCaption = ifelse(stageResults$isDatasetRates() && + dataInput$getNumberOfGroups() == 1, + "Cumulative treatment rate", "Cumulative effect size" ), roundDigits = digitsGeneral ) @@ -2573,7 +2649,8 @@ SummaryFactory <- R6::R6Class("SummaryFactory", ) summaryFactory$addParameter(stageResults, parameterName = controlRateParamName, - parameterCaption = "Cumulative control rate", roundDigits = digitsGeneral, enforceFirstCase = TRUE + parameterCaption = "Cumulative control rate", + roundDigits = digitsGeneral, enforceFirstCase = TRUE ) } } @@ -2582,18 +2659,24 @@ SummaryFactory <- R6::R6Class("SummaryFactory", summaryFactory$addParameter(stageResults, parameterName = "overallTestStatistics", parameterCaption = "Overall test statistic", - roundDigits = ifelse(digitsProbabilities > 1, digitsProbabilities - 1, digitsProbabilities), + roundDigits = ifelse(digitsProbabilities > 1, + digitsProbabilities - 1, digitsProbabilities + ), smoothedZeroFormat = TRUE ) summaryFactory$addParameter(stageResults, - parameterName = ifelse(multiHypothesesEnabled, "separatePValues", "overallPValues"), + 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), + roundDigits = ifelse(digitsProbabilities > 1, + digitsProbabilities - 1, digitsProbabilities + ), smoothedZeroFormat = TRUE ) summaryFactory$addParameter(stageResults, @@ -2607,11 +2690,13 @@ SummaryFactory <- R6::R6Class("SummaryFactory", if (.isTrialDesignConditionalDunnett(design)) { summaryFactory$addParameter(closedTestResults, parameterName = "conditionalErrorRate", - parameterCaption = "Conditional error rate", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + parameterCaption = "Conditional error rate", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) summaryFactory$addParameter(closedTestResults, parameterName = "secondStagePValues", - parameterCaption = "Second stage p-value", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE + parameterCaption = "Second stage p-value", + roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) } else { summaryFactory$addParameter(closedTestResults, @@ -2622,7 +2707,8 @@ SummaryFactory <- R6::R6Class("SummaryFactory", summaryFactory$addParameter(closedTestResults, parameterName = "overallAdjustedTestStatistics", parameterCaption = "Overall adjusted test statistic", - roundDigits = digitsProbabilities - ifelse(.isTrialDesignFisher(design) || digitsProbabilities <= 1, 0, 1), + roundDigits = digitsProbabilities - + ifelse(.isTrialDesignFisher(design) || digitsProbabilities <= 1, 0, 1), smoothedZeroFormat = !.isTrialDesignFisher(design) ) } @@ -2668,7 +2754,8 @@ SummaryFactory <- R6::R6Class("SummaryFactory", "Overall adjusted test statistic (", paste0(1:gMax, collapse = ", "), ")" ), - roundDigits = digitsProbabilities - ifelse(.isTrialDesignFisher(design) || digitsProbabilities <= 1, 0, 1), + roundDigits = digitsProbabilities - + ifelse(.isTrialDesignFisher(design) || digitsProbabilities <= 1, 0, 1), smoothedZeroFormat = !.isTrialDesignFisher(design), legendEntry = legendEntry ) @@ -2691,7 +2778,9 @@ SummaryFactory <- R6::R6Class("SummaryFactory", summaryFactory$addParameter(stageResults, parameterName = "combInverseNormal", parameterCaption = "Inverse normal combination", - roundDigits = ifelse(digitsProbabilities > 1, digitsProbabilities - 1, digitsProbabilities), + roundDigits = ifelse(digitsProbabilities > 1, + digitsProbabilities - 1, digitsProbabilities + ), smoothedZeroFormat = TRUE ) } @@ -2730,7 +2819,8 @@ SummaryFactory <- R6::R6Class("SummaryFactory", parameterCaption = "Conditional power", roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) - } else if (!multiHypothesesEnabled && analysisResults$.getParameterType("nPlanned") != C_PARAM_NOT_APPLICABLE) { + } else if (!multiHypothesesEnabled && + analysisResults$.getParameterType("nPlanned") != C_PARAM_NOT_APPLICABLE) { parameterName <- "conditionalPower" if (!is.null(analysisResults[["conditionalPowerSimulated"]]) && length(analysisResults[["conditionalPowerSimulated"]]) > 0) { @@ -2760,7 +2850,10 @@ SummaryFactory <- R6::R6Class("SummaryFactory", } summaryFactory$addParameter(analysisResults, - parameterName = c("repeatedConfidenceIntervalLowerBounds", "repeatedConfidenceIntervalUpperBounds"), + parameterName = c( + "repeatedConfidenceIntervalLowerBounds", + "repeatedConfidenceIntervalUpperBounds" + ), parameterCaption = parameterCaptionRepeatedCI, roundDigits = digitsGeneral ) @@ -2771,13 +2864,17 @@ SummaryFactory <- R6::R6Class("SummaryFactory", roundDigits = digitsProbabilities, formatRepeatedPValues = TRUE ) - if (!multiHypothesesEnabled && !is.null(analysisResults[["finalStage"]]) && !all(is.na(analysisResults$finalStage))) { + 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"), + parameterName = c( + "finalConfidenceIntervalLowerBounds", + "finalConfidenceIntervalUpperBounds" + ), parameterCaption = "Final confidence interval", roundDigits = digitsGeneral ) summaryFactory$addParameter(analysisResults, @@ -2811,8 +2908,12 @@ SummaryFactory <- R6::R6Class("SummaryFactory", if (is.na(digitsProbabilities)) { digitsProbabilities <- digits + 1 } - .assertIsSingleInteger(digitsProbabilities, "digitsProbabilities", validateType = FALSE, naAllowed = FALSE) - .assertIsInClosedInterval(digitsProbabilities, "digitsProbabilities", lower = -1, upper = 12, naAllowed = FALSE) + .assertIsSingleInteger(digitsProbabilities, "digitsProbabilities", + validateType = FALSE, naAllowed = FALSE + ) + .assertIsInClosedInterval(digitsProbabilities, "digitsProbabilities", + lower = -1, upper = 12, naAllowed = FALSE + ) } else { digitsSampleSize <- digits digitsGeneral <- digits @@ -2855,7 +2956,7 @@ SummaryFactory <- R6::R6Class("SummaryFactory", ) return(invisible(summaryFactory)) } - + informationRatesCaption <- "Planned information rate" percentFormatEnabled <- TRUE if (.isTrialDesignFisher(design)) { @@ -2869,12 +2970,18 @@ SummaryFactory <- R6::R6Class("SummaryFactory", } else { weights <- design$informationRates } - summaryFactory$addItem(informationRatesCaption, - .getSummaryValuesInPercent(weights, percentFormatEnabled = percentFormatEnabled)) + summaryFactory$addItem( + informationRatesCaption, + .getSummaryValuesInPercent(weights, percentFormatEnabled = percentFormatEnabled) + ) if (design$.isDelayedResponseDesign()) { - summaryFactory$addItem("Delayed information", - .getSummaryValuesInPercent(design$delayedInformation, percentFormatEnabled = TRUE)) + summaryFactory$addItem( + "Delayed information", + .getSummaryValuesInPercent(design$delayedInformation, + percentFormatEnabled = TRUE + ) + ) } return(invisible(summaryFactory)) @@ -2972,7 +3079,10 @@ SummaryFactory <- R6::R6Class("SummaryFactory", summaryFactory$addParameter(design, parameterName = "stageLevels", twoSided = design$sided == 2, - parameterCaption = paste0(ifelse(design$sided == 2, "Two", "One"), "-sided local significance level"), + parameterCaption = paste0( + ifelse(design$sided == 2, "Two", "One"), + "-sided local significance level" + ), roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) } @@ -3017,7 +3127,10 @@ SummaryFactory <- R6::R6Class("SummaryFactory", intervalFormat <- getOption("rpact.summary.intervalFormat", "[%s; %s]") .assertIsValidSummaryIntervalFormat(intervalFormat) - summaryFactory <- SummaryFactory$new(object = object, intervalFormat = intervalFormat, output = output, markdown = markdown) + summaryFactory <- SummaryFactory$new( + object = object, + intervalFormat = intervalFormat, output = output, markdown = markdown + ) if (output %in% c("all", "title", "overview")) { .addDesignInformationToSummary(design, designPlan, summaryFactory, output = output) @@ -3109,7 +3222,8 @@ SummaryFactory <- R6::R6Class("SummaryFactory", } if (!is.null(designPlan[["rejectPerStage"]])) { probsH1 <- list( - earlyStop = designPlan$rejectPerStage[1:(design$kMax - 1), ] + as.vector(designPlan$futilityPerStage), + earlyStop = designPlan$rejectPerStage[1:(design$kMax - 1), ] + + as.vector(designPlan$futilityPerStage), rejectPerStage = designPlan$rejectPerStage, futilityPerStage = designPlan$futilityPerStage ) @@ -3141,7 +3255,9 @@ SummaryFactory <- R6::R6Class("SummaryFactory", if (outputSize == "large" && multiArmEnabled) { .addSimulationMultiArmArrayParameter(designPlan, parameterName = "rejectedArmsPerStage", - parameterCaption = ifelse(design$kMax == 1, "Rejected arms", "Rejected arms per stage"), + parameterCaption = ifelse(design$kMax == 1, + "Rejected arms", "Rejected arms per stage" + ), summaryFactory, roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE ) } @@ -3149,7 +3265,9 @@ SummaryFactory <- R6::R6Class("SummaryFactory", if (outputSize == "large" && enrichmentEnabled) { .addSimulationArrayToSummary(designPlan, parameterName = "rejectedPopulationsPerStage", - parameterCaption = ifelse(design$kMax == 1, "Rejected populations", "Rejected populations per stage"), + parameterCaption = ifelse(design$kMax == 1, + "Rejected populations", "Rejected populations per stage" + ), summaryFactory, digitsSampleSize = digitsProbabilities, smoothedZeroFormat = TRUE ) } @@ -3174,13 +3292,15 @@ SummaryFactory <- R6::R6Class("SummaryFactory", summaryFactory$addParameter(designPlan, parameterName = "expectedNumberOfEvents", parameterCaption = "Expected number of events under H1", - roundDigits = digitsSampleSize, transpose = TRUE + roundDigits = digitsSampleSize, + transpose = TRUE ) } else { summaryFactory$addParameter(designPlan, parameterName = "expectedNumberOfSubjects", parameterCaption = "Expected number of subjects under H1", - roundDigits = digitsSampleSize, transpose = TRUE + roundDigits = digitsSampleSize, + transpose = TRUE ) } @@ -3189,7 +3309,9 @@ SummaryFactory <- R6::R6Class("SummaryFactory", summaryFactory$addParameter(designPlan, parameterName = "earlyStop", parameterCaption = "Overall exit probability", # (under H1) - roundDigits = digitsProbabilities, smoothedZeroFormat = TRUE, transpose = TRUE + roundDigits = digitsProbabilities, + smoothedZeroFormat = TRUE, + transpose = TRUE ) } @@ -3244,7 +3366,8 @@ SummaryFactory <- R6::R6Class("SummaryFactory", summaryFactory$addParameter(designPlan, parameterName = "numberOfActiveArms", parameterCaption = "Number of active arms", - roundDigits = digitsGeneral, transpose = TRUE + roundDigits = digitsGeneral, + transpose = TRUE ) } @@ -3253,7 +3376,8 @@ SummaryFactory <- R6::R6Class("SummaryFactory", summaryFactory$addParameter(designPlan, parameterName = "numberOfPopulations", parameterCaption = "Number of populations", - roundDigits = digitsGeneral, transpose = TRUE + roundDigits = digitsGeneral, + transpose = TRUE ) } @@ -3261,7 +3385,8 @@ SummaryFactory <- R6::R6Class("SummaryFactory", summaryFactory$addParameter(designPlan, parameterName = "conditionalPowerAchieved", parameterCaption = "Conditional power (achieved)", - roundDigits = digitsProbabilities, transpose = TRUE + roundDigits = digitsProbabilities, + transpose = TRUE ) } } @@ -3275,12 +3400,16 @@ SummaryFactory <- R6::R6Class("SummaryFactory", summaryFactory$addParameter(designPlan, parameterName = parameterName, parameterCaption = ifelse(design$kMax == 1, "Power", "Cumulative power"), - roundDigits = digitsProbabilities, cumsumEnabled = TRUE, smoothedZeroFormat = TRUE + roundDigits = digitsProbabilities, + cumsumEnabled = TRUE, + smoothedZeroFormat = TRUE ) } if (inherits(designPlan, "SimulationResults")) { - parameterNameSubjects <- ifelse(survivalEnabled, "numberOfSubjects", "sampleSizes") + parameterNameSubjects <- ifelse(survivalEnabled, + "numberOfSubjects", "sampleSizes" + ) parameterNameEvents <- "cumulativeEventsPerStage" } else { if (design$kMax == 1 && ( @@ -3443,7 +3572,7 @@ SummaryFactory <- R6::R6Class("SummaryFactory", if (outputSize == "large") { summaryFactory$addParameter(designPlan, parameterName = "analysisTime", - parameterCaption = "Analysis time", + parameterCaption = "Analysis time", roundDigits = digitsTime ) } @@ -3451,9 +3580,9 @@ SummaryFactory <- R6::R6Class("SummaryFactory", summaryFactory$addParameter(designPlan, parameterName = "studyDuration", parameterCaption = "Expected study duration", - roundDigits = digitsTime, - smoothedZeroFormat = TRUE, - transpose = TRUE + roundDigits = digitsTime, + smoothedZeroFormat = TRUE, + transpose = TRUE ) } } @@ -3745,7 +3874,10 @@ SummaryFactory <- R6::R6Class("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)) + stop( + C_EXCEPTION_TYPE_RUNTIME_ISSUE, class(designPlan)[1], + " does not contain the field ", sQuote(parameterName) + ) } numberOfVariedParams <- dim(arrayData)[2] @@ -3792,7 +3924,8 @@ SummaryFactory <- R6::R6Class("SummaryFactory", )]])[3] numberOfGroups <- dim(arrayData)[3] - if (parameterName == "selectedArms" && !grepl("Survival", .getClassName(designPlan))) { + if (parameterName == "selectedArms" && + !grepl("Survival", .getClassName(designPlan))) { numberOfGroups <- numberOfGroups - 1 # remove control group } numberOfVariedParams <- dim(arrayData)[2] diff --git a/R/class_time.R b/R/class_time.R index d4f11c52..59dbfc1d 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: 7823 $ -## | Last changed: $Date: 2024-04-16 08:27:22 +0200 (Di, 16 Apr 2024) $ +## | File version: $Revision: 7962 $ +## | Last changed: $Date: 2024-05-31 13:41:37 +0200 (Fr, 31 Mai 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -45,7 +45,11 @@ TimeDefinition <- R6::R6Class("TimeDefinition", 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)) + return(self$.getRegexpFromTo( + from = "0", + to = C_REGEXP_DECIMAL_NUMBER, + toPrefix = C_REGEXP_SMALLER + )) }, .getRegexpDecimalRange = function() { return(self$.getRegexpFromTo( @@ -119,7 +123,11 @@ TimeDefinition <- R6::R6Class("TimeDefinition", "e.g., \"20\", \">=20\" or \"20 - Inf\" or \"20 - <=30\"" ) } - if (grepl(self$.getRegexpOr(self$.getRegexpGreaterOrEqualThan(), self$.getRegexpDecimalRangeEnd()), + if (grepl( + self$.getRegexpOr( + self$.getRegexpGreaterOrEqualThan(), + self$.getRegexpDecimalRangeEnd() + ), timePeriod, perl = TRUE )) { @@ -127,7 +135,11 @@ TimeDefinition <- R6::R6Class("TimeDefinition", } timePeriod <- gsub("([Inf >=\\?x]*)|-", "", timePeriod) } else { - if (!grepl(self$.getRegexpOr(self$.getRegexpGreaterOrEqualThan(), self$.getRegexpDecimalRangeEnd()), + if (!grepl( + self$.getRegexpOr( + self$.getRegexpGreaterOrEqualThan(), + self$.getRegexpDecimalRangeEnd() + ), timePeriod, perl = TRUE )) { @@ -142,7 +154,8 @@ TimeDefinition <- R6::R6Class("TimeDefinition", 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 - 0 && !all(is.na(self$hazardRatio))) { self$.setParameterType("hazardRatio", C_PARAM_USER_DEFINED) hazardRatioCalculationEnabled <- FALSE @@ -880,7 +949,8 @@ PiecewiseSurvivalTime <- R6::R6Class("PiecewiseSurvivalTime", 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))' ", + "'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)" @@ -900,7 +970,8 @@ PiecewiseSurvivalTime <- R6::R6Class("PiecewiseSurvivalTime", 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$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) @@ -938,7 +1009,10 @@ PiecewiseSurvivalTime <- R6::R6Class("PiecewiseSurvivalTime", 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$hazardRatio <- getHazardRatioByPi( + self$pi1, self$pi2, self$eventTime, + kappa = self$kappa + ) self$.setParameterType("hazardRatio", C_PARAM_GENERATED) } } @@ -951,7 +1025,8 @@ PiecewiseSurvivalTime <- R6::R6Class("PiecewiseSurvivalTime", } if (identical(self$pi1, pi1Default)) { self$.setParameterType("pi1", C_PARAM_DEFAULT_VALUE) - } else if (hazardRatioCalculationEnabled && self$.getParameterType("pi1") != C_PARAM_GENERATED) { + } else if (hazardRatioCalculationEnabled && + self$.getParameterType("pi1") != C_PARAM_GENERATED) { self$.setParameterType("pi1", C_PARAM_USER_DEFINED) } } @@ -1021,8 +1096,12 @@ PiecewiseSurvivalTime <- R6::R6Class("PiecewiseSurvivalTime", 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") + 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) @@ -1041,11 +1120,14 @@ PiecewiseSurvivalTime <- R6::R6Class("PiecewiseSurvivalTime", ) } - if (self$delayedResponseAllowed && length(self$lambda1 > 0) && !all(is.na(self$lambda1)) && - length(self$lambda1) != length(self$lambda2) && self$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(self$lambda1), "), 'lambda2' (", length(self$lambda2), "), and ", + "length of 'lambda1' (", length(self$lambda1), "), ", + "'lambda2' (", length(self$lambda2), "), and ", "'piecewiseSurvivalTime' (", length(self$piecewiseSurvivalTime), ") must be equal" ) } @@ -1098,20 +1180,24 @@ PiecewiseSurvivalTime <- R6::R6Class("PiecewiseSurvivalTime", }, .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) { + 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) { + 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) { + 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) { + 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) } @@ -1123,7 +1209,8 @@ PiecewiseSurvivalTime <- R6::R6Class("PiecewiseSurvivalTime", 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)) { + 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) { @@ -1164,7 +1251,7 @@ PiecewiseSurvivalTime <- R6::R6Class("PiecewiseSurvivalTime", }, .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 && @@ -1188,7 +1275,8 @@ PiecewiseSurvivalTime <- R6::R6Class("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))) { + !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))) { @@ -1305,7 +1393,8 @@ PiecewiseSurvivalTime <- R6::R6Class("PiecewiseSurvivalTime", stop( C_EXCEPTION_TYPE_ILLEGAL_ARGUMENT, "'lambda1' (", .arrayToString(self$lambda1), ") ", - "is not as expected (", .arrayToString(target), ") for given hazard ratio ", self$hazardRatio + "is not as expected (", .arrayToString(target), ") ", + "for given hazard ratio ", self$hazardRatio ) } } @@ -1386,14 +1475,15 @@ AccrualTime <- R6::R6Class("AccrualTime", 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) + ifelse(is.na(self$absoluteAccrualIntensityEnabled), + C_PARAM_GENERATED, C_PARAM_USER_DEFINED + ) ) self$accrualIntensityRelative <- NA_real_ @@ -1412,7 +1502,7 @@ AccrualTime <- R6::R6Class("AccrualTime", self$.initAccrualIntensityAbsolute() self$.validateFormula() - self$.showWarningIfCaseIsNotAllowed() + self$.showWarningIfCaseIsNotAllowed() }, .asDataFrame = function() { accrualIntensityTemp <- self$accrualIntensity @@ -1446,16 +1536,23 @@ AccrualTime <- R6::R6Class("AccrualTime", "Method for automatically printing accrual time objects" self$.resetCat() if (showType == 2) { - super$.show(showType = showType, digits = digits, consoleOutputEnabled = consoleOutputEnabled) + 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) + 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) + self$.cat(" At all times:", self$accrualIntensity[1], "\n", + consoleOutputEnabled = consoleOutputEnabled + ) } else { accrualTimeStr <- format(self$accrualTime) accrualIntensityStr <- format(self$accrualIntensity) @@ -1601,8 +1698,12 @@ AccrualTime <- R6::R6Class("AccrualTime", # 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, ", + 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 ) @@ -1617,8 +1718,12 @@ AccrualTime <- R6::R6Class("AccrualTime", # 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, ", + 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 ) @@ -1632,7 +1737,10 @@ AccrualTime <- R6::R6Class("AccrualTime", # 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("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 @@ -1646,8 +1754,12 @@ AccrualTime <- R6::R6Class("AccrualTime", # 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, ", + 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 ) @@ -1661,7 +1773,10 @@ AccrualTime <- R6::R6Class("AccrualTime", # maxNumberOfSubjects = 1000) else if (!self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && self$absoluteAccrualIntensityEnabled) { - self$.cat("Case (#5):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) + 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 @@ -1678,7 +1793,10 @@ AccrualTime <- R6::R6Class("AccrualTime", else if (!self$endOfAccrualIsUserDefined && self$maxNumberOfSubjectsIsUserDefined && !self$absoluteAccrualIntensityEnabled) { caseIsAllowed <- FALSE - self$.cat("Case (#6):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) + 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 @@ -1693,7 +1811,10 @@ AccrualTime <- R6::R6Class("AccrualTime", # 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("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 @@ -1708,7 +1829,10 @@ AccrualTime <- R6::R6Class("AccrualTime", else if (!self$endOfAccrualIsUserDefined && !self$maxNumberOfSubjectsIsUserDefined && self$followUpTimeMustBeUserDefined && !self$absoluteAccrualIntensityEnabled) { caseIsAllowed <- FALSE - self$.cat("Case (#8):\n", sep = "", heading = 1, consoleOutputEnabled = consoleOutputEnabled) + 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 @@ -1718,7 +1842,6 @@ AccrualTime <- R6::R6Class("AccrualTime", ) } - # .cat("\n", consoleOutputEnabled = consoleOutputEnabled) if (!caseIsAllowed) { self$.cat(prefix, "(@) Cannot be calculated.\n", consoleOutputEnabled = consoleOutputEnabled @@ -1830,8 +1953,9 @@ AccrualTime <- R6::R6Class("AccrualTime", ) } - if (self$.showWarnings && !all(is.na(self$accrualIntensity)) && (length(self$accrualIntensity) != 1 || - self$accrualIntensity != C_ACCRUAL_INTENSITY_DEFAULT)) { + 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 @@ -1848,7 +1972,10 @@ AccrualTime <- R6::R6Class("AccrualTime", accrualTimeValue <- accrualTimeList[[timePeriod]] .assertIsSingleNumber(accrualTimeValue, paste0("accrualTime[", i, "]")) - settings <- self$.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 @@ -1981,7 +2108,7 @@ AccrualTime <- R6::R6Class("AccrualTime", accrualTimeArg <- accrualTimeArg[length(accrualTimeArg)] self$accrualTime <- c(0L, accrualTimeArg) self$.setParameterType("accrualTime", ifelse( - identical(as.integer(self$accrualTime), C_ACCRUAL_TIME_DEFAULT), + isTRUE(all.equal(as.integer(self$accrualTime), C_ACCRUAL_TIME_DEFAULT)), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED )) @@ -2026,7 +2153,7 @@ AccrualTime <- R6::R6Class("AccrualTime", } self$.setParameterType("accrualTime", ifelse( - identical(as.integer(self$accrualTime), C_ACCRUAL_TIME_DEFAULT), + isTRUE(all.equal(self$accrualTime, C_ACCRUAL_TIME_DEFAULT)), C_PARAM_DEFAULT_VALUE, C_PARAM_USER_DEFINED )) self$.setParameterType("accrualIntensity", C_PARAM_USER_DEFINED) @@ -2113,7 +2240,8 @@ AccrualTime <- R6::R6Class("AccrualTime", self$maxNumberOfSubjects <- sampleSize self$.setParameterType("maxNumberOfSubjects", C_PARAM_GENERATED) } - self$remainingTime <- self$accrualTime[length(self$accrualTime)] - self$accrualTime[length(self$accrualTime) - 1] + 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)), @@ -2128,7 +2256,8 @@ AccrualTime <- R6::R6Class("AccrualTime", self$.validateInitialization() self$maxNumberOfSubjectsIsUserDefined <- self$.getParameterType("maxNumberOfSubjects") == C_PARAM_USER_DEFINED - self$followUpTimeMustBeUserDefined <- !self$endOfAccrualIsUserDefined && !self$maxNumberOfSubjectsIsUserDefined + self$followUpTimeMustBeUserDefined <- !self$endOfAccrualIsUserDefined && + !self$maxNumberOfSubjectsIsUserDefined }, .getSampleSize = function() { if (length(self$accrualTime) < 2) { @@ -2252,7 +2381,6 @@ AccrualTime <- R6::R6Class("AccrualTime", 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()) diff --git a/R/f_design_plan_survival.R b/R/f_design_plan_survival.R index 21dee798..f0925a9d 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: 7902 $ -## | Last changed: $Date: 2024-05-21 08:44:08 +0200 (Di, 21 Mai 2024) $ +## | File version: $Revision: 7962 $ +## | Last changed: $Date: 2024-05-31 13:41:37 +0200 (Fr, 31 Mai 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -790,11 +790,11 @@ NULL designPlan$.setParameterType("maxNumberOfSubjects", C_PARAM_USER_DEFINED) } - if (identical(as.integer(accrualSetup$accrualTime), C_ACCRUAL_TIME_DEFAULT) || - identical( + if (isTRUE(all.equal(accrualSetup$accrualTime, C_ACCRUAL_TIME_DEFAULT)) || + isTRUE(all.equal( as.integer(c(0L, accrualSetup$.getAccrualTimeWithoutLeadingZero())), - C_ACCRUAL_TIME_DEFAULT - )) { + C_ACCRUAL_TIME_DEFAULT)) + ) { designPlan$.setParameterType("accrualTime", C_PARAM_DEFAULT_VALUE) } else { designPlan$.setParameterType("accrualTime", accrualSetup$.getParameterType("accrualTime")) @@ -903,7 +903,7 @@ NULL designPlan$.setParameterType(p, C_PARAM_NOT_APPLICABLE) } if (designPlan$.getParameterType("accrualTime") == C_PARAM_USER_DEFINED || - !identical(accrualTime, C_ACCRUAL_TIME_DEFAULT)) { + !isTRUE(all.equal(accrualTime, C_ACCRUAL_TIME_DEFAULT))) { designPlan$.warnInCaseArgumentExists(accrualSetup$accrualTime, "accrualTime") } designPlan$.warnInCaseArgumentExists(dropoutRate1, "dropoutRate1") diff --git a/R/f_quality_assurance.R b/R/f_quality_assurance.R index 3baf6198..a2c776b9 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: 7920 $ -## | Last changed: $Date: 2024-05-23 13:56:24 +0200 (Do, 23 Mai 2024) $ +## | File version: $Revision: 7961 $ +## | Last changed: $Date: 2024-05-30 14:58:05 +0200 (Thu, 30 May 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -22,10 +22,13 @@ NULL # See testthat::skip_on_cran() -.skipTestIfDisabled <- function() { +.skipTestIfDisabled <- function(msg = "Test is disabled", ..., ignoreInTestPlan = FALSE) { if (!isTRUE(.isCompleteUnitTestSetEnabled()) && base::requireNamespace("testthat", quietly = TRUE)) { - testthat::skip("Test is disabled") + if (isTRUE(ignoreInTestPlan)) { + msg <- paste(msg, "and ignored in test plan") + } + testthat::skip(msg) } } @@ -33,12 +36,12 @@ NULL if (.Platform$OS.type != "windows") { return(invisible()) } - - if (.isPackageInstalled("pkgbuild") && + + if (.isPackageInstalled("pkgbuild") && isTRUE(eval(parse(text = "pkgbuild::has_build_tools(debug = FALSE)")))) { return(invisible()) } - + testthat::skip("The test requires a C++ compiler") } diff --git a/cran-comments.md b/cran-comments.md index 8a98c9ed..6cf8bfd9 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,7 +1,7 @@ ## Test environments -* local OS X install, R 4.3.3 +* local OS X install, R 4.4.0 * win-builder (old release, devel, and release) ## R CMD check results @@ -10,7 +10,7 @@ There were no ERRORs or WARNINGs. ## Unit tests: testthat results (complete test) -OK: 43917 +OK: 34427 Failed: 0 Warnings: 0 Skipped: 0 diff --git a/inst/doc/rpact_getting_started.html b/inst/doc/rpact_getting_started.html index f8760d03..e5326bf8 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-05-28

+

2024-05-31

diff --git a/man-roxygen/examples_fetch_parameter_from_result.R b/man-roxygen/examples_fetch_parameter_from_result.R new file mode 100644 index 00000000..26ef2005 --- /dev/null +++ b/man-roxygen/examples_fetch_parameter_from_result.R @@ -0,0 +1,6 @@ +#' @examples +#' \dontrun{ +#' getDesignInverseNormal() |> fetch(kMax) +#' getDesignInverseNormal() |> fetch(kMax, output = "list") +#' } +#' diff --git a/man/PowerAndAverageSampleNumberResult.Rd b/man/PowerAndAverageSampleNumberResult.Rd index f7fda159..98ad43a6 100644 --- a/man/PowerAndAverageSampleNumberResult.Rd +++ b/man/PowerAndAverageSampleNumberResult.Rd @@ -7,7 +7,8 @@ Class for power and average sample number (ASN) results. } \details{ -This object cannot be created directly; use \code{\link[=getPowerAndAverageSampleNumber]{getPowerAndAverageSampleNumber()}} +This object cannot be created directly; +use \code{\link[=getPowerAndAverageSampleNumber]{getPowerAndAverageSampleNumber()}} with suitable arguments to create it. } \section{Fields}{ diff --git a/man/SimulationResultsBaseCountData.Rd b/man/SimulationResultsBaseCountData.Rd index df063b57..0c8fe5a1 100644 --- a/man/SimulationResultsBaseCountData.Rd +++ b/man/SimulationResultsBaseCountData.Rd @@ -7,7 +7,8 @@ A class for simulation results count data. } \details{ -Use \code{\link[=getSimulationCounts]{getSimulationCounts()}} to create an object of this type. +Use \code{\link[=getSimulationCounts]{getSimulationCounts()}} +to create an object of this type. } \section{Fields}{ diff --git a/man/SimulationResultsEnrichmentMeans.Rd b/man/SimulationResultsEnrichmentMeans.Rd index d32880ea..3aa7eb9a 100644 --- a/man/SimulationResultsEnrichmentMeans.Rd +++ b/man/SimulationResultsEnrichmentMeans.Rd @@ -7,7 +7,8 @@ A class for simulation results means in enrichment designs. } \details{ -Use \code{\link[=getSimulationEnrichmentMeans]{getSimulationEnrichmentMeans()}} to create an object of this type. +Use \code{\link[=getSimulationEnrichmentMeans]{getSimulationEnrichmentMeans()}} +to create an object of this type. } \section{Fields}{ diff --git a/man/SimulationResultsEnrichmentRates.Rd b/man/SimulationResultsEnrichmentRates.Rd index a7104790..5d167c42 100644 --- a/man/SimulationResultsEnrichmentRates.Rd +++ b/man/SimulationResultsEnrichmentRates.Rd @@ -7,7 +7,8 @@ A class for simulation results rates in enrichment designs. } \details{ -Use \code{\link[=getSimulationEnrichmentRates]{getSimulationEnrichmentRates()}} to create an object of this type. +Use \code{\link[=getSimulationEnrichmentRates]{getSimulationEnrichmentRates()}} +to create an object of this type. } \section{Fields}{ diff --git a/man/SimulationResultsEnrichmentSurvival.Rd b/man/SimulationResultsEnrichmentSurvival.Rd index 42c1e816..6fb2c079 100644 --- a/man/SimulationResultsEnrichmentSurvival.Rd +++ b/man/SimulationResultsEnrichmentSurvival.Rd @@ -7,7 +7,8 @@ A class for simulation results survival in enrichment designs. } \details{ -Use \code{\link[=getSimulationEnrichmentSurvival]{getSimulationEnrichmentSurvival()}} to create an object of this type. +Use \code{\link[=getSimulationEnrichmentSurvival]{getSimulationEnrichmentSurvival()}} +to create an object of this type. } \section{Fields}{ diff --git a/man/SimulationResultsMultiArmRates.Rd b/man/SimulationResultsMultiArmRates.Rd index 6809efad..2c8477b6 100644 --- a/man/SimulationResultsMultiArmRates.Rd +++ b/man/SimulationResultsMultiArmRates.Rd @@ -7,7 +7,8 @@ A class for simulation results rates in multi-arm designs. } \details{ -Use \code{\link[=getSimulationMultiArmRates]{getSimulationMultiArmRates()}} to create an object of this type. +Use \code{\link[=getSimulationMultiArmRates]{getSimulationMultiArmRates()}} +to create an object of this type. } \section{Fields}{ diff --git a/man/SimulationResultsMultiArmSurvival.Rd b/man/SimulationResultsMultiArmSurvival.Rd index 4107dd30..308c5ad5 100644 --- a/man/SimulationResultsMultiArmSurvival.Rd +++ b/man/SimulationResultsMultiArmSurvival.Rd @@ -7,7 +7,8 @@ A class for simulation results survival in multi-arm designs. } \details{ -Use \code{\link[=getSimulationMultiArmSurvival]{getSimulationMultiArmSurvival()}} to create an object of this type. +Use \code{\link[=getSimulationMultiArmSurvival]{getSimulationMultiArmSurvival()}} +to create an object of this type. } \section{Fields}{ diff --git a/man/SimulationResultsRates.Rd b/man/SimulationResultsRates.Rd index 0ae7b674..4b3814b1 100644 --- a/man/SimulationResultsRates.Rd +++ b/man/SimulationResultsRates.Rd @@ -7,7 +7,8 @@ A class for simulation results rates. } \details{ -Use \code{\link[=getSimulationRates]{getSimulationRates()}} to create an object of this type. +Use \code{\link[=getSimulationRates]{getSimulationRates()}} +to create an object of this type. \code{SimulationResultsRates} is the basic class for \itemize{ diff --git a/man/SimulationResultsSurvival.Rd b/man/SimulationResultsSurvival.Rd index d89f1ca4..e9ac0fac 100644 --- a/man/SimulationResultsSurvival.Rd +++ b/man/SimulationResultsSurvival.Rd @@ -7,7 +7,8 @@ A class for simulation results survival. } \details{ -Use \code{\link[=getSimulationSurvival]{getSimulationSurvival()}} to create an object of this type. +Use \code{\link[=getSimulationSurvival]{getSimulationSurvival()}} +to create an object of this type. \code{SimulationResultsSurvival} is the basic class for \itemize{ diff --git a/man/TrialDesignCharacteristics.Rd b/man/TrialDesignCharacteristics.Rd index d549f32e..c42d6840 100644 --- a/man/TrialDesignCharacteristics.Rd +++ b/man/TrialDesignCharacteristics.Rd @@ -7,7 +7,8 @@ Class for trial design characteristics. } \details{ -\code{TrialDesignCharacteristics} contains all fields required to collect the characteristics of a design. +\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. } diff --git a/man/TrialDesignGroupSequential.Rd b/man/TrialDesignGroupSequential.Rd index d0604935..efc84bc6 100644 --- a/man/TrialDesignGroupSequential.Rd +++ b/man/TrialDesignGroupSequential.Rd @@ -7,7 +7,8 @@ Trial design for group sequential design. } \details{ -This object should not be created directly; use \code{\link[=getDesignGroupSequential]{getDesignGroupSequential()}} +This object should not be created directly; +use \code{\link[=getDesignGroupSequential]{getDesignGroupSequential()}} with suitable arguments to create a group sequential design. } \section{Fields}{ diff --git a/man/as.data.frame.TrialDesign.Rd b/man/as.data.frame.TrialDesign.Rd index b352d711..5bcc78d6 100644 --- a/man/as.data.frame.TrialDesign.Rd +++ b/man/as.data.frame.TrialDesign.Rd @@ -34,7 +34,8 @@ Returns a \code{\link[base]{data.frame}}. Returns the \code{TrialDesign} as data frame. } \details{ -Each element of the \code{\link{TrialDesign}} is converted to a column in the data frame. +Each element of the \code{\link{TrialDesign}} is +converted to a column in the data frame. } \examples{ as.data.frame(getDesignGroupSequential()) diff --git a/man/fetch.ParameterSet.Rd b/man/fetch.ParameterSet.Rd new file mode 100644 index 00000000..cbd2c1e2 --- /dev/null +++ b/man/fetch.ParameterSet.Rd @@ -0,0 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_core_parameter_set.R +\name{pull} +\alias{pull} +\alias{pull.ParameterSet} +\alias{obtain} +\alias{obtain.ParameterSet} +\alias{fetch} +\alias{fetch.ParameterSet} +\title{Extract a single parameter} +\usage{ +pull(x, var, output) + +\method{pull}{ParameterSet}(x, var = -1, output = c("named", "value", "list")) + +obtain(x, var, output) + +\method{obtain}{ParameterSet}(x, var = -1, output = c("named", "value", "list")) + +fetch(x, var, output) + +\method{fetch}{ParameterSet}(x, var = -1, output = c("named", "value", "list")) +} +\arguments{ +\item{x}{The \code{\link{ParameterSet}} object to fetch from.} + +\item{var}{A variable specified as: +\itemize{ +\item a literal variable name +\item a positive integer, giving the position counting from the left +\item a negative integer, giving the position counting from the right. +The default returns the last parameter. +This argument is taken by expression and supports quasiquotation (you can unquote column names and column locations). +}} + +\item{output}{A character defining the output type as follows: +\itemize{ +\item "named" (default) returns the named value if the value is a single value, the value inside a named list otherwise +\item "value" returns only the value itself +\item "list" returns the value inside a named list +}} +} +\description{ +Fetch a parameter from a parameter set. +} +\examples{ +\dontrun{ +getDesignInverseNormal() |> fetch(kMax) +getDesignInverseNormal() |> fetch(kMax, output = "list") +} + +} diff --git a/man/getDesignSet.Rd b/man/getDesignSet.Rd index 7347c98c..d81dbfd7 100644 --- a/man/getDesignSet.Rd +++ b/man/getDesignSet.Rd @@ -23,8 +23,10 @@ The following generics (R generic functions) are available for this result objec \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}}. +\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}}. } } \description{ diff --git a/man/knit_print.SummaryFactory.Rd b/man/knit_print.SummaryFactory.Rd index d53df479..a0696742 100644 --- a/man/knit_print.SummaryFactory.Rd +++ b/man/knit_print.SummaryFactory.Rd @@ -12,15 +12,21 @@ \item{...}{Other arguments (see \code{\link[knitr]{knit_print}}).} } \description{ -The function \code{knit_print.SummaryFactory} is the default printing function for rpact summary objects in knitr. +The function \code{knit_print.SummaryFactory} is the default +printing function for rpact summary objects in knitr. The chunk option \code{render} uses this function by default. -To fall back to the normal printing behavior set the chunk option \code{render = normal_print}. +To fall back to the normal printing behavior set the +chunk option \code{render = normal_print}. For more information 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. +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.SimulationResults.Rd b/man/names.SimulationResults.Rd index ffc2d197..84e0b308 100644 --- a/man/names.SimulationResults.Rd +++ b/man/names.SimulationResults.Rd @@ -7,7 +7,8 @@ \method{names}{SimulationResults}(x) } \arguments{ -\item{x}{A \code{\link{SimulationResults}} object created by \code{getSimulationResults[MultiArm/Enrichment][Means/Rates/Survival]}.} +\item{x}{A \code{\link{SimulationResults}} object created by +\code{getSimulationResults[MultiArm/Enrichment][Means/Rates/Survival]}.} } \value{ Returns a \code{\link[base]{character}} vector containing the names of the \code{\link{AnalysisResults}} object. diff --git a/man/plot.SummaryFactory.Rd b/man/plot.SummaryFactory.Rd index 8031ac59..d9435174 100644 --- a/man/plot.SummaryFactory.Rd +++ b/man/plot.SummaryFactory.Rd @@ -9,12 +9,14 @@ \arguments{ \item{x}{The summary factory object.} -\item{y}{Not available for this kind of plot (is only defined to be compatible to the generic plot function).} +\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{showSummary}{Show the summary before creating the plot output, default is \code{FALSE}.} +\item{showSummary}{Show the summary before creating the +plot output, default is \code{FALSE}.} } \value{ Returns a \code{ggplot2} object. diff --git a/man/print.SimulationResults.Rd b/man/print.SimulationResults.Rd index 72252bba..928e13bd 100644 --- a/man/print.SimulationResults.Rd +++ b/man/print.SimulationResults.Rd @@ -12,11 +12,13 @@ \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; +\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{SimulationResults} argument and returns it invisibly (via \code{invisible(x)}). +\code{print} prints its \code{SimulationResults} argument and +returns it invisibly (via \code{invisible(x)}). } \details{ Prints the parameters and results of an \code{SimulationResults} object. diff --git a/man/print.SummaryFactory.Rd b/man/print.SummaryFactory.Rd index fc9ea906..2b448e43 100644 --- a/man/print.SummaryFactory.Rd +++ b/man/print.SummaryFactory.Rd @@ -12,7 +12,8 @@ \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{markdown}{If \code{TRUE}, the object \code{x} will be printed using markdown syntax; +\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})} \item{sep}{The separator line between the summary and the print output.} diff --git a/man/pull.ParameterSet.Rd b/man/pull.ParameterSet.Rd deleted file mode 100644 index 18aad973..00000000 --- a/man/pull.ParameterSet.Rd +++ /dev/null @@ -1,26 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_core_parameter_set.R -\name{pull} -\alias{pull} -\alias{pull.ParameterSet} -\title{Extract a single parameter} -\usage{ -pull(x, var) - -\method{pull}{ParameterSet}(x, var = -1) -} -\arguments{ -\item{x}{The \code{\link{ParameterSet}} object to pull from.} - -\item{var}{A variable specified as: -\itemize{ -\item a literal variable name -\item a positive integer, giving the position counting from the left -\item a negative integer, giving the position counting from the right. -The default returns the last column (on the assumption that's the column you've created most recently). -This argument is taken by expression and supports quasiquotation (you can unquote column names and column locations). -}} -} -\description{ -Pull a parameter from a parameter set. -} diff --git a/tests/testthat/test-class_core_parameter_set.R b/tests/testthat/test-class_core_parameter_set.R new file mode 100644 index 00000000..019e8300 --- /dev/null +++ b/tests/testthat/test-class_core_parameter_set.R @@ -0,0 +1,78 @@ +## | +## | *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_analysis_dataset.R +## | Creation date: 06 February 2023, 12:04:06 +## | File version: $Revision: 7742 $ +## | Last changed: $Date: 2024-03-22 13:46:29 +0100 (Fr, 22 Mrz 2024) $ +## | Last changed by: $Author: pahlke $ +## | + +test_plan_section("Testing the Class 'ParameterSet'") + +test_that("Test fetch/obtain method", { + .skipTestIfDisabled() + + S <- getDataSet( + events1 = c(11, 12), + events2 = c(6, 7), + n1 = c(36, 39), + n2 = c(38, 40) + ) + R <- getDataSet( + events1 = c(12, 10), + events2 = c(8, 8), + n1 = c(32, 33), + n2 = c(31, 29) + ) + design <- getDesignInverseNormal( + kMax = 2, + typeOfDesign = "noEarlyEfficacy" + ) + dataset <- getDataSet(S1 = S, R = R) + result <- getAnalysisResults( + design, + dataset, + stage = 1, + nPlanned = 150, + intersectionTest = "Simes" + ) + + expect_error(S |> obtain(xxx)) + expect_error(design |> obtain(xxx)) + expect_error(dataset |> obtain(xxx)) + expect_error(result |> obtain("xxx")) + + expect_equal(R |> obtain(sampleSizes), list(sampleSizes = c(32, 31, 33, 29))) + expect_equal(R |> obtain(sampleSizes, "value"), c(32, 31, 33, 29)) + expect_equal(R |> obtain(sampleSizes), list(sampleSizes = c(32, 31, 33, 29))) + + expect_equal(design |> obtain(1), c("kMax" = 2L)) + expect_equal(design |> obtain("kMax"), c("kMax" = 2L)) + expect_equal(design |> obtain(kMax, "value"), 2) + expect_equal(design |> obtain(kMax, "list"), list("kMax" = 2L)) + + expect_equal(dataset |> obtain(overallSampleSizes), list(overallSampleSizes = c(36, 32, 38, 31, 75, 65, 78, 60))) + expect_equal(dataset |> obtain(overallSampleSizes, "value"), c(36, 32, 38, 31, 75, 65, 78, 60)) + expect_equal(dataset |> obtain(overallSampleSizes, "list"), list(overallSampleSizes = c(36, 32, 38, 31, 75, 65, 78, 60))) + + expect_equal(result |> obtain(conditionalPower), list(conditionalPower = matrix(c(NA_real_, NA_real_, 0.81442253, 0.72909925), ncol = 2)), tolerance = 1e-07) + expect_equal(result |> obtain(conditionalPower, "value"), matrix(c(NA_real_, NA_real_, 0.81442253, 0.72909925), ncol = 2), tolerance = 1e-07) + expect_equal(result |> obtain(conditionalPower, "list"), list(conditionalPower = matrix(c(NA_real_, NA_real_, 0.81442253, 0.72909925), ncol = 2)), tolerance = 1e-07) + + expect_equal(result |> fetch(-5), list(repeatedConfidenceIntervalLowerBounds = matrix(rep(NA_real_, 4), ncol = 2)), tolerance = 1e-07) + + expect_equal(result |> fetch(), c(stratifiedAnalysis = TRUE)) +}) diff --git a/tests/testthat/test-f_design_plan_plot.R b/tests/testthat/test-f_design_plan_plot.R index 61a46b15..8c0f5e07 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: 7953 $ -## | Last changed: $Date: 2024-05-29 10:36:52 +0200 (Mi, 29 Mai 2024) $ +## | File version: $Revision: 7961 $ +## | Last changed: $Date: 2024-05-30 14:58:05 +0200 (Thu, 30 May 2024) $ ## | Last changed by: $Author: pahlke $ ## | @@ -68,7 +68,7 @@ test_that(".getTrialDesignPlanTheta function works as expected", { # Test case for .plotTrialDesignPlan function test_that(".plotTrialDesignPlan function works as expected", { - .skipTestIfDisabled() + .skipTestIfDisabled(ignoreInTestPlan = TRUE) design <- getDesignInverseNormal( typeOfDesign = "OF", kMax = 2, alpha = From 7f20297bef2bff711100228189af197d3eceb68d Mon Sep 17 00:00:00 2001 From: Friedrich Pahlke Date: Fri, 31 May 2024 13:50:08 +0200 Subject: [PATCH 3/3] NEWS and DESCRIPTION updated --- DESCRIPTION | 2 +- NEWS.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index c01807e9..c8d4d1cf 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: rpact Title: Confirmatory Adaptive Clinical Trial Design and Analysis Version: 4.0.0 -Date: 2024-05-30 +Date: 2024-05-31 Authors@R: c( person( given = "Gernot", diff --git a/NEWS.md b/NEWS.md index 74233464..9e900452 100644 --- a/NEWS.md +++ b/NEWS.md @@ -7,7 +7,7 @@ * 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 `getSimulationMultiArmMeans()`, `getSimulationMultiArmRates()`, and `getSimulationMultiArmSurvival()` functions now support an enhanced `selectArmsFunction` argument. Previously, only `effectVector` and `stage` were allowed as arguments. Now, users can optionally utilize additional arguments for more powerful custom function implementations, including `conditionalPower`, `conditionalCriticalValue`, `plannedSubjects/plannedEvents`, `allocationRatioPlanned`, `selectedArms`, `thetaH1` (for means and survival), `stDevH1` (for means), `overallEffects`, and for rates additionally: `piTreatmentsH1`, `piControlH1`, `overallRates`, and `overallRatesControl`. * Same as above for`getSimulationEnrichmentMeans()`, `getSimulationEnrichmentRates()`, and `getSimulationEnrichmentSurvival()`. Specifically, support for population selection with `selectPopulationsFunction` argument based on predictive/posterior probabilities added (see [#32](https://github.com/rpact-com/rpact/issues/32)) - +* The `fetch()` and `obtain()` functions can be used to extract a single parameter from an rpact result object, which is useful for writing pipe-operator linked commands ## Improvements, issues, and changes